summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2016-06-16 14:48:35 (GMT)
committerdgp <dgp@users.sourceforge.net>2016-06-16 14:48:35 (GMT)
commitb700360ad9501defb0b1e2d86353ac8d0db8eef4 (patch)
tree8b3bcb3adb8bd2eb44bcf16bb091722274e03e9e
parentc755ef08151343eb145710489f8c999edbef15ff (diff)
parent296aebbd6ee092a25741684fa37ee31ef5a3e222 (diff)
downloadtcl-b700360ad9501defb0b1e2d86353ac8d0db8eef4.zip
tcl-b700360ad9501defb0b1e2d86353ac8d0db8eef4.tar.gz
tcl-b700360ad9501defb0b1e2d86353ac8d0db8eef4.tar.bz2
Merge up to the 8.6.0 release.
-rw-r--r--ChangeLog7831
-rw-r--r--ChangeLog.20004
-rw-r--r--ChangeLog.20012
-rw-r--r--ChangeLog.20032
-rw-r--r--ChangeLog.20083796
-rw-r--r--README31
-rw-r--r--changes526
-rw-r--r--compat/README2
-rw-r--r--compat/dirent.h2
-rw-r--r--compat/dirent2.h2
-rw-r--r--compat/dlfcn.h3
-rw-r--r--compat/fake-rfc2553.c266
-rw-r--r--compat/fake-rfc2553.h170
-rw-r--r--compat/fixstrtod.c2
-rw-r--r--compat/float.h2
-rw-r--r--compat/gettod.c2
-rw-r--r--compat/limits.h2
-rw-r--r--compat/memcmp.c2
-rw-r--r--compat/mkstemp.c2
-rw-r--r--compat/opendir.c2
-rw-r--r--compat/stdlib.h2
-rw-r--r--compat/string.h2
-rw-r--r--compat/strncasecmp.c2
-rw-r--r--compat/strstr.c2
-rw-r--r--compat/strtod.c2
-rw-r--r--compat/strtol.c2
-rw-r--r--compat/strtoul.c2
-rw-r--r--compat/unistd.h2
-rw-r--r--compat/waitpid.c2
-rw-r--r--compat/zlib/CMakeLists.txt75
-rw-r--r--compat/zlib/ChangeLog205
-rw-r--r--compat/zlib/FAQ12
-rw-r--r--compat/zlib/INDEX13
-rw-r--r--compat/zlib/Makefile.in103
-rw-r--r--compat/zlib/README24
-rw-r--r--compat/zlib/adler32.c70
-rw-r--r--compat/zlib/as400/bndsrc (renamed from compat/zlib/old/as400/bndsrc)73
-rw-r--r--compat/zlib/as400/compile.clp110
-rw-r--r--compat/zlib/as400/readme.txt (renamed from compat/zlib/old/as400/readme.txt)14
-rw-r--r--compat/zlib/as400/zlib.inc (renamed from compat/zlib/old/as400/zlib.inc)154
-rw-r--r--compat/zlib/compress.c2
-rwxr-xr-xcompat/zlib/configure500
-rw-r--r--compat/zlib/contrib/ada/buffer_demo.adb2
-rw-r--r--compat/zlib/contrib/ada/mtest.adb2
-rw-r--r--compat/zlib/contrib/ada/read.adb2
-rw-r--r--compat/zlib/contrib/ada/test.adb2
-rw-r--r--compat/zlib/contrib/ada/zlib-streams.adb2
-rw-r--r--compat/zlib/contrib/ada/zlib-streams.ads2
-rw-r--r--compat/zlib/contrib/ada/zlib-thin.adb2
-rw-r--r--compat/zlib/contrib/ada/zlib-thin.ads2
-rw-r--r--compat/zlib/contrib/ada/zlib.adb2
-rw-r--r--compat/zlib/contrib/ada/zlib.ads2
-rw-r--r--compat/zlib/contrib/asm586/README.58643
-rw-r--r--compat/zlib/contrib/asm586/match.S364
-rw-r--r--compat/zlib/contrib/asm686/match.S16
-rw-r--r--compat/zlib/contrib/delphi/ZLib.pas2
-rw-r--r--compat/zlib/contrib/delphi/zlibd32.mak4
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs2
-rw-r--r--compat/zlib/contrib/infback9/inftree9.c6
-rw-r--r--compat/zlib/contrib/iostream2/zstream.h2
-rw-r--r--compat/zlib/contrib/masm686/match.asm413
-rw-r--r--compat/zlib/contrib/masmx64/gvmat64.objbin4119 -> 0 bytes
-rw-r--r--compat/zlib/contrib/masmx64/inffasx64.objbin5913 -> 0 bytes
-rw-r--r--compat/zlib/contrib/masmx86/gvmat32.asm972
-rw-r--r--compat/zlib/contrib/masmx86/gvmat32.objbin10241 -> 0 bytes
-rw-r--r--compat/zlib/contrib/masmx86/gvmat32c.c62
-rw-r--r--compat/zlib/contrib/masmx86/inffas32.asm9
-rw-r--r--compat/zlib/contrib/masmx86/inffas32.objbin14893 -> 0 bytes
-rw-r--r--compat/zlib/contrib/masmx86/match686.asm1
-rwxr-xr-xcompat/zlib/contrib/masmx86/mkasm.bat3
-rw-r--r--compat/zlib/contrib/minizip/ChangeLogUnzip67
-rw-r--r--compat/zlib/contrib/minizip/Makefile.am45
-rw-r--r--compat/zlib/contrib/minizip/configure.ac32
-rw-r--r--compat/zlib/contrib/minizip/ioapi.c22
-rw-r--r--compat/zlib/contrib/minizip/ioapi.h10
-rw-r--r--compat/zlib/contrib/minizip/miniunz.c38
-rw-r--r--compat/zlib/contrib/minizip/minizip.c39
-rw-r--r--compat/zlib/contrib/minizip/minizip.pc.in12
-rw-r--r--compat/zlib/contrib/minizip/mztools.c24
-rw-r--r--compat/zlib/contrib/minizip/mztools.h6
-rw-r--r--compat/zlib/contrib/minizip/unzip.c12
-rw-r--r--compat/zlib/contrib/minizip/zip.c13
-rw-r--r--compat/zlib/contrib/pascal/zlibd32.mak4
-rw-r--r--compat/zlib/contrib/pascal/zlibpas.pas42
-rw-r--r--compat/zlib/contrib/puff/Makefile40
-rw-r--r--compat/zlib/contrib/puff/puff.c252
-rw-r--r--compat/zlib/contrib/puff/puff.h8
-rw-r--r--compat/zlib/contrib/puff/pufftest.c165
-rw-r--r--compat/zlib/contrib/puff/zeros.rawbin1213 -> 2517 bytes
-rw-r--r--compat/zlib/contrib/vstudio/readme.txt14
-rw-r--r--compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj12
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlib.rc8
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibvc.def11
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj22
-rw-r--r--compat/zlib/contrib/vstudio/vc7/miniunz.vcproj126
-rw-r--r--compat/zlib/contrib/vstudio/vc7/minizip.vcproj126
-rw-r--r--compat/zlib/contrib/vstudio/vc7/testzlib.vcproj126
-rw-r--r--compat/zlib/contrib/vstudio/vc7/zlib.rc32
-rw-r--r--compat/zlib/contrib/vstudio/vc7/zlibstat.vcproj246
-rw-r--r--compat/zlib/contrib/vstudio/vc7/zlibvc.def92
-rw-r--r--compat/zlib/contrib/vstudio/vc7/zlibvc.sln78
-rw-r--r--compat/zlib/contrib/vstudio/vc7/zlibvc.vcproj445
-rw-r--r--compat/zlib/contrib/vstudio/vc8/miniunz.vcproj566
-rw-r--r--compat/zlib/contrib/vstudio/vc8/minizip.vcproj563
-rw-r--r--compat/zlib/contrib/vstudio/vc8/testzlib.vcproj948
-rw-r--r--compat/zlib/contrib/vstudio/vc8/testzlibdll.vcproj567
-rw-r--r--compat/zlib/contrib/vstudio/vc8/zlib.rc32
-rw-r--r--compat/zlib/contrib/vstudio/vc8/zlibstat.vcproj870
-rw-r--r--compat/zlib/contrib/vstudio/vc8/zlibvc.def92
-rw-r--r--compat/zlib/contrib/vstudio/vc8/zlibvc.sln144
-rw-r--r--compat/zlib/contrib/vstudio/vc8/zlibvc.vcproj1219
-rw-r--r--compat/zlib/contrib/vstudio/vc9/zlib.rc8
-rw-r--r--compat/zlib/contrib/vstudio/vc9/zlibvc.def11
-rw-r--r--compat/zlib/crc32.c85
-rw-r--r--compat/zlib/crc32.h2
-rw-r--r--compat/zlib/deflate.c261
-rw-r--r--compat/zlib/deflate.h12
-rw-r--r--compat/zlib/doc/algorithm.txt2
-rw-r--r--compat/zlib/gzguts.h87
-rw-r--r--compat/zlib/gzlib.c165
-rw-r--r--compat/zlib/gzread.c418
-rw-r--r--compat/zlib/gzwrite.c146
-rw-r--r--compat/zlib/infback.c14
-rw-r--r--compat/zlib/inffixed.h6
-rw-r--r--compat/zlib/inflate.c90
-rw-r--r--compat/zlib/inftrees.c46
-rw-r--r--compat/zlib/make_vms.com403
-rw-r--r--compat/zlib/msdos/Makefile.bor4
-rw-r--r--compat/zlib/msdos/Makefile.msc4
-rw-r--r--compat/zlib/msdos/Makefile.tc4
-rw-r--r--compat/zlib/old/Makefile.emx (renamed from compat/zlib/win32/Makefile.emx)0
-rw-r--r--compat/zlib/old/as400/compile.clp123
-rw-r--r--compat/zlib/old/visualc6/README.txt73
-rw-r--r--compat/zlib/old/visualc6/example.dsp278
-rw-r--r--compat/zlib/old/visualc6/minigzip.dsp278
-rw-r--r--compat/zlib/old/visualc6/zlib.dsp621
-rw-r--r--compat/zlib/old/visualc6/zlib.dsw59
-rw-r--r--compat/zlib/qnx/package.qpg10
-rw-r--r--compat/zlib/test/example.c (renamed from compat/zlib/example.c)84
-rw-r--r--compat/zlib/test/infcover.c671
-rw-r--r--compat/zlib/test/minigzip.c (renamed from compat/zlib/minigzip.c)195
-rw-r--r--compat/zlib/treebuild.xml4
-rw-r--r--compat/zlib/trees.c42
-rw-r--r--compat/zlib/uncompr.c2
-rw-r--r--compat/zlib/win32/Makefile.bor4
-rw-r--r--compat/zlib/win32/Makefile.gcc72
-rw-r--r--compat/zlib/win32/Makefile.msc13
-rw-r--r--compat/zlib/win32/README-WIN32.txt8
-rw-r--r--compat/zlib/win32/zdll.libbin13438 -> 15256 bytes
-rw-r--r--compat/zlib/win32/zlib.def14
-rw-r--r--compat/zlib/win32/zlib1.dllbin100352 -> 107520 bytes
-rw-r--r--compat/zlib/win64/zdll.libbin0 -> 14896 bytes
-rw-r--r--compat/zlib/win64/zlib1.dllbin0 -> 112640 bytes
-rw-r--r--compat/zlib/zconf.h198
-rw-r--r--compat/zlib/zconf.h.cmakein198
-rw-r--r--compat/zlib/zconf.h.in198
-rw-r--r--compat/zlib/zlib.318
-rw-r--r--compat/zlib/zlib.3.pdfbin8686 -> 8760 bytes
-rw-r--r--compat/zlib/zlib.h309
-rw-r--r--compat/zlib/zlib.map10
-rw-r--r--compat/zlib/zlib.pc.cmakein13
-rw-r--r--compat/zlib/zutil.c26
-rw-r--r--compat/zlib/zutil.h100
-rw-r--r--doc/Access.32
-rw-r--r--doc/AddErrInfo.316
-rw-r--r--doc/Alloc.32
-rw-r--r--doc/AllowExc.32
-rw-r--r--doc/AppInit.32
-rw-r--r--doc/AssocData.32
-rw-r--r--doc/Async.32
-rw-r--r--doc/BackgdErr.32
-rw-r--r--doc/Backslash.32
-rw-r--r--doc/BoolObj.36
-rw-r--r--doc/ByteArrObj.348
-rw-r--r--doc/CallDel.32
-rw-r--r--doc/Cancel.32
-rw-r--r--doc/ChnlStack.32
-rw-r--r--doc/Class.36
-rw-r--r--doc/CmdCmplt.32
-rw-r--r--doc/Concat.32
-rw-r--r--doc/CrtChannel.36
-rw-r--r--doc/CrtChnlHdlr.31
-rw-r--r--doc/CrtCloseHdlr.31
-rw-r--r--doc/CrtCommand.314
-rw-r--r--doc/CrtFileHdlr.32
-rw-r--r--doc/CrtInterp.34
-rw-r--r--doc/CrtMathFnc.313
-rw-r--r--doc/CrtObjCmd.322
-rw-r--r--doc/CrtSlave.324
-rw-r--r--doc/CrtTimerHdlr.32
-rw-r--r--doc/CrtTrace.32
-rw-r--r--doc/DString.32
-rw-r--r--doc/DetachPids.32
-rw-r--r--doc/DictObj.336
-rw-r--r--doc/DoOneEvent.32
-rw-r--r--doc/DoWhenIdle.32
-rw-r--r--doc/DoubleObj.328
-rw-r--r--doc/DumpActiveMemory.32
-rw-r--r--doc/Encoding.32
-rw-r--r--doc/Ensemble.38
-rw-r--r--doc/Environment.32
-rw-r--r--doc/Eval.327
-rw-r--r--doc/Exit.32
-rw-r--r--doc/ExprLong.310
-rw-r--r--doc/ExprLongObj.314
-rw-r--r--doc/FileSystem.3163
-rw-r--r--doc/FindExec.39
-rwxr-xr-xdoc/GetCwd.32
-rw-r--r--doc/GetHostName.32
-rw-r--r--doc/GetIndex.320
-rw-r--r--doc/GetInt.32
-rw-r--r--doc/GetOpnFl.31
-rw-r--r--doc/GetStdChan.34
-rw-r--r--doc/GetTime.326
-rwxr-xr-xdoc/GetVersion.32
-rw-r--r--doc/Hash.312
-rw-r--r--doc/Init.32
-rw-r--r--doc/InitStubs.38
-rw-r--r--doc/IntObj.333
-rw-r--r--doc/Interp.32
-rw-r--r--doc/Limit.32
-rw-r--r--doc/LinkVar.32
-rw-r--r--doc/ListObj.3119
-rw-r--r--doc/Load.35
-rw-r--r--doc/Method.34
-rw-r--r--doc/NRE.310
-rw-r--r--doc/Namespace.36
-rw-r--r--doc/Notifier.36
-rw-r--r--doc/Object.3180
-rw-r--r--doc/ObjectType.365
-rw-r--r--doc/OpenFileChnl.329
-rw-r--r--doc/OpenTcp.31
-rw-r--r--doc/Panic.322
-rw-r--r--doc/ParseArgs.36
-rw-r--r--doc/ParseCmd.36
-rw-r--r--doc/PkgRequire.32
-rw-r--r--doc/Preserve.32
-rw-r--r--doc/PrintDbl.32
-rw-r--r--doc/RecEvalObj.38
-rw-r--r--doc/RecordEval.38
-rw-r--r--doc/RegConfig.33
-rw-r--r--doc/RegExp.322
-rw-r--r--doc/SaveResult.36
-rw-r--r--doc/SetChanErr.311
-rw-r--r--doc/SetErrno.31
-rw-r--r--doc/SetRecLmt.32
-rw-r--r--doc/SetResult.344
-rw-r--r--doc/SetVar.310
-rw-r--r--doc/Signal.31
-rw-r--r--doc/Sleep.32
-rw-r--r--doc/SourceRCFile.33
-rw-r--r--doc/SplitList.36
-rw-r--r--doc/SplitPath.34
-rw-r--r--doc/StaticPkg.32
-rw-r--r--doc/StdChannels.32
-rw-r--r--doc/StrMatch.32
-rw-r--r--doc/StringObj.3113
-rw-r--r--doc/SubstObj.38
-rw-r--r--doc/TCL_MEM_DEBUG.34
-rw-r--r--doc/Tcl.n40
-rw-r--r--doc/TclZlib.346
-rw-r--r--doc/Tcl_Main.35
-rw-r--r--doc/Thread.314
-rw-r--r--doc/ToUpper.32
-rw-r--r--doc/TraceCmd.32
-rw-r--r--doc/TraceVar.32
-rw-r--r--doc/Translate.313
-rw-r--r--doc/UniCharIsAlpha.32
-rw-r--r--doc/UpVar.32
-rw-r--r--doc/Utf.32
-rw-r--r--doc/WrongNumArgs.316
-rw-r--r--doc/after.n6
-rw-r--r--doc/append.n2
-rw-r--r--doc/array.n2
-rw-r--r--doc/bgerror.n2
-rw-r--r--doc/binary.n10
-rw-r--r--doc/break.n4
-rw-r--r--doc/case.n2
-rw-r--r--doc/catch.n10
-rw-r--r--doc/cd.n2
-rw-r--r--doc/chan.n38
-rw-r--r--doc/class.n2
-rw-r--r--doc/clock.n8
-rw-r--r--doc/close.n25
-rw-r--r--doc/concat.n2
-rw-r--r--doc/continue.n6
-rw-r--r--doc/copy.n23
-rw-r--r--doc/coroutine.n60
-rw-r--r--doc/dde.n37
-rw-r--r--doc/define.n193
-rw-r--r--doc/dict.n52
-rw-r--r--doc/encoding.n2
-rw-r--r--doc/eof.n2
-rw-r--r--doc/error.n13
-rw-r--r--doc/eval.n2
-rw-r--r--doc/exec.n4
-rw-r--r--doc/exit.n2
-rw-r--r--doc/expr.n63
-rw-r--r--doc/fblocked.n2
-rw-r--r--doc/fconfigure.n2
-rw-r--r--doc/fcopy.n2
-rw-r--r--doc/file.n20
-rw-r--r--doc/fileevent.n6
-rw-r--r--doc/filename.n4
-rw-r--r--doc/flush.n2
-rw-r--r--doc/for.n2
-rw-r--r--doc/foreach.n2
-rw-r--r--doc/format.n5
-rw-r--r--doc/gets.n12
-rw-r--r--doc/glob.n7
-rw-r--r--doc/global.n2
-rw-r--r--doc/history.n2
-rw-r--r--doc/http.n9
-rw-r--r--doc/if.n2
-rw-r--r--doc/incr.n2
-rw-r--r--doc/info.n144
-rw-r--r--doc/interp.n72
-rw-r--r--doc/join.n2
-rw-r--r--doc/lappend.n2
-rw-r--r--doc/lassign.n12
-rw-r--r--doc/library.n1
-rw-r--r--doc/lindex.n12
-rw-r--r--doc/linsert.n2
-rw-r--r--doc/list.n2
-rw-r--r--doc/llength.n2
-rw-r--r--doc/lmap.n85
-rw-r--r--doc/load.n24
-rw-r--r--doc/lrange.n2
-rw-r--r--doc/lrepeat.n2
-rw-r--r--doc/lreplace.n2
-rw-r--r--doc/lreverse.n2
-rw-r--r--doc/lsearch.n4
-rwxr-xr-xdoc/lset.n10
-rw-r--r--doc/lsort.n16
-rw-r--r--doc/man.macros2
-rw-r--r--doc/mathfunc.n17
-rw-r--r--doc/mathop.n17
-rw-r--r--doc/memory.n2
-rw-r--r--doc/msgcat.n51
-rw-r--r--doc/my.n4
-rw-r--r--doc/namespace.n7
-rw-r--r--doc/next.n20
-rw-r--r--doc/object.n29
-rw-r--r--doc/open.n45
-rw-r--r--doc/package.n8
-rw-r--r--doc/packagens.n12
-rw-r--r--doc/pid.n2
-rw-r--r--doc/pkgMkIndex.n11
-rw-r--r--doc/platform.n26
-rw-r--r--doc/platform_shell.n2
-rw-r--r--doc/prefix.n2
-rw-r--r--doc/proc.n6
-rw-r--r--doc/puts.n2
-rw-r--r--doc/pwd.n2
-rw-r--r--doc/re_syntax.n44
-rw-r--r--doc/read.n9
-rw-r--r--doc/refchan.n7
-rw-r--r--doc/regexp.n2
-rw-r--r--doc/registry.n6
-rw-r--r--doc/regsub.n2
-rw-r--r--doc/rename.n2
-rw-r--r--doc/return.n5
-rw-r--r--doc/safe.n15
-rw-r--r--doc/scan.n2
-rw-r--r--doc/seek.n8
-rw-r--r--doc/self.n37
-rw-r--r--doc/set.n2
-rw-r--r--doc/socket.n129
-rw-r--r--doc/source.n2
-rw-r--r--doc/split.n2
-rw-r--r--doc/string.n37
-rw-r--r--doc/subst.n2
-rw-r--r--doc/switch.n2
-rw-r--r--doc/tailcall.n2
-rw-r--r--doc/tclsh.14
-rw-r--r--doc/tcltest.n6
-rw-r--r--doc/tclvars.n87
-rw-r--r--doc/tell.n2
-rw-r--r--doc/throw.n4
-rw-r--r--doc/time.n2
-rw-r--r--doc/tm.n2
-rw-r--r--doc/trace.n4
-rw-r--r--doc/transchan.n5
-rw-r--r--doc/try.n2
-rw-r--r--doc/unknown.n2
-rw-r--r--doc/unload.n2
-rw-r--r--doc/unset.n8
-rw-r--r--doc/update.n2
-rw-r--r--doc/uplevel.n2
-rw-r--r--doc/upvar.n5
-rw-r--r--doc/variable.n2
-rw-r--r--doc/vwait.n2
-rw-r--r--doc/while.n2
-rw-r--r--doc/zlib.n138
-rw-r--r--generic/README2
-rw-r--r--generic/regc_lex.c35
-rw-r--r--generic/regc_locale.c931
-rw-r--r--generic/regcomp.c4
-rw-r--r--generic/regcustom.h2
-rw-r--r--generic/tcl.decls26
-rw-r--r--generic/tcl.h208
-rw-r--r--generic/tclAlloc.c26
-rw-r--r--generic/tclAssembly.c4357
-rw-r--r--generic/tclAsync.c6
-rw-r--r--generic/tclBasic.c957
-rw-r--r--generic/tclBinary.c196
-rw-r--r--generic/tclCkalloc.c159
-rw-r--r--generic/tclClock.c24
-rw-r--r--generic/tclCmdAH.c1980
-rw-r--r--generic/tclCmdIL.c537
-rw-r--r--generic/tclCmdMZ.c455
-rw-r--r--generic/tclCompCmds.c2760
-rw-r--r--generic/tclCompCmdsSZ.c745
-rw-r--r--generic/tclCompExpr.c636
-rw-r--r--generic/tclCompile.c577
-rw-r--r--generic/tclCompile.h62
-rw-r--r--generic/tclConfig.c40
-rw-r--r--generic/tclDTrace.d18
-rw-r--r--generic/tclDate.c9
-rw-r--r--generic/tclDecls.h47
-rw-r--r--generic/tclDictObj.c866
-rw-r--r--generic/tclEncoding.c54
-rw-r--r--generic/tclEnsemble.c293
-rw-r--r--generic/tclEnv.c60
-rw-r--r--generic/tclEvent.c108
-rw-r--r--generic/tclExecute.c1562
-rw-r--r--generic/tclFCmd.c583
-rw-r--r--generic/tclFileName.c356
-rw-r--r--generic/tclFileSystem.h57
-rw-r--r--generic/tclGet.c4
-rw-r--r--generic/tclGetDate.y10
-rw-r--r--generic/tclHash.c42
-rw-r--r--generic/tclHistory.c6
-rw-r--r--generic/tclIO.c377
-rw-r--r--generic/tclIO.h15
-rw-r--r--generic/tclIOCmd.c368
-rw-r--r--generic/tclIOGT.c18
-rw-r--r--generic/tclIORChan.c446
-rw-r--r--generic/tclIORTrans.c362
-rw-r--r--generic/tclIOSock.c182
-rw-r--r--generic/tclIOUtil.c476
-rw-r--r--generic/tclIndexObj.c240
-rw-r--r--generic/tclInt.decls122
-rw-r--r--generic/tclInt.h388
-rw-r--r--generic/tclIntDecls.h56
-rw-r--r--generic/tclIntPlatDecls.h215
-rw-r--r--generic/tclInterp.c502
-rw-r--r--generic/tclLink.c20
-rw-r--r--generic/tclListObj.c775
-rw-r--r--generic/tclLiteral.c140
-rw-r--r--generic/tclLoad.c336
-rw-r--r--generic/tclLoadNone.c9
-rw-r--r--generic/tclMain.c487
-rw-r--r--generic/tclNamesp.c777
-rw-r--r--generic/tclNotify.c15
-rw-r--r--generic/tclOO.c803
-rw-r--r--generic/tclOO.decls4
-rw-r--r--generic/tclOO.h21
-rw-r--r--generic/tclOOBasic.c375
-rw-r--r--generic/tclOOCall.c271
-rw-r--r--generic/tclOODecls.h93
-rw-r--r--generic/tclOODefineCmds.c1309
-rw-r--r--generic/tclOOInfo.c288
-rw-r--r--generic/tclOOInt.h54
-rw-r--r--generic/tclOOIntDecls.h57
-rw-r--r--generic/tclOOMethod.c134
-rw-r--r--generic/tclOOStubInit.c2
-rw-r--r--generic/tclOOStubLib.c12
-rw-r--r--generic/tclObj.c235
-rw-r--r--generic/tclPanic.c33
-rw-r--r--generic/tclParse.c182
-rw-r--r--generic/tclParse.h17
-rw-r--r--generic/tclPathObj.c389
-rw-r--r--generic/tclPipe.c133
-rw-r--r--generic/tclPkg.c215
-rw-r--r--generic/tclPkgConfig.c6
-rw-r--r--generic/tclPlatDecls.h12
-rw-r--r--generic/tclPort.h12
-rw-r--r--generic/tclPosixStr.c10
-rw-r--r--generic/tclPreserve.c38
-rw-r--r--generic/tclProc.c280
-rw-r--r--generic/tclRegexp.c24
-rw-r--r--generic/tclRegexp.h2
-rw-r--r--generic/tclResolve.c12
-rw-r--r--generic/tclResult.c153
-rw-r--r--generic/tclScan.c89
-rwxr-xr-xgeneric/tclStrToD.c3113
-rw-r--r--generic/tclStringObj.c434
-rw-r--r--generic/tclStubInit.c203
-rw-r--r--generic/tclStubLib.c32
-rw-r--r--generic/tclTest.c611
-rw-r--r--generic/tclTestObj.c185
-rw-r--r--generic/tclTestProcBodyObj.c2
-rw-r--r--generic/tclThread.c17
-rwxr-xr-xgeneric/tclThreadAlloc.c57
-rw-r--r--generic/tclThreadJoin.c6
-rw-r--r--generic/tclThreadStorage.c4
-rw-r--r--generic/tclThreadTest.c55
-rw-r--r--generic/tclTimer.c110
-rw-r--r--generic/tclTomMath.decls11
-rw-r--r--generic/tclTomMath.h8
-rw-r--r--generic/tclTomMathDecls.h22
-rw-r--r--generic/tclTomMathInt.h1
-rw-r--r--generic/tclTomMathInterface.c2
-rw-r--r--generic/tclTomMathStubLib.c10
-rw-r--r--generic/tclTrace.c152
-rw-r--r--generic/tclUniData.c2052
-rw-r--r--generic/tclUtf.c78
-rw-r--r--generic/tclUtil.c2413
-rw-r--r--generic/tclVar.c206
-rw-r--r--generic/tclZlib.c2287
-rw-r--r--library/auto.tcl11
-rw-r--r--library/clock.tcl37
-rw-r--r--library/dde/pkgIndex.tcl10
-rw-r--r--library/history.tcl4
-rw-r--r--library/http/http.tcl43
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--library/http1.0/http.tcl2
-rw-r--r--library/init.tcl49
-rw-r--r--library/msgcat/msgcat.tcl156
-rw-r--r--library/msgcat/pkgIndex.tcl2
-rwxr-xr-xlibrary/msgs/uk.msg2
-rw-r--r--library/opt/optparse.tcl2
-rw-r--r--library/package.tcl4
-rw-r--r--library/parray.tcl2
-rw-r--r--library/platform/pkgIndex.tcl2
-rw-r--r--library/platform/platform.tcl87
-rw-r--r--library/platform/shell.tcl2
-rwxr-xr-xlibrary/reg/pkgIndex.tcl10
-rw-r--r--library/safe.tcl159
-rw-r--r--library/tcltest/pkgIndex.tcl2
-rw-r--r--library/tcltest/tcltest.tcl51
-rw-r--r--library/tzdata/Africa/Cairo178
-rw-r--r--library/tzdata/Africa/Casablanca180
-rw-r--r--library/tzdata/Africa/Dar_es_Salaam4
-rw-r--r--library/tzdata/Africa/Juba39
-rw-r--r--library/tzdata/Africa/Kampala4
-rw-r--r--library/tzdata/Africa/Nairobi4
-rw-r--r--library/tzdata/America/Araguaina175
-rwxr-xr-xlibrary/tzdata/America/Atikokan2
-rw-r--r--library/tzdata/America/Bahia3
-rwxr-xr-xlibrary/tzdata/America/Blanc-Sablon2
-rw-r--r--library/tzdata/America/Creston8
-rw-r--r--library/tzdata/America/Dawson_Creek2
-rw-r--r--library/tzdata/America/Edmonton2
-rw-r--r--library/tzdata/America/Glace_Bay2
-rw-r--r--library/tzdata/America/Goose_Bay357
-rw-r--r--library/tzdata/America/Halifax2
-rw-r--r--library/tzdata/America/Havana182
-rw-r--r--library/tzdata/America/Juneau5
-rw-r--r--library/tzdata/America/Kralendijk5
-rw-r--r--library/tzdata/America/Lower_Princes5
-rw-r--r--library/tzdata/America/Metlakatla43
-rwxr-xr-xlibrary/tzdata/America/Moncton2
-rw-r--r--library/tzdata/America/Montreal2
-rw-r--r--library/tzdata/America/Nipigon2
-rw-r--r--library/tzdata/America/North_Dakota/Beulah279
-rw-r--r--library/tzdata/America/Port-au-Prince2
-rw-r--r--library/tzdata/America/Rainy_River2
-rw-r--r--library/tzdata/America/Regina2
-rwxr-xr-xlibrary/tzdata/America/Resolute373
-rw-r--r--library/tzdata/America/Santiago8
-rw-r--r--library/tzdata/America/Sitka275
-rw-r--r--library/tzdata/America/St_Johns357
-rw-r--r--library/tzdata/America/Swift_Current2
-rw-r--r--library/tzdata/America/Toronto2
-rw-r--r--library/tzdata/America/Vancouver2
-rw-r--r--library/tzdata/America/Winnipeg2
-rw-r--r--library/tzdata/Antarctica/Casey2
-rw-r--r--library/tzdata/Antarctica/Davis2
-rw-r--r--library/tzdata/Antarctica/Palmer12
-rw-r--r--library/tzdata/Asia/Amman3
-rw-r--r--library/tzdata/Asia/Anadyr179
-rw-r--r--library/tzdata/Asia/Damascus176
-rw-r--r--library/tzdata/Asia/Gaza185
-rw-r--r--library/tzdata/Asia/Hebron104
-rw-r--r--library/tzdata/Asia/Hong_Kong2
-rw-r--r--library/tzdata/Asia/Irkutsk179
-rw-r--r--library/tzdata/Asia/Jerusalem182
-rw-r--r--library/tzdata/Asia/Kamchatka179
-rw-r--r--library/tzdata/Asia/Krasnoyarsk179
-rw-r--r--library/tzdata/Asia/Magadan179
-rw-r--r--library/tzdata/Asia/Novokuznetsk179
-rw-r--r--library/tzdata/Asia/Novosibirsk179
-rw-r--r--library/tzdata/Asia/Omsk179
-rw-r--r--library/tzdata/Asia/Sakhalin179
-rw-r--r--library/tzdata/Asia/Vladivostok179
-rw-r--r--library/tzdata/Asia/Yakutsk179
-rw-r--r--library/tzdata/Asia/Yekaterinburg179
-rw-r--r--library/tzdata/Asia/Yerevan177
-rw-r--r--library/tzdata/Atlantic/Stanley180
-rw-r--r--library/tzdata/Europe/Istanbul3
-rw-r--r--library/tzdata/Europe/Kaliningrad179
-rw-r--r--library/tzdata/Europe/Minsk179
-rw-r--r--library/tzdata/Europe/Moscow179
-rw-r--r--library/tzdata/Europe/Samara179
-rwxr-xr-xlibrary/tzdata/Europe/Volgograd179
-rw-r--r--library/tzdata/Pacific/Apia180
-rw-r--r--library/tzdata/Pacific/Easter8
-rw-r--r--library/tzdata/Pacific/Fakaofo3
-rw-r--r--library/tzdata/Pacific/Fiji179
-rw-r--r--library/tzdata/Pacific/Honolulu7
-rw-r--r--library/word.tcl6
-rw-r--r--libtommath/bn_error.c4
-rw-r--r--libtommath/bn_fast_mp_invmod.c4
-rw-r--r--libtommath/bn_fast_mp_montgomery_reduce.c4
-rw-r--r--libtommath/bn_fast_s_mp_mul_digs.c4
-rw-r--r--libtommath/bn_fast_s_mp_mul_high_digs.c4
-rw-r--r--libtommath/bn_fast_s_mp_sqr.c4
-rw-r--r--libtommath/bn_mp_2expt.c4
-rw-r--r--libtommath/bn_mp_abs.c4
-rw-r--r--libtommath/bn_mp_add.c4
-rw-r--r--libtommath/bn_mp_add_d.c5
-rw-r--r--libtommath/bn_mp_addmod.c4
-rw-r--r--libtommath/bn_mp_and.c4
-rw-r--r--libtommath/bn_mp_clamp.c4
-rw-r--r--libtommath/bn_mp_clear.c4
-rw-r--r--libtommath/bn_mp_clear_multi.c4
-rw-r--r--libtommath/bn_mp_cmp.c4
-rw-r--r--libtommath/bn_mp_cmp_d.c4
-rw-r--r--libtommath/bn_mp_cmp_mag.c4
-rw-r--r--libtommath/bn_mp_cnt_lsb.c6
-rw-r--r--libtommath/bn_mp_copy.c4
-rw-r--r--libtommath/bn_mp_count_bits.c4
-rw-r--r--libtommath/bn_mp_div.c4
-rw-r--r--libtommath/bn_mp_div_2.c4
-rw-r--r--libtommath/bn_mp_div_2d.c4
-rw-r--r--libtommath/bn_mp_div_3.c4
-rw-r--r--libtommath/bn_mp_div_d.c6
-rw-r--r--libtommath/bn_mp_dr_is_modulus.c4
-rw-r--r--libtommath/bn_mp_dr_reduce.c4
-rw-r--r--libtommath/bn_mp_dr_setup.c4
-rw-r--r--libtommath/bn_mp_exch.c4
-rw-r--r--libtommath/bn_mp_expt_d.c4
-rw-r--r--libtommath/bn_mp_exptmod.c4
-rw-r--r--libtommath/bn_mp_exptmod_fast.c5
-rw-r--r--libtommath/bn_mp_exteuclid.c4
-rw-r--r--libtommath/bn_mp_fread.c4
-rw-r--r--libtommath/bn_mp_fwrite.c4
-rw-r--r--libtommath/bn_mp_gcd.c4
-rw-r--r--libtommath/bn_mp_get_int.c4
-rw-r--r--libtommath/bn_mp_grow.c4
-rw-r--r--libtommath/bn_mp_init.c4
-rw-r--r--libtommath/bn_mp_init_copy.c4
-rw-r--r--libtommath/bn_mp_init_multi.c4
-rw-r--r--libtommath/bn_mp_init_set.c4
-rw-r--r--libtommath/bn_mp_init_set_int.c4
-rw-r--r--libtommath/bn_mp_init_size.c4
-rw-r--r--libtommath/bn_mp_invmod.c4
-rw-r--r--libtommath/bn_mp_invmod_slow.c4
-rw-r--r--libtommath/bn_mp_is_square.c4
-rw-r--r--libtommath/bn_mp_jacobi.c4
-rw-r--r--libtommath/bn_mp_karatsuba_mul.c4
-rw-r--r--libtommath/bn_mp_karatsuba_sqr.c4
-rw-r--r--libtommath/bn_mp_lcm.c4
-rw-r--r--libtommath/bn_mp_lshd.c4
-rw-r--r--libtommath/bn_mp_mod.c4
-rw-r--r--libtommath/bn_mp_mod_2d.c4
-rw-r--r--libtommath/bn_mp_mod_d.c4
-rw-r--r--libtommath/bn_mp_montgomery_calc_normalization.c4
-rw-r--r--libtommath/bn_mp_montgomery_reduce.c4
-rw-r--r--libtommath/bn_mp_montgomery_setup.c6
-rw-r--r--libtommath/bn_mp_mul.c4
-rw-r--r--libtommath/bn_mp_mul_2.c4
-rw-r--r--libtommath/bn_mp_mul_2d.c4
-rw-r--r--libtommath/bn_mp_mul_d.c4
-rw-r--r--libtommath/bn_mp_mulmod.c4
-rw-r--r--libtommath/bn_mp_n_root.c4
-rw-r--r--libtommath/bn_mp_neg.c4
-rw-r--r--libtommath/bn_mp_or.c4
-rw-r--r--libtommath/bn_mp_prime_fermat.c4
-rw-r--r--libtommath/bn_mp_prime_is_divisible.c4
-rw-r--r--libtommath/bn_mp_prime_is_prime.c4
-rw-r--r--libtommath/bn_mp_prime_miller_rabin.c4
-rw-r--r--libtommath/bn_mp_prime_next_prime.c6
-rw-r--r--libtommath/bn_mp_prime_rabin_miller_trials.c4
-rw-r--r--libtommath/bn_mp_prime_random_ex.c4
-rw-r--r--libtommath/bn_mp_radix_size.c5
-rw-r--r--libtommath/bn_mp_radix_smap.c4
-rw-r--r--libtommath/bn_mp_rand.c4
-rw-r--r--libtommath/bn_mp_read_radix.c6
-rw-r--r--libtommath/bn_mp_read_signed_bin.c4
-rw-r--r--libtommath/bn_mp_read_unsigned_bin.c4
-rw-r--r--libtommath/bn_mp_reduce.c4
-rw-r--r--libtommath/bn_mp_reduce_2k.c4
-rw-r--r--libtommath/bn_mp_reduce_2k_l.c4
-rw-r--r--libtommath/bn_mp_reduce_2k_setup.c4
-rw-r--r--libtommath/bn_mp_reduce_2k_setup_l.c4
-rw-r--r--libtommath/bn_mp_reduce_is_2k.c4
-rw-r--r--libtommath/bn_mp_reduce_is_2k_l.c4
-rw-r--r--libtommath/bn_mp_reduce_setup.c4
-rw-r--r--libtommath/bn_mp_rshd.c4
-rw-r--r--libtommath/bn_mp_set.c4
-rw-r--r--libtommath/bn_mp_set_int.c4
-rw-r--r--libtommath/bn_mp_shrink.c15
-rw-r--r--libtommath/bn_mp_signed_bin_size.c4
-rw-r--r--libtommath/bn_mp_sqr.c4
-rw-r--r--libtommath/bn_mp_sqrmod.c4
-rw-r--r--libtommath/bn_mp_sqrt.c5
-rw-r--r--libtommath/bn_mp_sub.c4
-rw-r--r--libtommath/bn_mp_sub_d.c4
-rw-r--r--libtommath/bn_mp_submod.c4
-rw-r--r--libtommath/bn_mp_to_signed_bin.c4
-rw-r--r--libtommath/bn_mp_to_signed_bin_n.c4
-rw-r--r--libtommath/bn_mp_to_unsigned_bin.c4
-rw-r--r--libtommath/bn_mp_to_unsigned_bin_n.c4
-rw-r--r--libtommath/bn_mp_toom_mul.c4
-rw-r--r--libtommath/bn_mp_toom_sqr.c4
-rw-r--r--libtommath/bn_mp_toradix.c4
-rw-r--r--libtommath/bn_mp_toradix_n.c4
-rw-r--r--libtommath/bn_mp_unsigned_bin_size.c4
-rw-r--r--libtommath/bn_mp_xor.c4
-rw-r--r--libtommath/bn_mp_zero.c4
-rw-r--r--libtommath/bn_prime_tab.c4
-rw-r--r--libtommath/bn_reverse.c4
-rw-r--r--libtommath/bn_s_mp_add.c4
-rw-r--r--libtommath/bn_s_mp_exptmod.c4
-rw-r--r--libtommath/bn_s_mp_mul_digs.c4
-rw-r--r--libtommath/bn_s_mp_mul_high_digs.c4
-rw-r--r--libtommath/bn_s_mp_sqr.c4
-rw-r--r--libtommath/bn_s_mp_sub.c4
-rw-r--r--libtommath/bncore.c4
-rw-r--r--libtommath/changes.txt14
-rw-r--r--libtommath/demo/demo.c4
-rw-r--r--libtommath/demo/timing.c4
-rw-r--r--libtommath/etc/2kprime.c9
-rw-r--r--libtommath/etc/drprime.c5
-rw-r--r--libtommath/etc/drprimes.txt11
-rw-r--r--libtommath/etc/mersenne.c4
-rw-r--r--libtommath/etc/mont.c9
-rw-r--r--libtommath/etc/pprime.c4
-rw-r--r--libtommath/etc/tune.c4
-rw-r--r--libtommath/logs/index.html3
-rw-r--r--libtommath/makefile7
-rw-r--r--libtommath/makefile.cygwin_dll4
-rw-r--r--libtommath/makefile.shared2
-rw-r--r--libtommath/mtest/logtab.h5
-rw-r--r--libtommath/mtest/mpi-config.h5
-rw-r--r--libtommath/mtest/mpi-types.h5
-rw-r--r--libtommath/mtest/mpi.c6
-rw-r--r--libtommath/mtest/mpi.h6
-rw-r--r--libtommath/mtest/mtest.c4
-rw-r--r--libtommath/pre_gen/mpi.c502
-rw-r--r--libtommath/tommath.h6
-rw-r--r--libtommath/tommath_class.h4
-rw-r--r--libtommath/tommath_superclass.h4
-rw-r--r--macosx/GNUmakefile3
-rw-r--r--macosx/README13
-rw-r--r--macosx/Tcl-Common.xcconfig3
-rw-r--r--macosx/Tcl-Debug.xcconfig3
-rw-r--r--macosx/Tcl-Info.plist.in2
-rw-r--r--macosx/Tcl-Release.xcconfig3
-rw-r--r--macosx/Tcl.xcode/project.pbxproj8
-rw-r--r--macosx/Tcl.xcodeproj/project.pbxproj8
-rw-r--r--macosx/Tclsh-Info.plist.in2
-rw-r--r--macosx/configure.ac2
-rw-r--r--macosx/tclMacOSXBundle.c2
-rw-r--r--macosx/tclMacOSXFCmd.c72
-rw-r--r--macosx/tclMacOSXNotify.c10
-rw-r--r--pkgs/README58
-rw-r--r--pkgs/package.list.txt26
-rw-r--r--tests/README2
-rw-r--r--tests/all.tcl4
-rw-r--r--tests/append.test95
-rw-r--r--tests/appendComp.test138
-rw-r--r--tests/apply.test2
-rw-r--r--tests/assemble.test3293
-rw-r--r--tests/assemble1.bench85
-rw-r--r--tests/assocd.test5
-rw-r--r--tests/async.test11
-rw-r--r--tests/autoMkindex.test285
-rw-r--r--tests/basic.test6
-rw-r--r--tests/binary.test40
-rw-r--r--tests/case.test2
-rw-r--r--tests/chan.test4
-rw-r--r--tests/chanio.test4032
-rw-r--r--tests/clock.test189
-rw-r--r--tests/cmdAH.test111
-rw-r--r--tests/cmdIL.test18
-rw-r--r--tests/cmdInfo.test5
-rw-r--r--tests/cmdMZ.test58
-rw-r--r--tests/compExpr-old.test5
-rw-r--r--tests/compExpr.test218
-rw-r--r--tests/compile.test288
-rw-r--r--tests/concat.test23
-rw-r--r--tests/config.test2
-rw-r--r--tests/coroutine.test79
-rw-r--r--tests/dcall.test5
-rw-r--r--tests/dict.test536
-rw-r--r--tests/dstring.test271
-rw-r--r--tests/encoding.test205
-rw-r--r--tests/env.test5
-rw-r--r--tests/error.test112
-rw-r--r--tests/eval.test23
-rw-r--r--tests/event.test14
-rw-r--r--tests/exec.test2
-rw-r--r--tests/execute.test221
-rw-r--r--tests/expr-old.test5
-rw-r--r--tests/expr.test9
-rw-r--r--tests/fCmd.test247
-rw-r--r--tests/fileName.test32
-rw-r--r--tests/fileSystem.test399
-rw-r--r--tests/for-old.test2
-rw-r--r--tests/for.test2
-rw-r--r--tests/foreach.test11
-rw-r--r--tests/format.test9
-rw-r--r--tests/get.test5
-rw-r--r--tests/history.test2
-rw-r--r--tests/http.test76
-rw-r--r--tests/http11.test2
-rw-r--r--tests/httpd10
-rw-r--r--tests/httpold.test2
-rw-r--r--tests/if-old.test2
-rw-r--r--tests/if.test2
-rw-r--r--tests/incr-old.test2
-rw-r--r--tests/incr.test232
-rw-r--r--tests/indexObj.test43
-rw-r--r--tests/info.test175
-rw-r--r--tests/init.test80
-rw-r--r--tests/interp.test407
-rw-r--r--tests/io.test113
-rw-r--r--tests/ioCmd.test466
-rw-r--r--tests/ioTrans.test1748
-rw-r--r--tests/iogt.test481
-rw-r--r--tests/join.test4
-rw-r--r--tests/lindex.test5
-rw-r--r--tests/link.test159
-rw-r--r--tests/linsert.test2
-rw-r--r--tests/list.test6
-rw-r--r--tests/listObj.test7
-rw-r--r--tests/llength.test2
-rw-r--r--tests/lmap.test464
-rw-r--r--tests/load.test29
-rw-r--r--tests/lrange.test16
-rw-r--r--tests/lrepeat.test4
-rw-r--r--tests/lreplace.test2
-rw-r--r--tests/lsearch.test104
-rw-r--r--tests/lset.test5
-rwxr-xr-xtests/lsetComp.test2
-rw-r--r--tests/macOSXFCmd.test3
-rw-r--r--tests/macOSXLoad.test2
-rw-r--r--tests/main.test14
-rw-r--r--tests/mathop.test4
-rw-r--r--tests/misc.test5
-rw-r--r--tests/msgcat.test52
-rw-r--r--tests/namespace-old.test12
-rw-r--r--tests/namespace.test134
-rwxr-xr-xtests/notify.test5
-rw-r--r--tests/nre.test41
-rw-r--r--tests/obj.test5
-rw-r--r--tests/oo.test837
-rw-r--r--tests/ooNext2.test788
-rw-r--r--tests/opt.test2
-rw-r--r--tests/package.test1258
-rw-r--r--tests/parse.test49
-rw-r--r--tests/parseExpr.test71
-rw-r--r--tests/parseOld.test5
-rw-r--r--tests/pid.test2
-rw-r--r--tests/pkg.test1222
-rw-r--r--tests/pkgMkIndex.test113
-rw-r--r--tests/platform.test15
-rw-r--r--tests/proc-old.test2
-rw-r--r--tests/proc.test369
-rw-r--r--tests/pwd.test2
-rw-r--r--tests/reg.test83
-rw-r--r--tests/regexp.test49
-rw-r--r--tests/regexpComp.test37
-rw-r--r--tests/registry.test20
-rw-r--r--tests/remote.tcl45
-rw-r--r--tests/rename.test5
-rw-r--r--tests/resolver.test203
-rw-r--r--tests/result.test13
-rw-r--r--tests/safe.test270
-rw-r--r--tests/scan.test20
-rw-r--r--tests/security.test16
-rw-r--r--tests/set-old.test2
-rw-r--r--tests/set.test5
-rw-r--r--tests/socket.test779
-rw-r--r--tests/source.test17
-rw-r--r--tests/split.test2
-rw-r--r--tests/stack.test2
-rw-r--r--tests/string.test125
-rw-r--r--tests/stringComp.test19
-rw-r--r--tests/stringObj.test21
-rw-r--r--tests/subst.test26
-rw-r--r--tests/switch.test30
-rw-r--r--tests/tailcall.test5
-rwxr-xr-xtests/tcltest.test2
-rw-r--r--tests/thread.test1620
-rw-r--r--tests/timer.test2
-rw-r--r--tests/tm.test2
-rw-r--r--tests/trace.test66
-rw-r--r--tests/unixFCmd.test5
-rw-r--r--tests/unixFile.test5
-rw-r--r--tests/unixInit.test143
-rw-r--r--tests/unixNotfy.test22
-rw-r--r--tests/unknown.test2
-rw-r--r--tests/unload.test5
-rw-r--r--tests/uplevel.test53
-rw-r--r--tests/upvar.test184
-rw-r--r--tests/utf.test105
-rw-r--r--tests/util.test2920
-rw-r--r--tests/var.test388
-rw-r--r--tests/while-old.test2
-rw-r--r--tests/while.test2
-rw-r--r--tests/winConsole.test2
-rw-r--r--tests/winDde.test304
-rw-r--r--tests/winFCmd.test6
-rw-r--r--tests/winFile.test5
-rw-r--r--tests/winNotify.test5
-rw-r--r--tests/winPipe.test62
-rw-r--r--tests/winTime.test5
-rw-r--r--tests/zlib.test323
-rw-r--r--tools/.cvsignore7
-rw-r--r--tools/Makefile.in4
-rw-r--r--tools/README3
-rwxr-xr-xtools/checkLibraryDoc.tcl2
-rwxr-xr-xtools/configure2852
-rw-r--r--tools/configure.in1
-rw-r--r--tools/encoding/big5.txt2
-rw-r--r--tools/encoding/gb2312.txt2
-rwxr-xr-xtools/findBadExternals.tcl3
-rwxr-xr-xtools/fix_tommath_h.tcl3
-rw-r--r--tools/genStubs.tcl50
-rw-r--r--tools/index.tcl3
-rw-r--r--tools/installData.tcl3
-rwxr-xr-xtools/loadICU.tcl3
-rw-r--r--tools/man2help.tcl3
-rw-r--r--tools/man2help2.tcl3
-rw-r--r--tools/man2html.tcl3
-rw-r--r--tools/man2html1.tcl3
-rw-r--r--tools/man2html2.tcl3
-rw-r--r--tools/man2tcl.c2
-rw-r--r--tools/mkdepend.tcl3
-rw-r--r--tools/regexpTestLib.tcl3
-rw-r--r--tools/str2c6
-rw-r--r--tools/tcl.wse.in2376
-rw-r--r--tools/tclSplash.bmpbin162030 -> 0 bytes
-rwxr-xr-xtools/tclZIC.tcl6
-rw-r--r--tools/tclmin.wse247
-rw-r--r--tools/tcltk-man2html-utils.tcl811
-rwxr-xr-xtools/tcltk-man2html.tcl550
-rw-r--r--tools/uniClass.tcl47
-rw-r--r--tools/uniParse.tcl139
-rw-r--r--unix/.cvsignore22
-rw-r--r--unix/Makefile.in271
-rw-r--r--unix/README7
-rwxr-xr-xunix/configure955
-rw-r--r--unix/configure.in74
-rw-r--r--unix/dltest/.cvsignore5
-rw-r--r--unix/dltest/Makefile.in3
-rw-r--r--unix/dltest/README2
-rw-r--r--unix/dltest/pkga.c3
-rw-r--r--unix/dltest/pkgb.c45
-rw-r--r--unix/dltest/pkgc.c3
-rw-r--r--unix/dltest/pkgd.c3
-rw-r--r--unix/dltest/pkge.c3
-rw-r--r--unix/dltest/pkgua.c3
-rwxr-xr-xunix/install-sh580
-rwxr-xr-xunix/ldAix4
-rw-r--r--unix/tcl.m4234
-rw-r--r--unix/tcl.pc.in1
-rw-r--r--unix/tcl.spec3
-rw-r--r--unix/tclAppInit.c10
-rw-r--r--unix/tclConfig.h.in70
-rw-r--r--unix/tclConfig.sh.in4
-rw-r--r--unix/tclLoadAix.c2
-rw-r--r--unix/tclLoadDl.c62
-rw-r--r--unix/tclLoadDyld.c308
-rw-r--r--unix/tclLoadNext.c32
-rw-r--r--unix/tclLoadOSF.c33
-rw-r--r--unix/tclLoadShl.c46
-rw-r--r--unix/tclUnixChan.c129
-rw-r--r--unix/tclUnixCompat.c320
-rw-r--r--unix/tclUnixEvent.c2
-rw-r--r--unix/tclUnixFCmd.c200
-rw-r--r--unix/tclUnixFile.c154
-rw-r--r--unix/tclUnixInit.c84
-rw-r--r--unix/tclUnixNotfy.c337
-rw-r--r--unix/tclUnixPipe.c139
-rw-r--r--unix/tclUnixPort.h498
-rw-r--r--unix/tclUnixSock.c1085
-rw-r--r--unix/tclUnixTest.c21
-rw-r--r--unix/tclUnixThrd.c17
-rw-r--r--unix/tclUnixThrd.h2
-rw-r--r--unix/tclUnixTime.c138
-rw-r--r--unix/tclXtNotify.c21
-rw-r--r--unix/tclXtTest.c11
-rw-r--r--unix/tclooConfig.sh6
-rw-r--r--win/.cvsignore31
-rw-r--r--win/Makefile.in171
-rw-r--r--win/README52
-rwxr-xr-xwin/buildall.vc.bat43
-rw-r--r--win/cat.c17
-rw-r--r--win/coffbase.txt4
-rwxr-xr-xwin/configure2019
-rw-r--r--win/configure.in381
-rw-r--r--win/makefile.bc14
-rw-r--r--win/makefile.vc126
-rw-r--r--win/nmakehlp.c91
-rw-r--r--win/rules.vc135
-rw-r--r--win/tcl.dsp4
-rw-r--r--win/tcl.m4286
-rw-r--r--win/tcl.rc2
-rw-r--r--win/tclAppInit.c98
-rw-r--r--win/tclConfig.sh.in2
-rw-r--r--win/tclWin32Dll.c174
-rw-r--r--win/tclWinChan.c32
-rw-r--r--win/tclWinConsole.c451
-rw-r--r--win/tclWinDde.c535
-rw-r--r--win/tclWinError.c81
-rw-r--r--win/tclWinFCmd.c210
-rw-r--r--win/tclWinFile.c810
-rw-r--r--win/tclWinInit.c81
-rw-r--r--win/tclWinInt.h98
-rw-r--r--win/tclWinLoad.c296
-rw-r--r--win/tclWinNotify.c2
-rw-r--r--win/tclWinPipe.c205
-rw-r--r--win/tclWinPort.h108
-rw-r--r--win/tclWinReg.c404
-rw-r--r--win/tclWinSerial.c168
-rw-r--r--win/tclWinSock.c1207
-rw-r--r--win/tclWinTest.c233
-rw-r--r--win/tclWinThrd.c95
-rw-r--r--win/tclWinThrd.h21
-rw-r--r--win/tclWinTime.c118
-rw-r--r--win/tclooConfig.sh6
-rw-r--r--win/tclsh.rc2
1028 files changed, 78833 insertions, 55229 deletions
diff --git a/ChangeLog b/ChangeLog
index 60235a0..4995a93 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,40 +1,3696 @@
+2012-12-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmdsSZ.c (TclSubstCompile): Improved the sequence of
+ instructions issued for [subst] when dealing with simple variable
+ references.
+
+2012-12-14 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.6.0 TAGGED FOR RELEASE ***
+
+ * changes: updates for 8.6.0
+
+2012-12-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclZlib.c: Repair same issue with misusing the
+ * tests/zlib.test: 'fire and forget' nature of Tcl_ObjSetVar2
+ in the new TIP 400 implementation.
+
+2012-12-13 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdAH.c: (CatchObjCmdCallback): do not decrRefCount
+ * tests/cmdAH.test: the newValuePtr sent to Tcl_ObjSetVar2:
+ TOSV2 is 'fire and forget', it decrs on its own.
+ Fix for [Bug 3595576], found by andrewsh.
+
+2012-12-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: Fix Tcl_DecrRefCount macro such that it doesn't
+ access its objPtr parameter twice any more.
+
+2012-12-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Bump version number to 8.6.0.
+ * library/init.tcl:
+ * unix/configure.in:
+ * win/configure.in:
+ * unix/tcl.spec:
+ * README:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+2012-12-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * tools/tcltk-man2html.tcl (plus-pkgs): Increased robustness of
+ version number detection code to deal with packages whose names are
+ prefixes of other packages.
+ * unix/Makefile.in (dist): Added pkgs/package.list.txt to distribution
+ builds to ensure that 'make html' will work better.
+
+2012-12-09 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * tests/chan.test: Clean up unwanted eofchar side-effect of chan-4.6
+ leading to a spurious "'" at end of chan.test under certain conditions
+ (see [Bug 3389289] and [Bug 3389251]).
+
+ * doc/expr.n: [Bug 3594188]: Clarifications about commas.
+
+2012-12-08 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclIO.c: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT
+ when there are unflushed nonblocking channels. Thanks Miguel for
+ spotting.
+
+2012-12-07 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/dltest/pkgb.c: Turn pkgb.so into a Tcl9 interoperability test
+ library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should
+ either result in an error-message, either succeed, but never crash.
+
+2012-11-28 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclZlib.c (ZlibStreamSubcmd): [Bug 3590483]: Use a mechanism
+ for complex option resolution that has fewer problems with more
+ finicky compilers.
+
+2012-11-26 Reinhard Max <max@suse.de>
+
+ * unix/tclUnixSock.c: Factor out creation of the -sockname and
+ -peername lists from TcpGetOptionProc() to TcpHostPortList(). Make it
+ robust against implementations of getnameinfo() that error out if
+ reverse mapping fails instead of falling back to the numeric
+ representation.
+
+2012-11-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBinary.c (BinaryDecode64): [Bug 3033307]: Corrected
+ handling of trailing whitespace when decoding base64. Thanks to Anton
+ Kovalenko for reporting, and Andy Goth for the fix and tests.
+
+2012-11-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (INST_STR_RANGE_IMM): [Bug 3588366]: Corrected
+ implementation of bounds restriction for end-indexed compiled [string
+ range]. Thanks to Emiliano Gavilan for diagnosis and fix.
+
+2012-11-15 Jan Nijtmans <nijtmans@users.sf.net>
+
+ IMPLEMENTATION OF TIP#416
+
+ New Options for 'load': -global and -lazy
+
+ * generic/tcl.h:
+ * generic/tclLoad.c
+ * unix/tclLoadDl.c
+ * unix/tclLoadDyld.c
+ * tests/load.test
+ * doc/Load.3
+ * doc/load.n
+
+2012-11-14 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/tclUnixFCmd.c (TclUnixOpenTemporaryFile): [Bug 2933003]: Factor
+ out all the code to do temporary file creation so that it is possible
+ to make it correct in one place. Allow overriding of the back-stop
+ default temporary file location at compile time by setting the
+ TCL_TEMPORARY_FILE_DIRECTORY #def to a string containing the directory
+ name (defaults to "/tmp" as that is the most common default).
+
+2012-11-13 Joe Mistachkin <joe@mistachkin.com>
+
+ * win/tclWinInit.c: also search for the library directory (init.tcl,
+ encodings, etc) relative to the build directory associated with the
+ source checkout.
+
+2012-11-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: re-enable bcc-tailcall, after fixing an
+ * generic/tclExecute.c: infinite loop in the TCL_COMPILE_DEBUG mode
+
+
+2012-11-07 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata/Africa/Casablanca:
+ * library/tzdata/America/Araguaina:
+ * library/tzdata/America/Bahia:
+ * library/tzdata/America/Havana:
+ * library/tzdata/Asia/Amman:
+ * library/tzdata/Asia/Gaza:
+ * library/tzdata/Asia/Hebron:
+ * library/tzdata/Asia/Jerusalem:
+ * library/tzdata/Pacific/Apia:
+ * library/tzdata/Pacific/Fakaofo:
+ * library/tzdata/Pacific/Fiji: Import tzdata2012i.
+
+2012-11-06 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/http/http.tcl (http::Finish): [Bug 3581754]: Ensure that
+ callbacks are done at most once to prevent problems with timeouts on a
+ keep-alive connection (combined with reentrant http package use)
+ causing excessive stack growth. Not a fix for the underlying problem,
+ but ensures that pain will be mostly kept away from users.
+ Bump http package to 2.8.5.
+
+2012-11-05 Donal K. Fellows <dkf@users.sf.net>
+
+ Added bytecode compilation of many Tcl commands. Some of these are
+ total compilations and some are only partial (i.e., only compile in
+ some cases). The (sub-)commands affected are:
+ * array: exists, set, unset
+ * dict: create, exists, merge
+ * format: (simple cases only)
+ * info: commands, coroutine, level, object
+ * info object: class, isa object, namespace
+ * namespace: current, code, qualifiers, tail, which
+ * regsub: (only cases convertable to simple [string map])
+ * self: (only no-argument and [self object] cases)
+ * string: first, last, map, range
+ * tailcall:
+ * yield:
+
+ [This was work originally done on the 'dkf-compile-misc-info' branch.]
+
+2012-11-05 Jan Nijtmans <nijtmans@users.sf.net>
+
+ IMPLEMENTATION OF TIP#413
+
+ Align the [string trim] and [string is space] commands, such that
+ [string trim] by default trims all characters for which [string is
+ space] returns 1, augmented with the NUL character.
+
+ * generic/tclUtf.c: Add NEL, BOM and two more characters to [string is
+ space]
+ * generic/tclCmdMZ.c: Modify [string trim] for Unicode modifications.
+ * generic/regc_locale.c: Regexp engine must match [string is space]
+ * doc/string.n
+ * tests/string.test
+ ***POTENTIAL INCOMPATIBILITY***
+ Code that relied on characters not previously trimmed being not
+ removed will notice a difference; it is believed that this is rare,
+ but a workaround to get the behavior in Tcl 8.5 is to use " \t\n\r" as
+ an explicit trim set.
+
+2012-10-31 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/Makefile.in: Dde version number to 1.4.0, ready for Tcl 8.6.0rc1
+ * win/makefile.vc
+ * win/tclWinDde.c
+ * library/dde/pkgIndex.tcl
+ * tests/winDde.test
+
+2012-10-24 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileDictUnsetCmd): Added compilation of
+ the [dict unset] command (for scalar var in LVT only).
+
+2012-10-23 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.h: Add "flags" parameter from Tcl_LoadFile to
+ * generic/tclIOUtil.c: to various internal functions, so these
+ * generic/tclLoadNone.c: flags are available through the whole
+ * unix/tclLoad*.c: filesystem for (future) internal use.
+ * win/tclWinLoad.c:
+
+2012-10-17 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (TclNRCoroutineObjCmd): insure that numlevels
+ are properly set, fix bug discovered by dkf and reported at
+ http://code.activestate.com/lists/tcl-core/12213/
+
+2012-10-16 Donal K. Fellows <dkf@users.sf.net>
+
+ IMPLEMENTATION OF TIP#405
+
+ New commands for applying a transformation to the elements of a list
+ to produce another list (the [lmap] command) and to the mappings of a
+ dictionary to produce another dictionary (the [dict map] command). In
+ both cases, a [continue] will cause the skipping of an element/pair,
+ and a [break] will terminate the construction early and successfully.
+
+ * generic/tclCmdAH.c (Tcl_LmapObjCmd, TclNRLmapCmd): Implementation of
+ the new [lmap] command, based on (and sharing much of) [foreach].
+ * generic/tclDictObj.c (DictMapNRCmd): Implementation of the new [dict
+ map] subcommand, based on (and sharing much of) [dict for].
+ * generic/tclCompCmds.c (TclCompileLmapCmd, TclCompileDictMapCmd):
+ Compilation engines for [lmap] and [dict map].
+
+ IMPLEMENTATION OF TIP#400
+
+ * generic/tclZlib.c: Allow the specification of a compression
+ dictionary (a binary blob used to seed the compression engine) in both
+ streams and channel transformations. Also some reorganization to allow
+ for getting gzip header dictionaries and controlling buffering levels
+ in channel transformations (allowing a trade-off between formal
+ correctness and speed).
+ (Tcl_ZlibStreamSetCompressionDictionary): New C API to allow setting
+ the compression dictionary without using a Tcl script.
+
+2012-10-14 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclDictObj.c: [Bug 3576509]: ::tcl::Bgerror crashes with
+ * generic/tclEvent.c: invalid arguments. Better fix, which helps
+ for all Tcl_DictObjGet() calls in Tcl's source code.
+
+2012-10-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclEvent.c: [Bug 3576509]: tcl::Bgerror crashes with invalid
+ arguments
+
+2012-10-06 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/Makefile.in: [Bug 2459774]: tcl/win/Makefile.in not compatible
+ with msys 0.8.
+
+2012-10-03 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIO.c: When checking for std channels being closed,
+ compare the channel state, not the channel itself so that stacked
+ channels do not cause trouble.
+
+2012-09-26 Reinhard Max <max@suse.de>
+
+ * generic/tclIOSock.c (TclCreateSocketAddress): Work around a bug in
+ getaddrinfo() on OSX that caused name resolution to fail for [socket
+ -server foo -myaddr localhost 0].
+
+2012-09-20 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/configure.in: New import libraries for zlib 1.2.7, usable for
+ * win/configure: all win32/win64 compilers
+ * compat/zlib/win32/zdll.lib:
+ * compat/zlib/win64/zdll.lib:
+
+ * win/tclWinDde.c: [FRQ 3527238]: Full unicode support for dde. Dde
+ version is now 1.4.0b2.
+ ***POTENTIAL INCOMPATIBILITY***
+
+2012-09-19 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: Make Tcl_Interp a fully opaque structure if
+ TCL_NO_DEPRECATED is set (TIP 330 and 336).
+ * win/nmakehlp.c: Let "nmakehlp -V" start searching digits after the
+ found match (suggested by Harald Oehlmann).
+
+2012-09-07 Harald Oehlmann <oehhar@users.sf.net>
+
+ *** 8.6b3 TAGGED FOR RELEASE ***
+
+ IMPLEMENTATION OF TIP#404.
+
+ * library/msgcat/msgcat.tcl: [FRQ 3544988]: New commands [mcflset]
+ * library/msgcat/pkgIndex.tcl: and [mcflmset] to set mc entries with
+ * unix/Makefile.in: implicit message file locale.
+ * win/Makefile.in: Bump to 1.5.0.
+
+2012-08-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/msgs/uk.msg: [Bug 3561330]: Use the correct full name of
+ March in Ukrainian. Thanks to Mikhail Teterin for reporting.
+
+2012-08-23 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclBinary.c: [Bug 3496014]: Unecessary memset() in
+ Tcl_SetByteArrayObj().
+
+2012-08-20 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPathObj.c: [Bug 3559678]: Fix bad filename normalization
+ when the last component is the empty string.
+
+2012-08-20 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinPort.h: Remove wrapper macro for ntohs(): unnecessary,
+ because it doesn't require an initialized winsock_2 library. See:
+ <http://msdn.microsoft.com/en-us/library/windows/desktop/ms740075%28v=vs.85%29.aspx>
+ * win/tclWinSock.c:
+ * generic/tclStubInit.c:
+
+2012-08-17 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/nmakehlp.c: Add "-V<num>" option, in order to be able to detect
+ partial version numbers.
+
+2012-08-15 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/buildall.vc.bat: Only build the threaded builds by default
+ * win/rules.vc: Some code cleanup
+
+2010-08-13 Stuart Cassoff <stwo@users.sourceforge.net>
+
+ * unix/tclUnixCompat.c: [Bug 3555454]: Rearrange a bit to quash
+ 'declared but never defined' compiler warnings.
+
+2012-08-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * compat/zlib/win64/zlib1.dll: Add 64-bit build of zlib1.dll, and use
+ * compat/zlib/win64/zdll.lib: it for the dynamic mingw-w64 build.
+ * win/Makefile.in:
+ * win/configure.in:
+ * win/configure:
+
+2012-08-09 Reinhard Max <max@suse.de>
+
+ * tests/http.test: Fix http-3.29 for machines without IPv6 support.
+
+2010-08-08 Stuart Cassoff <stwo@users.sourceforge.net>
+
+ * unix/tclUnixCompat.c: Change one '#ifdef' to '#if defined()' for
+ improved consistency within the file.
+
+2012-08-08 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclfileName.c: [Bug #1536227]: Cygwin network pathname
+ * tests/fileName.test: support
+
+2012-08-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIOUtil.c: [Bug 3554250]: Overlooked one field of cleanup
+ in the thread exit handler for the filesystem subsystem.
+
+2012-07-31 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclInterp.c (Tcl_GetInterpPath):
+ * unix/tclUnixPipe.c (TclGetAndDetachPids, Tcl_PidObjCmd):
+ * win/tclWinPipe.c (TclGetAndDetachPids, Tcl_PidObjCmd):
+ Purge use of Tcl_AppendElement, and corrected conversion of PIDs to
+ integer objects.
+
+2012-07-31 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/nmakehlp.c: Add -Q option from sampleextension.
+ * win/Makefile.in: [FRQ 3544967]: Missing objectfiles in static lib
+ * win/makefile.vc: (Thanks to Jos Decoster).
+
+2012-07-29 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/Makefile.in: No longer build tcltest.exe to run the tests,
+ but use tclsh86.exe in combination with tcltest86.dll to do that.
+ * tests/*.test: load tcltest86.dll if necessary.
+
+2012-07-28 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tests/clock.test: [Bug 3549770]: Multiple test failures running
+ * tests/registry.test: tcltest outside build tree
+ * tests/winDde.test:
+
+2012-07-27 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclUniData.c: Support Unicode 6.2 (Add Turkish lira sign)
+ * generic/regc_locale.c:
+
+2012-07-25 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * win/tclWinPipe.c: [Bug 3547994]: Abandon the synchronous Windows
+ pipe driver to its fate when needed to honour TIP#398.
+
+2012-07-24 Trevor Davel <twylite@crypt.co.za>
+
+ * win/tclWinSock.c: [Bug: 3545363]: Loop over multiple underlying file
+ descriptors for a socket where required (TcpCloseProc, SocketProc).
+ Refactor socket/descriptor setup to manage linked list operations in
+ one place. Fix memory leak in socket close (TcpCloseProc) and related
+ dangling pointers in SocketEventProc.
+
+2012-07-19 Reinhard Max <max@suse.de>
+
+ * win/tclWinSock.c (TcpAccept): [Bug: 3545363]: Use a large enough
+ buffer for accept()ing IPv6 connections. Fix conversion of host and
+ port for passing to the accept proc to be independent of the IP
+ version.
+
+2012-07-23 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclIO.c: [Bug 3545365]: Never try a bg-flush on a dead
+ channel, just like before 2011-08-17.
+
+2012-07-19 Joe Mistachkin <joe@mistachkin.com>
+
+ * generic/tclTest.c: Fix several more missing mutex-locks in
+ TestasyncCmd.
+
+2012-07-19 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclTest.c: [Bug 3544685]: Missing mutex-lock in
+ TestasyncCmd since 2011-08-19. Unbounded gratitude to Stuart
+ Cassoff for spotting it.
+
+2012-07-17 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails
+
+2012-07-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclUtil.c (UpdateStringOfEndOffset): [Bug 3544658]: Stop
+ 1-byte overrun in memcpy, that object placement rules made harmless
+ but which still caused compiler complaints.
+
+2012-07-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * library/reg/pkgIndex.tcl: Make registry 1.3 package dynamically
+ loadable when ::tcl::pkgconfig is available.
+
+2012-07-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinReg.c: [Bug 3362446]: registry keys command fails
+ with 8.5/8.6. Follow Microsofts example better in order to prevent
+ problems when using HKEY_PERFORMANCE_DATA.
+
+2012-07-10 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tclUnixNotfy.c: [Bug 3541646]: Don't panic on triggerPipe
+ overrun.
+
+2012-07-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * win/tclWinSock.c (InitializeHostName): Corrected logic that
+ extracted the name of the computer from the gethostname call so that
+ it would use the name on success, not failure. Also ensured that the
+ buffer size is exactly that recommended by Microsoft.
+
+2012-07-08 Reinhard Max <max@suse.de>
+
+ * library/http/http.tcl: [Bug 3531209]: Add fix and test for URLs that
+ * tests/http.test: contain literal IPv6 addresses.
+
+2012-07-05 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/tclUnixPipe.c: [Bug 1189293]: Make "<<" binary safe.
+ * win/tclWinPipe.c:
+
+2012-07-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclUtil.c (TclDStringAppendObj, TclDStringAppendDString):
+ * generic/tclInt.h (TclDStringAppendLiteral, TclDStringClear):
+ * generic/tclCompile.h (TclDStringAppendToken): Added wrappers to make
+ common cases of appending to Tcl_DStrings simpler to write. Prompted
+ by looking at [FRQ 1357401] (these are an _internal_ implementation of
+ that FRQ).
+
+2012-06-29 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * library/msgcat/msgcat.tcl: Add tn, ro_MO and ru_MO to msgcat.
+
+2012-06-29 Harald Oehlmann <oehhar@users.sf.net>
+
+ * library/msgcat/msgcat.tcl: [Bug 3536888]: Locale guessing of
+ * library/msgcat/pkgIndex.tcl: msgcat fails on (some) Windows 7. Bump
+ * unix/Makefile.in: to 1.4.5
+ * win/Makefile.in:
+
+2012-06-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/GetIndex.3: Reinforced the description of the requirement for
+ the tables of names to index over to be static, following posting to
+ tcl-core by Brian Griffin about a bug caused by Tktreectrl not obeying
+ this rule correctly. This does not represent a functionality change,
+ merely a clearer documentation of a long-standing constraint.
+
+2012-06-26 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tcl.m4: Let Cygwin shared build link with
+ * unix/configure.in: zlib1.dll, not cygz.dll (two less
+ * unix/configure: dependencies on cygwin-specific dll's)
+ * unix/Makefile.in:
+
+2012-06-26 Reinhard Max <max@suse.de>
+
+ * generic/tclIOSock.c: Use EAI_SYSTEM only if it exists.
+ * unix/tclUnixSock.c:
+
+2012-06-25 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclFileSystem.h: [Bug 3024359]: Make sure that the
+ * generic/tclIOUtil.c: per-thread cache of the list of file systems
+ * generic/tclPathObj.c: currently registered is only updated at times
+ when no active loops are traversing it. Also reduce the amount of
+ epoch storing and checking to where it can make a difference.
+
+2012-06-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdAH.c (EncodingDirsObjCmd): [Bug 3537605]: Do the right
+ thing when reporting errors with the number of arguments.
+
+2012-06-25 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclfileName.c: [Patch 1536227]: Cygwin network pathname
+ * tests/fileName.test: support.
+
+2012-06-23 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tclUnixNotfy.c: [Bug 3508771]: Cygwin notifier for handling
+ win32 events.
+
+2012-06-22 Reinhard Max <max@suse.de>
+
+ * generic/tclIOSock.c: Rework the error message generation of [socket],
+ * unix/tclUnixSock.c: so that the error code of getaddrinfo is used
+ * win/tclWinSock.c: instead of errno unless it is EAI_SYSTEM.
+
+2012-06-21 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinReg.c: [Bug 3362446]: registry keys command fails
+ * tests/registry.test: with 8.5/8.6
+
+2012-06-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: [Bug 3532959]: Make sure the lifetime
+ * generic/tclProc.c: management of entries in the linePBodyPtr
+ * tests/proc.test: hash table can tolerate either order of
+ teardown, interp first, or Proc first.
+
+2012-06-08 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/configure.in: Update autogoo for gettimeofday().
+ * unix/tclUnixPort.h: Thanks Joe English.
+ * unix/configure: autoconf 2.13
+
+ * unix/tclUnixPort.h: [Bug 3530533]: Centralize #include <pthread.h>
+ * unix/tclUnixThrd.c: in the tclUnixPort.h header so that old unix
+ systems that need inclusion in all compilation units are supported.
+
+2012-06-08 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinDde.c: Revise the "null data" check: null strings are
+ possible, but empty binary arrays are not.
+ * tests/winDde.test: Add test-case (winDde-9.4) for transferring
+ null-strings with dde. Convert tests to tcltest-2 syntax.
+
+2012-06-06 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclZlib.c (TclZlibInit): Declare that Tcl is publishing the
+ zlib package (version 2.0) as part of its bootstrap process. This will
+ have an impact on tclkit (which includes zlib 1.1) but otherwise be
+ very low impact.
+
+2012-06-06 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tclUnixInit.c: On Cygwin, use win32 API in stead of uname()
+ to determine the tcl_platform variables.
+
+2012-05-31 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclZlib.c: [Bug 3530536]: zlib-7.4 fails on IRIX64
+ * tests/zlib.test:
+ * doc/zlib.n: Document that [stream checksum] doesn't do
+ what's expected for "inflate" and "deflate" formats
+
+2012-05-31 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/safe.tcl (safe::AliasFileSubcommand): Don't assume that
+ slaves have corresponding commands, as that is not true for
+ sub-subinterpreters (used in Tk's test suite).
+
+ * doc/safe.n: [Bug 1997845]: Corrected formatting so that generated
+ HTML can link properly.
+
+ * tests/socket.test (socket*-13.1): Prevented intermittent test
+ failure due to race condition.
+
+2012-05-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/expr.n, doc/mathop.n: [Bug 2931407]: Clarified semantics of
+ division and remainder operators.
+
+2012-05-29 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinDde.c: [Bug 3525762]: Encoding handling in dde.
+ * win/Makefile.in: Fix "make genstubs" when cross-compiling on UNIX
+
+2012-05-28 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/safe.tcl (safe::AliasFileSubcommand): [Bug 3529949]: Made a
+ more sophisticated method for preventing information leakage; it
+ changes references to "~user" into "./~user", which is safe.
+
+2012-05-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/namespace.n, doc/Ensemble.3: [Bug 3528418]: Document what is
+ going on with respect to qualification of command prefixes in ensemble
+ subcommand maps.
+
+ * generic/tclIO.h (SYNTHETIC_EVENT_TIME): Factored out the definition
+ of the amount of time that should be waited before firing a synthetic
+ event on a channel.
+
+2012-05-25 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinDde.c: [Bug 473946]: Special characters were not correctly
+ sent, now for XTYP_EXECUTE as well as XTYP_REQUEST.
+ * win/Makefile.in: Fix "make genstubs" when cross-compiling on UNIX
+
+2012-05-24 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/genStubs.tcl: Take cygwin handling of X11 into account.
+ * generic/tcl*Decls.h: re-generated
+ * generic/tclStubInit.c: Implement TclpIsAtty, Cygwin only.
+ * doc/dde.n: Doc fix: "dde execute iexplore" doesn't work
+ without -async, because iexplore doesn't return a value
+
+2012-05-24 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/genStubs.tcl: Let cygwin share stub table with win32
+ * win/tclWinSock.c: implement TclpInetNtoa for win32
+ * generic/tclInt.decls: Revert most of [3caedf05df], since when
+ we let cygwin share the win32 stub table this is no longer necessary
+ * generic/tcl*Decls.h: re-generated
+ * doc/dde.n: 1.3 -> 1.4
+
+2012-05-23 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclZlib.c (ZlibTransformInput): [Bug 3525907]: Ensure that
+ decompressed input is flushed through the transform correctly when the
+ input stream gets to the end. Thanks to Alexandre Ferrieux and Andreas
+ Kupries for their work on this.
+
+2012-05-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclFileName.c: When using Tcl_SetObjLength() calls to
+ * generic/tclPathObj.c: grow and shrink the objPtr->bytes
+ buffer, care must be taken that the value cannot possibly become pure
+ Unicode. Calling Tcl_AppendToObj() has the possibility of making such
+ a conversion. Bug found while valgrinding the trunk.
+
+2012-05-21 Jan Nijtmans <nijtmans@users.sf.net>
+
+ IMPLEMENTATION OF TIP#106
+
+ * win/tclWinDde.c: Added encoding-related abilities to
+ * library/dde/pkgIndex.tcl: the [dde] command. The dde package's
+ * tests/winDde.test: version is now 1.4.0.
+ * doc/dde.n:
+
+2012-05-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOBasic.c (TclOO_Class_Constructor): [Bug 2023112]: Cut
+ the amount of hackiness in class constructors, and refactor some of
+ the error message handling from [oo::define] to be saner in the face
+ of odd happenings.
+
+2012-05-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): [Bug 3106532]: Corrected
+ resulting indexes from -indexvar option to be usable with [string
+ range]; this was always the intention (and is consistent with [regexp
+ -indices] too).
+ ***POTENTIAL INCOMPATIBILITY***
+ Uses of [switch -regexp -indexvar] that previously compensated for the
+ wrong offsets (by subtracting 1 from the end indices) now do not need
+ to do so as the value is correct.
+
+ * library/safe.tcl (safe::InterpInit): Ensure that the module path is
+ constructed in the correct order.
+ (safe::AliasGlob): [Bug 2964715]: More extensive handling of what
+ globbing is required to support package loading.
+
+ * doc/expr.n: [Bug 3525462]: Corrected statement about what happens
+ when comparing "0y" and "0x12"; the previously documented behavior was
+ actually a subtle bug (now long-corrected).
+
+2012-05-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdAH.c (TclMakeFileCommandSafe): [Bug 3445787]: Improve
+ the compatibility of safe interpreters' version of 'file' with that of
+ unsafe interpreters.
+ * library/safe.tcl (::safe::InterpInit): Teach the safe-interp scripts
+ about how to expose 'file' properly.
+
+2012-05-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinDde.c: Protect against receiving strings without ending
+ \0, as external applications (or Tcl with TIP #106) could generate
+ that.
+
+2012-05-10 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinDde.c: [Bug 473946]: Special characters not correctly sent
+ * library/dde/pkgIndex.tcl: Increase version to 1.3.3
+
+2012-05-10 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * {win,unix}/configure{,.in}: [Bug 2812981]: Clean up bundled
+ packages' build directory from within Tcl's ./configure, to avoid
+ stale configuration.
+
+2012-05-09 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIORChan.c: [Bug 3522560]: Fixed the crash, enabled the
+ test case. Modified [chan postevent] to properly inject the event(s)
+ into the owner thread's event queue for execution in the correct
+ context. Renamed the ForwardOpTo...Thread() function to match with our
+ terminology.
+
+ * tests/ioCmd.test: [Bug 3522560]: Added a test which crashes the core
+ if it were not disabled as knownBug. For a reflected channel
+ transfered to a different thread the [chan postevent] run in the
+ handler thread tries to execute the owner threads's fileevent scripts
+ by itself, wrongly reaching across thread boundaries.
+
+2012-04-28 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclIO.c: Properly close nonblocking channels even when
+ not flushing them.
+
+2012-05-03 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * compat/zlib/*: Upgrade to zlib 1.2.7 (pre-built dll is still 1.2.5,
+ will be upgraded as soon as the official build is available)
+
+2012-05-03 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/socket.test: [Bug 3428754]: Test socket-14.2 tolerate
+ [socket -async] connection that connects synchronously.
+
+ * unix/tclUnixSock.c: [Bug 3428753]: Fix [socket -async] connections
+ that manage to connect synchronously.
+
+2012-05-02 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/configure.in: Better detection and implementation for
+ * generic/configure: cpuid instruction on Intel-derived
+ * generic/tclUnixCompat.c: processors, both 32-bit and 64-bit.
+ * generic/tclTest.c: Move cpuid testcase from win-specific to
+ * win/tclWinTest.c: generic tests, as it should work on all
+ * tests/platform.test: Intel-related platforms now.
+
+2012-04-30 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * tests/ioCmd.test: [Bug 3522560]: Tame deadlocks in broken refchan
+ tests.
+
+2012-04-28 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ IMPLEMENTATION OF TIP#398
+
+ * generic/tclIO.c: Quickly Exit with Non-Blocking Blocked Channels
+ * tests/io.test : *** POTENTIAL INCOMPATIBILITY ***
+ * doc/close.n : (compat flag available)
+
+2012-04-27 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclPort.h: Move CYGWIN-specific stuff from tclPort.h to
+ * generic/tclEnv.c: tclUnixPort.h, where it belongs.
+ * unix/tclUnixPort.h:
+ * unix/tclUnixFile.c:
+
+2012-04-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/init.tcl (auto_execok): Allow shell builtins to be detected
+ even if they are upper-cased.
+
+2012-04-26 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclStubInit.c: Get rid of _ANSI_ARGS_ and CONST
+ * generic/tclIO.c:
+ * generic/tclIOCmd.c:
+ * generic/tclTest.c:
+ * unix/tclUnixChan.c:
+
+2012-04-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclUtil.c (TclDStringToObj): Added internal function to make
+ the fairly-common operation of converting a DString into an Obj a more
+ efficient one; for long strings, it can just transfer the ownership of
+ the buffer directly. Replaces this:
+ obj=Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ with this:
+ obj=TclDStringToObj(&ds);
+
+2012-04-24 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.decls: [Bug 3508771]: load tclreg.dll in cygwin
+ tclsh
+ * generic/tclIntPlatDecls.h: Implement TclWinGetSockOpt,
+ * generic/tclStubInit.c: TclWinGetServByName and TclWinCPUID for
+ * generic/tclUnixCompat.c: Cygwin.
+ * unix/configure.in:
+ * unix/configure:
+ * unix/tclUnixCompat.c:
+
+2012-04-18 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata/Africa/Casablanca:
+ * library/tzdata/America/Port-au-Prince:
+ * library/tzdata/Asia/Damascus:
+ * library/tzdata/Asia/Gaza:
+ * library/tzdata/Asia/Hebron: tzdata2012c
+
+2012-04-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/FileSystem.3 (Tcl_FSOpenFileChannelProc): [Bug 3518244]: Fixed
+ documentation of this filesystem callback function; it must not
+ register its created channel - that's the responsibility of the caller
+ of Tcl_FSOpenFileChannel - as that leads to reference leaks.
+
+2012-04-15 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclEnsemble.c (NsEnsembleImplementationCmdNR):
+ * generic/tclIOUtil.c (Tcl_FSEvalFileEx): Cut out levels of the C
+ stack by going direct to the relevant internal evaluation function.
+
+ * generic/tclZlib.c (ZlibTransformSetOption): [Bug 3517696]: Make
+ flushing work correctly in a pushed compressing channel transform.
+
+2012-04-12 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.decls: [Bug 3514475]: Remove TclpGetTimeZone and
+ * generic/tclIntDecls.h: TclpGetTZName
+ * generic/tclIntPlatDecls.h:
+ * generic/tclStubInit.c:
+ * unix/tclUnixTime.c:
+ * unix/tclWinTilemc:
+
+2012-04-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinInit.c: [Bug 3448512]: clock scan "1958-01-01" fails
+ * win/tcl.m4: only in debug compilation.
+ * win/configure:
+ * unix/tcl.m4: Use NDEBUG consistantly meaning: no debugging.
+ * unix/configure:
+ * generic/tclBasic.c:
+ * library/dde/pkgIndex.tcl: Use [::tcl::pkgconfig get debug] instead
+ * library/reg/pkgIndex.tcl: of [info exists ::tcl_platform(debug)]
+
+2012-04-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tcl.h (TCL_DEPRECATED_API): [Bug 2458976]: Added macro that
+ can be used to mark parts of Tcl's API as deprecated. Currently only
+ used for fields of Tcl_Interp, which TIPs 330 and 336 have deprecated
+ with a migration strategy; we want to encourage people to move away
+ from those fields.
+
+2012-04-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOODefineCmds.c (ClassVarsSet, ObjVarsSet): [Bug 3396896]:
+ Ensure that the lists of variable names used to drive variable
+ resolution will never have the same name twice.
+
+ * generic/tclVar.c (AppendLocals): [Bug 2712377]: Fix problem with
+ reporting of declared variables in methods. It's really a problem with
+ how [info vars] interacts with variable resolvers; this is just a bit
+ of a hack so it is no longer a big problem.
+
+2012-04-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance):
+ [Bug 3514761]: Fixed bogosity with automated argument description
+ handling when constructing an instance of a class that is itself a
+ member of an ensemble. Thanks to Andreas Kupries for identifying that
+ this was a problem case at all!
+ (Tcl_CopyObjectInstance): Fix potential bleed-over of ensemble
+ information into [oo::copy].
+
+2012-04-04 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinSock.c: [Bug 510001]: TclSockMinimumBuffers needs
+ * generic/tclIOSock.c: platform implementation.
+ * generic/tclInt.decls:
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+
+2012-04-03 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclStubInit.c: Remove the TclpGetTZName implementation for
+ * generic/tclIntDecls.h: Cygwin (from 2012-04-02 commit), re-generated
+ * generic/tclIntPlatDecls.h:
+
+2012-04-02 Donal K. Fellows <dkf@users.sf.net>
+
+ IMPLEMENTATION OF TIP#396.
+
+ * generic/tclBasic.c (builtInCmds, TclNRYieldToObjCmd): Convert the
+ formerly-unsupported yieldm and yieldTo commands into [yieldto].
+
+2012-04-02 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.decls: [Bug 3508771]: load tclreg.dll in cygwin tclsh
+ * generic/tclIntPlatDecls.h: Implement TclWinGetTclInstance,
+ * generic/tclStubInit.c: TclpGetTZName, and various more
+ win32-specific internal functions for Cygwin, so win32 extensions
+ using those can be loaded in the cygwin version of tclsh.
+
+2012-03-30 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tcl.m4: [Bug 3511806]: Compiler checks too early
+ * unix/configure.in: This change allows to build the cygwin and
+ * unix/tclUnixPort.h: mingw32 ports of Tcl/Tk to build out-of-the-box
+ * win/tcl.m4: using a native or cross-compiler.
+ * win/configure.in:
+ * win/tclWinPort.h:
+ * win/README Document how to build win32 or win64 executables
+ with Linux, Cygwin or Darwin.
+
+2012-03-29 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclCmdMZ.c (StringIsCmd): Faster mem-leak free
+ implementation of [string is entier].
+
+2012-03-27 Donal K. Fellows <dkf@users.sf.net>
+
+ IMPLEMENTATION OF TIP#395.
+
+ * generic/tclCmdMZ.c (StringIsCmd): Implementation of the [string is
+ entier] check. Code by Jos Decoster.
+
+2012-03-27 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: [Bug 3508771]: Wrong Tcl_StatBuf used on MinGW.
+ * generic/tclFCmd.c: [Bug 2015723]: Duplicate inodes from file stat
+ * generic/tclCmdAH.c: on windows (but now for cygwin as well).
+ * generic/tclOODefineCmds.c: minor gcc warning
+ * win/tclWinPort.h: Use lower numbers, preventing integer overflow.
+ Remove the workaround for mingw-w64 [Bug 3407992]. It's long fixed.
+
+2012-03-27 Donal K. Fellows <dkf@users.sf.net>
+
+ IMPLEMENTATION OF TIP#397.
+
+ * generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: Make the
+ target object name optional when copying classes. [RFE 3485060]: Add
+ callback method ("<cloned>") so that scripted control over copying is
+ easier.
+ ***POTENTIAL INCOMPATIBILITY***
+ If you'd previously been using the "<cloned>" method name, this now
+ has a standard semantics and call interface. Only a problem if you are
+ also using [oo::copy].
+
+2012-03-26 Donal K. Fellows <dkf@users.sf.net>
+
+ IMPLEMENTATION OF TIP#380.
+
+ * doc/define.n, doc/object.n, generic/tclOO.c, generic/tclOOBasic.c:
+ * generic/tclOOCall.c, generic/tclOODefineCmds.c, generic/tclOOInt.h:
+ * tests/oo.test: Switch definitions of lists of things in objects and
+ classes to a slot-based approach, which gives a lot more flexibility
+ and programmability at the script-level. Introduce new [::oo::Slot]
+ class which is the implementation of these things.
+
+ ***POTENTIAL INCOMPATIBILITY***
+ The unknown method handler now may be asked to deal with the case
+ where no method name is provided at all. The default implementation
+ generates a compatible error message, and any override that forces the
+ presence of a first argument (i.e., a method name) will continue to
+ function as at present as well, so this is a pretty small change.
+
+ * generic/tclOOBasic.c (TclOO_Object_Destroy): Made it easier to do a
+ tailcall inside a normally-invoked destructor; prevented leakage out
+ to calling command.
+
+2012-03-25 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.decls: [Bug 3508771]: load tclreg.dll in cygwin
+ * generic/tclIntPlatDecls.h: tclsh. Implement TclWinConvertError,
+ * generic/tclStubInit.c: TclWinConvertWSAError, and various more
+ * unix/Makefile.in: win32-specific internal functions for
+ * unix/tcl.m4: Cygwin, so win32 extensions using those
+ * unix/configure: can be loaded in the cygwin version of
+ * win/tclWinError.c: tclsh.
+
+2012-03-23 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.decls: Revert some cygwin-related signature
+ * generic/tclIntPlatDecls.h: changes from [835f8e1e9d] (2010-01-22).
+ * win/tclWinError.c: They were an attempt to make the cygwin
+ port compile again, but since cygwin is
+ based on unix this serves no purpose any
+ more.
+ * win/tclWinSerial.c: Use EAGAIN in stead of EWOULDBLOCK,
+ * win/tclWinSock.c: because in VS10+ the value of
+ EWOULDBLOCK is no longer the same as
+ EAGAIN.
+ * unix/Makefile.in: Add tclWinError.c to the CYGWIN build.
+ * unix/tcl.m4:
+ * unix/configure:
+
+2012-03-20 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.decls: [Bug 3508771]: load tclreg.dll in cygwin
+ * generic/tclInt.decls: tclsh. Implement TclWinGetPlatformId,
+ * generic/tclIntPlatDecls.h: Tcl_WinUtfToTChar, Tcl_WinTCharToUtf (and
+ * generic/tclPlatDecls.h: a dummy TclWinCPUID) for Cygwin, so win32
+ * generic/tclStubInit.c: extensions using those can be loaded in
+ * unix/tclUnixCompat.c: the cygwin version of tclsh.
+
+2012-03-19 Venkat Iyer <venkat@comit.com>
+
+ * library/tzdata/America/Atikokan: Update to tzdata2012b.
+ * library/tzdata/America/Blanc-Sablon:
+ * library/tzdata/America/Dawson_Creek:
+ * library/tzdata/America/Edmonton:
+ * library/tzdata/America/Glace_Bay:
+ * library/tzdata/America/Goose_Bay:
+ * library/tzdata/America/Halifax:
+ * library/tzdata/America/Havana:
+ * library/tzdata/America/Moncton:
+ * library/tzdata/America/Montreal:
+ * library/tzdata/America/Nipigon:
+ * library/tzdata/America/Rainy_River:
+ * library/tzdata/America/Regina:
+ * library/tzdata/America/Santiago:
+ * library/tzdata/America/St_Johns:
+ * library/tzdata/America/Swift_Current:
+ * library/tzdata/America/Toronto:
+ * library/tzdata/America/Vancouver:
+ * library/tzdata/America/Winnipeg:
+ * library/tzdata/Antarctica/Casey:
+ * library/tzdata/Antarctica/Davis:
+ * library/tzdata/Antarctica/Palmer:
+ * library/tzdata/Asia/Yerevan:
+ * library/tzdata/Atlantic/Stanley:
+ * library/tzdata/Pacific/Easter:
+ * library/tzdata/Pacific/Fakaofo:
+ * library/tzdata/America/Creston: (new)
+
+2012-03-19 Reinhard Max <max@suse.de>
+
+ * unix/tclUnixSock.c (Tcl_OpenTcpServer): Use the values returned
+ by getaddrinfo() for all three arguments to socket() instead of
+ only using ai_family. Try to keep the most meaningful error while
+ iterating over the result list, because using the last error can
+ be misleading.
+
+2012-03-15 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: [Bug 3288345]: Wrong Tcl_StatBuf used on Cygwin
+ * unix/tclUnixFile.c:
+ * unix/tclUnixPort.h:
+ * win/cat.c: Remove cygwin stuff no longer needed
+ * win/tclWinFile.c:
+ * win/tclWinPort.h:
+
+2012-03-12 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinFile.c: [Bug 3388350]: mingw64 compiler warnings
+
+2012-03-11 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/*.n, doc/*.3: A number of small spelling and wording fixes.
+
+2012-03-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/info.n: Various minor fixes (prompted by Andreas Kupries
+ * doc/socket.n: detecting a spelling mistake).
+
+2012-03-07 Andreas Kupries <andreask@activestate.com>
+
+ * library/http/http.tcl: [Bug 3498327]: Generate upper-case
+ * library/http/pkgIndex.tcl: hexadecimal output for compliance
+ * tests/http.test: with RFC 3986. Bumped version to 2.8.4.
+ * unix/Makefile.in:
+ * win/Makefile.in:
+
+2012-03-06 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinPort.h: Compatibility with older Visual Studio versions.
+
+2012-03-04 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclLoad.c: Patch from the cygwin folks
+ * unix/tcl.m4:
+ * unix/configure: (re-generated)
+
+2012-03-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBinary.c (Tcl_SetByteArrayObj): [Bug 3496014]: Only zero
+ out the memory block if it is not being immediately overwritten. (Our
+ caller might still overwrite, but we should at least avoid
+ known-useless work.)
+
+2012-02-29 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclIOUtil.c: [Bug 3466099]: BOM in Unicode
+ * generic/tclEncoding.c:
+ * tests/source.test:
+
+2012-02-23 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/reg.test (14.21-23): Add tests relating to Bug 1115587. Actual
+ bug is characterised by test marked with 'knownBug'.
+
+2012-02-17 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclIOUtil.c: [Bug 2233954]: AIX: compile error
+ * unix/tclUnixPort.h:
+
+2012-02-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (INST_LIST_RANGE_IMM): Enhance implementation
+ so that shortening a (not multiply-referenced) list by lopping the end
+ off with [lrange] or [lreplace] is efficient.
+
+2012-02-15 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileLreplaceCmd): Added a compilation
+ strategy for [lreplace] that tackles the cases which are equivalent to
+ a static [lrange].
+ (TclCompileLrangeCmd): Add compiler for [lrange] with constant indices
+ so we can take advantage of existing TCL_LIST_RANGE_IMM opcode.
+ (TclCompileLindexCmd): Improve coverage of constant-index-style
+ compliation using technique developed for [lrange] above.
+
+ (TclCompileDictForCmd): [Bug 3487626]: Fix crash in compilation of
+ [dict for] when its implementation command is used directly rather
+ than through the ensemble.
+
+2012-02-09 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStringObj.c: Converted the memcpy() calls in append
+ operations to memmove() calls. This adds safety in the case of
+ overlapping copies, and improves performance on some benchmarks.
+
+2012-02-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclEnsemble.c: [Bug 3485022]: TclCompileEnsemble() avoid
+ * tests/trace.test: compile when exec traces set.
+
+2012-02-06 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclTrace.c: [Bug 3484621]: Ensure that execution traces on
+ * tests/trace.test: bytecoded commands bump the interp's compile
+ epoch.
+
+2012-02-02 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclUniData.c: [FRQ 3464401]: Support Unicode 6.1
+ * generic/regc_locale.c:
+
+2012-02-02 Don Porter <dgp@users.sourceforge.net>
+
+ * win/tclWinFile.c: [Bugs 2974459,2879351,1951574,1852572,
+ 1661378,1613456]: Revisions to the NativeAccess() routine that queries
+ file permissions on Windows native filesystems. Meant to fix numerous
+ bugs where [file writable|readable|executable] "lies" about what
+ operations are possible, especially when the file resides on a Samba
+ share.
+
+2012-02-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/AddErrInfo.3: [Bug 3482614]: Documentation nit.
+
+2012-01-30 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileCatchCmd): Added a more efficient
+ bytecode generator for the case where 'catch' is used without any
+ variable arguments; don't capture the result just to discard it.
+
+2012-01-26 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdAH.c: [Bug 3479689]: New internal routine
+ * generic/tclFCmd.c: TclJoinPath(). Refactor all the
+ * generic/tclFileName.c: *Join*Path* routines to give them more
+ * generic/tclInt.h: useful interfaces that are easier to
+ * generic/tclPathObj.c: manage getting the refcounts right.
+
+2012-01-26 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPathObj.c: [Bug 3475569]: Add checks for unshared values
+ before calls demanding them. [Bug 3479689]: Stop memory corruption
+ when shimmering 0-refCount value to "path" type.
+
+2012-01-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: When
+ copying an object, make sure that the configuration of the variable
+ resolver is also duplicated.
+
+2012-01-22 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/uniClass.tcl: [FRQ 3473670]: Various Unicode-related
+ * tools/uniParse.tcl: speedups/robustness. Enhanced tools to be
+ * generic/tclUniData.c: able to handle characters > 0xffff. Done in
+ * generic/tclUtf.c: all branches in order to simplify merges for
+ * generic/regc_locale.c: new Unicode versions (such as 6.1)
+
+2012-01-22 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclDictObj.c (DictExistsCmd): [Bug 3475264]: Ensure that
+ errors only ever happen when insufficient arguments are supplied, and
+ not when a path doesn't exist or a dictionary is poorly formatted (the
+ two cases can't be easily distinguished).
+
+2012-01-21 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: [Bug 3474726]: Eliminate detection of struct
+ * generic/tclWinPort.h: _stat32i64, just use _stati64 in combination
+ * generic/tclFCmd.c: with _USE_32BIT_TIME_T, which is the same
+ * generic/tclTest.c: then. Only keep _stat32i64 usage for cygwin,
+ * win/configure.in: so it will not conflict with cygwin's own
+ * win/configure: struct stat.
+
+2012-01-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c: [Bug 3475667]: Prevent buffer read overflow.
+ Thanks to "sebres" for the report and fix.
+
+2012-01-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/dict.n (dict with): [Bug 3474512]: Explain better what is going
+ on when a dictionary key and the dictionary variable collide.
+
+2012-01-13 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/http/http.tcl (http::Connect): [Bug 3472316]: Ensure that we
+ only try to read the socket error exactly once.
+
+2012-01-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/tclvars.n: [Bug 3466506]: Document more environment variables.
+
+2012-01-09 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclUtf.c: [Bug 3464428]: [string is graph \u0120] was
+ * generic/regc_locale.c: wrong. Add table for Unicode [:cntrl:] class.
+ * tools/uniClass.tcl: Generate Unicode [:cntrl:] class table.
+ * tests/utf.test:
+
+2012-01-08 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl (ReadZoneinfoFile): [Bug 3470928]: Corrected a bug
+ * tests/clock.test (clock-56.4): where loading zoneinfo would
+ fail if one timezone abbreviation was a proper tail of another, and
+ zic used the same bytes of the file to represent both of them. Added a
+ test case for the bug, using the same data that caused the observed
+ failure "in the wild."
+
+2011-12-30 Venkat Iyer <venkat@comit.com>
+
+ * library/tzdata/America/Bahia: Update to Olson's tzdata2011n
+ * library/tzdata/America/Havana:
+ * library/tzdata/Europe/Kiev:
+ * library/tzdata/Europe/Simferopol:
+ * library/tzdata/Europe/Uzhgorod:
+ * library/tzdata/Europe/Zaporozhye:
+ * library/tzdata/Pacific/Fiji:
+
+2011-12-23 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclUtf.c: [Bug 3464428]: [string is graph \u0120] is wrong.
+ * generic/tclUniData.c:
+ * generic/regc_locale.c:
+ * tests/utf.test:
+ * tools/uniParse.tcl: Clean up some unused stuff, and be more robust
+ against changes in UnicodeData.txt syntax
+
+2011-12-13 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclCompile.c (TclInitAuxDataTypeTable): Extended to register
+ the DictUpdateInfo structure as an AuxData type. For use by tbcload,
+ tclcompiler.
+
+2011-12-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/regc_locale.c: [Bug 3457031]: Some Unicode 6.0 chars not
+ * tests/utf.test: in [:print:] class
+
+2011-12-07 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/uniParse.tcl: [Bug 3444754]: string tolower \u01c5 is wrong
+ * generic/tclUniData.c:
+ * tests/utf.test:
+
+2011-11-30 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * library/tcltest/tcltest.tcl: [Bug 967195]: Make tcltest work
+ when tclsh is compiled without using the setargv() function on mingw.
+
+2011-11-29 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/Makefile.in: don't install tommath_(super)?class.h
+ * unix/Makefile.in: don't install directories like 8.2 and 8.3
+ * generic/tclTomMath.h: [Bug 2991415]: move include tclInt.h from
+ * generic/tclTomMathInt.h: tclTomMath.h to tclTomMathInt.h
+
+2011-11-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/history.tcl (history): Simplify the dance of variable
+ management used when chaining to the implementation command.
+
+2011-11-22 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TclCompileObj): Simplify and de-indent the
+ logic so that it is easier to comprehend.
+
+2011-11-22 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinPort.h: [Bug 3354324]: Windows: [file mtime] sets wrong
+ * win/tclWinFile.c: time (VS2005+ only).
+ * generic/tclTest.c:
+
+2011-11-20 Joe Mistachkin <joe@mistachkin.com>
+
+ * tests/thread.test: Remove unnecessary [after] calls from the thread
+ tests. Make error message matching more robust for tests that may
+ have built-in race conditions. Test thread-7.26 must first unset all
+ thread testing related variables. Revise results of the thread-7.28
+ through thread-7.31 tests to account for the fact they are canceled
+ via a script sent to the thread asynchronously, which then impacts the
+ error message handling. Attempt to manually drain the event queue for
+ the main thread after joining the test thread to make sure no stray
+ events are processed at the wrong time on the main thread. Revise all
+ the synchronization and comparison semantics related to the thread id
+ and error message.
+
+2011-11-18 Joe Mistachkin <joe@mistachkin.com>
+
+ * tests/thread.test: Remove all use of thread::release from the thread
+ 7.x tests, replacing it with a script that can easily cause "stuck"
+ threads to self-destruct for those test cases that require it. Also,
+ make the error message handling far more robust by keeping track of
+ every asynchronous error.
+
+2011-11-17 Joe Mistachkin <joe@mistachkin.com>
+
+ * tests/thread.test: Refactor all the remaining thread-7.x tests that
+ were using [testthread]. Note that this test file now requires the
+ very latest version of the Thread package to pass all tests. In
+ addition, the thread-7.18 and thread-7.19 tests have been flagged as
+ knownBug because they cannot pass without modifications to the [expr]
+ command, persuant to TIP #392.
+
+2011-11-17 Joe Mistachkin <joe@mistachkin.com>
+
+ * generic/tclThreadTest.c: For [testthread cancel], avoid creating a
+ new Tcl_Obj when the default script cancellation result is desired.
+
+2011-11-11 Donal K. Fellows <dkf@users.sf.net>
+
+ * win/tclWinConsole.c: Refactor common thread handling patterns.
+
+2011-11-11 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * tests/zlib.test: [Bug 3428756]: Use nonblocking writes in
+ single-threaded IO tests to avoid deadlocks when going beyond OS
+ buffers. Tidy up [chan configure] flags across zlib.test.
+
+2011-11-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/tclUnixCompat.c (TclpGetPwNam, TclpGetPwUid, TclpGetGrNam)
+ (TclpGetGrGid): Use the elaborate memory management scheme outlined on
+ http://www.opengroup.org/austin/docs/austin_328.txt to handle Tcl's
+ use of standard reentrant versions of the passwd/group access
+ functions so that everything can work on all BSDs. Problem identified
+ by Stuart Cassoff.
+
+2011-10-20 Don Porter <dgp@users.sourceforge.net>
+
+ * library/http/http.tcl: Bump to version 2.8.3
+ * library/http/pkgIndex.tcl:
+ * unix/Makefile.in:
+ * win/Makefile.in:
+
+ * changes: Updates toward 8.6b3 release.
+
+2011-10-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclLiteral.c (TclInvalidateCmdLiteral): [Bug 3418547]:
+ Additional code for handling the invalidation of literals.
+ * generic/tclBasic.c (Tcl_CreateObjCommand, Tcl_CreateCommand)
+ (TclRenameCommand, Tcl_ExposeCommand): The four additional places that
+ need extra care when dealing with literals.
+ * generic/tclTest.c (TestInterpResolverCmd): Additional test machinery
+ for interpreter resolvers.
+
+2011-10-18 Reinhard Max <max@suse.de>
+
+ * library/clock.tcl (::tcl::clock::GetSystemTimeZone): Cache the time
+ zone only if it was detected by one of the expensive methods.
+ Otherwise after unsetting TCL_TZ or TZ the previous value will still
+ be used.
+
+2011-10-15 Venkat Iyer <venkat@comit.com>
+
+ * library/tzdata/America/Sitka: Update to Olson's tzdata2011l
+ * library/tzdata/Pacific/Fiji:
+ * library/tzdata/Asia/Hebron: (New)
+
+2011-10-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinFile.c: [Bug 2935503]: Incorrect mode field returned by
+ [file stat] command.
+
+2011-10-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileDictWithCmd): Corrected handling of
+ qualified names, and added spacial cases for empty bodies (used when
+ [dict with] is just used for extracting variables).
+
+2011-10-07 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: Fix gcc warnings (discovered with latest
+ * generic/tclIORChan.c: mingw, based on gcc 4.6.1)
+ * tests/env.test: Fix env.test, when running under wine 1.3.
+
+2011-10-06 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclDictObj.c (TclDictWithInit, TclDictWithFinish):
+ * generic/tclCompCmds.c (TclCompileDictWithCmd): Experimental
+ compilation for the [dict with] subcommand, using parts factored out
+ from the interpreted version of the command.
+
+2011-10-05 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinInt.h: Remove tclWinProcs, as it is no longer
+ * win/tclWin32Dll.c: being used.
+
+2011-10-03 Venkat Iyer <venkat@comit.com>
+
+ * library/tzdata/Africa/Dar_es_Salaam: Update to Olson's tzdata2011k
+ * library/tzdata/Africa/Kampala:
+ * library/tzdata/Africa/Nairobi:
+ * library/tzdata/Asia/Gaza:
+ * library/tzdata/Europe/Kaliningrad:
+ * library/tzdata/Europe/Kiev:
+ * library/tzdata/Europe/Minsk:
+ * library/tzdata/Europe/Simferopol:
+ * library/tzdata/Europe/Uzhgorod:
+ * library/tzdata/Europe/Zaporozhye:
+ * library/tzdata/Pacific/Apia:
+
+2011-09-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * tools/tcltk-man2html.tcl, tools/tcltk-man2html-utils.tcl: More
+ refactoring so that more of the utility code is decently out of the
+ way. Adjusted the header-material generator so that version numbers
+ are only included in locations where there is room.
+
+2011-09-28 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclOO.h: [RFE 3010352]: make all TclOO API functions
+ * generic/tclOODecls.h: MODULE_SCOPE
+ * generic/tclOOIntDecls.h:
+
+2011-09-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclIndexObj.c (Tcl_ParseArgsObjv): [Bug 3413857]: Corrected
+ the memory management for the code parsing arguments when returning
+ "large" numbers of arguments. Also unbroke the TCL_ARGV_AUTO_REST
+ macro in passing.
+
+2011-09-26 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdAH.c (TclMakeFileCommandSafe): [Bug 3211758]: Also
+ make the main [file] command hidden by default in safe interpreters,
+ because that's what existing code expects. This will reduce the amount
+ which the code breaks, but not necessarily eliminate it...
+
+2011-09-23 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIORTrans.c: More revisions to get finalization of
+ ReflectedTransforms correct, including adopting a "dead" field as was
+ done in tclIORChan.c.
+
+ * tests/thread.test: Stop using the deprecated thread management
+ commands of the tcltest package. The test suite ought to provide
+ these tools for itself. They do not belong in a testing harness.
+
+2011-09-22 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdIL.c: Revise [info frame] so that it stops creating
+ cycles in the iPtr->cmdFramePtr stack.
+
+2011-09-22 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/re_syntax.n: [Bug 2903743]: Add more magic so that we can do at
+ least something sane on Solaris.
+ * tools/tcltk-man2html-utils.tcl (process-text): Teach the HTML
+ generator how to handle this magic.
+
+2011-09-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclThreadTest.c: Revise the thread exit handling of the
+ [testthread] command so that it properly maintains the per-process
+ data structures even when the thread exits for reasons other than the
+ [testthread exit] command.
+
+2011-09-21 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * unix/tclIO.c: [Bug 3412487]: Now short reads are allowed in
+ synchronous fcopy, avoid mistaking them as nonblocking ones.
+
+2011-09-21 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIORTrans.c (ForwardOpToOwnerThread): Fixed the missing
+ initialization of the 'dsti' field. Reported by Don Porter, on chat.
+
+2011-09-20 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIORChan.c: Re-using the "interp" field to signal a dead
+ channel (via NULL value) interfered with conditional cleanup tasks
+ testing for "the right interp". Added a new field "dead" to perform
+ the dead channel signalling task so the corrupted logic is avoided.
+
+ * generic/tclIORTrans.c: Revised ReflectClose() and
+ FreeReflectedTransform() so that we stop leaking ReflectedTransforms,
+ yet free all Tcl_Obj values in the same thread that alloced them.
+
+2011-09-19 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/ioTrans.test: Conversion from [testthread] to Thread package
+ stops most memory leaks.
+
+ * tests/thread.test: Plug most memory leaks in thread.test.
+ Constrain the rest to be skipped during `make valgrind'. Tests using
+ the [testthread cancel] testing command are leaky. Corrections wait
+ for either addition of [thread::cancel] to the Thread package, or
+ improvements to the [testthread] testing command to make leak-free
+ versions of these tests possible.
+
+ * generic/tclIORChan.c: Plug all memory leaks in ioCmd.test exposed
+ * tests/ioCmd.test: by `make valgrind'.
+ * unix/Makefile.in:
+
+2011-09-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ IMPLEMENTATION OF TIP #388
+
+ * doc/Tcl.n:
+ * doc/re_syntax.n:
+ * generic/regc_lex.c:
+ * generic/regcomp.c:
+ * generic/regcustom.h:
+ * generic/tcl.h:
+ * generic/tclParse.c:
+ * tests/reg.test:
+ * tests/utf.test:
+
+2011-09-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclProc.c (ProcWrongNumArgs): [Bugs 3400658,3408830]:
+ Corrected the handling of procedure error messages (found by TclOO).
+
+2011-09-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: Don't change Tcl_UniChar type when
+ * generic/regcustom.h: TCL_UTF_MAX == 4 (not supported anyway)
+
+2011-09-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclProc.c (ProcWrongNumArgs): [Bugs 3400658,3408830]:
+ Ensemble-like rewriting of error messages is complex, and TclOO (in
+ combination with iTcl) hits the most tricky cases.
+
+ * library/http/http.tcl (http::geturl): [Bug 3391977]: Ensure that the
+ -headers option overrides the -type option (important because -type
+ has a default that is not always appropriate, and the header must not
+ be duplicated).
+
+2011-09-15 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: [Bug 3408408]: Partial improvement by sharing
+ as literals the computed values of constant subexpressions when we can
+ do so without incurring the cost of string rep generation.
+
+2011-09-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclUtil.c: [Bug 3390638]: Workaround broken Solaris
+ Studio cc optimizer. Thanks to Wolfgang S. Kechel.
+
+ * generic/tclDTrace.d: [Bug 3405652]: Portability workaround for
+ broken system DTrace support. Thanks to Dagobert Michelson.
+
+2011-09-12 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinPort.h: [Bug 3407070]: tclPosixStr.c won't build with
+ EOVERFLOW==E2BIG
+
+2011-09-11 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/thread.test: Convert [testthread] use to Thread package use
+ in thread-6.1. Eliminates a memory leak in `make valgrind`.
+
+ * tests/socket.test: [Bug 3390699]: Convert [testthread] use to
+ Thread package use in socket_*-13.1. Eliminates a memory leak in
+ `make valgrind`.
+
+2011-09-09 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/chanio.test: [Bug 3389733]: Convert [testthread] use to
+ * tests/io.test: Thread package use in *io-70.1. Eliminates a
+ memory leak in `make valgrind`.
+
+2011-09-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: [Bug 3401704]: Allow function names like
+ * tests/parseExpr.test: influence(), nanobot(), and 99bottles() that
+ have been parsed as missing operator syntax errors before with the
+ form NUMBER + FUNCTION.
+ ***POTENTIAL INCOMPATIBILITY***
+
+2011-09-06 Venkat Iyer <venkat@comit.com>
+
+ * library/tzdata/America/Goose_Bay: Update to Olson's tzdata2011i
+ * library/tzdata/America/Metlakatla:
+ * library/tzdata/America/Resolute:
+ * library/tzdata/America/St_Johns:
+ * library/tzdata/Europe/Kaliningrad:
+ * library/tzdata/Pacific/Apia:
+ * library/tzdata/Pacific/Honolulu:
+ * library/tzdata/Africa/Juba: (new)
+
+2011-09-06 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: [RFE 1711975]: Tcl_MainEx() (like Tk_MainEx())
+ * generic/tclDecls.h:
+ * generic/tclMain.c:
+
+2011-09-02 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/http.test: Convert [testthread] use to Thread package use.
+ Eliminates memory leak seen in `make valgrind`.
+
+2011-09-01 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * unix/tclUnixSock.c: [Bug 3401422]: Cache script-level changes to the
+ nonblocking flag of an async client socket in progress, and commit
+ them on completion.
+
+2011-09-01 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStrToD.c: [Bug 3402540]: Corrections to TclParseNumber()
+ * tests/binary.test: to make it reject invalid Nan(Hex) strings.
+
+ * tests/scan.test: [scan Inf %g] is portable; remove constraint.
+
+2011-08-30 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclInterp.c (SlaveCommandLimitCmd, SlaveTimeLimitCmd):
+ [Bug 3398794]: Ensure that low-level conditions in the limit API are
+ enforced at the script level through errors, not a Tcl_Panic. This
+ means that interpreters cannot read their own limits (writing already
+ did not work).
+
+2011-08-30 Reinhard Max <max@suse.de>
+
+ * unix/tclUnixSock.c (TcpWatchProc): [Bug 3394732]: Put back the check
+ for server sockets.
+
+2011-08-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIORTrans.c: Leak of ReflectedTransformMap.
+
+2011-08-27 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStringObj.c: [RFE 3396731]: Revise the [string reverse]
+ * tests/string.test: implementation to operate on the representation
+ that comes in, avoid conversion to other reps.
+
+2011-08-23 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIORChan.c: [Bug 3396948]: Leak of ReflectedChannelMap.
+
+2011-08-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIORTrans.c: [Bugs 3393279, 3393280]: ReflectClose(.) is
+ missing Tcl_EventuallyFree() calls at some of its exits.
+
+ * generic/tclIO.c: [Bugs 3394654, 3393276]: Revise FlushChannel() to
+ account for the possibility that the ChanWrite() call might recycle
+ the buffer out from under us.
+
+ * generic/tclIO.c: Preserve the chanPtr during FlushChannel so that
+ channel drivers don't yank it away before we're done with it.
+
+2011-08-19 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclTest.c: [Bug 2981154]: async-4.3 segfault.
+ * tests/async.test: [Bug 1774689]: async-4.3 sometimes fails.
+
+2011-08-18 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclIO.c: [Bug 3096275]: Sync fcopy buffers input.
+
+2011-08-18 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclUniData.c: [Bug 3393714]: Overflow in toupper delta
+ * tools/uniParse.tcl:
+ * tests/utf.test:
+
+2011-08-17 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclIO.c: [Bug 2946474]: Consistently resume backgrounded
+ * tests/ioCmd.test: flushes+closes when exiting.
+
+2011-08-17 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * doc/interp.n: Document TIP 378's one-way-ness.
+
+2011-08-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclGet.c: [Bug 3393150]: Overlooked free of intreps.
+ (It matters for bignums!)
+
+2011-08-16 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.c: [Bug 3392070]: More complete prevention of
+ Tcl_Obj reference cycles when producing an intrep of ByteCode.
+
+2011-08-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclListObj.c (TclLindexList, TclLsetFlat): Silence warnings
+ about (unreachable) cases of uninitialized variables.
+ * generic/tclCmdIL.c (SelectObjFromSublist): Improve the generation of
+ * generic/tclIndexObj.c (Tcl_ParseArgsObjv): messages through the use
+ * generic/tclVar.c (ArrayStartSearchCmd): of Tcl_ObjPrintf.
+
+2011-08-15 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: [Bug 3390272]: Leak of [info script] value.
+
+2011-08-15 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclPosixStr.c: [Bug 3388350]: mingw64 compiler warnings
+ * win/tclWinPort.h:
+ * win/configure.in:
+ * win/configure:
+
+2011-08-14 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * doc/FindExec.3: [Patch 3124554]: Move WishPanic from Tk to Tcl
+ * doc/Panic.3 Added Documentation
+
+2011-08-12 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPathObj.c: [Bug 3389764]: Eliminate possibility that dup
+ of a "path" value can create reference cycle.
+
+2011-08-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclZlib.c (ZlibTransformOutput): [Bug 3390073]: Return the
+ correct length of written data for a compressing transform.
+
+2011-08-10 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclTestObj.c: [Bug 3386721]: Allow multiple [load]ing of the
+ Tcltest package.
+
+2011-08-09 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclBasic.c: [Bug 2919042]: Restore "valgrindability" of Tcl
+ * generic/tclEvent.c: that was lost by the streamlining of [exit], by
+ * generic/tclExecute.c: conditionally forcing a full Finalize:
+ * generic/tclInt.h: use -DPURIFY or ::env(TCL_FINALIZE_ON_EXIT)
+
+2011-08-09 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclCompCmds.c: [Bug 3386417]: Avoid a reference loop between
+ * generic/tclInt.h: the bytecode and its companion errostack
+ * generic/tclResult.c: when compiling a syntax error.
+
+2011-08-09 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinConsole.c: [Bug 3388350]: mingw64 compiler warnings
+ * win/tclWinDde.c:
+ * win/tclWinPipe.c:
+ * win/tclWinSerial.c:
+
+2011-08-09 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.h: Change the signature of TclParseHex(), such that
+ * generic/tclParse.c: it can now parse up to 8 hex characters.
+
+2011-08-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclZlib.c (ZlibStreamCmd): Make the -buffersize option to
+ '$zstream add' function correctly instead of having its value just be
+ discarded unceremoniously. Also generate error codes from more of the
+ code, not just the low-level code but also the Tcl infrastructure.
+
+2011-08-07 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOInfo.c (InfoClassCallCmd): [Bug 3387082]: Plug memory
+ leak in call chain introspection.
+
+2011-08-06 Kevin B, Kenny <kennykb@acm.org>
+
+ * generic/tclAssemnbly.c: [Bug 3384840]: Plug another memory leak.
+ * generic/tclStrToD.c: [Bug 3386975]: Plug another memory leak.
+
+2011-08-05 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclStrToD.c: [Bug 3386975]: Plugged a memory leak in
+ double->string conversion.
+
+2011-08-05 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.6b2 TAGGED FOR RELEASE ***
+
+ * changes: Updates for 8.6b2 release.
+
+2011-08-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclAssembly.c (AssembleOneLine): Ensure that memory isn't
+ leaked when an unknown instruction is encountered. Also simplify code
+ through use of Tcl_ObjPrintf in error message generation.
+
+ * generic/tclZlib.c (ZlibTransformClose): [Bug 3386197]: Plug a memory
+ leak found by Miguel with valgrind, and ensure that the correct
+ direction's buffers are released.
+
+2011-08-04 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (TclPtrSetVar): Fix valgrind-detected error when
+ newValuePtr is the interp's result obj.
+
+2011-08-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclAssembly.c (FreeAssemblyEnv): [Bug 3384840]: Plug another
+ possible memory leak due to over-complex code for freeing the table of
+ labels.
+
+2011-08-04 Reinhard Max <max@suse.de>
+
+ * generic/tclIOSock.c (TclCreateSocketAddress): Don't bother using
+ AI_ADDRCONFIG for now, as it was causing problems in various
+ situations.
+
+2011-08-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclAssembly.c (AssembleOneLine, GetBooleanOperand)
+ (GetIntegerOperand, GetListIndexOperand, FindLocalVar): [Bug 3384840]:
+ A Tcl_Obj is allocated by GetNextOperand, so callers of it must not
+ hold a reference to one in the 'out' parameter when calling it. This
+ was causing a great many memory leaks.
+ * tests/assemble.test (assemble-51.*): Added group of memory leak
+ tests.
+
+2011-08-02 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updates for 8.6b2 release.
+ * tools/tcltk-man2html.tcl: Variable substitution botch.
+
+2011-08-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclObj.c (Tcl_DbIncrRefCount, Tcl_DbDecrRefCount)
+ (Tcl_DbIsShared): [Bug 3384007]: Fix the panic messages so they share
+ what should be shared and have the right number of spaces.
+
+2011-08-01 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclProc.c (TclProcCompileProc): [Bug 3383616]: Fix for leak
+ of resolveInfo when recompiling procs. Thanks go to Gustaf Neumann for
+ detecting the bug and providing the fix.
+
+2011-08-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/tclvars.n (EXAMPLES): Added some examples of how some of the
+ standard global variables can be used, following prompting by a
+ request by Robert Hicks.
+
+ * tools/tcltk-man2html.tcl (plus-pkgs): [Bug 3382474]: Added code to
+ determine the version number of contributed packages from their
+ directory names so that HTML documentation builds are less confusing.
+
+2011-07-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * tools/tcltk-man2html.tcl (ensemble_commands, remap_link_target):
+ Small enhancements to improve cross-linking with contributed packages.
+ * tools/tcltk-man2html-utils.tcl (insert-cross-references): Enhance to
+ cope with contributed packages' C API.
+
+2011-07-28 Reinhard Max <max@suse.de>
+
+ * unix/tcl.m4 (SC_TCL_IPV6): Fix AC_DEFINE invocation for
+ NEED_FAKE_RFC2553.
+ * unix/configure: autoconf-2.59
+
+2011-07-28 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updates for 8.6b2 release.
+
+ * library/tzdata/Asia/Anadyr: Update to Olson's tzdata2011h
+ * library/tzdata/Asia/Irkutsk:
+ * library/tzdata/Asia/Kamchatka:
+ * library/tzdata/Asia/Krasnoyarsk:
+ * library/tzdata/Asia/Magadan:
+ * library/tzdata/Asia/Novokuznetsk:
+ * library/tzdata/Asia/Novosibirsk:
+ * library/tzdata/Asia/Omsk:
+ * library/tzdata/Asia/Sakhalin:
+ * library/tzdata/Asia/Vladivostok:
+ * library/tzdata/Asia/Yakutsk:
+ * library/tzdata/Asia/Yekaterinburg:
+ * library/tzdata/Europe/Kaliningrad:
+ * library/tzdata/Europe/Moscow:
+ * library/tzdata/Europe/Samara:
+ * library/tzdata/Europe/Volgograd:
+ * library/tzdata/America/Kralendijk: (new)
+ * library/tzdata/America/Lower_Princes: (new)
+
+2011-07-26 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c (initScript): Ensure that TclOO is properly found by
+ all the various package mechanisms (by adding a dummy ifneeded script)
+ and not just some of them.
+
+2011-07-21 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinPort.h: [Bug 3372130]: Fix hypot math function with MSVC10
+
+2011-07-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclUtil.c: [Bug 3371644]: Repair failure to properly handle
+ * tests/util.test: (length == -1) scanning in TclConvertElement().
+ Thanks to Thomas Sader and Alexandre Ferrieux.
+
+2011-07-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/*.3, doc/*.n: Many small fixes to documentation as part of
+ project to improve quality of generated HTML docs.
+
+ * tools/tcltk-man2html.tcl (remap_link_target): More complete set of
+ definitions of link targets, especially for major C API types.
+ * tools/tcltk-man2html-utils.tcl (output-IP-list, cross-reference):
+ Update to generation to produce proper HTML bulleted and enumerated
+ lists.
+
+2011-07-19 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * doc/upvar.n: Undocument long gone limitation of [upvar].
+
+2011-07-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Bump version number to 8.6b2.
+ * library/init.tcl:
+ * unix/configure.in:
+ * win/configure.in:
+ * unix/tcl.spec:
+ * tools/tcl.wse.in:
+ * README:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+2011-07-15 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.c: Avoid segfaults when RecordByteCodeStats() is
+ called in a deleted interp.
+
+ * generic/tclCompile.c: [Bug 467523, 3357771]: Prevent circular
+ references in values with ByteCode intreps. They can lead to memory
+ leaks.
+
+2011-07-14 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOCall.c (TclOORenderCallChain): [Bug 3365156]: Remove
+ stray refcount bump that caused a memory leak.
+
+2011-07-12 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclUnixSock.c: [Bug 3364777]: Stop segfault caused by
+ reading from struct after it had been freed.
+
+2011-07-11 Joe Mistachkin <joe@mistachkin.com>
+
+ * generic/tclExecute.c: [Bug 3339502]: Correct cast for CURR_DEPTH to
+ silence compiler warning.
+
+2011-07-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/http.n: [FRQ 3358415]: State what RFC defines HTTP/1.1.
+
+2011-07-07 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Add missing INT2PTR
+
+2011-07-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/FileSystem.3: Corrected statements about ctime field of 'struct
+ stat'; that was always the time of the last metadata change, not the
+ time of creation.
+
+2011-07-02 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclStrToD.c:
+ * generic/tclTomMath.decls:
+ * generic/tclTomMathDecls.h:
+ * macosx/Tcl.xcode/project.pbxproj:
+ * macosx/Tcl.xcodeproj/project.pbxproj:
+ * tests/util.test:
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/Makefile.vc:
+ [Bug 3349507]: Fix a bug where bignum->double conversion is "round up"
+ and not "round to nearest" (causing expr double(1[string repeat 0 23])
+ not to be 1e+23).
+
+2011-06-28 Reinhard Max <max@suse.de>
+
+ * unix/tclUnixSock.c (CreateClientSocket): [Bug 3325339]: Fix and
+ simplify posting of the writable fileevent at the end of an
+ asynchronous connection attempt. Improve comments for some of the
+ trickery around [socket -async].
+
+ * tests/socket.test: Adjust tests to the async code changes. Add more
+ tests for corner cases of async sockets.
+
+2011-06-22 Andreas Kupries <andreask@activestate.com>
+
+ * library/platform/pkgIndex.tcl: Updated to platform 1.0.10. Added
+ * library/platform/platform.tcl: handling of the DEB_HOST_MULTIARCH
+ * unix/Makefile.in: location change for libc.
+ * win/Makefile.in:
+
+ * generic/tclInt.h: Fixed the inadvertently committed disabling of
+ stack checks, see my 2010-11-15 commit.
+
+2011-06-22 Reinhard Max <max@suse.de>
+
+ Merge from rmax-ipv6-branch:
+ * unix/tclUnixSock.c: Fix [socket -async], so that all addresses
+ returned by getaddrinfo() are tried, not just the first one. This
+ requires the event loop to be running while the async connection is in
+ progress. ***POTENTIAL INCOMPATIBILITY***
+ * tests/socket.test: Add a test for the above.
+ * doc/socket: Document the fact that -async needs the event loop
+ * generic/tclIOSock.c: AI_ADDRCONFIG is broken on HP-UX
+
+2011-06-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclLink.c: [Bug 3317466]: Prevent multiple links to a
+ single Tcl variable when calling Tcl_LinkVar().
+
+2011-06-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStrToD.c: [Bug 3315098]: Mem leak fix from Gustaf
+ Neumann.
+
+2011-06-08 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclExecute.c: Reverted the fix for [Bug 3274728] committed
+ on 2011-04-06 and replaced with one which is 64bit-safe. The existing
+ fix crashed tclsh on Windows 64bit.
+
+2011-06-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/fileSystem.test: Reduce the amount of use of duplication of
+ complex code to perform common tests, and convert others to do the
+ test result check directly using Tcltest's own primitives.
+
+2011-06-06 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tests/socket.test: Add test constraint, so 6.2 and 6.3 don't fail
+ when the machine does not have support for ip6. Follow-up to checkin
+ from 2011-05-11 by rmax.
+
+2011-06-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Removed TclCleanupLiteralTable(), and old
+ * generic/tclInt.h: band-aid routine put in place while a fix for
+ * generic/tclLiteral.c: [Bug 994838] took shape. No longer needed.
+
+2011-06-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclInt.h (TclInvalidateNsCmdLookup): [Bug 3185407]: Extend
+ the set of epochs that are potentially bumped when a command is
+ created, for a slight performance drop (in some circumstances) and
+ improved semantics.
+
+2011-06-01 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Using the two free data elements in NRCommand to
+ store objc and objv - useful for debugging.
+
+2011-06-01 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclUtil.c: Fix for [Bug 3309871]: Valgrind finds: invalid
+ read in TclMaxListLength().
+
+2011-05-31 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: Use a complete growth algorithm for lists so
+ * generic/tclListObj.c: that length limits do not overconstrain by a
+ * generic/tclStringObj.c: factor of 2. [Bug 3293874]: Fix includes
+ * generic/tclUtil.c: rooting all growth routines by default on a
+ common tunable parameter TCL_MIN_GROWTH.
+
+2011-05-25 Don Porter <dgp@users.sourceforge.net>
+
+ * library/msgcat/msgcat.tcl: Bump to msgcat 1.4.4.
+ * library/msgcat/pkgIndex.tcl:
+ * unix/Makefile.in:
+ * win/Makefile.in:
+
+2011-05-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.h (TCLOO_VERSION): Bump version.
+
+ IMPLEMENTATION OF TIP#381.
+
+ * doc/next.n, doc/ooInfo.n, doc/self.n, generic/tclOO.c,
+ * generic/tclOOBasic.c, generic/tclOOCall.c, generic/tclOOInfo.c,
+ * generic/tclOOInt.h, tests/oo.test, tests/ooNext2.test: Added
+ introspection of call chains ([self call], [info object call], [info
+ class call]) and ability to skip ahead in chain ([nextto]).
+
+2011-05-24 Venkat Iyer <venkat@comit.com>
+
+ * library/tzdata/Africa/Cairo: Update to Olson tzdata2011g
+
+2011-05-24 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/msgcat/msgcat.tcl (msgcat::mcset, msgcat::mcmset): Remove
+ some useless code; [dict set] builds dictionary levels for us.
+
+2011-05-17 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclCompile.c (TclFixupForwardJump): Tracked down and fixed
+ * generic/tclBasic.c (TclArgumentBCEnter): the cause of a violation of
+ my assertion that 'ePtr->nline == objc' in TclArgumentBCEnter. When a
+ bytecode was grown during jump fixup the pc -> command line mapping
+ was not updated. When things aligned just wrong the mapping would
+ direct command A to the data for command B, with a different number of
+ arguments.
+
+2011-05-11 Reinhard Max <max@suse.de>
+
+ * unix/tclUnixSock.c (TcpWatchProc): No need to check for server
+ sockets here, as the generic server code already takes care of that.
+ * tests/socket.test (accept): Add tests to make sure that this remains
+ so.
+
+2011-05-10 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: New internal routines TclScanElement() and
+ * generic/tclUtil.c: TclConvertElement() are rewritten guts of
+ machinery to produce string rep of lists. The new routines avoid and
+ correct [Bug 3173086]. See comments for much more detail.
+
+ * generic/tclDictObj.c: Update all callers.
+ * generic/tclIndexObj.c:
+ * generic/tclListObj.c:
+ * generic/tclUtil.c:
+ * tests/list.test:
+
+2011-05-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclNamesp.c (NamespacePathCmd): Convert to use Tcl_Obj API
+ * generic/tclPkg.c (Tcl_PackageObjCmd): for result generation in
+ * generic/tclTimer.c (Tcl_AfterObjCmd): [after info], [namespace
+ path] and [package versions].
+
+2011-05-09 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclListObj.c: Revise empty string tests so that we avoid
+ potentially expensive string rep generations, especially for dicts.
+
+2011-05-07 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclLoad.c (TclGetLoadedPackages): Convert to use Tcl_Obj API
+ for result generation.
+
+2011-05-07 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.h: Fix USE_TCLALLOC so that it can be enabled without
+ * unix/Makefile.in: editing the Makefile.
+
+2011-05-05 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclListObj.c: Stop generating string rep of dict when
+ converting to list. Tolerate NULL interps more completely.
+
+2011-05-03 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclUtil.c: Tighten Tcl_SplitList().
+ * generic/tclListObj.c: Tighten SetListFromAny().
+ * generic/tclDictObj.c: Tighten SetDictFromAny().
+ * tests/join.test:
+ * tests/mathop.test:
+
+2011-05-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c: Revised TclFindElement() interface. The final
+ * generic/tclDictObj.c: argument had been bracePtr, the address of a
+ * generic/tclListObj.c: boolean var, where the caller can be told
+ * generic/tclParse.c: whether or not the parsed list element was
+ * generic/tclUtil.c: enclosed in braces. In practice, no callers
+ really care about that. What the callers really want to know is
+ whether the list element value exists as a literal substring of the
+ string being parsed, or whether a call to TclCopyAndCollpase() is
+ needed to produce the list element value. Now the final argument is
+ changed to do what callers actually need. This is a better fit for the
+ calls in tclParse.c, where now a good deal of post-processing checking
+ for "naked backslashes" is no longer necessary.
+ ***POTENTIAL INCOMPATIBILITY***
+ For any callers calling in via the internal stubs table who really do
+ use the final argument explicitly to check for the enclosing brace
+ scenario. Simply looking for the braces where they must be is the
+ revision available to those callers, and it will backport cleanly.
+
+ * tests/parse.test: Tests for expanded literals quoting detection.
+
+ * generic/tclCompCmdsSZ.c: New TclFindElement() is also a better
+ fit for the [switch] compiler.
+
+ * generic/tclInt.h: Replace TclCountSpaceRuns() with
+ * generic/tclListObj.c: TclMaxListLength() which is the function we
+ * generic/tclUtil.c: actually want.
+ * generic/tclCompCmdsSZ.c:
+
+ * generic/tclCompCmdsSZ.c: Rewrite of parts of the switch compiler to
+ better use the powers of TclFindElement() and do less parsing on its
+ own.
+
+2011-04-28 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: New utility routines:
+ * generic/tclParse.c: TclIsSpaceProc() and TclCountSpaceRuns()
+ * generic/tclUtil.c:
+
+ * generic/tclCmdMZ.c: Use new routines to replace calls to isspace()
+ * generic/tclListObj.c: and their /* INTL */ risk.
+ * generic/tclStrToD.c:
+ * generic/tclUtf.c:
+ * unix/tclUnixFile.c:
+
+ * generic/tclStringObj.c: Improved reaction to out of memory.
+
+2011-04-27 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c: TclFreeIntRep() correction & cleanup.
+ * generic/tclExecute.c:
+ * generic/tclIndexObj.c:
+ * generic/tclInt.h:
+ * generic/tclListObj.c:
+ * generic/tclNamesp.c:
+ * generic/tclResult.c:
+ * generic/tclStringObj.c:
+ * generic/tclVar.c:
+
+ * generic/tclListObj.c: FreeListInternalRep() cleanup.
+
+2011-04-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: Use macro to set List intreps.
+ * generic/tclListObj.c:
+
+ * generic/tclCmdIL.c: Limits on list length were too strict.
+ * generic/tclInt.h: Revised panics to errors where possible.
+ * generic/tclListObj.c:
+ * tests/lrepeat.test:
+
+ * generic/tclCompile.c: Make sure SetFooFromAny routines react
+ * generic/tclIO.c: reasonably when passed a NULL interp.
+ * generic/tclIndexObj.c:
+ * generic/tclListObj.c:
+ * generic/tclNamesp.c:
+ * generic/tclObj.c:
+ * generic/tclProc.c:
+ * macosx/tclMacOSXFCmd.c:
+
+2011-04-21 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: fix for [Bug 3288345]: Wrong Tcl_StatBuf
+ * generic/tclInt.h: used on MinGW. Make sure that all _WIN32
+ * win/tclWinFile.c: compilers use exactly the same layout
+ * win/configure.in: for Tcl_StatBuf - the one used by MSVC6 -
+ * win/configure: in all situations.
+
+2011-04-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclConfig.c: Reduce internals access in the implementation
+ of [<foo>::pkgconfig list].
+
+2011-04-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdIL.c: Use ListRepPtr(.) and other cleanup.
+ * generic/tclConfig.c:
+ * generic/tclListObj.c:
+
+ * generic/tclInt.h: Define and use macros that test whether a Tcl
+ * generic/tclBasic.c: list value is canonical.
+ * generic/tclUtil.c:
+
+2011-04-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/dict.n: [Bug 3288696]: Command summary was confusingly wrong
+ when it came to [dict filter] with a 'value' filter.
+
+2011-04-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclFCmd.c (TclFileAttrsCmd): Add comments to make this code
+ easier to understand. Added a panic to handle the case where the VFS
+ layer does something odd.
+
+2011-04-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclUtil.c: [Bug 3285375]: Rewrite of Tcl_Concat*()
+ routines to prevent segfaults on buffer overflow. Build them out of
+ existing primitives already coded to handle overflow properly. Uses
+ the new TclTrim*() routines.
+
+ * generic/tclCmdMZ.c: New internal utility routines TclTrimLeft()
+ * generic/tclInt.h: and TclTrimRight(). Refactor the
+ * generic/tclUtil.c: [string trim*] implementations to use them.
+
+2011-04-13 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c: [Bug 2662380]: Fix crash caused by appending to a
+ variable with a write trace that unsets it.
+
+2011-04-13 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclUtil.c (Tcl_ConcatObj): [Bug 3285375]: Make the crash
+ less mysterious through the judicious use of a panic. Not yet properly
+ fixed, but at least now clearer what the failure mode is.
+
+2011-04-12 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/string.test: Test for [Bug 3285472]. Not buggy in trunk.
+
+2011-04-12 Venkat Iyer <venkat@comit.com>
+
+ * library/tzdata/Atlantic/Stanley: Update to Olson tzdata2011f
+
+2011-04-12 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Fix for [Bug 2440625], kbk's patch
+
+2011-04-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c:
+ * tests/coroutine.test: [Bug 3282869]: Ensure that 'coroutine eval'
+ runs the initial command in the proper context.
+
+2011-04-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: Fix for [Bug 3281728]: Tcl sources from 2011-04-06
+ * unix/tcl.m4: do not build on GCC9 (RH9)
+ * unix/configure:
+
+2011-04-08 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinPort.h: Fix for [Bug 3280043]: win2k: unresolved DLL
+ * win/configure.in: imports.
+ * win/configure
+
+2011-04-06 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TclCompileObj): Earlier return if Tip280
+ gymnastics not needed.
+
+ * generic/tclExecute.c: Fix for [Bug 3274728]: making *catchTop an
+ unsigned long.
+
+2011-04-06 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tclAppInit.c: Make symbols "main" and "Tcl_AppInit"
+ MODULE_SCOPE: there is absolutely no reason for exporting them.
+ * unix/tcl.m4: Don't use -fvisibility=hidden with static
+ * unix/configure libraries (--disable-shared)
+
+2011-04-06 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclFCmd.c, macosx/tclMacOSXFCmd.c, unix/tclUnixChan.c,
+ * unix/tclUnixFCmd.c, win/tclWinChan.c, win/tclWinDde.c,
+ * win/tclWinFCmd.c, win/tclWinLoad.c, win/tclWinPipe.c,
+ * win/tclWinReg.c, win/tclWinSerial.c, win/tclWinSock.c: More
+ generation of error codes (most platform-specific parts not already
+ using Tcl_PosixError).
+
+2011-04-05 Venkat Iyer <venkat@comit.com>
+
+ * library/tzdata/Africa/Casablanca: Update to Olson's tzdata2011e
+ * library/tzdata/America/Santiago:
+ * library/tzdata/Pacific/Easter:
+ * library/tzdata/America/Metlakatla: (new)
+ * library/tzdata/America/North_Dakota/Beulah: (new)
+ * library/tzdata/America/Sitka: (new)
+
+2011-04-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c, generic/tclOOBasic.c, generic/tclOODefineCmds.c
+ * generic/tclOOInfo.c, generic/tclOOMethod.c: More generation of
+ error codes (TclOO miscellany).
+
+ * generic/tclCmdAH.c, generic/tclCmdIL.c: More generation of error
+ codes (miscellaneous commands mostly already handled).
+
+2011-04-04 Don Porter <dgp@users.sourceforge.net>
+
+ * README: [Bug 3202030]: Updated README files, repairing broken
+ * macosx/README:URLs and removing other bits that were clearly wrong.
+ * unix/README: Still could use more eyeballs on the detailed build
+ * win/README: advice on various plaforms.
+
+2011-04-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/init.tcl (tcl::mathfunc::rmmadwiw): Disable by default to
+ make test suite work.
+
+ * generic/tclBasic.c, generic/tclStringObj.c, generic/tclTimer.c,
+ * generic/tclTrace.c, generic/tclUtil.c: More generation of error
+ codes ([format], [after], [trace], RE optimizer).
+
+2011-04-04 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclCmdAH.c: Better error-message in case of errors
+ * generic/tclCmdIL.c: related to setting a variable. This fixes
+ * generic/tclDictObj.c: a warning: "Why make your own error
+ * generic/tclScan.c: message? Why?"
+ * generic/tclTest.c:
+ * test/error.test:
+ * test/info.test:
+ * test/scan.test:
+ * unix/tclUnixThrd.h: Remove this unused header file.
+
+2011-04-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclNamesp.c, generic/tclObj.c, generic/tclPathObj.c:
+ * generic/tclPipe.c, generic/tclPkg.c, generic/tclProc.c:
+ * generic/tclScan.c: More generation of error codes (namespace
+ creation, path normalization, pipeline creation, package handling,
+ procedures, [scan] formats)
+
+2011-04-02 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclStrToD.c (QuickConversion): Replaced another couple
+ of 'double' declarations with 'volatile double' to work around
+ misrounding issues in mingw-gcc 3.4.5.
+
+2011-04-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclInterp.c, generic/tclListObj.c, generic/tclLoad.c:
+ More generation of errorCodes ([interp], [lset], [load], [unload]).
+
+ * generic/tclEvent.c, generic/tclFileName.c: More generation of
+ errorCode information (default [bgerror] and [glob]).
+
+2011-04-01 Reinhard Max <max@suse.de>
+
+ * library/init.tcl: TIP#131 implementation.
+
+2011-03-31 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclGetDate.y, generic/tclDate.c (TclClockOldscanObjCmd):
+ More generation of errorCode information.
+
+2011-03-28 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdMZ.c, generic/tclConfig.c, generic/tclUtil.c: More
+ generation of errorCode information, notably when lists are mis-parsed
+
+ * generic/tclCmdMZ.c (Tcl_RegexpObjCmd, Tcl_RegsubObjCmd): Use the
+ error messages generated by the variable management code rather than
+ creating our own.
+
+2011-03-27 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (TclNREvalObjEx): fix performance issue, notably
+ apparent in tclbench's "LIST lset foreach". Many thanks to Twylite for
+ patiently researching the issue and explaining it to me: a missing
+ Tcl_ResetObjResult that causes unwanted sharing of the current result
+ Tcl_Obj.
+
+2011-03-26 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclNamesp.c (Tcl_Export, Tcl_Import, DoImport): More
+ generation of errorCode information.
+
+ * generic/tclCompExpr.c, generic/tclCompile.c, generic/tclExecute.c:
+ * generic/tclListObj.c, generic/tclNamesp.c, generic/tclObj.c:
+ * generic/tclStringObj.c, generic/tclUtil.c: Reduce the number of
+ casts used to manage Tcl_Obj internal representations.
+
+2011-03-24 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h (ckfree,etc.): Restored C++ usability to the memory
+ allocation and free macros.
+
+2011-03-24 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclFCmd.c (TclFileAttrsCmd): Ensure that any reference to
+ temporary index tables is squelched immediately rather than hanging
+ around to trip us up in the future.
+
+2011-03-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclObj.c: Exploit HAVE_FAST_TSD for the deletion context in
+ TclFreeObj()
+
+2011-03-22 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclThreadAlloc.c: Simpler initialization of Cache under
+ HAVE_FAST_TSD, from mig-alloc-reform.
+
+2011-03-21 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tclLoadDl.c: [Bug 3216070]: Loading extension libraries
+ * unix/tclLoadDyld.c: from embedded Tcl applications.
+ ***POTENTIAL INCOMPATIBILITY***
+ For extensions which rely on symbols from other extensions being
+ present in the global symbol table. For an example and some discussion
+ of workarounds, see http://stackoverflow.com/q/8330614/301832
+
+2011-03-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCkAlloc.c:
+ * generic/tclInt.h: Remove one level of allocator indirection in
+ non-memdebug builds, imported from mig-alloc-reform.
+
+2011-03-20 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclThreadAlloc.c: Imported HAVE_FAST_TSD support from
+ mig-alloc-reform. The feature has to be enabled by hand: no autoconf
+ support has been added. It is not clear how universal a build using
+ this will be: it also requires some loader support.
+
+2011-03-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompExpr.c (ParseExpr): Generate errorCode information on
+ failure to parse expressions.
+
+2011-03-17 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclMain.c: [Patch 3124683]: Reorganize the platform-specific
+ stuff in (tcl|tk)Main.c.
+
+2011-03-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclCkalloc.c: [Bug 3197864]: Pointer truncation on Win64
+ TCL_MEM_DEBUG builds.
+
+2011-03-16 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Some rewrites to eliminate calls to isspace()
+ * generic/tclParse.c: and their /* INTL */ risk.
+ * generic/tclProc.c:
+
+2011-03-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tcl.m4: Make SHLIB_LD_LIBS='${LIBS}' the default and
+ * unix/configure: set to "" on per-platform necessary basis.
+ Backported from TEA, but kept all original platform code which was
+ removed from TEA.
+
+2011-03-14 Kevin B. Kenny <kennykb@acm.org>
+
+ * tools/tclZIC.tcl (onDayOfMonth): Allow for leading zeroes in month
+ and day so that tzdata2011d parses correctly.
+ * library/tzdata/America/Havana:
+ * library/tzdata/America/Juneau:
+ * library/tzdata/America/Santiago:
+ * library/tzdata/Europe/Istanbul:
+ * library/tzdata/Pacific/Apia:
+ * library/tzdata/Pacific/Easter:
+ * library/tzdata/Pacific/Honolulu: tzdata2011d
+
+ * generic/tclAssembly.c (BBEmitInstInt1): Changed parameter data types
+ in an effort to silence a MSVC warning reported by Ashok P. Nadkarni.
+ Unable to test, since both forms work on my machine in VC2005, 2008,
+ 2010, in both release and debug builds.
+ * tests/tclTest.c (TestdstringCmd): Restored MSVC buildability broken
+ by [5574bdd262], which changed the effective return type of 'ckalloc'
+ from 'char*' to 'void*'.
+
+2011-03-13 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: remove TEBCreturn()
+
+2011-03-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tcl.h (ckalloc,ckfree,ckrealloc): Moved casts into these
+ macro so that they work with VOID* (which is a void* on all platforms
+ which Tcl actually builds on) and unsigned int for the length
+ parameters, removing the need for MANY casts across the rest of Tcl.
+ Note that this is a strict source-level-only change, so size_t cannot
+ be used (would break binary compatibility on 64-bit platforms).
+
+2011-03-12 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinFile.c: [Bug 3185609]: File normalization corner case
+ of ... broken with -DUNICODE
+
+2011-03-11 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/unixInit.test: Make better use of tcltest2.
+
+2011-03-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c, generic/tclCompCmds.c, generic/tclEnsemble.c:
+ * generic/tclInt.h, generic/tclNamesp.c, library/auto.tcl:
+ * tests/interp.test, tests/namespace.test, tests/nre.test:
+ Converted the [namespace] command into an ensemble. This has the
+ consequence of making it vital for Tcl code that wishes to work with
+ namespaces to _not_ delete the ::tcl namespace.
+ ***POTENTIAL INCOMPATIBILITY***
+
+ * library/tcltest/tcltest.tcl (loadIntoSlaveInterpreter): Added this
+ command to handle connecting tcltest to a slave interpreter. This adds
+ in the hook (inside the tcltest namespace) that allows the tests run
+ in the child interpreter to be reported as part of the main sequence
+ of test results. Bumped version of tcltest to 2.3.3.
+ * tests/init.test, tests/package.test: Adapted these test files to use
+ the new feature.
+
+ * generic/tclAlloc.c, generic/tclCmdMZ.c, generic/tclCompExpr.c:
+ * generic/tclCompile.c, generic/tclEnv.c, generic/tclEvent.c:
+ * generic/tclIO.c, generic/tclIOCmd.c, generic/tclIORChan.c:
+ * generic/tclIORTrans.c, generic/tclLiteral.c, generic/tclNotify.c:
+ * generic/tclParse.c, generic/tclStringObj.c, generic/tclUtil.c:
+ * generic/tclZlib.c, unix/tclUnixFCmd.c, unix/tclUnixNotfy.c:
+ * unix/tclUnixPort.h, unix/tclXtNotify.c: Formatting fixes, mainly to
+ comments, so code better fits the style in the Engineering Manual.
+
+2011-03-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/incr.test: Update more of the test suite to use Tcltest 2.
+
+2011-03-09 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclNamesp.c: [Bug 3202171]: Tighten the detector of nested
+ * tests/namespace.test: [namespace code] quoting that the quoted
+ scripts function properly even in a namespace that contains a custom
+ "namespace" command.
+
+ * doc/tclvars.n: Formatting fix. Thanks to Pat Thotys.
+
+2011-03-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/dstring.test, tests/init.test, tests/link.test: Update more of
+ the test suite to use Tcltest 2.
+
+2011-03-08 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclBasic.c: Fix gcc warnings: variable set but not used
+ * generic/tclProc.c:
+ * generic/tclIORChan.c:
+ * generic/tclIORTrans.c:
+ * generic/tclAssembly.c: Fix gcc warning: comparison between signed
+ and unsigned integer expressions
+
+2011-03-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: Remove TclMarkList() routine, an experimental
+ * generic/tclUtil.c: dead-end from the 8.5 alpha days.
+
+ * generic/tclResult.c (ResetObjResult): [Bug 3202905]: Correct failure
+ to clear invalid intrep. Thanks to Colin McDonald.
+
+2011-03-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclAssembly.c, tests/assemble.test: Migrate to use a style
+ more consistent with the rest of Tcl.
+
+2011-03-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: More replacements of Tcl_UtfBackslash() calls
+ * generic/tclCompile.c: with TclParseBackslash() where possible.
+ * generic/tclCompCmdsSZ.c:
+ * generic/tclParse.c:
+ * generic/tclUtil.c:
+
+ * generic/tclUtil.c (TclFindElement): [Bug 3192636]: Guard escape
+ sequence scans to not overrun the string end.
+
+2011-03-05 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParse.c (TclParseBackslash): [Bug 3200987]: Correct
+ * tests/parse.test: trunction checks in \x and \u substitutions.
+
+2011-03-05 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TclStackFree): insure that the execStack
+ satisfies "at most one free stack after the current one" when
+ consecutive reallocs caused the creation of intervening stacks.
+
+2011-03-05 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclAssembly.c (new file):
+ * generic/tclBasic.c (Tcl_CreateInterp):
+ * generic/tclInt.h:
+ * tests/assemble.test (new file):
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc: Merged dogeen-assembler-branch into HEAD. Since
+ all functional changes are in the tcl::unsupported namespace, there's
+ no reason to sequester this code on a separate branch.
+
+2011-03-05 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: Cleaner mem management for TEBCdata
+
+ * generic/tclExecute.c:
+ * tests/nre.test: Renamed BottomData to TEBCdata, so that the name
+ refers to what it is rather than to its storage location.
+
+ * generic/tclBasic.c: Renamed struct TEOV_callback to the more
+ * generic/tclCompExpr.c: descriptive NRE_callback.
+ * generic/tclCompile.c:
+ * generic/tclExecute.c:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclTest.c:
+
+2011-03-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect)
+ (ProcedureMethodCompiledVarDelete): [Bug 3185009]: Keep references to
+ resolved object variables so that an unset doesn't leave any dangling
+ pointers for code to trip over.
+
+2011-03-01 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (TclNREvalObjv): Missing a variable declaration
+ in commented out non-optimised code, left for ref in checkin
+ [b97b771b6d]
+
+2011-03-03 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclResult.c (Tcl_AppendResultVA): Use the directive
+ USE_INTERP_RESULT [TIP 330] to force compat with interp->result
+ access, instead of the improvised hack USE_DIRECT_INTERP_RESULT_ACCESS
+ from releases past.
+
+2011-03-01 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompCmdsSZ.c (TclCompileThrowCmd, TclCompileUnsetCmd):
+ fix leaks
+
+ * generic/tclBasic.c: This is [Patch 3168398],
+ * generic/tclCompCmdsSZ.c: Joe Mistachkin's optimisation
+ * generic/tclExecute.c: of Tip #285
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclInterp.c:
+ * generic/tclOODecls.h:
+ * generic/tclStubInit.c:
+ * win/makefile.vc:
+
+ * generic/tclExecute.c (ExprObjCallback): Fix object leak
+
+ * generic/tclExecute.c (TEBCresume): Store local var array and
+ constants in automatic vars to reduce indirection, slight perf
+ increase
+
+ * generic/tclOOCall.c (TclOODeleteContext): Added missing '*' so that
+ trunk compiles.
+
+ * generic/tclBasic.c (TclNRRunCallbacks): [Patch 3168229]: Don't do
+ the trampoline dance for commands that do not have an nreProc.
+
+2011-03-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance)
+ (TclOOObjectCmdCore, FinalizeObjectCall):
+ * generic/tclOOBasic.c (TclOO_Object_Destroy, AfterNRDestructor):
+ * generic/tclOOCall.c (TclOODeleteContext, TclOOGetCallContext):
+ Reorganization of call context reference count management so that code
+ is (mostly) simpler.
+
+2011-01-26 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/RegExp.3: [Bug 3165108]: Corrected documentation of description
+ of subexpression info in Tcl_RegExpInfo structure.
+
+2011-01-25 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclPreserve.c: Don't miss 64-bit address bits in panic
+ message.
+ * win/tclWinChan.c: Fix various gcc-4.5.2 64-bit warning
+ * win/tclWinConsole.c: messages, e.g. by using full 64-bits for
+ * win/tclWinDde.c: socket fd's
+ * win/tclWinPipe.c:
+ * win/tclWinReg.c:
+ * win/tclWinSerial.c:
+ * win/tclWinSock.c:
+ * win/tclWinThrd.c:
+
+2011-01-19 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/genStubs.tcl: [FRQ 3159920]: Tcl_ObjPrintf() crashes with
+ * generic/tcl.decls bad format specifier.
+ * generic/tcl.h:
+ * generic/tclDecls.h:
+
+2011-01-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOMethod.c (PushMethodCallFrame): [Bug 3001438]: Make
+ sure that the cmdPtr field of the procPtr is correct and relevant at
+ all times so that [info frame] can report sensible information about a
+ frame after a return to it from a recursive call, instead of probably
+ crashing (depending on what else has overwritten the Tcl stack!)
+
+2011-01-18 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclBasic.c: Various mismatches between Tcl_Panic
+ * generic/tclCompCmds.c: format string and its arguments,
+ * generic/tclCompCmdsSZ.c: discovered thanks to [Bug 3159920]
+ * generic/tclCompExpr.c:
+ * generic/tclEnsemble.c:
+ * generic/tclPreserve.c:
+ * generic/tclTest.c:
+
+2011-01-17 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclIOCmd.c: [Bug 3148192]: Commands "read/puts" incorrectly
+ * tests/chanio.test: interpret parameters. Improved error-message
+ * tests/io.test regarding legacy form.
+ * tests/ioCmd.test
+
+2011-01-15 Kevin B. Kenny <kennykb@acm.org>
+
+ * doc/tclvars.n:
+ * generic/tclStrToD.c:
+ * generic/tclUtil.c (Tcl_PrintDouble):
+ * tests/util.test (util-16.*): [Bug 3157475]: Restored full Tcl 8.4
+ compatibility for the formatting of floating point numbers when
+ $::tcl_precision is not zero. Added compatibility tests to make sure
+ that excess trailing zeroes are suppressed for all eight major code
+ paths.
+
+2011-01-12 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinFile.c: Use _vsnprintf in stead of vsnprintf, because
+ MSVC 6 doesn't have it. Reported by andreask.
+ * win/tcl.m4: handle --enable-64bit=ia64 for gcc
+ * win/configure.in: more accurate test for correct <intrin.h>
+ * win/configure: (autoconf-2.59)
+ * win/tclWin32Dll.c: VS 2005 64-bit does not have intrin.h, and
+ * generic/tclPanic.c: does not need it.
+
+2011-01-07 Kevin B. Kenny <kennykb@acm.org>
+
+ * tests/util.test (util-15.*): Added test cases for floating point
+ conversion of the largest denormal and the smallest normal number, to
+ avoid any possibility of the failure suffered by PHP in the last
+ couple of days. (They didn't fail, so no actual functional change.)
+
+2011-01-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/package.test, tests/pkg.test: Coalesce these tests into one
+ file that is concerned with the package system. Convert to use
+ tcltest2 properly.
+ * tests/autoMkindex.test, tests/pkgMkIndex.test: Convert to use
+ tcltest2 properly.
+
+2011-01-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/cmdAH.test, tests/cmdMZ.test, tests/compExpr.test,
+ * tests/compile.test, tests/concat.test, tests/eval.test,
+ * tests/fileName.test, tests/fileSystem.test, tests/interp.test,
+ * tests/lsearch.test, tests/namespace-old.test, tests/namespace.test,
+ * tests/oo.test, tests/proc.test, tests/security.test,
+ * tests/switch.test, tests/unixInit.test, tests/var.test,
+ * tests/winDde.test, tests/winPipe.test: Clean up of tests and
+ conversion to tcltest 2. Target has been to get init and cleanup code
+ out of the test body and into the -setup/-cleanup stanzas.
+
+ * tests/execute.test (execute-11.1): [Bug 3142026]: Added test that
+ fails (with a crash) in an unfixed memdebug build on 64-bit systems.
+
+2010-12-31 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdIL.c (SortElement): Use unions properly in the
+ definition of this structure so that there is no need to use nasty
+ int/pointer type punning. Made it clearer what the purposes of the
+ various parts of the structure are.
+
+2010-12-31 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/dltest/*.c: [Bug 3148192]: Fix broken [load] tests by ensuring
+ that the affected files are never compiled with -DSTATIC_BUILD.
+
+2010-12-30 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (GrowEvaluationStack): Off-by-one error in
+ sizing the new allocation - was ok in comment but wrong in the code.
+ Triggered by [Bug 3142026] which happened to require exactly one more
+ than what was in existence.
+
+2010-12-26 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): Fix crash when multiple -index
+ options are used. Simplified memory handling logic.
+
+2010-12-20 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWin32Dll.c: [Patch 3059922]: fixes for mingw64 - gcc4.5.1
+ tdm64-1: completed for all environments.
+
+2010-12-20 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/configure.in: Explicitely test for intrinsics support in
+ compiler, before assuming only MSVC has it.
+ * win/configure: (autoconf-2.59)
+ * generic/tclPanic.c:
+
+2010-12-19 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWin32Dll.c: [Patch 3059922]: fixes for mingw64 - gcc4.5.1
+ tdm64-1: Fixed for gcc, not yet for MSVC 64-bit.
+
+2010-12-17 Stuart Cassoff <stwo@users.sourceforge.net>
+
+ * unix/Makefile.in: Remove unwanted/obsolete 'ddd' target.
+
+2010-12-17 Stuart Cassoff <stwo@users.sourceforge.net>
+
+ * unix/Makefile.in: Clean up '.PHONY:' targets: Arrange those
+ common to Tcl and Tk as in Tk's Makefile.in,
+ add any missing ones and remove duplicates.
+
+2010-12-17 Stuart Cassoff <stwo@users.sourceforge.net>
+
+ * unix/Makefile.in: [Bug 2446711]: Remove 'allpatch' target.
+
+2010-12-17 Stuart Cassoff <stwo@users.sourceforge.net>
+
+ * unix/Makefile.in: [Bug 2537626]: Use 'rpmbuild', not 'rpm'.
+
+2010-12-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclPanic.c: [Patch 3124554]: Move WishPanic from Tk to Tcl
+ * win/tclWinFile.c: Better communication with debugger, if present.
+
+2010-12-15 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+
+ * tclAssembly.c:
+ * assemble.test: Reworked beginCatch/endCatch handling to
+ enforce the more severe (but more correct) restrictions on catch
+ handling that appeared in the discussion of [Bug 3098302] and in
+ tcl-core traffic beginning about 2010-10-29.
+
+2010-12-15 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclPanic.c: Restore abort() as it was before.
+ * win/tclWinFile.c: [Patch 3124554]: Use ExitProcess() here, like
+ in wish.
+
+2010-12-14 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: [Bug 3137454]: Tcl CVS HEAD does not build on GCC 3.
+
+2010-12-14 Reinhard Max <max@suse.de>
+
+ * win/tclWinSock.c (CreateSocket): Swap the loops over
+ * unix/tclUnixSock.c (CreateClientSocket): local and remote addresses,
+ so that the system's address preference for the remote side decides
+ which family gets tried first. Cleanup and clarify some of the
+ comments.
+
+2010-12-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: [Bug 3135271]: Link error due to hidden
+ * unix/tcl.m4: symbols (CentOS 4.2)
+ * unix/configure: (autoconf-2.59)
+ * win/tclWinFile.c: Undocumented feature, only meant to be used by
+ Tk_Main. See [Patch 3124554]: Move WishPanic from Tk to Tcl
+
+2010-12-12 Stuart Cassoff <stwo@users.sourceforge.net>
+
+ * unix/tcl.m4: Better building on OpenBSD.
+ * unix/configure: (autoconf-2.59)
+
+2010-12-10 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: [Bug 3129448]: Possible over-allocation on
+ * generic/tclCkalloc.c: 64-bit platforms, part 2
+ * generic/tclCompile.c:
+ * generic/tclHash.c:
+ * generic/tclInt.h:
+ * generic/tclIO.h:
+ * generic/tclProc.c:
+
+2010-12-10 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclIO.c: Make sure [fcopy -size ... -command ...] always
+ * tests/io.test: calls the callback asynchronously, even for size
+ zero.
+
+2010-12-10 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclBinary.c: Fix gcc -Wextra warning: missing initializer
+ * generic/tclCmdAH.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclDictObj.c:
+ * generic/tclIndexObj.c:
+ * generic/tclIOCmd.c:
+ * generic/tclVar.c:
+ * win/tcl.m4: Fix manifest-generation for 64-bit gcc
+ (mingw-w64)
+ * win/configure.in: Check for availability of intptr_t and
+ uintptr_t
+ * win/configure: (autoconf-2.59)
+ * generic/tclInt.decls: Change 1st param of TclSockMinimumBuffers
+ * generic/tclIntDecls.h: to ClientData, and TclWin(Get|Set)SockOpt
+ * generic/tclIntPlatDecls.h:to SOCKET, because on Win64 those are
+ * generic/tclIOSock.c: 64-bit, which does not fit.
+ * win/tclWinSock.c:
+ * unix/tclUnixSock.c:
+
+2010-12-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/fCmd.test: Improve sanity of constraints now that we don't
+ support anything before Windows 2000.
+
+ * generic/tclCmdAH.c (TclInitFileCmd, TclMakeFileCommandSafe, ...):
+ Break up [file] into an ensemble. Note that the ensemble is safe in
+ itself, but the majority of its subcommands are not.
+ * generic/tclFCmd.c (FileCopyRename,TclFileDeleteCmd,TclFileAttrsCmd)
+ (TclFileMakeDirsCmd): Adjust these subcommand implementations to work
+ inside an ensemble.
+ (TclFileLinkCmd, TclFileReadLinkCmd, TclFileTemporaryCmd): Move these
+ subcommand implementations from tclCmdAH.c, where they didn't really
+ belong.
+ * generic/tclIOCmd.c (TclChannelNamesCmd): Move to more appropriate
+ source file.
+ * generic/tclEnsemble.c (TclMakeEnsemble): Start of code to make
+ partially-safe ensembles. Currently does not function as expected due
+ to various shortcomings in how safe interpreters are constructed.
+ * tests/cmdAH.test, tests/fCmd.test, tests/interp.test: Test updates
+ to take into account systematization of error messages.
+
+ * tests/append.test, tests/appendComp.test: Clean up tests so that
+ they don't leave things in the global environment (detected when doing
+ -singleproc testing).
+
+2010-12-07 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/fCmd.test, tests/safe.test, tests/uplevel.test,
+ * tests/upvar.test, tests/var.test: Convert more tests to tcltest2 and
+ factor them to be easier to understand.
+
+ * generic/tclStrToD.c: Tidy up code so that more #ifdef-fery is
+ quarantined at the front of the file and function headers follow the
+ modern Tcl style.
+
+2010-12-06 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclBinary.c: [Bug 3129448]: Possible over-allocation on
+ * generic/tclCkalloc.c: 64-bit platforms.
+ * generic/tclTrace.c:
+
+2010-12-05 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tcl.m4: [Patch 3116490]: Cross-compile support for unix
+ * unix/configure: (autoconf-2.59)
+
+2010-12-03 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclUtil.c (TclReToGlob): Add extra check for multiple inner
+ *s that leads to poor recursive glob matching, defer to original RE
+ instead. tclbench RE var backtrack.
+
+2010-12-03 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclUtil.c: Silence gcc warning when using -Wwrite-strings
+ * generic/tclStrToD.c: Silence gcc warning for non-IEEE platforms
+ * win/Makefile.in: [Patch 3116490]: Cross-compile Tcl mingw32 on unix
+ * win/tcl.m4: This makes it possible to cross-compile Tcl/Tk for
+ * win/configure.in: Windows (either 32-bit or 64-bit) out-of-the-box
+ * win/configure: on UNIX, using mingw-w64 build tools (If Itcl,
+ tdbc and Thread take over the latest tcl.m4, they can do that too).
+
+2010-12-01 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclStrToD.c (SetPrecisionLimits, TclDoubleDigits):
+ [Bug 3124675]: Added meaningless initialization of 'i', 'ilim' and
+ 'ilim1' to silence warnings from the C compiler about possible use of
+ uninitialized variables, Added a panic to the 'switch' that assigns
+ them, to assert that the 'default' case is impossible.
+
+2010-12-01 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclBasic.c: Fix gcc 64-bit warnings: cast from pointer to
+ * generic/tclHash.c: integer of different size.
+ * generic/tclTest.c:
+ * generic/tclThreadTest.c:
+ * generic/tclStrToD.c: Fix gcc(-4.5.2) warning: 'static' is not at
+ beginning of declaration.
+ * generic/tclPanic.c: Allow Tcl_Panic() to enter the debugger on win32
+ * generic/tclCkalloc.c: Use Tcl_Panic() in stead of duplicating the
+ code.
+
+2010-11-30 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclInt.decls, generic/tclInt.h, generic/tclIntDecls.h:
+ * generic/tclStubInit.c: TclFormatInt restored at slot 24
+ * generic/tclUtil.c (TclFormatInt): restore TclFormatInt func from
+ 2005-07-05 macro-ization. Benchmarks indicate it is faster, as a key
+ int->string routine (e.g. int-indexed arrays).
+
+2010-11-29 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclBasic.c: Patch by Miguel, providing a
+ [::tcl::unsupported::inject coroname command args], which prepends
+ ("injects") arbitrary code to a suspended coro's future resumption.
+ Neat for debugging complex coros without heavy instrumentation.
+
+2010-11-29 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclStrToD.c:
+ * generic/tclTest.c:
+ * generic/tclTomMath.decls:
+ * generic/tclUtil.c:
+ * tests/util.test:
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc: Rewrite of Tcl_PrintDouble and TclDoubleDigits that
+ (a) fixes a severe performance problem with floating point shimmering
+ reported by Karl Lehenbauer, (b) allows TclDoubleDigits to generate
+ the digit strings for 'e' and 'f' format, so that it can be used for
+ tcl_precision != 0 (and possibly later for [format]), (c) fixes [Bug
+ 3120139] by making TclPrintDouble inherently locale-independent, (d)
+ adds test cases to util.test for correct rounding in difficult cases
+ of TclDoubleDigits where fixed- precision results are requested. (e)
+ adds test cases to util.test for the controversial aspects of [Bug
+ 3105247]. As a side effect, two more modules from libtommath
+ (bn_mp_set_int.c and bn_mp_init_set_int.c) are brought into the build,
+ since the new code uses them.
+
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+ * generic/tclTomMathDecls.h: Regenerated.
+
+2010-11-24 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/chanio.test, tests/iogt.test, tests/ioTrans.test: Convert more
+ tests to tcltest2 and factor them to be easier to understand.
+
+2010-11-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/chanio.test: Converted many tests to tcltest2 by marking the
+ setup and cleanup parts as such.
+
+2010-11-19 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWin32Dll.c: Fix gcc warnings: unused variable 'registration'
+ * win/tclWinChan.c:
+ * win/tclWinFCmd.c:
+
+2010-11-18 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclAppInit.c: [FRQ 491789]: "setargv() doesn't support a unicode
+ cmdline" now implemented for cygwin and mingw32 too.
+ * tests/main.test: No longer disable tests Tcl_Main-1.4 and 1.6 on
+ Windows, because those now work on all supported platforms.
+ * win/configure.in: Set NO_VIZ=1 when zlib is compiled in libtcl,
+ this resolves compiler warnings in 64-bit and static builds.
+ * win/configure (regenerated)
+
+2010-11-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/file.n: [Bug 3111298]: Typofix.
+
+ * tests/oo.test: [Bug 3111059]: Added testing that neatly trapped this
+ issue.
+
+2010-11-18 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclNamesp.c: [Bug 3111059]: Fix leak due to bad looping
+ construct.
+
+2010-11-17 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tcl.m4: [FRQ 491789]: "setargv() doesn't support a unicode
+ cmdline" now implemented for mingw-w64
+ * win/configure (re-generated)
+
+2010-11-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclAppInit.c:Bring compilation under mingw-w64 a bit closer
+ * win/cat.c: to reality. See for what's missing:
+ * win/tcl.m4: <https://sourceforge.net/apps/trac/mingw-w64/wiki/Unicode%20apps>
+ * win/configure: (re-generated)
+ * win/tclWinPort.h: [Bug 3110161]: Extensions using TCHAR don't
+ compile on VS2005 SP1
+
+2010-11-15 Andreas Kupries <andreask@activestate.com>
+
+ * doc/interp.n: [Bug 3081184]: TIP #378.
+ * doc/tclvars.n: Performance fix for TIP #280.
+ * generic/tclBasic.c:
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * generic/tclInterp.c:
+ * tests/info.test:
+ * tests/interp.test:
+
+2010-11-10 Andreas Kupries <andreask@activestate.com>
+
+ * changes: Updates for 8.6b2 release.
+
+2010-11-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOMethod.c (ProcedureMethodVarResolver): [Bug 3105999]:
+ * tests/oo.test: Make sure that resolver structures that are
+ only temporarily needed get squelched.
+
+2010-11-05 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclMain.c: Thanks, Kevin, for the fix, but this how it was
+ supposed to be (TCL_ASCII_MAIN is only supposed to be defined on
+ WIN32).
+
+2010-11-05 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclMain.c: Added missing conditional on _WIN32 around code
+ that messes around with the definition of _UNICODE, to correct a badly
+ broken Unix build from Jan's last commit.
+
+2010-11-04 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclDecls.h: [FRQ 491789]: "setargv() doesn't support a
+ * generic/tclMain.c: unicode cmdline" implemented for Tcl on MSVC++
+ * doc/Tcl_Main.3:
+ * win/tclAppInit.c:
+ * win/makefile.vc:
+ * win/Makefile.in:
+ * win/tclWin32Dll.c: Eliminate minor MSVC warning TCHAR -> char
+ conversion
+
+2010-11-04 Reinhard Max <max@suse.de>
+
+ * tests/socket.test: Run the socket tests three times with the address
+ family set to any, inet, and inet6 respectively. Use constraints to
+ skip the tests if a family is found to be unsupported or not
+ configured on the local machine. Adjust the tests to dynamically adapt
+ to the address family that is being tested.
+
+ Rework some of the tests to speed them up by avoiding (supposedly)
+ unneeded [after]s.
+
+2010-11-04 Stuart Cassoff <stwo@users.sourceforge.net>
+
+ * unix/Makefile.in: [Patch 3101127]: Installer Improvements.
+ * unix/install-sh:
+
+2010-11-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/error.test (error-19.13): Another variation on testing for
+ issues in [try] compilation.
+
+ * doc/Tcl.n (Variable substitution): [Bug 3099086]: Increase clarity
+ of explanation of what characters are actually permitted in variable
+ substitutions. Note that this does not constitute a change of
+ behavior; it is just an improvement of explanation.
+
+2010-11-04 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updates for 8.6b2 release. (Thanks Andreas Kupries)
+
+2010-11-03 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinFcmd.c: [FRQ 2965056]: Windows build with -DUNICODE
+ * win/tclWinFile.c: (more clean-ups for pre-win2000 stuff)
+ * win/tclWinReg.c:
+
+2010-11-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdMZ.c (TryPostBody): Ensure that errors when setting
+ * tests/error.test (error-19.1[12]): message/opt capture variables get
+ reflected properly to the caller.
+
+2010-11-03 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclCompCmds.c (TclCompileCatchCmd): [Bug 3098302]:
+ * tests/compile.test (compile-3.6): Reworked the compilation of the
+ [catch] command so as to avoid placing any code that might throw an
+ exception (specifically, any initial substitutions or any stores to
+ result or options variables) between the BEGIN_CATCH and END_CATCH but
+ outside the exception range. Added a test case that panics on a stack
+ smash if the change is not made.
+
+2010-11-01 Stuart Cassoff <stwo@users.sourceforge.net>
+
+ * library/safe.tcl: Improved handling of non-standard module path
+ * tests/safe.test: lists, empty path lists in particular.
+
+2010-11-01 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata/Asia/Hong_Kong:
+ * library/tzdata/Pacific/Apia:
+ * library/tzdata/Pacific/Fiji: Olson's tzdata2010o.
+
+2010-10-29 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclTimer.c: [Bug 2905784]: Stop small [after]s from
+ wasting CPU while keeping accuracy.
+
+2010-10-28 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+ * generic/tclAssembly.c:
+ * tests/assembly.test (assemble-31.*): Added jump tables.
+
+2010-10-28 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/http.test: [Bug 3097490]: Make http-4.15 pass in
+ isolation.
+
+ * unix/tclUnixSock.c: [Bug 3093120]: Prevent calls of
+ freeaddrinfo(NULL) which can crash some
+ systems. Thanks Larry Virden.
+
+2010-10-26 Reinhard Max <max@suse.de>
+
+ * Changelog.2008: Split off from Changelog.
+ * generic/tclIOSock.c (TclCreateSocketAddress): The interp != NULL
+ check is needed for ::tcl::unsupported::socketAF as well.
+
+2010-10-26 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/tclUnixSock.c (TcpGetOptionProc): Prevent crash if interp is
+ * win/tclWinSock.c (TcpGetOptionProc): NULL (a legal situation).
+
+2010-10-26 Reinhard Max <max@suse.de>
+
+ * unix/tclUnixSock.c (TcpGetOptionProc): Added support for
+ ::tcl::unsupported::noReverseDNS, which if set to any value, prevents
+ [fconfigure -sockname] and [fconfigure -peername] from doing
+ reverse DNS queries.
+
+2010-10-24 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+ * generic/tclAssembly.c:
+ * tests/assembly.test (assemble-17.15): Reworked branch handling so
+ that forward branches can use jump1 (jumpTrue1, jumpFalse1). Added
+ test cases that the forward branches will expand to jump4, jumpTrue4,
+ jumpFalse4 when needed.
+
+2010-10-23 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+ * generic/tclAssembly.h (removed):
+ Removed file that was included in only one
+ source file.
+ * generictclAssembly.c: Inlined tclAssembly.h.
+
+2010-10-17 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * doc/info.n: [Patch 2995655]:
+ * generic/tclBasic.c: Report inner contexts in [info errorstack]
+ * generic/tclCompCmds.c:
+ * generic/tclCompile.c:
+ * generic/tclCompile.h:
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * generic/tclNamesp.c:
+ * tests/error.test:
+ * tests/result.test:
+
+2010-10-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileDictForCmd): Update the compilation
+ * generic/tclCompile.c (tclInstructionTable): of [dict for] so that
+ * generic/tclExecute.c (TEBCresume): it no longer makes any
+ use of INST_DICT_DONE now that's not needed, and make it clearer in
+ the implementation of the instruction that it's just a deprecated form
+ of unset operation. Followup to my commit of 2010-10-16.
+
+2010-10-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclZlib.c (Tcl_ZlibStreamGet): [Bug 3081008]: Ensure that
+ when a bytearray gets its internals entangled with zlib for more than
+ a passing moment, that bytearray will never be shimmered away. This
+ increases the amount of copying but is simple to get right, which is a
+ reasonable trade-off.
+
+ * generic/tclStringObj.c (Tcl_AppendObjToObj): Added some special
+ cases so that most of the time when you build up a bytearray by
+ appending, it actually ends up being a bytearray rather than
+ shimmering back and forth to string.
+
+ * tests/http11.test (check_crc): Use a simpler way to express the
+ functionality of this procedure.
+
+ * generic/tclZlib.c: Purge code that wrote to the object returned by
+ Tcl_GetObjResult, as we don't want to do that anti-pattern no more.
+
+2010-10-18 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/uniParse.tcl: [Bug 3085863]: tclUniData was 9 years old;
+ Ignore non-BMP characters and fix comment about UnicodeData.txt file.
+ * generic/regcomp.c: Fix comment
+ * tests/utf.test: Add some Unicode 6 testcases
+
+2010-10-17 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * doc/info.n: Document [info errorstack] faithfully.
+
+2010-10-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (ReleaseDictIterator): Factored out the release
+ of the bytecode-level dictionary iterator information so that the
+ side-conditions on instruction issuing are simpler.
+
+2010-10-15 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/reg_locale.c: [Bug 3085863]: tclUniData 9 years old: Updated
+ * generic/tclUniData.c: Unicode tables to latest UnicodeData.txt,
+ * tools/uniParse.tcl: corresponding with Unicode 6.0 (except for
+ out-of-range chars > 0xFFFF)
+
+2010-10-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.c: Alternative fix for [Bugs 467523,983660] where
+ * generic/tclExecute.c: sharing of empty scripts is allowed again.
+
+2010-10-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinThrd.h: (removed) because it is just empty en used nowhere
+ * win/tcl.dsp
+
+2010-10-12 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/uniClass.tcl: Spacing and comments: let uniClass.tcl
+ * generic/regc_locale.c: generation match better the current
+ (hand-modified) regc_locale.c
+ * tools/uniParse.tcl: Generate proper const qualifiers for
+ * generic/tclUniData.c: tclUniData.c
+
+2010-10-12 Reinhard Max <max@suse.de>
+
+ * unix/tclUnixSock.c (CreateClientSocket): [Bug 3084338]: Fix a
+ memleak and refactor the calls to freeaddrinfo().
+
+2010-10-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinDde.c: [FRQ 2965056]: Windows build with -DUNICODE
+ * win/tclWinReg.c:
+ * win/tclWinTest.c: More cleanups
+ * win/tclWinFile.c: Add netapi32 to the link line, so we no longer
+ * win/tcl.m4: have to use LoadLibrary to access those
+ functions.
+ * win/makefile.vc:
+ * win/configure: (Re-generate with autoconf-2.59)
+ * win/rules.vc Update for VS10
+
+2010-10-09 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: Fix overallocation of exec stack in TEBC (due
+ to mixing numwords and numbytes)
+
+2010-10-08 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclIOSock.c: On Windows, use gai_strerrorA
+
+2010-10-06 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/winPipe.test: Test hygiene with makeFile and removeFile.
+
+ * generic/tclCompile.c: [Bug 3081065]: Prevent writing to the intrep
+ * tests/subst.test: fields of a freed Tcl_Obj.
+
+2010-10-06 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+
+ * generic/tclAssembly.c:
+ * generic/tclAssembly.h:
+ * tests/assemble.test: Added catches. Still needs a lot of testing.
+
+2010-10-02 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+
+ * generic/tclAssembly.c:
+ * generic/tclAssembly.h:
+ * tests/assemble.test: Added dictAppend, dictIncrImm, dictLappend,
+ dictSet, dictUnset, nop, regexp, nsupvar, upvar, and variable.
+
+2010-10-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TEBCresume): [Bug 3079830]: Added invalidation
+ of string representations of dictionaries in some cases.
+
+2010-10-01 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclExecute.c (EvalStatsCmd): change 'evalstats' to return
+ data to interp by default, or if given an arg, use that as filename to
+ output to (accepts 'stdout' and 'stderr'). Fix output to print used
+ inst count data.
+ * generic/tclCkalloc.c: Change TclDumpMemoryInfo sig to allow objPtr
+ * generic/tclInt.decls: as well as FILE* as output.
+ * generic/tclIntDecls.h:
+
+2010-10-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c, generic/tclClock.c, generic/tclEncoding.c,
+ * generic/tclEnv.c, generic/tclLoad.c, generic/tclNamesp.c,
+ * generic/tclObj.c, generic/tclRegexp.c, generic/tclResolve.c,
+ * generic/tclResult.c, generic/tclUtil.c, macosx/tclMacOSXFCmd.c:
+ More purging of strcpy() from locations where we already know the
+ length of the data being copied.
+
+2010-10-01 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+
+ * tests/assemble.test:
+ * generic/tclAssemble.h:
+ * generic/tclAssemble.c: Added listIn, listNotIn, and dictGet.
+
+2010-09-30 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+
+ * tests/assemble.test: Added tryCvtToNumeric and several more list
+ * generic/tclAssemble.c: operations.
+ * generic/tclAssemble.h:
+
+2010-09-29 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+
+ * tests/assemble.test: Completed conversion of tests to a
+ * generic/tclAssemble.c: "white box" structure that follows the
+ C code. Added missing safety checks on the operands of 'over' and
+ 'reverse' so that negative operand counts don't smash the stack.
+
+2010-09-29 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/configure: Re-generate with autoconf-2.59
+ * win/configure:
+ * generic/tclMain.c: Make compilable with -DUNICODE as well
+
+2010-09-28 Reinhard Max <max@suse.de>
+
+ TIP #162 IMPLEMENTATION
+
+ * doc/socket.n: Document the changes to the [socket] and
+ [fconfigure] commands.
+
+ * generic/tclInt.h: Introduce TclCreateSocketAddress() as a
+ * generic/tclIOSock.c: replacement for the platform-dependent
+ * unix/tclUnixSock.c: TclpCreateSocketAddress() functions. Extend
+ * unix/tclUnixChan.c: the [socket] and [fconfigure] commands to
+ * unix/tclUnixPort.h: behave as proposed in TIP #162. This is the
+ * win/tclWinSock.c: core of what is required to support the use of
+ * win/tclWinPort.h: IPv6 sockets in Tcl.
+
+ * compat/fake-rfc2553.c: A compat implementation of the APIs defined
+ * compat/fake-rfc2553.h: in RFC-2553 (getaddrinfo() and friends) on
+ top of the existing gethostbyname() etc.
+ * unix/configure.in: Test whether the fake-implementation is
+ * unix/tcl.m4: needed.
+ * unix/Makefile.in: Add a compile target for fake-rfc2553.
+
+ * win/configure.in: Allow cross-compilation by default.
+
+ * tests/socket.test: Improve the test suite to make more use of
+ * tests/remote.tcl: randomized ports to reduce interference with
+ tests running in parallel or other services on
+ the machine.
+
+2010-09-28 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+
+ * tests/assemble.test: Added more "white box" tests.
+ * generic/tclAssembly.c: Added the error checking and reporting
+ for undefined labels. Revised code so that no pointers into the
+ bytecode sequence are held (because the sequence can move!),
+ that no Tcl_HashEntry pointers are held (because the hash table
+ doesn't guarantee their stability!) and to eliminate the BBHash
+ table, which is merely additional information indexed by jump
+ labels and can just as easily be held in the 'label' structure.
+ Renamed shared structures to CamelCase, and renamed 'label' to
+ JumpLabel because other types of labels may eventually be possible.
+
+2010-09-27 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+
+ * tests/assemble.test: Added more "white box" tests.
+ * generic/tclAssembly.c: Fixed bugs exposed by the new tests.
+ (a) [eval] and [expr] had incorrect stack balance computed if
+ the arg was not a simple word. (b) [concat] accepted a negative
+ operand count. (c) [invoke] accepted a zero or negative operand
+ count. (d) more misspelt error messages.
+ Also replaced a funky NRCallTEBC with the new call
+ TclNRExecuteByteCode, necessitated by a merge with changes on the
+ HEAD.
+
2010-09-26 Miguel Sofer <msofer@users.sf.net>
* generic/tclBasic.c: [Patch 3072080] (minus the itcl
* generic/tclCmdIL.c: update): a saner NRE.
* generic/tclCompExpr.c:
- * generic/tclCompile.c: This makes TclNRExecuteByteCode
- * generic/tclCompile.h: (ex TEBC) to be a normal NRE
- * generic/tclExecute.c: citizen: it loses its special status.
+ * generic/tclCompile.c: This makes TclNRExecuteByteCode (ex TEBC)
+ * generic/tclCompile.h: to be a normal NRE citizen: it loses its
+ * generic/tclExecute.c: special status.
* generic/tclInt.decls: The logic flow within the BC engine is
* generic/tclInt.h: simplified considerably.
* generic/tclIntDecls.h:
* generic/tclObj.c:
* generic/tclProc.c:
* generic/tclTest.c:
-
-
- * generic/tclVar.c: use the macro HasLocalVars everywhere
-
+
+ * generic/tclVar.c: Use the macro HasLocalVars everywhere
+
2010-09-26 Miguel Sofer <msofer@users.sf.net>
* generic/tclOOMethod.c (ProcedureMethodVarResolver): avoid code
duplication, let the runtime var resolver call the compiled var
resolver.
+2010-09-26 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+
+ * tests/assemble.test: Added many new tests moving toward a more
+ comprehensive test suite for the assembler.
+ * generic/tclAssembly.c: Fixed bugs exposed by the new tests:
+ (a) [bitnot] and [not] had incorrect operand counts. (b)
+ INST_CONCAT cannot concatenate zero objects. (c) misspelt error
+ messages. (d) the "assembly code" internal representation lacked
+ a duplicator, which caused double-frees of the Bytecode object
+ if assembly code ever was duplicated.
+
+2010-09-25 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+
+ * generic/tclAssembly.c: Massive refactoring of the assembler
+ * generic/tclAssembly.h: to use a Tcl-like syntax (and use
+ * tests/assemble.test: Tcl_ParseCommand to parse it). The
+ * tests/assemble1.bench: refactoring also ensures that
+ Tcl_Tokens in the assembler have string ranges inside the source
+ code, which allows for [eval] and [expr] assembler directives
+ that simply call TclCompileScript and TclCompileExpr recursively.
+
2010-09-24 Jeff Hobbs <jeffh@ActiveState.com>
* tests/stringComp.test: improved string eq/cmp test coverage
- * generic/tclExecute.c (TclExecuteByteCode): merge INST_STR_CMP
- and INST_STR_EQ/INST_STR_NEQ paths. Speeds up eq/ne/[string eq]
- with obj-aware comparisons and eq/==/ne/!= with length equality
- check.
+ * generic/tclExecute.c (TclExecuteByteCode): merge INST_STR_CMP and
+ INST_STR_EQ/INST_STR_NEQ paths. Speeds up eq/ne/[string eq] with
+ obj-aware comparisons and eq/==/ne/!= with length equality check.
2010-09-24 Andreas Kupries <andreask@activestate.com>
- * tclWinsock.c: [Bug 3056775]: Fixed race condition between thread
- and internal co-thread access of a socket's structure because of
- the thread not using the socketListLock in TcpAccept(). Added
+ * tclWinsock.c: [Bug 3056775]: Fixed race condition between thread and
+ internal co-thread access of a socket's structure because of the
+ thread not using the socketListLock in TcpAccept(). Added
documentation on how the module works to the top.
2010-09-23 Jan Nijtmans <nijtmans@users.sf.net>
@@ -52,27 +3708,27 @@
2010-09-23 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tclAppInit.c: Make compilable with -DUNICODE (not
- * win/tclAppInit.c: actived yet), many clean-ups in comments.
+ * unix/tclAppInit.c: Make compilable with -DUNICODE (not activated
+ * win/tclAppInit.c: yet), many clean-ups in comments.
2010-09-22 Miguel Sofer <msofer@users.sf.net>
- * generic/tclExecute: one more DECACHE_STACK_INFO() missing; this
- fixes [Bug 3072640]
+ * generic/tclExecute: [Bug 3072640]: One more DECACHE_STACK_INFO() was
+ missing.
- * tests/execute.test: added execute-10.3 for [Bug 3072640]. The
- test causes a mem failure.
+ * tests/execute.test: Added execute-10.3 for [Bug 3072640]. The test
+ causes a mem failure.
- * generic/tclExecute: protect all possible writes to ::errorInfo
- or ::errorCode with DECACHE_STACK_INFO(), as they could run
- traces. The new calls to be protected are Tcl_ResetResult(),
- Tcl_SetErrorCode(), IllegalExprOperandType(),
- TclExprFloatError(). The error was triggered by [Patch 3072080].
+ * generic/tclExecute: Protect all possible writes to ::errorInfo or
+ ::errorCode with DECACHE_STACK_INFO(), as they could run traces. The
+ new calls to be protected are Tcl_ResetResult(), Tcl_SetErrorCode(),
+ IllegalExprOperandType(), TclExprFloatError(). The error was triggered
+ by [Patch 3072080].
2010-09-22 Jan Nijtmans <nijtmans@users.sf.net>
- * win/tcl.m4: Add kernel32 to LIBS, so the link line for mingw
- * win/configure: is exactly the same as for MSVC++.
+ * win/tcl.m4: Add kernel32 to LIBS, so the link line for
+ * win/configure: mingw is exactly the same as for MSVC++.
2010-09-21 Jeff Hobbs <jeffh@ActiveState.com>
@@ -81,16 +3737,32 @@
* generic/tclVar.c (TclLookupSimpleVar, CompareVarKeys):
* generic/tclPathObj.c (Tcl_FSGetNormalizedPath, Tcl_FSEqualPaths):
* generic/tclIOUtil.c (TclFSCwdPointerEquals): peephole opt
- * generic/tclResult.c (TclMergeReturnOptions): use memcmp where
+ * generic/tclResult.c (TclMergeReturnOptions): Use memcmp where
applicable as possible speedup on some libc variants.
+2010-09-21 Kevin B. Kenny <kennykb@acm.org>
+
+ [BRANCH: dogeen-assembler-branch]
+
+ * generic/tclAssembly.c (new file):
+ * generic/tclAssembly.h:
+ * generic/tclBasic.c (builtInCmds, Tcl_CreateInterp):
+ * generic/tclInt.h:
+ * tests/assemble.test (new file):
+ * tests/assemble1.bench (new file):
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/Makefile.vc:
+ Initial commit of Ozgur Dogan Ugurlu's (SF user: dogeen)
+ assembler for the Tcl bytecode language.
+
2010-09-21 Jan Nijtmans <nijtmans@users.sf.net>
* win/tclWinFile.c: Fix declaration after statement.
- * win/tcl.m4: Add -Wdeclaration-after-statement, so
- * win/configure: this mistake cannot happen again.
- * win/tclWinFCmd.c: [Bug 3069278]: Breakage on head Windows triggered
- * win/tclWinPipe.c: by install-tzdata, final fix
+ * win/tcl.m4: Add -Wdeclaration-after-statement, so this
+ * win/configure: mistake cannot happen again.
+ * win/tclWinFCmd.c: [Bug 3069278]: Breakage on head Windows
+ * win/tclWinPipe.c: triggered by install-tzdata, final fix
2010-09-20 Jan Nijtmans <nijtmans@users.sf.net>
@@ -118,10 +3790,10 @@
2010-09-16 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclDecls.h Make Tcl_FindExecutable() work in UNICODE
- * generic/tclEncoding.c compiles (windows-only) as well as ASCII.
- * generic/tclStubInit.c Needed for [FRQ 491789]: setargv() doesn't
- support a unicode cmdline
+ * generic/tclDecls.h: Make Tcl_FindExecutable() work in UNICODE
+ * generic/tclEncoding.c: compiles (windows-only) as well as ASCII.
+ * generic/tclStubInit.c: Needed for [FRQ 491789]: setargv() doesn't
+ support a unicode cmdline.
2010-09-15 Donal K. Fellows <dkf@users.sf.net>
@@ -529,8 +4201,8 @@
2010-07-02 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclInt.decls: [Bug 803489]: Tcl_FindNamespace problem in the
- * generic/tclIntDecls.h: Stubs table
+ * generic/tclInt.decls: [Bug 803489]: Tcl_FindNamespace problem in
+ * generic/tclIntDecls.h: the Stubs table
* generic/tclStubInit.c:
2010-07-02 Donal K. Fellows <dkf@users.sf.net>
@@ -768,7 +4440,7 @@
2010-05-06 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclPkg.c Unnecessary type casts, See Tcl [Patch #2997087]
+ * generic/tclPkg.c: Unnecessary type casts, see [Patch 2997087]
2010-05-04 Jan Nijtmans <nijtmans@users.sf.net>
@@ -1195,7 +4867,7 @@
* generic/tclIndexObj: [FRQ 2974744]: share exception codes
* generic/tclResult.c: further optimization, making use of indexType.
- * generic/tclZlib.c [Bug 2979399]: uninitialized value troubles
+ * generic/tclZlib.c: [Bug 2979399]: uninitialized value troubles
2010-03-30 Donal K. Fellows <dkf@users.sf.net>
@@ -1917,8 +5589,8 @@
2010-01-21 Miguel Sofer <msofer@users.sf.net>
- * generic/tclCompile.h: NRE-enable direct eval on BC spoilage
- * generic/tclExecute.c: [Bug 2910748]
+ * generic/tclCompile.h: [Bug 2910748]: NRE-enable direct eval on BC
+ * generic/tclExecute.c: spoilage.
* tests/nre.test:
2010-01-19 Donal K. Fellows <dkf@users.sf.net>
@@ -2479,23 +6151,23 @@
2009-11-19 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclInt.h Make all internal initialization
- * generic/tclTest.c routines MODULE_SCOPE
- * generic/tclTestObj.c
- * generic/tclTestProcBodyObj.c
- * generic/tclThreadTest.c
- * unix/Makefile.in Fix [Bug 2883850]: pkgIndex.tcl doesn't
- * unix/tclAppInit.c get created with static Tcl build
- * unix/tclXtTest.c
- * unix/tclXtNotify.c
- * unix/tclUnixTest.c
- * win/Makefile.in
- * win/tcl.m4
- * win/configure (regenerated)
- * win/tclAppInit.c
- * win/tclWinDde.c Always compile with Stubs.
- * win/tclWinReg.c
- * win/tclWinTest.c
+ * generic/tclInt.h: Make all internal initialization
+ * generic/tclTest.c: routines MODULE_SCOPE
+ * generic/tclTestObj.c:
+ * generic/tclTestProcBodyObj.c:
+ * generic/tclThreadTest.c:
+ * unix/Makefile.in: Fix [Bug 2883850]: pkgIndex.tcl doesn't
+ * unix/tclAppInit.c: get created with static Tcl build
+ * unix/tclXtTest.c:
+ * unix/tclXtNotify.c:
+ * unix/tclUnixTest.c:
+ * win/Makefile.in:
+ * win/tcl.m4:
+ * win/configure: (regenerated)
+ * win/tclAppInit.c:
+ * win/tclWinDde.c: Always compile with Stubs.
+ * win/tclWinReg.c:
+ * win/tclWinTest.c:
2009-11-18 Jan Nijtmans <nijtmans@users.sf.net>
@@ -2731,10 +6403,11 @@
For 32-bit builds where "long" and "int" are two names for the same
thing, this is no change at all. For 64-bit builds, though, this
causes the dp[] array of an mp_int to be made up of 32-bit elements
- instead of 64-bit elements. This is a huge improvement because details
- elsewhere in the mp_int implementation cause only 28 bits of each
- element to be actually used storing number data. Without this change
- bignums are over 50% wasted space on 64-bit systems. [Bug 2800740].
+ instead of 64-bit elements. This is a huge improvement because
+ details elsewhere in the mp_int implementation cause only 28 bits of
+ each element to be actually used storing number data. Without this
+ change bignums are over 50% wasted space on 64-bit systems. [Bug
+ 2800740].
***POTENTIAL INCOMPATIBILITY***
For 64-bit builds, callers of routines with (mp_digit) or (mp_digit *)
@@ -2860,10 +6533,10 @@
2009-10-18 Joe Mistachkin <joe@mistachkin.com>
* tests/thread.test (thread-4.[345]): [Bug 1565466]: Correct tests to
- save their error state before the final call to threadReap just in case
- it triggers an "invalid thread id" error. This error can occur if one
- or more of the target threads has exited prior to the attempt to send
- it an asynchronous exit command.
+ save their error state before the final call to threadReap just in
+ case it triggers an "invalid thread id" error. This error can occur
+ if one or more of the target threads has exited prior to the attempt
+ to send it an asynchronous exit command.
2009-10-17 Donal K. Fellows <dkf@users.sf.net>
@@ -2906,14 +6579,15 @@
2009-10-05 Andreas Kupries <andreask@activestate.com>
* library/safe.tcl (AliasGlob): Fixed conversion of catch to
- try/finally, it had an 'on ok msg' branch missing, causing a
- silent error immediately, and bogus glob results, breaking
- search for Tcl modules.
+ try/finally, it had an 'on ok msg' branch missing, causing a silent
+ error immediately, and bogus glob results, breaking search for Tcl
+ modules.
2009-10-04 Daniel Steffen <das@users.sourceforge.net>
- * macosx/tclMacOSXBundle.c: Workaround CF memory managment bug in
- * unix/tclUnixInit.c: Mac OS X 10.4 & earlier. [Bug 2569449]
+ * macosx/tclMacOSXBundle.c: [Bug 2569449]: Workaround CF memory
+ * unix/tclUnixInit.c: managment bug in Mac OS X 10.4 &
+ earlier.
2009-10-02 Kevin B. Kenny <kennykb@acm.org>
@@ -3153,9 +6827,9 @@
* unix/dltest/pkge.c: const addition
* unix/tclUnixThrd.c: Use <pthread.h> in stead of "pthread.h"
* win/tclWinDde.c: Eliminate some more gcc warnings
- * win/tclWinReg.c
- * generic/tclInt.h Change ForIterData, make it const-safe.
- * generic/tclCmdAH.c
+ * win/tclWinReg.c:
+ * generic/tclInt.h: Change ForIterData, make it const-safe.
+ * generic/tclCmdAH.c:
2009-08-12 Don Porter <dgp@users.sourceforge.net>
@@ -3656,7 +7330,7 @@
2009-04-27 Jan Nijtmans <nijtmans@users.sf.net>
* generic/tclIndexObj.c: Reset internal INTERP_ALTERNATE_WRONG_ARGS
- * generic/tclIOCmd.c flag inside the Tcl_WrongNumArgs function,
+ * generic/tclIOCmd.c: flag inside the Tcl_WrongNumArgs function,
so the caller no longer has to do the reset.
2009-04-24 Stuart Cassoff <stwo@users.sf.net>
@@ -3700,9 +7374,9 @@
* unix/tclUnixChan.c: TclUnixWaitForFile(): use FD_* macros
* macosx/tclMacOSXNotify.c: to manipulate select masks (Cassoff).
- [Bug 1960647]
+ [FRQ 1960647] [Bug 3486554]
- * unix/tclLoadDyld.c: use RTLD_GLOBAL instead of RTLD_LOCAL.
+ * unix/tclLoadDyld.c: Use RTLD_GLOBAL instead of RTLD_LOCAL.
[Bug 1961211]
* macosx/tclMacOSXNotify.c: revise CoreFoundation notifier to allow
@@ -3898,9 +7572,8 @@
2009-03-15 Joe Mistachkin <joe@mistachkin.com>
- * generic/tclThread.c: Modify fix for TSD leak to match Tcl 8.5
- * generic/tclThreadStorage.c: (and prior) allocation semantics. [Bug
- 2687952]
+ * generic/tclThread.c: [Bug 2687952]: Modify fix for TSD leak to match
+ * generic/tclThreadStorage.c: Tcl 8.5 (and prior) allocation semantics
2009-03-15 Donal K. Fellows <dkf@users.sf.net>
@@ -3940,7 +7613,7 @@
* generic/tcl.decls: [Bug 218977]: Tcl_DbCkfree needs return value
* generic/tclCkalloc.c
- * generic/tclDecls.h (regenerated)
+ * generic/tclDecls.h: (regenerated)
* generic/tclInt.decls: don't use CONST84/CONST86 here
* generic/tclCompile.h: don't use CONST86 here, comment fixing.
* generic/tclIO.h: don't use CONST86 here, comment fixing.
@@ -3988,10 +7661,10 @@
2009-02-20 Don Porter <dgp@users.sourceforge.net>
- * generic/tclPathObj.c: Fixed mistaken logic in TclFSGetPathType()
- * tests/fileName.test: that assumed (not "absolute" => "relative").
- This is a false assumption on Windows, where "volumerelative" is
- another possibility. [Bug 2571597]
+ * generic/tclPathObj.c: [Bug 2571597]: Fixed mistaken logic in
+ * tests/fileName.test: TclFSGetPathType() that assumed (not
+ "absolute") => "relative". This is a false assumption on Windows,
+ where "volumerelative" is another possibility.
2009-02-18 Don Porter <dgp@users.sourceforge.net>
@@ -4045,23 +7718,23 @@
2009-02-16 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclZlib.c: hack needed for official zlib1.dll build.
+ * generic/tclZlib.c: Hack needed for official zlib1.dll build.
* win/configure.in: fix [Feature Request 2605263] use official
* win/Makefile.in: zlib build.
* win/configure: (regenerated)
* compat/zlib/zdll.lib: new files
* compat/zlib/zlib1.dll:
- * win/Makefile.in: fix [Bug 2605232] tdbc doesn't build when
- Tcl is compiled with --disable-shared.
+ * win/Makefile.in: [Bug 2605232]: tdbc doesn't build when Tcl is
+ compiled with --disable-shared.
2009-02-15 Don Porter <dgp@users.sourceforge.net>
- * generic/tclStringObj.c: Added protections from invalid memory
- * generic/tclTestObj.c: accesses when we append (some part of)
- * tests/stringObj.test: a Tcl_Obj to itself. Added the
- appendself and appendself2 subcommands to the [teststringobj] testing
- command and added tests to the test suite. [Bug 2603158]
+ * generic/tclStringObj.c: [Bug 2603158]: Added protections from
+ * generic/tclTestObj.c: invalid memory accesses when we append
+ * tests/stringObj.test: (some part of) a Tcl_Obj to itself.
+ Added the appendself and appendself2 subcommands to the
+ [teststringobj] testing command and added tests to the test suite.
* generic/tclStringObj.c: Factor out duplicate code from
Tcl_AppendObjToObj.
@@ -4145,41 +7818,41 @@
2009-02-10 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclEncoding.c Eliminate some unnessary type casts
- * generic/tclEvent.c some internal const decorations
- * generic/tclExecute.c spacing
- * generic/tclIndexObj.c
- * generic/tclInterp.c
- * generic/tclIO.c
- * generic/tclIOCmd.c
- * generic/tclIORChan.c
- * generic/tclIOUtil.c
- * generic/tclListObj.c
- * generic/tclLiteral.c
- * generic/tclNamesp.c
- * generic/tclObj.c
- * generic/tclOOBasic.c
- * generic/tclPathObj.c
- * generic/tclPkg.c
- * generic/tclProc.c
- * generic/tclRegexp.c
- * generic/tclScan.c
- * generic/tclStringObj.c
- * generic/tclTest.c
- * generic/tclTestProcBodyObj.c
- * generic/tclThread.c
- * generic/tclThreadTest.c
- * generic/tclTimer.c
- * generic/tclTrace.c
- * generic/tclUtil.c
- * generic/tclVar.c
- * generic/tclStubInit.c (regenerated)
+ * generic/tclEncoding.c: Eliminate some unnessary type casts
+ * generic/tclEvent.c: some internal const decorations
+ * generic/tclExecute.c: spacing
+ * generic/tclIndexObj.c:
+ * generic/tclInterp.c:
+ * generic/tclIO.c:
+ * generic/tclIOCmd.c:
+ * generic/tclIORChan.c:
+ * generic/tclIOUtil.c:
+ * generic/tclListObj.c:
+ * generic/tclLiteral.c:
+ * generic/tclNamesp.c:
+ * generic/tclObj.c:
+ * generic/tclOOBasic.c:
+ * generic/tclPathObj.c:
+ * generic/tclPkg.c:
+ * generic/tclProc.c:
+ * generic/tclRegexp.c:
+ * generic/tclScan.c:
+ * generic/tclStringObj.c:
+ * generic/tclTest.c:
+ * generic/tclTestProcBodyObj.c:
+ * generic/tclThread.c:
+ * generic/tclThreadTest.c:
+ * generic/tclTimer.c:
+ * generic/tclTrace.c:
+ * generic/tclUtil.c:
+ * generic/tclVar.c:
+ * generic/tclStubInit.c: (regenerated)
2009-02-10 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tcl.m4: fix [tcl-Bug 2502365] Building of head on HPUX is
- broken when using the native CC.
- * unix/configure (autoconf-2.59)
+ * unix/tcl.m4: [Bug 2502365]: Building of head on HPUX is broken when
+ using the native CC.
+ * unix/configure: (autoconf-2.59)
2009-02-10 Don Porter <dgp@users.sourceforge.net>
@@ -4197,7 +7870,7 @@
2009-02-09 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclCompile.c: fix [Bug 2555129] const compiler warning (as
+ * generic/tclCompile.c: [Bug 2555129]: const compiler warning (as
error) in tclCompile.c
2009-02-07 Donal K. Fellows <dkf@users.sf.net>
@@ -4209,8 +7882,8 @@
2009-02-05 Joe Mistachkin <joe@mistachkin.com>
- * generic/tclInterp.c: Fix argument checking for [interp cancel]. [Bug
- 2544618]
+ * generic/tclInterp.c: [Bug 2544618]: Fix argument checking for
+ [interp cancel].
* unix/Makefile.in: Fix build issue with zlib on FreeBSD (and possibly
other platforms).
@@ -4232,12 +7905,12 @@
2009-02-04 Don Porter <dgp@users.sourceforge.net>
- * generic/tclStringObj.c: Added overflow protections to the
- AppendUtfToUtfRep routine to either avoid invalid arguments and
- crashes, or to replace them with controlled panics. [Bug 2561794]
+ * generic/tclStringObj.c: [Bug 2561794]: Added overflow protections to
+ the AppendUtfToUtfRep routine to either avoid invalid arguments and
+ crashes, or to replace them with controlled panics.
- * generic/tclCmdMZ.c: Prevent crashes due to int overflow of the
- length of the result of [string repeat]. [Bug 2561746]
+ * generic/tclCmdMZ.c: [Bug 2561746]: Prevent crashes due to int
+ overflow of the length of the result of [string repeat].
2009-02-03 Jan Nijtmans <nijtmans@users.sf.net>
@@ -4269,9 +7942,9 @@
2009-02-03 Don Porter <dgp@users.sourceforge.net>
- * generic/tclStringObj.c (SetUnicodeObj): Corrected failure of
- Tcl_SetUnicodeObj() to panic on a shared object. [Bug 2561488]. Also
- factored out common code to reduce duplication.
+ * generic/tclStringObj.c (SetUnicodeObj): [Bug 2561488]:
+ Corrected failure of Tcl_SetUnicodeObj() to panic on a shared object.
+ Also factored out common code to reduce duplication.
* generic/tclObj.c (Tcl_GetStringFromObj): Reduce code duplication.
@@ -4346,19 +8019,19 @@
2009-01-26 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * generic/tclInt.h: Fix [Bug 1028264]: WSACleanup() too early.
- * generic/tclEvent.c: The fix introduces "late exit handlers"
- * win/tclWinSock.c: for similar late process-wide cleanups.
+ * generic/tclInt.h: [Bug 1028264]: WSACleanup() too early.
+ * generic/tclEvent.c: The fix introduces "late exit handlers" for
+ * win/tclWinSock.c: similar late process-wide cleanups.
2009-01-26 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * win/tclWinSock.c: Fix [Bug 2446662]: resync Win behavior on RST
- with that of unix (EOF).
+ * win/tclWinSock.c: [Bug 2446662]: Resync Win behavior on RST with
+ that of unix (EOF).
2009-01-26 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclZlib.c (ChanClose): Only generate error messages in the
- interpreter when the thread is not being closed down. [Bug 2536400]
+ * generic/tclZlib.c (ChanClose): [Bug 2536400]: Only generate error
+ messages in the interpreter when the thread is not being closed down.
2009-01-23 Donal K. Fellows <dkf@users.sf.net>
@@ -4385,7 +8058,7 @@
2009-01-21 Andreas Kupries <andreask@activestate.com>
- * generic/tclIORChan.c (ReflectClose): Fix for [Bug 2458202].
+ * generic/tclIORChan.c (ReflectClose): [Bug 2458202]:
* generic/tclIORTrans.c (ReflectClose): Closing a channel may supply
NULL for the 'interp'. Test for finalization needs to be different,
and one place has to pull the interp out of the channel instead.
@@ -4397,12 +8070,12 @@
2009-01-19 Kevin B. Kenny <kennykb@acm.org>
- * unix/Makefile.in: Added a CONFIG_INSTALL_DIR parameter so that
- * unix/tcl.m4: distributors can control where tclConfig.sh goes.
- Made the installation of 'ldAix' conditional upon actually being on an
- AIX system. Allowed for downstream packagers to customize
- SHLIB_VERSION on BSD-derived systems. Thanks to Stuart Cassoff for
- [Patch 907924].
+ * unix/Makefile.in: [Patch 907924]:Added a CONFIG_INSTALL_DIR
+ * unix/tcl.m4: parameter so that distributors can control where
+ tclConfig.sh goes. Made the installation of 'ldAix' conditional upon
+ actually being on an AIX system. Allowed for downstream packagers to
+ customize SHLIB_VERSION on BSD-derived systems. Thanks to Stuart
+ Cassoff for his help.
* unix/configure: Autoconf 2.59
2009-01-19 David Gravereaux <davygrvy@pobox.com>
@@ -4439,8 +8112,8 @@
2009-01-13 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tcl.m4: fix [tcl-Bug 2502365] Building of head on HPUX is
- broken when using the native CC.
+ * unix/tcl.m4: [Bug 2502365]: Building of head on HPUX is broken when
+ using the native CC.
* unix/configure (autoconf-2.59)
2009-01-13 Donal K. Fellows <dkf@users.sf.net>
@@ -4463,20 +8136,20 @@
2009-01-09 Don Porter <dgp@users.sourceforge.net>
- * generic/tclStringObj.c (STRING_SIZE): Corrected failure to limit
- memory allocation requests to the sizes that can be supported by Tcl's
- memory allocation routines. [Bug 2494093]
+ * generic/tclStringObj.c (STRING_SIZE): [Bug 2494093]: Corrected
+ failure to limit memory allocation requests to the sizes that can be
+ supported by Tcl's memory allocation routines.
2009-01-09 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclNamesp.c (NamespaceEnsembleCmd): Error out when someone
- gives wrong # of args to [namespace ensemble create]. [Bug 1558654]
+ * generic/tclNamesp.c (NamespaceEnsembleCmd): [Bug 1558654]: Error out
+ when someone gives wrong # of args to [namespace ensemble create].
2009-01-08 Don Porter <dgp@users.sourceforge.net>
- * generic/tclStringObj.c (STRING_UALLOC): Added missing parens
- required to get correct results out of things like
- STRING_UALLOC(num + append). [Bug 2494093]
+ * generic/tclStringObj.c (STRING_UALLOC): [Bug 2494093]: Added missing
+ parens required to get correct results out of things like
+ STRING_UALLOC(num + append).
2009-01-08 Donal K. Fellows <dkf@users.sf.net>
@@ -4488,7 +8161,7 @@
2009-01-07 Donal K. Fellows <dkf@users.sf.net>
- * doc/dict.n: Added more examples. [Tk Bug 2491235]
+ * doc/dict.n: [Tk Bug 2491235]: Added more examples.
* tests/oo.test (oo-22.1): Adjusted test to be less dependent on the
specifics of how [info frame] reports general frame information, and
@@ -4507,20 +8180,20 @@
* generic/tclDictObj.c (DictIncrCmd): Corrected twiddling in internals
of dictionaries so that literals can't get destroyed.
- * tests/expr.test: Eliminate non-ASCII char. [Bug 2006879]
+ * tests/expr.test: [Bug 2006879]: Eliminate non-ASCII char.
- * generic/tclOOInfo.c (InfoObjectMethodsCmd,InfoClassMethodsCmd): Only
- delete pointers that were actually allocated! [Bug 2489836]
+ * generic/tclOOInfo.c (InfoObjectMethodsCmd,InfoClassMethodsCmd):
+ [Bug 2489836]: Only delete pointers that were actually allocated!
* generic/tclOO.c (TclNRNewObjectInstance, Tcl_NewObjectInstance):
- Perform search for existing commands in right context. [Bug 2481109]
+ [Bug 2481109]: Perform search for existing commands in right context.
2009-01-05 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclCmdMZ.c (TclNRSourceObjCmd): Make implementation of the
- * generic/tclIOUtil.c (TclNREvalFile): [source] command be NRE
- enabled so that [yield] inside a script sourced in a coroutine can
- work. [Bug 2412068]
+ * generic/tclCmdMZ.c (TclNRSourceObjCmd): [Bug 2412068]: Make
+ * generic/tclIOUtil.c (TclNREvalFile): implementation of the
+ [source] command be NRE enabled so that [yield] inside a script
+ sourced in a coroutine can work.
2009-01-04 Donal K. Fellows <dkf@users.sf.net>
@@ -4535,3806 +8208,22 @@
2009-01-02 Donal K. Fellows <dkf@users.sf.net>
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Force the use of the compatibility
- version of mkstemp() on IRIX. [Bug 878333]
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 878333]: Force the use of the
+ compatibility version of mkstemp() on IRIX.
* unix/configure.in, unix/Makefile.in (mkstemp.o):
- * compat/mkstemp.c (new file): Added a compatibility implementation of
- the mkstemp() function, which is apparently needed on some platforms.
- [Bug 741967]
-
-2008-12-31 Don Porter <dgp@users.sourceforge.net>
-
- * unix/Makefile.in: Set TCLLIBPATH in SHELL_ENV so that targets
- like `make shell` have access to builds of bundled packages.
-
-2008-12-28 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclZlib.c (Tcl_ZlibStreamPut): Plug a memory leak.
-
-2008-12-27 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclZlib.c (ZlibStreamCmd): Fix compilation consistency. [Bug
- * generic/tcl.decls: 2470237]
-
- * generic/tclZlib.c (Tcl_ZlibStreamGet): Corrected the semantics of
- this function to be useful to the PNG implementation. If the argument
- object is empty, this gives the previous semantics.
- (Tcl_ZlibStreamChecksum): Corrected name to be less misleading; it
- only produced Adler-32 checksums when the stream was processing the
- right type of compressed data format.
- (Tcl_ZlibAdler32, Tcl_ZlibCRC32): Corrected types so that they work
- naturally with the results of Tcl_GetByteArrayFromObj().
- *** POTENTIAL INCOMPATIBILITY *** for all above changes, but very
- unlikely to be difficult for anyone to deal with.
-
-2008-12-26 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tcl.decls: Tidy up the commenting style, adding markers for
- each of the big release points under TCT stewardship and noting the
- general purpose of each TIP that added C API. Overall effect is to
- make this file much more informative to read without having to spend
- effort correlating with TIPs and ChangeLogs.
-
-2008-12-23 Jan Nijtmans <nijtmans@users.sf.net>
-
- * win/Makefile.in: Fix build of zlib objects with msvc
- * win/tcl.m4:
- * win/configure: autoconf-2.59
-
-2008-12-23 Donal K. Fellows <dkf@users.sf.net>
-
- * win/Makefile.in: Handle file extensions correctly. [Bug 2459725]
-
-2008-12-22 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- *** 8.6b1 TAGGED FOR RELEASE ***
-
- * win/makefile.vc: Ensure pkgs directories are suitable and quote the
- paths. [Bug 2458395]
-
-2008-12-22 Joe Mistachkin <joe@mistachkin.com>
-
- * tools/man2help2.tcl: Added support for "\(mi" nroff macro. [Bug
- 2330040]
-
-2008-12-22 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * win/makefile.vc: Support the pkgs tree in the NMAKE builds.
-
-2008-12-21 Daniel Steffen <das@users.sourceforge.net>
-
- * unix/Makefile.in: Fix broken build of bundled packages when path
- to build dir contains spaces by switching to
- relative paths to toplevel build dir.
-
- * unix/configure.in: Preserve configure environment variables for
- sub-configures of bundled packages; reuse
- configure cache file for sub-configures.
-
- * unix/configure: autoconf-2.59
-
-2008-12-21 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/TclZlib.3: Fix minor typo. [Bug 2455165]
-
-2008-12-20 Kevin B. Kenny <kennykb@acm.org>
-
- * win/Makefile.in: Renamed the static library libtcl86s.a to
- * win/configure.in: have a name distinct from the import library
- libtcl86.a. This renaming dodges an ancient
- bug in the Makefile revealed by the last
- commit where the $(TCL_LIB_FILE) rule can
- fire to try to build the static library in a
- --enable-shared build (and create a static
- library that subsequently fails to link).
- Revised the zlib objects so that they are
- built directly into the build dir, without
- building an intermediate static library.
- *** POTENTIAL INCOMPATIBILITY *** for
- embedders who link to the static library, but
- I couldn't figure out how to sort this out
- any other way.
- * win/configure: Autoconf 2.59
-
-2008-12-20 Donal K. Fellows <dkf@users.sf.net>
-
- * win/Makefile.in: Minor updates to make building work better with
- msys on Windows. (Apparently the gcc used doesn't like a / at the end
- of a -I argument...)
-
-2008-12-20 Don Porter <dgp@users.sourceforge.net>
-
- * changes: Updates for 8.6b1 release.
-
-2008-12-20 Daniel Steffen <das@users.sourceforge.net>
-
- * unix/Makefile.in: Make package install directory of bundled
- * unix/configure.in: packages configurable via PACKAGE_DIR makefile
- variable (set to platform-specific default).
-
- * unix/Makefile.in (*-packages): Ensure toplevel targets fail if
- sub-make/configure fails; fix quoting when
- builddir path contains spaces.
-
- * macosx/GNUmakefile: Add install-packages to install targets.
-
- * unix/configure: autoconf-2.59
-
-2008-12-19 Don Porter <dgp@users.sourceforge.net>
-
- * doc/NRE.3: Formatting errors found by `make html`
- * doc/Tcl_Main.3:
- * doc/zlib.n:
-
- * tests/chanio.test: Add missing [removeFile] cleanups.
- * tests/io.test: Add missing [close $f] to io-73.2.
-
- * unix/Makefile.in: Update `make dist' target to include the files
- from the compat/zlib directory as well as all the bundled packages
- found under the pkgs directory, according to their individual `make
- dist' targets. Change includes breaking a `configure-packages' target
- out of the `packages` target.
-
- * README: Bump version number to 8.6b1
- * generic/tcl.h:
- * library/init.tcl:
- * tools/tcl.wse.in:
- * unix/configure.in:
- * unix/tcl.spec:
- * win/configure.in:
-
- * unix/configure: autoconf-2.59
- * win/configure:
-
-2008-12-19 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclInt.decls: CONSTify TclGetLoadedPackages second param
- * generic/tclLoad.c
- * generic/tclIntDecls.h (regenerated)
-
-2008-12-19 Kevin Kenny <kennykb@acm.org>
-
- * generic/tclExecute.c: Fix compile warnings when --enable-symbols=all
-
- * win/configure.in:
- * win/Makefile.in: Added build of packages in the 'pkgs/' directory.
- * win/configure: Autoconf 2.59
-
-2008-12-19 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * win/makefile.vc: Added build of compat/zlib
-
-2008-12-18 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclIO.c (Tcl_CloseEx, CloseWrite, CloseChannelPart)
- (ChanCloseHalf): Rewrite the half-close to properly flush the channel,
- like is done for a full close, going through FlushChannel, and using
- the flag BG_FLUSH_SCHEDULED (async flush during close). New functions
- CloseWrite, CloseChannelPart, new flag CHANNEL_CLOSEDWRITE.
-
- * tests/chanio.test (chanio-28.[67]): Reactivated these tests.
- Replaced tclsh -> [interpreter] to get correct executable for the pipe
- process, and added after cancel to kill the fail timers when we are
- done. Removed the explicits calls to [flush], now that [close] handles
- this correctly.
-
-2008-12-18 Don Porter <dgp@users.sourceforge.net>
-
- * tests/chanio.test: Replaced [chan event] handlers that returned
- TCL_RETURN return code, with more conventional ones that return TCL_OK
- to suppress otherwise strange writes of outdated $::errorInfo values
- to stderr. [Bug 2444274]
-
- * generic/tclExecute.c: Disabled apparently faulty assertion. [Bug
- 2415422]
-
-2008-12-18 Donal K. Fellows <dkf@users.sf.net>
-
- * unix/configure.in, unix/Makefile.in: Autoconf wizardry.
- * compat/zlib/*: Import of zlib 1.2.3. The license is directly
- compatible with Tcl's. This import omits the obsolete and contributed
- parts (i.e. selected directories) and the supplied examples.
-
- * generic/tclZlib.c: First implementation of the compressing and
- * doc/zlib.n: decompressing channel transformations.
- * tests/zlib.test (zlib-8.*):
-
-2008-12-18 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tcl.decls: VOID -> void
- * generic/tclInt.decls:
- * compat/dlfcn.h:
- * generic/tclDecls.h: (regenerated)
- * generic/tclIntDecls.h:
-
-2008-12-18 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-
- TIP #332 IMPLEMENTATION - Half-Close for Bidirectional Channels
-
- * doc/close.n, generic/tclIO.c, generic/tclIOCmd.c:
- * unix/tclUnixChan.c, unix/tclUnixPipe.c, win/tclWinSock.c:
- * generic/tcl.decls, generic/tclDecls.h, generic/tclStubInit.c:
- * tests/chan.test, tests/chanio.test, tests/ioCmd.test:
-
-2008-12-17 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/SetChanErr.3: General improvements in nroff rendering and some
- corrections to language issues.
-
-2008-12-17 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclResult.c: Move variable "length" inside if()
- * generic/tclStringObj.c: Don't use ckfree((void *)...) but
- * generic/tclVar.c: ckfree((char *)...)
- * generic/tclZlib.c
- * generic/tclBasic.c
-
-2008-12-17 Donal K. Fellows <dkf@users.sf.net>
-
- * tests/namespace.test (namespace-28.1): Make tests not
- * tests/namespace-old.test (namespace-old-9.5): dependent on the
- global namespace's particular imports. [Bug 2433936]
-
-2008-12-17 Don Porter <dgp@users.sourceforge.net>
-
- * unix/Makefile.in: Modify the distclean-packages target so that
- empty build directories are deleted.
-
- * unix/Makefile.in: Add build support for collections of TEA
- * unix/configure.in: packages found under the pkgs directory.
- [Patch 1163406]. Still needs porting to Windows.
-
- * unix/configure: autoconf-2.59
-
-2008-12-17 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tcl.h, generic/tclZlib.c: Removed undocumented flag.
-
-2008-12-16 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclThreadTest.c: Eliminate -Wwrite-strings warnings in
- --enable-threads build.
- * generic/tclExecute.c: Use TclNewLiteralStringObj()
- * unix/tclUnixFCmd.c: Use TclNewLiteralStringObj()
- * win/tclWinFCmd.c: Use TclNewLiteralStringObj()
-
-2008-12-16 Donal K. Fellows <dkf@users.sf.net>
-
- TIP #329 IMPLEMENTATION
-
- * tests/error.test: Tests for the new commands.
- * doc/throw.n, doc/try.n: Documentation of the new commands.
- * library/init.tcl (throw, try): Implementation of commands documented
- in TIP. This implementation is in Tcl and is a stop-gap until
- higher-performance ones can be written.
-
-2008-12-16 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tcl.h: Add TIP 338 routines to stub table.
- * generic/tcl.decls: [Bug 2431338]
-
- * generic/tclDecls.h: make genstubs
- * generic/tclStubInit.c:
-
-2008-12-15 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclExecute.c (TEBC:INST_DICT_GET): Make sure that the result
- is empty when generating an error message. [Bug 2431847]
-
-2008-12-15 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-
- * generic/tclBinary.c: Redefine non-strict decoding to ignore only
- * doc/binary.n: whitespace. [Bug 2380293]
- * tests/binary.test:
-
-2008-12-15 Don Porter <dgp@users.sourceforge.net>
-
- * doc/AddErrInfo.3: Documented Tcl_(Set|Get)ErrorLine (TIP 336).
- * doc/CrtCommand.3: Various other documentation updates to
- * doc/CrtInterp.3: reflect the lack of access to Tcl_Interp
- * doc/Interp.3: fields by default.
- * doc/SetResult.3:
- * doc/tcl.decls:
-
- TIP #338 IMPLEMENTATION
-
- * doc/AppInit.c: Made routines Tcl_SetStartupScript and
- * doc/Tcl_Main.3: Tcl_GetStartupScript public. Removed all
- * generic/tcl.h: internal stub access to Tcl*Startup* routines,
- * generic/tclInt.decls: and removed their implementations. Their
- * generic/tclMain.c: function can now be completely performed with
- the new public interface.
- *** POTENTIAL INCOMPATIBILITY for callers of the internal
- Tcl*Startup* routines. ***
-
- * generic/tclIntDecls.h: make genstubs
- * generic/tclStubInit.c:
- * generic/tclDecls.h:
-
-2008-12-14 Donal K. Fellows <dkf@users.sf.net>
-
- * tests/zlib.test: Added constraint so that tests don't fail where
- they cannot work due to zlib support being missing.
-
- * unix/configure.in, win/configure.in: Improve the autodetection code.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Remove the assumption of the presence
- of zlib library on Windows.
- * win/makefile.vc, win/makefile.bc: Add support for building tclZlib.o
- but only in stubbed-out mode for now.
-
-2008-12-13 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/TclZlib.3: Basic documentation of the C-level API.
- * doc/zlib.n: Substantially improve documentation of Tcl-level API.
- * generic/tclZlib.c (ZlibCmd): Flesh out the argument parsing for the
- command to integrate with channels.
-
-2008-12-12 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclZlib.c (Tcl_ZlibInflate): Change PATH_MAX to MAXPATHLEN,
- since MSVC doesn't have PATH_MAX.
-
- * doc/clock.n: Document new DST fallback rules.
- * library/clock.tcl (ProcessPosixTimeZone): Fix time change in Eastern
- Europe (not 3:00 but 4:00 local time). [Bug 2207436]
-
-2008-12-12 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclZlib.c, unix/configure.in: Added stubs to use when the
- version of zlib is not capable enough, and automagic to detect when
- that is the case. [Bug 2421265]
-
-2008-12-12 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-
- * unix/tclUnixNotfy.c: Fix missing CLOEXEC on internal pipes [2417695]
- * unix/tclUnixPipe.c: Fix missing CLOEXEC on [chan pipe] fds.
-
-2008-12-12 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclZlib.c (Tcl_ZlibDeflate): Add a bit of extra space for
- the gzip header. [Bug 2419061]
- (Tcl_ZlibInflate): Ensure that gzip header extraction is done
- correctly.
-
-2008-12-12 Kevin Kenny <kennykb@acm.org>
-
- TIP #322 IMPLEMENTATION
-
- * doc/NRE.3 (new file): Added documentation of the published API for
- Non-Recursive Evaluation (NRE).
-
-2008-12-11 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclZlib.c: Eliminate warning: different 'const' qualifiers
- with msvc compiler. A few more 'const' optimizations.
- * win/tcl.m4: Fix Windows build (msvc) for TIP #234 implementation
- * win/Makefile.in:
- * win/configure:
-
-2008-12-11 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclIO.c (SetChannelFromAny and related): Modified the
- * tests/io.test: internal representation of the tclChannelType to
- contain not only the ChannelState pointer, but also a reference to
- the interpreter it was made in. Invalidate and recompute the
- internal representation when it is used in a different interpreter,
- like cmdName intrep's. Added testcase. [Bug 2407783]
-
-2008-12-11 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclZlib.c (ConvertError): Factor out code to turn zlib
- errors into Tcl errors.
-
- * doc/zlib.n: Added a start at the documentation. Still very rough.
-
-2008-12-11 Jan Nijtmans <nijtmans@users.sf.net>
-
- * win/Makefile.in: Fix Windows build (mingw) for TIP #234
- implementation (additionally, first make sure that zlib is available,
- and rename the standard zdll.lib to libz.a, but at least this works so
- far).
-
-2008-12-11 Donal K. Fellows <dkf@users.sf.net>
-
- * tests/zlib.test: Start of test suite for zlib command.
-
-2008-12-11 Jan Nijtmans <nijtmans@users.sf.net>
-
- * library/clock.tcl (ProcessPosixTimeZone): Fallback to European time
- zone DST rules, when the timezone is between 0 and -12. [Bug 2207436]
- * tests/clock.test (clock-52.[23]): Test cases for [Bug 2207436]
-
-2008-12-11 Donal K. Fellows <dkf@users.sf.net>
-
- TIP #234 IMPLEMENTATION
-
- * generic/tclZlib.c: A very preliminary hack at an interface to the
- zlib library, based on code from Pascal Scheffers.
- WARNING! The C API may be subect to change without much warning! USE
- AT YOUR OWN RISK!
-
-2008-12-10 Kevin B. Kenny <kennykb@acm.org>
-
- * library/tzdata/*: Update from Olson's tzdata2008i.
-
-2008-12-10 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-
- TIP #343 IMPLEMENTATION - A Binary Specifier for [format/scan]
-
- * doc/format.n
- * doc/scan.n
- * generic/tclInt.h
- * generic/tclScan.c
- * generic/tclStrToD.c
- * generic/tclStringObj.c
- * tests/format.test
- * tests/scan.test
-
-2008-12-10 Donal K. Fellows <dkf@users.sf.net>
-
- TIP #341 IMPLEMENTATION
-
- * generic/tclDictObj.c (DictFilterCmd): Made key and value filtering
- * tests/dict.test, doc/dict.n: accept arbitrary numbers of
- glob arguments.
-
-2008-12-09 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclInt.decls: Restore source and binary compatibility for
- TIP #337 implementation. (When it is _that_
- simple, there is no excuse not to do it! :-))
- * generic/tclIntDecls.h: make genstubs
- * generic/tclStubInit.c:
-
-2008-12-09 Don Porter <dgp@users.sourceforge.net>
-
- TIP #337 IMPLEMENTATION
-
- * doc/BackgdErr.3: Converted internal routine
- * doc/interp.n: TclBackgroundException() into public routine
- * generic/tcl.decls: Tcl_BackgroundException().
- * generic/tclEvent.c:
- * generic/tclInt.decls:
-
- * generic/tclDecls.h: make genstubs
- * generic/tclIntDecls.h:
- * generic/tclStubInit.c:
-
- * generic/tclIO.c: Update callers.
- * generic/tclIOCmd.c:
- * generic/tclInterp.c:
- * generic/tclTimer.c:
- *** POTENTIAL INCOMPATIBILITY only for extensions using the converted
- internal routine ***
-
-2008-12-09 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclIO.c (ChanClose,ChanRead,...): Factored out some of the
- code to connect to channel drivers that was common in multiple
- locations so as to make code more readable.
-
-2008-12-06 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclCmdAH.c (FileTempfileCmd): Force temporary files to be
- created in the native filesystem. Attempting to provide a template
- that puts it elsewhere will result in the directory part of the
- template being ignored. Partial address of [Bug 2388866] concerns.
-
-2008-12-05 Donal K. Fellows <dkf@users.sf.net>
-
- TIP #335 IMPLEMENTATION
-
- * generic/tclBasic.c (Tcl_InterpActive): Added function for working
- * doc/CrtInterp.3: out if an interp is in use.
-
- TIP #307 IMPLEMENTATION
-
- * generic/tclResult.c (Tcl_TransferResult): Renamed function from
- * generic/tcl.decls: TclTransferResult. Added
- * doc/SetResult.3: to public stubs table.
-
-2008-12-04 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclPathObj.c (Tcl_FSGetNormalizedPath): Added another
- flag value TCLPATH_NEEDNORM to mark those intreps which need more
- complete normalization attention for correct results. [Bug 2385549]
-
-2008-12-03 Donal K. Fellows <dkf@users.sf.net>
-
- * win/tclWinPipe.c (TclpOpenTemporaryFile): Avoid an infinite loop due
- to GetTempFileName/CreateFile interaction. [Bug 2380318]
-
-2008-12-03 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclFileName.c (DoGlob): One of the Tcl_FSMatchInDirectory
- calls did not have its return code checked. This caused error messages
- returned by some Tcl_Filesystem drivers to be swallowed.
-
-2008-12-02 Don Porter <dgp@users.sourceforge.net>
-
- TIP #336 IMPLEMENTATION
-
- * generic/tcl.decls: New routines Tcl_(Get|Set)ErrorLine.
- * generic/tcl.h: Dropped default access to interp->errorLine.
- * generic/tclCmdAH.c: Restore it with -DUSE_INTERP_ERRORLINE.
- * generic/tclCmdMZ.c: Updated callers.
- * generic/tclDictObj.c:
- * generic/tclIOUtil.c:
- * generic/tclNamesp.c:
- * generic/tclOOBasic.c:
- * generic/tclOODefinedCmds.c:
- * generic/tclOOMethod.c:
- * generic/tclProc.c:
- * generic/tclResult.c:
- *** POTENTIAL INCOMPATIBILITY for C code directly using the
- interp->errorLine field ***
-
- * generic/tclDecls.h: make genstubs
- * generic/tclStubInit.c:
-
-2008-12-02 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclIO.c (TclFinalizeIOSubsystem): Replaced Alexandre
- Ferrieux's first patch for [Bug 2270477] with a gentler version, also
- supplied by him.
-
-2008-12-01 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclParse.c: Coding standards fixups.
-
-2008-12-01 Donal K. Fellows <dkf@users.sf.net>
-
- * tests/cmdAH.test (cmdAH-32.6): Test was not portable; depended on a
- C API function not universally available. [Bug 2371623]
-
-2008-11-30 Kevin B. Kenny <kennykb@acm.org>
-
- * library/clock.tcl (format, ParseClockScanFormat): Added a [string
- map] to get rid of namespace delimiters before caching a scan or
- format procedure. [Bug 2362156]
- * tests/clock.test (clock-64.[12]): Added test cases for the bug that
- was tickled by a namespace delimiter inside a format string.
-
-2008-11-29 Donal K. Fellows <dkf@users.sf.net>
-
- TIP #210 IMPLEMENTATION
-
- * generic/tclCmdAH.c (FileTempfileCmd):
- * unix/tclUnixFCmd.c (TclpOpenTemporaryFile, DefaultTempDir):
- * win/tclWinPipe.c (TclpOpenTemporaryFile):
- * doc/file.n, tests/cmdAH.test: Implementation of [file tempfile]. I
- do not claim that this is a brilliant implementation, especially on
- Windows, but it covers the main points.
-
- * generic/tclThreadStorage.c: General revisions to make code clearer
- and more like the style used in the rest of the core. Includes adding
- more comments and explanation of what is going on. Reduce the amount
- of locking required.
-
-2008-11-27 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-
- * generic/tcl.h: Alternate fix for [Bug 2251175]: missing
- * generic/tclCompile.c: backslash substitution on expanded literals.
- * generic/tclParse.c:
- * generic/tclTest.c:
- * tests/parse.test:
-
-2008-11-26 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclIndexObj.c: Eliminate warning: unused variable
- * generic/tclTest.c: A few more (harmless) Tcl_SetResult
- eliminations.
-
-2008-11-26 Kevin B. Kenny <kennykb@acm.org>
-
- * library/tclIndex: Removed reference to no-longer-extant procedure
- 'tclLdAout'.
- * doc/library.n: Corrected mention of 'auto_exec' to 'auto_execok'.
- [Patch 2114900] thanks to Stuart Cassoff <stwo@users.sf.net>
-
-2008-11-25 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclIndexObj.c: Eliminate 3 calls to Tcl_SetResult, as
- * generic/tclIO.c: examples how it should have been done.
- * generic/tclTestObj.c: purpose: contribute in the TIP #340
- discussion.
-
-2008-11-25 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclIO.c (TclFinalizeIOSubsystem): Applied Alexandre
- Ferrieux's patch for [Bug 2270477] to prevent infinite looping during
- finalization of channels not bound to interpreters.
-
-2008-11-25 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclTest.c: Don't assume that Tcl_SetResult sets
- interp->result, especially not in a DString test, in preparation for
- TIP #340
-
-2008-11-24 Donal K. Fellows <dkf@users.sf.net>
-
- * tools/tcltk-man2html.tcl: Improvements to tackle tricky aspects of
- cross references and new entities to map. [Bug 2330040]
-
-2008-11-19 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclThreadTest.c: Convert Tcl_SetResult(......, TCL_DYNAMIC)
- to Tcl_SetResult(......, TCL_VOLATILE), in preparation for TIP #340
-
-2008-11-17 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tcl.decls: Fix signature and implementation of
- * generic/tclDecls.h: Tcl_HashStats, such that it conforms to the
- * generic/tclHash.c: documentation. [Bug 2308236]
- * generic/tclVar.c:
- * doc/Hash.3:
- * generic/tclDictObj.c: Convert Tcl_SetResult call to
- Tcl_SetObjResult.
-
-2008-11-17 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-
- * tests/for.test: Check for uncompiled-for-continue [Bug 2186888]
- fixed earlier.
-
- * generic/tcl.h: Fix [Bug 2251175]: missing backslash
- * generic/tclCompCmds.c: substitution on expanded literals.
- * generic/tclCompile.c
- * generic/tclParse.c
- * generic/tclTest.c
- * tests/compile.test
- * tests/parse.test
-
-2008-11-16 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclTest.c: Replace two times Tcl_SetResult with
- Tcl_SetObjResult, a little simplification in preparation for the TIP
- #340 patch.
-
-2008-11-13 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclInt.h: Rename static function FSUnloadTempFile to
- * generic/tclIOUtil.c: TclFSUnloadTempFile, needed in tclLoad.c
-
- * generic/tclLoad.c: Fixed [Bug 2269431]: Load of shared
- objects leaves temporary files on windows.
-
-2008-11-12 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * tests/registry.test: Use HKCU to avoid requiring admin access for
- registry testing on Vista/Server2008
-
-2008-11-11 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclNamesp.c: Eliminate warning: passing arg 4 of
- Tcl_SplitList from incompatible pointer type.
- * win/tcl.m4: Reverted change from 2008-11-06 (was under the
- impression that "-Wno-implicit-int" added an extra
- warning)
- * win/configure: (regenerated)
- * unix/tcl.m4: Use -O2 as gcc optimization compiler flag, and get rid
- of -Wno-implicit-int for UNIX.
- * unix/configure: (regenerated)
-
-2008-11-10 Andreas Kupries <andreask@activestate.com>
-
- * doc/platform_shell.n: Fixed [Bug 2255235], reported by Ulrich
- * library/platform/pkgIndex.tcl: Ring <uring@users.sourceforge.net>.
- * library/platform/shell.tcl: Updated the LOCATE command in the
- * library/tm.tcl: package 'platform::shell' to handle the new form
- * unix/Makefile.in: of 'provide' commands generated by tm.tcl. Bumped
- * win/Makefile.in: package to version 1.1.4. Added cross-references
- to the relevant parts of the code to avoid future desynchronization.
-
-2008-11-07 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * generic/tclInt.h: Applied [Patch 2215022] from Duoas to clean up
- * generic/tclBinary.c: the binary ensemble initiailization code.
- * generic/tclNamesp.c: Extends the TclMakeEnsemble to do
- * doc/ByteArrObj.3: sub-ensembles from tables.
-
-2008-11-06 Jan Nijtmans <nijtmans@users.sf.net>
-
- * win/tcl.m4: Add "-Wno-implicit-int" flag for gcc, as on UNIX
- * win/configure: (regenerated)
- * generic/tclIO.c: Eliminate an 'array index out of bounds' warning
- on HP-UX.
-
-2008-11-04 Jeff Hobbs <jeffh@ActiveState.com>
-
- * generic/tclPort.h: Remove the ../win/ header dir as the build system
- already has it, and it confuses builds when used with private headers
- installed.
-
-2008-11-01 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOO.h (TCLOO_VERSION): Bump version of TclOO.
-
-2008-10-31 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOOBasic.c (TclOONRUpcatch): Reworked the code that does
- * generic/tclOO.c (InitFoundation): class constructor handling so
- that it is more robust and runs the constructor call in the context of
- the caller of the class's constructor method. Needed because the
- previously used code did not work at all after applying the fix below;
- no Tcl existing command could reliably do what was needed any more.
-
- * generic/tclOODefineCmds.c (GetClassInOuterContext): Rework and
- factor out the code to resolve class names in definitions so that
- classes are resolved from the perspective of the caller of the
- [oo::define] command, rather than from the oo::define namespace! This
- makes much code simpler by reducing how often fully-qualified names
- are required (previously always in practice, so no back-compat issues
- exist). [Bug 2200824]
-
-2008-10-28 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclCompile.h: CONSTify TclDTraceInfo
- * generic/tclBasic.c:
- * generic/tclProc.c:
- * generic/tclEnv.c: Eliminate some -Wwrite-strings warnings
- * generic/tclLink.c:
-
-2008-10-27 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclEncoding.c: Use "iso8859-1" and not "identity" as
- the default and original [encoding system] value. Since "iso8859-1" is
- built in to the C source code for Tcl now, there's no availability
- issue, and it has the good feature of "identity" that we must have
- ("bytes in" == "bytes out") without the bad feature of "identity"
- ("broken as designed") that makes us want to abandon it. [RFE 2008609]
- *** POTENTIAL INCOMPATIBILITY for older releases of Tclkit and any
- other code expecting a particular value for Tcl's default system
- encoding ***
-
-2008-10-24 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * library/http/http.tcl: Fixed a failure to read SHOUTcast streams
- with the new 2.7 package. Introduced a new intial state as the first
- response may not be HTTP*.
-
-2008-10-23 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclCmdAH.c (ForNextCallback): handle TCL_CONTINUE in the for
- body. [Bug 2186888]
-
-2008-10-22 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tcl.h: CONST -> const and white-spacing
- * generic/tclCompile.h:
- * generic/tclEncoding.c:
- * generic/tclStubInit.c:
- * generic/tclStubLib.c:
- * generic/tcl.decls
- * generic/tclInt.decls
- * generic/tclTomMath.decls
- * generic/tclDecls.h: (regenerated)
- * generic/tclIntDecls.h: (regenerated)
- * generic/tclIntPlatDecls.h: (regenerated)
- * generic/tclOODecls.h: (regenerated)
- * generic/tclOOIntDecls.h: (regenerated)
- * generic/tclPlatDecls.h: (regenerated)
- * generic/tclTomMathDecls.h: (regenerated)
- * generic/tclIntDecls.h: (regenerated)
- * tools/genStubs.tcl: CONST -> const and white-spacing
-
-2008-10-19 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclProc.c: Reset -level and -code values to defaults
- after they are used. [Bug 2152286]
-
-2008-10-19 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclBasic.c (TclInfoCoroutineCmd): Added code to make this
- check for being invoked in a syntactically correct way.
-
- * doc/info.n: Added documentation of [info coroutine].
-
- * doc/prefix.n: Improved the documentation by fixing formatting,
- adding good-practice recommendations and cross-references, etc.
-
-2008-10-17 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclOO.decls: CONST -> const.
- * generic/tclOODecls.h: (regenerated)
- * generic/tclOOIntDecls.h: (regenerated)
-
-2008-10-17 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclIORTrans.c (DeleteReflectedTransformMap): Removed debug
- output in C++ comment.
-
-2008-10-17 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclCompile.h: Declare the internal tclInstructionTable to
- * generic/tclExecute.c: simply be "const", not CONST86.
-
- * generic/tclCmdAH.c: whitespace.
- * generic/tclCmdIL.c: Uninitialized variable warning.
- * generic/tclTest.c: const correctness warning.
-
-2008-10-17 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/*: Many very small formatting fixes.
- * doc/{glob,http,if}.n: More substantial reformatting for clarity.
- * doc/split.n: Remove mention of defunct c.l.t.announce
-
-2008-10-16 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/regc_locale.c: Add "const" to many internal const tables.
- * generic/tclClock.c: No functional or API change.
- * generic/tclCmdIL.c
- * generic/tclConfig.c
- * generic/tclDate.c
- * generic/tclEncoding.c
- * generic/tclEvent.c
- * generic/tclExecute.c
- * generic/tclFileName.c
- * generic/tclGetDate.y
- * generic/tclInterp.c
- * generic/tclIO.c
- * generic/tclIOCmd.c
- * generic/tclIORChan.c
- * generic/tclIORTrans.c
- * generic/tclLoad.c
- * generic/tclObj.c
- * generic/tclOOBasic.c
- * generic/tclOOCall.c
- * generic/tclOOInfo.c
- * generic/tclPathObj.c
- * generic/tclPkg.c
- * generic/tclResult.c
- * generic/tclStringObj.c
- * generic/tclTest.c
- * generic/tclTestObj.c
- * generic/tclThreadTest.c
- * generic/tclTimer.c
- * generic/tclTrace.c
- * macosx/tclMacOSXFCmd.c
- * win/cat.c
- * win/tclWinInit.c
- * win/tclWinTest.c
-
-2008-10-16 Don Porter <dgp@users.sourceforge.net>
-
- * library/init.tcl: Revised [unknown] so that it carefully
- preserves the state of the ::errorInfo and ::errorCode variables at
- the start of auto-loading and restores that state before the
- autoloaded command is evaluated. [Bug 2140628]
-
-2008-10-15 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclInt.h: Add "const" to many internal const tables, so
- * generic/tclBinary.c: those will be put by the C-compiler in the
- * generic/tclCompile.c: TEXT segment in stead of the DATA segment.
- * generic/tclDictObj.c: This makes those tables sharable in shared
- * generic/tclHash.c: libraries.
- * generic/tclListObj.c:
- * generic/tclNamesp.c:
- * generic/tclObj.c:
- * generic/tclProc.c:
- * generic/tclRegexp.c:
- * generic/tclStringObj.c:
- * generic/tclUtil.c:
- * generic/tclVar.c:
-
-2008-10-14 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclCmdAH.c: Fix minor compiler warnings when compiling
- * generic/tclCmdMZ.c: with -Wwrite-strings.
- * generic/tclIndexObj.c:
- * generic/tclProc.c:
- * generic/tclStubLib.c:
- * generic/tclUtil.c:
- * win/tclWinChan.c:
- * win/tclWinDde.c:
- * win/tclWinInit.c:
- * win/tclWinReg.c:
- * win/tclWinSerial.c:
-
-2008-10-14 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/binary.n: Formatting fix.
-
-2008-10-14 Don Porter <dgp@users.sourceforge.net>
-
- * README: Bump version number to 8.6a4
- * generic/tcl.h:
- * library/init.tcl:
- * tools/tcl.wse.in:
- * unix/configure.in:
- * unix/tcl.spec:
- * win/configure.in:
-
- * unix/configure: autoconf-2.59
- * win/configure:
-
- * generic/tclExecute.c: Fix compile warnings when --enable-symbols=all
-
- * generic/tclCmdIL.c: Fix write to unallocated memory whenever
- [lrepeat] returns an empty list.
-
-2008-10-14 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/chan.n, doc/fconfigure.n: Added even more emphatic text to
- direct people to the correct manual pages for specific channel types,
- suitable for the hard-of-reading. Following discussion on tcl-core.
-
-2008-10-13 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * win/tclWinThrd.c (TclpThreadCreate): We need to initialize the
- thread id variable to 0 as on 64 bit windows this is a pointer sized
- field while windows only fills it with a 32 bit value. The result is
- an inability to join the threads as the ids cannot be matched.
-
- * generic/tclTest.c (TestNRELevels): Set array to the right size.
-
-2008-10-13 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOOInfo.c (InfoClassDestrCmd): Handle error case.
-
- * generic/tclOOInt.h: Added macro magic to make things work with
- Objective C. [Bug 2163447]
-
-2008-10-12 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclCompile.c: Fix bug in srcDelta encoding within ByteCodes.
- The bug can only be triggered under conditions that cannot happen in
- Tcl, but were met during development of L. Thanks go to Robert Netzer
- for diagnosis and fix.
-
-2008-10-10 Don Porter <dgp@users.sourceforge.net>
-
- *** 8.6a3 TAGGED FOR RELEASE ***
-
- * changes: Updates for 8.6a3 release.
-
-2008-10-10 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOODefineCmds.c (TclOODefineUnexportObjCmd)
- (TclOODefineExportObjCmd): Corrected export/unexport record synthesis.
- [Bug 2155658]
-
-2008-10-08 Jan Nijtmans <nijtmans@users.sf.net>
-
- * unix/tclUnixChan.c: Fix minor compiler warning.
- * unix/tcl.m4: Fix for [Bug 2073255]
- * unix/configure: Regenerated
-
-2008-10-08 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic (TclInfoCoroutineCmd):
- * tests/unsupported.test: Arrange for [info coroutine] to return {}
- when a coroutine is running but the resume command has been deleted.
- [Bug 2153080]
-
-2008-10-08 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclTrace.c: Corrected handling of errors returned by
- variable traces so that the errorInfo value contains the original
- error message. [Bug 2151707]
-
- * generic/tclVar.c: Revised implementation of TclObjVarErrMsg so
- that error message construction does not disturb an existing
- iPtr->errorInfo that may be in progress.
-
-2008-10-07 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/binary.n: Added better documentation of the [binary encode] and
- [binary decode] subcommands.
-
-2008-10-07 Miguel Sofer <msofer@users.sf.net>
-
- TIP #327,#328 IMPLEMENTATIONS
-
- * generic/tclBasic.c: Move [tailcall], [coroutine] and
- * generic/tclCmdIL.c: [yield] out of ::tcl::unsupported
- * tclInt.h:
- * tests/info.test: and into global scope: TIPs #327
- * tests/unsupported.test: and #328
-
-2008-10-07 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/chan.n, doc/transchan.n: Documented the channel transformation
- API of TIP #230.
-
-2008-10-06 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * tests/winFCmd.test: Fixed some erroneous tests on Vista+.
- * generic/tclFCmd.c: Fix constness for msvc of last commit
-
-2008-10-06 Joe Mistachkin <joe@mistachkin.com>
-
- * tools/man2tcl.c: Added missing line from patch by Harald Oehlmann.
- [Bug 1934200]
-
-2008-10-05 Jan Nijtmans <nijtmans@users.sf.net>
-
- * doc/FileSystem.3: CONSTified Tcl_FSFileAttrStringsProc
- * generic/tclFCmd.c: and tclpFileAttrStrings. This allows
- * generic/tclIOUtil.c: FileSystems to report their attributes
- * generic/tclTest.c: as const strings, without worrying that
- * unix/tclUnixFCmd.c: Tcl modifies them (which Tcl should not
- * win/tclWinFCmd.c: do anyway, but the API didn't indicate that)
- * generic/tcl.decls
- * generic/tclDecls.h: regenerated
- * generic/tcl.h: Make sure that if CONST84 is defined as empty,
- CONST86 should be defined as empty as well
- (unless overridden). This change complies with
- TIP #27
- *** POTENTIAL INCOMPATIBILITY ***
-
-2008-10-05 Kevin B, Kenny <kennykb@acm.org>
-
- * libtommath/bn_mp_sqrt.c (bn_mp_sqrt): Handle the case where a
- * tests/expr.test (expr-47.13): number's square root is
- between n<<DIGIT_BIT and n<<DIGIT_BIT+1. [Bug 2143288]
- Thanks to Malcolm Boffey (malcolm.boffey@virgin.net) for the patch.
-
- TIP #331 IMPLEMENTATION
-
- * doc/lset.n:
- * generic/tclListObj.c (TclLsetFlat):
- * tests/lset.test: Modified the [lset] command so that it allows for
- an index of 'end+1', which has the effect of appending an element to
- the list.
-
-2008-10-05 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclInt.decls: CONSTified the AuxDataType argument
- * generic/tclCompCmds.c: of TclCreateAuxData and
- * generic/tclCompile.c: TclRegisterAuxDataType and the return
- * generic/tclCompile.h: values of TclGetAuxDataType and
- * generic/tclExecute.c: TclGetInstructionTable
- * generic/tclIntDecls.h: regenerated
- This change complies with TIP #27 (even though it only involves
- internal function, so this is not even necessary).
-
-2008-10-05 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclIndexObj.c (TclInitPrefixCmd): Make the [tcl::prefix]
- into an exported command. [Bug 2144595]
-
-2008-10-04 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclCmdIL.c (InfoFrameCmd): Improved hygiene of result
- * generic/tclRegexp.c (TclRegAbout): handling.
-
-2008-10-04 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/tclLoad.c: Make sure that any library which doesn't have an
- unloadproc is only really unloaded when no library code is executed
- yet. [Bug 2059262]
-
-2008-10-04 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOOInfo.c (GetClassFromObj): Factor out the code to parse
- a Tcl_Obj and get a class. Also make result handling hygienic.
- * generic/tclOOBasic.c (TclOOSelfObjCmd): Better hygiene of results,
- and stop allocating quite so much memory by sharing special "method"
- names.
-
-2008-10-04 Jan Nijtmans <nijtmans@users.sf.net>
-
- * doc/ChnlStack.3: CONSTified the typePtr argument
- * doc/CrtChannel.3: of Tcl_CreateChannel and Tcl_StackChannel
- * generic/tcl.decls: and the return value of Tcl_GetChannelType
- * generic/tcl.h
- * generic/tclIO.h
- * generic/tclIO.c
- * generic/tclDecls.h: regenerated
- This change complies with TIP #27.
-
- * doc/Hash.3: CONSTified the typePtr argument
- * generic/tcl.decls: of Tcl_InitCustomHashTable.
- * generic/tcl.h
- * generic/tclHash.c
- * generic/tclDecls.h: regenerated
- This change complies with TIP #27.
-
- * doc/RegConfig.3: CONSTified the configuration argument
- * generic/tcl.decls: of Tcl_RegisterConfig.
- * generic/tcl.h
- * generic/tclConfig.c
- * generic/tclPkgConfig.c
- * generic/tclDecls.h: regenerated
- This change complies with TIP #27.
-
- * doc/GetIndex.3: CONSTified the tablePtr argument
- * generic/tcl.decls: of Tcl_GetIndexFromObj.
- * generic/tclIndexObj.c
- * generic/tclDecls.h: regenerated
- This change complies with TIP #27.
-
-2008-10-03 Miguel Sofer <msofer@users.sf.net>
-
- * tests/stack.test:
- * unix/tclUnixTest.c: Removed test command teststacklimit and the
- corresponding constraint: it is not needed with NRE
-
-2008-10-03 Donal K. Fellows <dkf@users.sf.net>
-
- TIP #195 IMPLEMENTATION
-
- * generic/tclIndexObj.c (TclGetIndexFromObjList, PrefixMatchObjCmd)
- * doc/prefix.n, tests/string.test: Added [tcl::prefix] command for
- working with prefixes of strings at the Tcl level. [Patch 1040206]
-
- TIP #265 IMPLEMENTATION
-
- * generic/tclIndexObj.c (Tcl_ParseArgsObjv, PrintUsage):
- * generic/tcl.h (Tcl_ArgvInfo): Added function for simple parsing of
- * doc/ParseArgs.3 (new file): optional arguments to commands. Still
- needs tests and the like. [FRQ 1446696] Note that some of the type
- signatures are changed a bit from the proposed implementation so that
- they better reflect codified good practice for argument order.
-
-2008-10-02 Andreas Kupries <andreask@activestate.com>
-
- * tests/info.test (info-23.3): Updated output of the test to handle
- the NRE-enabled eval and the proper propagation of location
- information through it. [Bug 2017632]
-
- * doc/info.n: Rephrased the documentation of 'info frame' for positive
- numbers as level argument. [Bug 2134049]
-
- * tests/info.test (info-22.8): Made pattern for file containing
- tcltest less specific to accept both .tcl and .tm variants of the file
- during matching. [Bug 2129828]
-
-2008-10-02 Don Porter <dgp@users.sourceforge.net>
-
- TIP #330 IMPLEMENTATION
-
- * generic/tcl.h: Remove the "result" and "freeProc" fields
- * generic/tclBasic.c: from the default public declaration of the
- * generic/tclResult.c: Tcl_Interp struct. Code should no longer
- * generic/tclStubLib.c: be accessing these fields. Access can be
- * generic/tclTest.c: restored by defining USE_INTERP_RESULT, but
- * generic/tclUtil.c: that should only be a temporary migration aid.
- *** POTENTIAL INCOMPATIBILITY ***
-
-2008-10-02 Joe Mistachkin <joe@mistachkin.com>
-
- * doc/info.n: Fix unmatched font change.
- * doc/tclvars.n: Fix unmatched font change.
- * doc/variable.n: Fix unmatched font change.
- * tools/man2help2.tcl: Integrated patch from Harald Oehlmann.
- [Bug 1934272]
- * tools/man2tcl.c: Increase MAX_LINE_SIZE to fix "Too long line" error.
- * win/buildall.vc.bat: Prefer the HtmlHelp target over the WinHelp
- target. [Bug 2072891]
- * win/makefile.vc: Fix the HtmlHelp and WinHelp targets to not be
- mutually exclusive.
-
-2008-09-29 Don Porter <dgp@users.sourceforge.net>
-
- TIP #323 IMPLEMENTATION (partial)
-
- * doc/glob.n: Revise [glob] to accept zero patterns.
- * generic/tclFileName.c:
- * tests fileName.test:
-
- * doc/linsert.n: Revise [linsert] to accept zero elements.
- * generic/tclCmdIL.c:
- * tests/linsert.test:
-
-2008-09-29 Donal K. Fellows <dkf@users.sf.net>
-
- TIP #326 IMPLEMENTATION
-
- * generic/tclCmdIL.c (Tcl_LsortObjCmd): Added -stride option to carry
- * doc/lsort.n, tests/cmdIL.test: out sorting of lists where the
- elements are grouped. Adapted from [Patch 2082681]
-
- TIP #313 IMPLEMENTATION
-
- * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Added -bisect option to
- * doc/lsearch.n, tests/lsearch.test: allow the finding of the
- place to insert an element in a sorted list when that element is
- not already there. [Patch 1894241]
-
- TIP #318 IMPLEMENTATION
-
- * generic/tclCmdMZ.c (StringTrimCmd,StringTrimLCmd,StringTrimRCmd):
- Update the default set of trimmed characters to include some from the
- larger UNICODE space. Factor out the default trim set into a macro so
- that it is easier to keep them in synch.
-
-2008-09-28 Donal K. Fellows <dkf@users.sf.net>
-
- TIP #314 IMPLEMENTATION
-
- * generic/tclCompCmds.c (TclCompileEnsemble)
- * generic/tclNamesp.c (NamespaceEnsembleCmd)
- (Tcl_SetEnsembleParameterList, Tcl_GetEnsembleParameterList)
- (NsEnsembleImplementationCmdNR):
- * generic/tcl.decls, doc/Ensemble.3, doc/namespace.n
- * tests/namespace.test: Allow the handling of a (fixed) number of
- formal parameters between an ensemble's command and subcommand at
- invokation time. [Patch 1901783]
-
-2008-09-28 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Fix the numLevels computations on
- * generic/tclInt.h: coroutine yield/resume
- * tests/unsupported.test:
-
-2008-09-27 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclFileName.c (Tcl_GetBlock*FromStat): Made this work
- acceptably when working with OSes that don't support reporting the
- block size from the stat() call. [Bug 2130726]
-
- * generic/tclCmdIL.c (Tcl_LrepeatObjCmd): Improve the handling of the
- case where the combination of number of elements and repeat count
- causes the resulting list to be too large. [Bug 2130992]
-
-2008-09-26 Don Porter <dgp@users.sourceforge.net>
-
- TIP #323 IMPLEMENTATION (partial)
-
- * doc/lrepeat.n: Revise [lrepeat] to accept both zero
- * generic/tclCmdIL.c: repetitions and zero elements to be repeated.
- * tests/lrepeat.test:
-
- * doc/object.n: Revise standard oo method [my variable] to
- * generic/tclOOBasic.c: accept zero variable names.
- * tests/oo.test:
-
- * doc/tm.n: Revise [tcl::tm::path add] and
- * library/tm.tcl: [tcl::tm::path remove] to accept zero paths.
- * tests/tm.test:
-
- * doc/namespace.n: Revise [namespace upvar] to accept zero
- * generic/tclNamesp.c: variable names.
- * tests/upvar.test:
-
- * doc/lassign.n: Revise [lassign] to accept zero variable names.
- * generic/tclCmdIL.c:
- * tests/cmdIL.test:
-
-2008-09-26 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOO.h (TCLOO_VERSION): Bump the version.
-
-2008-09-25 Don Porter <dgp@users.sourceforge.net>
-
- TIP #323 IMPLEMENTATION (partial)
-
- * doc/global.n: Revise [global] to accept zero variable names.
- * doc/variable.n: Revise [variable] likewise.
- * generic/tclVar.c:
- * tests/proc-old.test:
- * tests/var.test:
-
- * doc/global.n: Correct false claim about [info locals].
-
-2008-09-25 Donal K. Fellows <dkf@users.sf.net>
-
- TIP #315 IMPLEMENTATION
-
- * tests/platform.test: Update tests to expect revised results
- * tests/safe.test: corresponding to the TIP 315 change.
-
- * unix/tclUnixInit.c, win/tclWinInit.c (TclpSetVariables):
- * doc/tclvars.n (tcl_platform): Define what character is used for
- separating PATH-like lists. Forms part of the tcl_platform array.
-
- * generic/tclOOCall.c (InitCallChain, IsStillValid):
- * tests/oo.test (oo-25.2): Revise call chain cache management so that
- it takes into account class-wide caching correctly. [Bug 2120903]
-
-2008-09-24 Don Porter <dgp@users.sourceforge.net>
-
- TIP #323 IMPLEMENTATION (partial)
-
- * doc/file.n: Revise [file delete] and [file mkdir] to
- * generic/tclCmdAH.c: accept zero "pathname" arguments (the
- * generic/tclFCmd.c: no-op case).
- * tests/cmdAH.test:
- * tests/fCmd.test:
-
-2008-09-24 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOOMethod.c (DBPRINT): Remove obsolete debugging macro.
- [Bug 2124814]
-
- TIP #316 IMPLEMENTATION
-
- * generic/tcl.decls, generic/tclFileName.c (Tcl_GetSizeFromStat, etc):
- * doc/FileSystem.3: Added reader functions for Tcl_StatBuf.
-
-2008-09-23 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/Method.3: Corrected documentation. [Patch 2082450]
-
- * doc/lreverse.n, mathop.n, regexp.n, regsub.n: Make sure that the
- initial line of the manpage includes nothing that chokes old versions
- of man. [Bug 2118123]
-
-2008-09-22 Donal K. Fellows <dkf@users.sf.net>
-
- TIP #320 IMPLEMENTATION
-
- * generic/tclOODefineCmds.c (TclOODefineVariablesObjCmd):
- * generic/tclOOInfo.c (InfoObjectVariablesCmd, InfoClassVariablesCmd):
- * generic/tclOOMethod.c (TclOOSetupVariableResolver, etc):
- * doc/define.n, doc/ooInfo.n, benchmarks/cps.tcl:
- * tests/oo.test (oo-26.*): Allow the declaration of the common
- variables used in methods of a class or object. These are then mapped
- in using a variable resolver. This makes many class declarations much
- simpler overall, encourages good usage of variable names, and also
- boosts speed a bit.
-
- * generic/tclOOMethod.c (TclOOGetMethodBody): Factor out the code to
- get the body of a procedure-like method. Reduces the amount of "poking
- inside the abstraction" that is done by the introspection code.
-
-2008-09-22 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-
- * doc/chan.n: Clean up paragraph order.
-
-2008-09-18 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c (NEXT_INST_F):
- * generic/tclInt.h (TCL_CT_ASSERT): New compile-time assertions,
- adapted from www.pixelbeat.org/programming/gcc/static_assert.html
-
-2008-09-17 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclInt.h: Correct the TclGetLongFromObj, TclGetIntFromObj,
- and TclGetIntForIndexM macros so that they retrieve the longValue
- field from the internalRep instead of casting the otherValuePtr field
- to type long.
-
-2008-09-17 Miguel Sofer <msofer@users.sf.net>
-
- * library/init.tcl: Export min and max commands from the mathfunc
- namespace. [Bug 2116053]
-
-2008-09-16 Joe Mistachkin <joe@mistachkin.com>
-
- * generic/tclParse.c: Move TclResetCancellation to be called on
- returning to level 0, as opposed to it being called on starting a
- substitution at level 0.
-
-2008-09-16 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Move TclResetCancellation to be called on
- returning to level 0, as opposed to it being called on starting a
- command at level 0. Add a call on returning via Tcl_EvalObjEx to fix
- [Bug 2114165].
-
-2008-09-10 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/binary.n: Added partial documentation of [binary encode] and
- [binary decode].
-
- * tests/binary.test,cmdAH.test,cmdIL.test,cmdMZ.test,fileSystem.test:
- More use of tcltest2 to simplify the tests as exposed to people.
- * tests/compile.test (compile-18.*): Added *some* tests of the
- disassmbler, though not of its output format.
-
-2008-09-10 Miguel Sofer <msofer@users.sf.net>
-
- * tests/nre.test: Add missing constraints; enable test of foreach
- recursion.
-
- * generic/tclBasic.c:
- * generic/tclCompile.h:
- * generic/tclExecute.c (INST_EVAL_STK): Wrong numLevels when evaling a
- canonical list. [Bug 2102930]
-
-2008-09-10 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclListObj.c (Tcl_ListObjGetElements): Make this list->dict
- transformation - encountered when using [foreach] with dicts - not as
- expensive as it was before. Spotted by Kieran Elby and reported on
- tcl-core.
-
-2008-09-08 Donal K. Fellows <dkf@users.sf.net>
-
- * tests/append.test, appendComp.test, cmdAH.test: Use the powers of
- tcltest2 to make these files simpler.
-
-2008-09-07 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclCompile.c (TclCompileTokens):
- * generic/tclExecute.c (CompileExprObj): Fix a perf bug (found by Alex
- Ferrieux) where some variables in the LVT where not being accessed by
- index. Fix missing localCache management in compiled expressions found
- while analyzing the bug.
-
-2008-09-07 Miguel Sofer <msofer@users.sf.net>
-
- * doc/namespace.n: Fix [Bug 2098441]
-
-2008-09-04 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclTrace.test (TraceVarProc):
- * generic/unsupported.test: Insure that unset traces are run even when
- the coroutine is unwinding. [Bug 2093947]
-
- * generic/tclExecute.c (CACHE_STACK_INFO):
- * tests/unsupported.test: Restore execEnv's bottomPtr. [Bug 2093188]
-
-2008-09-02 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tcl.h: Stripped "callers" of the _ANSI_ARGS_ macro
- * compat/dirent2.h: to support a TCL_NO_DEPRECATED build.
- * compat/dlfcn.h:
- * unix/tclUnixPort.h:
-
- * generic/tcl.h: Removed the conditional #define of
- _ANSI_ARGS_ that would support pre-prototype C compilers. Since
- _ANSI_ARGS_ is no longer used in tclDecls.h, it's clear no one
- compiling against Tcl 8.5 headers is making use of a -DNO_PROTOTYPES
- configuration.
-
-2008-09-02 Donal K. Fellows <dkf@users.sf.net>
-
- * tests/socket.test: Rewrote so as to use tcltest2 better.
-
-2008-09-01 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclCmdAH.c: NRE-enabling [eval]; eval scripts are now
- * generic/tclOOBasic.c: bytecompiled. Adapted recursion limit tests
- * tests/interp.test: that were relying on eval not being
- * tests/nre.test: compiled. Part of the [Bug 2017632] project.
- * tests/unsupported.test:
-
-2008-09-01 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOOMethod.c (InvokeProcedureMethod):
- * generic/tclOO.c (ObjectRenamedTrace): Arrange for only methods that
- involve callbacks into the Tcl interpreter to be skipped when the
- interpreter is being torn down. Allows the semantics of destructors in
- a dying interpreter to be more useful when they're implemented in C.
-
-2008-08-29 Donal K. Fellows <dkf@users.sf.net>
-
- * unix/Makefile.in: Ensure that all TclOO headers get installed.
- * win/Makefile.in: [Bug 2082299]
- * win/makefile.bc:
- * win/makefile.vc:
-
-2008-08-28 Don Porter <dgp@users.sourceforge.net>
-
- * README: Bump version number to 8.6a3
- * generic/tcl.h:
- * library/init.tcl:
- * tools/tcl.wse.in:
- * unix/configure.in:
- * unix/tcl.spec:
- * win/configure.in:
-
- * unix/configure: autoconf-2.59
- * win/configure:
-
-2008-08-27 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/tclvars.n, doc/library.n: Ensured that these two manual pages
- properly cross-reference each other. Issue reported on Tcler's Chat.
-
-2008-08-26 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c (InfoCoroutine):
- * tests/unsupported.test: New command that returns the FQN of the
- currently executing coroutine. Lives as infoCoroutine under
- unsupported, but is designed to become a subcommand of [info]
-
-2008-08-23 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c (NRInterpCoroutine): Store the caller's eePtr,
- stop assuming the coroutine is invoked from the same execEnv where it
- was created.
-
-2008-08-24 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclCmdAH.c (TclNRForeachCmd): Converted the [foreach]
- command to have an NRE-aware non-compiled implementation. Part of the
- [Bug 2017632] project. Also restructured the code so as to manage its
- temporary memory more efficiently.
-
-2008-08-23 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Removed unused var; fixed function pointer
- * generic/tclOOInt.h: declarations (why did gcc start complaining
- * generic/tclOOMethod.c: all of a sudden?)
- * generic/tclProc.c:
-
-2008-08-23 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclInt.h (EnsembleImplMap): Added extra field to make it
- * generic/tclNamesp.c (TclMakeEnsemble): easier to build non-recursive
- ensembles in the core.
-
- * generic/tclDictObj.c (DictForNRCmd): Converted the [dict for]
- command to have an NRE-aware non-compiled implementation. Part of the
- [Bug 2017632] project.
-
-2008-08-22 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c:
- * generic/tclExecute.c: Set special errocodes: COROUTINE_BUSY,
- COROUTINE_CANT_YIELD, COROUTINE_ILLEGAL_YIELD.
-
-2008-08-22 Don Porter <dgp@users.sourceforge.net>
-
- *** 8.6a2 TAGGED FOR RELEASE ***
-
- * changes: Updates for 8.6a2 release.
-
- * generic/tcl.h: Drop use of USE_COMPAT85_CONST. That added
- indirection without value. Use -DCONST86="" to engage source compat
- support for code written for 8.5 headers.
-
- * generic/tclUtil.c (TclReToGlob): Added missing set of the
- *exactPtr value to really fix [Bug 2065115]. Also avoid possible
- DString overflow.
- * tests/regexpComp.test: Correct duplicate test names.
-
-2008-08-21 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Previous fix, now done right.
- * generic/tclCmdIL.c:
- * generic/tclInt.h:
- * tests/unsupported.test:
-
-2008-08-21 Jeff Hobbs <jeffh@ActiveState.com>
-
- * tests/regexp.test, tests/regexpComp.test: Correct re2glob ***=
- * generic/tclUtil.c (TclReToGlob): translation from exact
- to anywhere-in-string match. [Bug 2065115]
-
-2008-08-21 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tcl.h: Reduced the use of CONST86 and eliminated
- * generic/tcl.decls: the use of CONST86_RETURN to support source
- code compatibility with Tcl 8.5 on those public routines passing
- (Tcl_Filesystem *), (Tcl_Timer *), and (Tcl_Objtype *) values which
- have been const-ified. What remains is the minimum configurability
- needed to support code written for pre-8.6 headers via the new
- -DUSE_COMPAT85_CONST compiler directive.
- *** POTENTIAL INCOMPATIBILITY ***
-
- * generic/tclDecls.h: make genstubs
-
-2008-08-21 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Fix the cmdFrame level count in
- * generic/tclCmdIL.c: coroutines. Fix small bug on coroutine
- * generic/tclInt.h: rewind.
-
-2008-08-21 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclProc.c (Tcl_DisassembleObjCmd): Added ability to
- disassemble TclOO methods. The code to do this is very ugly.
-
-2008-08-21 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * generic/tclOOMethod.c: Added casts to make MSVC happy
- * generic/tclBasic.c:
-
-2008-08-20 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOO.c (AllocObject): Suppress compilation of commands in
- the namespace allocated for each object.
- * generic/tclOOMethod.c (PushMethodCallFrame): Restore some of the
- hackery that makes calling methods of classes fast. Fixes performance
- problem introduced by the fix of [Bug 2037727].
-
- * generic/tclCompile.c (TclCompileScript): Allow the suppression of
- * generic/tclInt.h (NS_SUPPRESS_COMPILATION): compilation of commands
- * generic/tclNamesp.c (Tcl_CreateNamespace): from a namespace or its
- children.
-
-2008-08-20 Daniel Steffen <das@users.sourceforge.net>
-
- * generic/tclTest.c (TestconcatobjCmd): Fix use of internal-only
- TclInvalidateStringRep macro. [Bug 2057479]
-
-2008-08-17 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Implementation of [coroutine] and [yield]
- * generic/tclCmdAH.c: commands (in tcl::unsupported).
- * generic/tclCompile.h:
- * generic/tclExecute.c:
- * generic/tclInt.h:
- * tests/unsupported.test:
-
- * generic/tclTest.c (TestconcatobjCmd):
- * generic/tclUtil.c (Tcl_ConcatObj):
- * tests/util.test (util-4.7):
- Fix [Bug 1447328]; the original "fix" turned Tcl_ConcatObj() into a
- hairy monster. This was exposed by [Bug 2055782]. Additionally,
- Tcl_ConcatObj could corrupt its input under certain conditions!
-
- *** NASTY BUG FIXED ***
-
-2008-08-16 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c: Better cmdFrame management
-
-2008-08-14 Don Porter <dgp@users.sourceforge.net>
-
- * tests/fileName.test: Revise new tests for portability to case
- insensitive filesystems.
-
-2008-08-14 Daniel Steffen <das@users.sourceforge.net>
-
- * generic/tclBasic.c (TclNREvalObjv, Tcl_NRCallObjProc):
- * generic/tclProc.c (TclNRInterpProcCore, InterpProcNR2):
- DTrace probes for NRE. [Bug 2017160]
-
- * generic/tclBasic.c (TclDTraceInfo): Add two extra arguments to
- * generic/tclCompile.h: DTrace 'info' probes for tclOO
- * generic/tclDTrace.d: method & class/object info.
-
- * generic/tclCompile.h: Add support for debug logging of DTrace
- * generic/tclBasic.c: 'proc', 'cmd' and 'inst' probes (does _not_
- require a platform with DTrace).
-
- * generic/tclCmdIL.c (TclInfoFrame): Check fPtr->line before
- dereferencing as line info may
- not exists when TclInfoFrame()
- is called from a DTrace probe.
-
- * tests/fCmd.test (fCmd-6.23): Made result matching robust when test
- workdir and /tmp are not on same FS.
-
- * unix/tclUnixThrd.c: Remove unused TclpThreadGetStackSize()
- * generic/tclInt.h: and related ifdefs and autoconf tests.
- * unix/tclUnixPort.h: [Bug 2017264] (jenglish)
- * unix/tcl.m4:
-
- * unix/Makefile.in: Ensure Makefile shell is /bin/bash for
- * unix/configure.in (SunOS): DTrace-enabled build on Solaris.
- (followup to 2008-06-12) [Bug 2016584]
-
- * unix/tcl.m4 (SC_PATH_X): Check for libX11.dylib in addition to
- libX11.so et al.
-
- * unix/configure: autoconf-2.59
- * unix/tclConfig.h.in: autoheader-2.59
-
-2008-08-13 Miguel Sofer <msofer@users.sf.net>
-
- * tests/nre.test: Added test for large {*}-expansion effects
-
-2008-08-13 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclFileName.c: Fix for errors handling -types {}
- * tests/fileName.test: option to [glob]. [Bug 1750300]
- Thanks to Matthias Kraft and George Peter Staplin.
-
-2008-08-12 Jeff Hobbs <jeffh@ActiveState.com>
-
- * generic/tclOOInfo.c (InfoObjectDefnCmd, InfoObjectMixinsCmd):
- Fix # args displayed. [Bug 2048676]
-
-2008-08-08 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclOOMethod.c (PushMethodCallFrame): Added missing check
- for bytecode validity. [Bug 2037727]
-
- * generic/tclProc.c (TclProcCompileProc): On recompile of a
- proc, clear away any entries on the CompiledLocal list from the
- previous compile. This will prevent compile of temporary variables in
- the proc body from growing the localCache arbitrarily large.
-
- * README: Bump version number to 8.6a2
- * generic/tcl.h:
- * library/init.tcl:
- * tools/tcl.wse.in:
- * unix/configure.in:
- * unix/tcl.spec:
- * win/configure.in:
-
- * unix/configure: autoconf-2.59
- * win/configure:
-
- * changes: Updates for 8.6a2 release.
-
-2008-08-11 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * library/http/http.tcl: Remove 8.5 requirement.
- * library/http/pkgIndex.tcl:
- * unix/Makefile.in:
- * win/Makefile.in:
- * win/makefile.vc:
-
-2008-08-11 Andreas Kupries <andreask@activestate.com>
-
- * library/tm.tcl: Added a 'package provide' command to the generated
- ifneeded scripts of Tcl Modules, for early detection of conflicts
- between the version specified through the file name and a 'provide'
- command in the module implementation, if any. Note that this change
- also now allows Tcl Modules to not provide a 'provide' command at all,
- and declaring their version only through their filename.
-
- * generic/tclProc.c (Tcl_ProcObjCmd): Fixed memory leak triggered by
- * tests/proc.test: procbody::test::proc. See [Bug 2043636]. Added a
- test case demonstrating the leak before the fix. Fixed a few spelling
- errors in test descriptions as well.
-
-2008-08-11 Don Porter <dgp@users.sourceforge.net>
-
- * library/http/http.tcl: Bump http version to 2.7.1 to account
- * library/http/pkgIndex.tcl: for [Bug 2046486] bug fix. This
- * unix/Makefile.in: release of http now requires a
- * win/Makefile.in: dependency on Tcl 8.5 to be able to
- * win/makefile.bc: use the unsigned formats in the
- * win/makefile.vc: [binary scan] command.
-
-2008-08-11 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * library/http/http.tcl: CRC field from zlib data should be treated as
- unsigned for 64bit support. [Bug 2046846]
-
-2008-08-10 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclProc.c: Completely removed ProcCompileProc, which was a
- fix for [Bug 1482718]. This is not needed at least since varReform,
- where the local variable data at runtime is read from the CallFrame
- and/or the LocalCache.
-
-2008-08-09 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Slight cleanup
- * generic/tclCompile.h:
- * generic/tclExecute.c:
-
-2008-08-09 Daniel Steffen <das@users.sourceforge.net>
-
- * generic/tclExecute.c: Fix warnings.
-
- * generic/tclOOMethod.c (PushMethodCallFrame): Fix uninitialized efi
- name field.
-
- * tests/lrange.test (lrange-1.17): Add test cleanup; whitespace.
-
-2008-08-08 Don Porter <dgp@users.sourceforge.net>
-
- * changes: Updates for 8.6a2 release.
-
-2008-08-08 Kevin Kenny <kennykb@acm.org>
-
- * library/tzdata/CET:
- * library/tzdata/MET:
- * library/tzdata/Africa/Casablanca:
- * library/tzdata/America/Eirunepe:
- * library/tzdata/America/Rio_Branco:
- * library/tzdata/America/Santarem:
- * library/tzdata/America/Argentina/San_Luis:
- * library/tzdata/Asia/Karachi:
- * library/tzdata/Europe/Belgrade:
- * library/tzdata/Europe/Berlin:
- * library/tzdata/Europe/Budapest:
- * library/tzdata/Europe/Sofia:
- * library/tzdata/Indian/Mauritius: Olson's tzdata2008e.
-
-2008-08-07 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Fix tailcalls falling out of tebc into
- * generic/tclExecute.c: Tcl_EvalEx. [Bug 2017946]
- * generic/tclInt.h:
-
-2008-08-06 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclOO.c: Revised TclOO's check for an interp being
- deleted during handling of object command deletion. The old code was
- relying on documented features of command delete traces that do not in
- fact work. [Bug 2039178]
-
- * tests/oo.test (oo-26.*): Added tests that demonstrate failure
- of TclOO to check for various kinds of invalid bytecode during method
- dispatch. [Bug 2037727]
-
-2008-08-06 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclVar.c (TclLookupSimpleVar): Fix bug that the core could
- not trigger before TclOO: the number of locals was being read from the
- Proc, which can under some circumstance be out of sync with the
- localCache's. Found by dgp while investigating [Bug 2037727].
-
- * library/init.tcl (::unknown): Removed the [namespace inscope]
- hack that was maintained for Itcl
-
- *** POTENTIAL INCOMPATIBILITY *** for Itcl
- Itcl users will need a new release with Itcl's [Patch 2040295], or
- else load the tiny script in that patch by themselves (rewrite
- ::unknown). Note that it is a script-only patch.
-
-2008-08-05 Joe English <jenglish@users.sourceforge.net>
-
- * unix/tclUnixChan.c: Streamline async connect logic [Patch 1994512]
-
-2008-08-05 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c: Fix for [Bug 2038069] by dgp.
- * tests/execute.test:
-
-2008-08-04 Miguel Sofer <msofer@users.sf.net>
-
- * tests/nre.test: Added tests for [if], [while] and [for]. A test
- for [foreach] has been added and marked as knownbug, awaiting for it
- to be NR-enabled.
-
- * generic/tclBasic.c: Made atProcExit commands run
- * generic/tclCompile.h: unconditionally, streamlined
- * generic/tclExecute.c: atProcExit/tailcall processing in TEBC.
- * generic/tclProc.c:
- * tests/unsupported.test:
-
-2008-08-04 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclExecute.c: Stopped faulty double-logging of errors to
- * tests/execute.test: stack trace when a compile epoch bump triggers
- fallback to direct evaluation of commands in a compiled script.
- [Bug 2037338]
-
-2008-08-03 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: New unsupported command atProcExit that
- * generic/tclCompile.h: shares the implementation with tailcall.
- * generic/tclExecute.c: Fixed a segfault in tailcalls. Tests added.
- * generic/tclInt.h:
- * generic/tclInterp.c:
- * generic/tclNamesp.c:
- * tests/unsupported.test:
-
-2008-08-02 Miguel Sofer <msofer@users.sf.net>
-
- * tests/NRE.test (removed): Migrated tests to standard locations,
- * tests/nre.test (new): separating core functionality from the
- * tests/unsupported.test (new): experimental commands.
-
-2008-08-01 Jeff Hobbs <jeffh@ActiveState.com>
-
- * doc/Exit.3: Do not call Tcl_Finalize implicitly
- * generic/tclEvent.c: on DLL_PROCESS_DETACH as it may lead
- * win/tclWin32Dll.c (DllMain): to issues and the user should be
- explicitly calling Tcl_Finalize before unloading regardless. Clarify
- the docs to note the explicit need in embedded use.
-
-2008-08-01 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclBasic.c: Revised timing of the CmdFrame stack
- * tests/info.test: management in TclEvalEx so that the CmdFrame
- will still be on the stack at the time Tcl_LogCommandInfo is called to
- append another level of -errorinfo information. Sets the stage to add
- file and line data to the stack trace. Added test to check that [info
- frame] functioning remains unchanged by the revision.
-
-2008-07-31 Miguel Sofer <msofer@users.sf.net>
-
- * tests/NRE.test: Replaced all deep-recursing tests by shallower
- tests that actually measure the C-stack depth. This makes them
- bearable again (even under memdebug) and avoid crashing on failure.
-
- * generic/tclBasic.c: NR-enabling [catch], [if] and [for] and
- * generic/tclCmdAH.c: [while] (the script, not the tests)
- * generic/tclCmdIL.c:
- * generic/tclCmdMZ.c:
- * generic/tclInt.h:
- * tests/NRE.test:
-
- * generic/tclBasic.c: Moved the few remaining defs from tclNRE.h to
- * generic/tclDictObj.c: tclInt.h, eliminated inclusion of tclNRE.h
- * generic/tclExecute.c: everywhere.
- * generic/tclInt.h:
- * generic/tclInterp.c:
- * generic/tclNRE.h (removed):
- * generic/tclNamesp.c:
- * generic/tclOOBasic.c:
- * generic/tclOOInt.h:
- * generic/tclProc.c:
- * generic/tclTest.c:
- * unix/Makefile.in:
-
-2008-07-30 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Improved tailcalls.
- * generic/tclCompile.h:
- * generic/tclExecute.c:
- * generic/tclTest.c:
- * tests/NRE.test:
-
- * generic/tclBasic.c (TclNREvalObjEx): New comments and code reorg
- to clarify what is happening.
-
- * generic/tclBasic.c: Guard against the value of iPtr->evalFlags
- changing between the times where TEOV and TEOV_exception run. Thanks
- dgp for catching this.
-
-2008-07-29 Miguel Sofer <msofer@users.sf.net>
-
- * tests/NRE.test: New tests that went MIA in the NRE revamping
-
- * generic/tclBasic.c: Clean up
- * generic/tclNRE.h:
- * generic/tclExecute.c:
-
- * generic/tclBasic.c: Made use of the thread's alloc cache stored in
- * generic/tclInt.h: the ekeko at interp creation to avoid hitting
- * generic/tclNRE.h: the TSD each time an NRE callback is pushed or
- * generic/tclThreadAlloc.c: pulled; the approach is suitably general
- to extend to every other obj allocation where an interp is know; this
- is left for some other time, requires a lot of grunt work.
-
- * generic/tclExecute.c: Fix [Bug 2030670] that cause TclStackRealloc
- to panic on rare corner cases. Thx ajpasadyn for diagnose and patch.
-
- * generic/tcl.decls: Completely revamped NRE implementation, with
- * generic/tclBasic.c: (almost) unchanged API.
- * generic/tclCompile.h:
- * generic/tclExecute.c: TEBC will require a bit of a facelift, but
- * generic/tclInt.decls: TEOV at least looks great now. There are new
- * generic/tclInt.h: tests (incomplete!) to verify that execution
- * generic/tclInterp.c: is indeed in the same TEBC instance, at the
- * generic/tclNRE.h: same level in all stacks involved. Tailcalls
- * generic/tclNamesp.c: are still a bit leaky, still deserving to be
- * generic/tclOOBasic.c: in tcl::unsupported.
- * generic/tclOOMethod.c:
- * generic/tclProc.c: Uninit'd var warnings in TEBC with -O2, no
- * generic/tclTest.c: warnings otherwise.
-
-2008-07-28 Jan Nijtmans <nijtmans@users.sf.net>
-
- * doc/FileSystem.3: CONSTified many functions using
- * generic/tcl.decls: Tcl_FileSystem which all are supposed
- * generic/tclDecls.h: to be a constant, but this was not
- * generic/tclFileSystem.h: reflected in the API: Tcl_FSData,
- * generic/tclIOUtil.c: Tcl_FSGetInternalRep, Tcl_FSRegister,
- * generic/tclPathObj.c: Tcl_FSNewNativePath, Tcl_FSUnregister,
- * generic/tclTest.c: Tcl_FSGetFileSystemForPath ...
- This change complies with TIP #27.
- ***POTENTIAL INCOMPATIBILITY***
-
-2008-07-28 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclBasic.c: Added missing ref count when creating an empty
- string as path (TclEvalEx). In 8.4 the missing code caused panics in
- the testsuite. It doesn't in 8.5. I am guessing that the code path
- with the missing the incr-refcount is not invoked any longer. Because
- the bug in itself is certainly the same.
-
-2008-07-27 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOOMethod.c (PushMethodCallFrame): Remove hack that should
- have gone when this code was merged into Tcl.
-
-2008-07-27 Jan Nijtmans <nijtmans@users.sf.net>
-
- * doc/Object.3: CONSTified 3 functions using Tcl_ObjType
- * doc/ObjectType.3: which all are supposed to be a constant, but
- * generic/tcl.decls: this was not reflected in the API:
- * generic/tcl.h: Tcl_RegisterObjType, Tcl_ConvertToType,
- * generic/tclDecls.h: Tcl_GetObjType
- * generic/tclObj.c: Introduced a CONST86_RETURN, so extensions
- * generic/tclCompCmds.c: which use Tcl_ObjType directly can be
- * generic/tclOOMethod.c: modified to compile against both Tcl 8.5 and
- * generic/tclTestobj.c: Tcl 8.6. tclDecls.h regenerated
- This change complies with TIP #27.
- ***POTENTIAL INCOMPATIBILITY***
-
-2008-07-25 Andreas Kupries <andreask@activestate.com>
-
- * test/info.test: More work on singleTestInterp usability. [1605269]
-
- * tests/info.test: Tests 38.* added, exactly testing the tracking of
- location for uplevel scripts. Resolved merge conflict on info-37.0,
- switched !singleTestInterp constraint to glob matching instead. Ditto
- info-22.8, removed constraint, more glob matching, and reduced the
- depth of the stack we check. More is coming, right now I want to
- commit the bug fixes.
-
- * tests/oo.test: Updated oo-22.1 for expanded location tracking.
-
- * generic/tclCompile.c (TclInitCompileEnv): Reorganized the
- initialization of the #280 location information to match the flow in
- TclEvalObjEx to get more absolute contexts.
-
- * generic/tclBasic.c (TclEvalObjEx): Added missing cleanup of extended
- location information.
-
-2008-07-25 Daniel Steffen <das@users.sourceforge.net>
-
- * tests/info.test (info-37.0): Add !singleTestInterp constraint;
- (info-22.8, info-23.0): switch to glob matching to avoid sensitivity
- to tcltest.tcl line number changes, remove knownBug constraint, fix
- expected result. [Bug 1605269]
-
-2008-07-24 Jan Nijtmans <nijtmans@users.sf.net>
-
- * doc/Notifier.3: CONSTified 4 functions in the Notifier which
- * doc/Thread.3: all have a Tcl_Time* in it which is supposed
- * generic/tcl.decls: to be a constant, but this was not reflected
- * generic/tcl.h: reflected in the API:
- * generic/tclDecls.h: Tcl_SetTimer, Tcl_WaitForEvent,
- * generic/tclNotify.c: Tcl_ConditionWait, Tcl_SetMaxBlockTime
- * macosx/tclMacOSXNotify.c:
- * generic/tclThread.c: Introduced a CONST86, so extensions which have
- * unix/tclUnixNotfy.c: have their own Notifier (are there any?) can
- * unix/tclUnixThrd.c: can be modified to compile against both Tcl
- * win/tclWinNotify.c: Tcl 8.5 and Tcl 8.6
- * win/tclWinThrd.c: Regenerated tclDecls.h with "make stubs".
- This change complies with TIP #27
- ***POTENTIAL INCOMPATIBILITY***
-
-2008-07-23 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-
- * tests/lrange.test: Added relative speed test to check for lrange
- in-place optimization committed 2008-06-30.
- * tests/binary.test: Added relative speed test to check for pure byte
- array CONCAT1 optimization committed 2008-06-30.
-
-2008-07-23 Andreas Kupries <andreask@activestate.com>
-
- * tests/info.test: Reordered the tests to have monotonously increasing
- numbers.
-
- * generic/tclBasic.c: Modified TclArgumentGet to reject pure lists
- * generic/tclCmdIL.c: immediately, without search. Reworked setup of
- * generic/tclCompile.c: eoFramePtr, doesn't need the line information,
- * tests/info.test: more sensible to have everything on line 1 when
- eval'ing a pure list. Updated the users of the line information to
- special case this based on the frame type (i.e.
- TCL_LOCATION_EVAL_LIST). Added a testcase demonstrating the new
- behaviour.
-
-2008-07-23 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c (GetCommandSource): Added comment with
- explanation and warning for waintainers.
-
-2008-07-22 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclCompile.c: Made the new TclEnterCmdWordIndex static, and
- * generic/tclCompile.h: ansified.
-
- * generic/tclBasic.c: Ansified the new functions. Added missing
- function comments.
-
- * generic/tclBasic.c: Reworked the handling of bytecode literals for
- * generic/tclCompile.c: #280 to fix the abysmal performance for deep
- * generic/tclCompile.h: recursion, replaced the linear search through
- * generic/tclExecute.c: the whole stack with another hashtable and
- * generic/tclInt.h: simplified the data structure used by the compiler
- by using an array instead of a hashtable. Incidentially this also
- fixes the memory leak reported via [Bug 2024937].
-
-2008-07-22 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Added numLevels field to CommandFrame, let
- * generic/tclExecute.c: GetCommandSource use it. This solves [Bug
- * generic/tclInt.h: 2017146]. Thx dgp for the analysis.
-
-2008-07-21 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclBasic.c: Extended the existing TIP #280 system (info
- * generic/tclCmdAH.c: frame), added the ability to track the absolute
- * generic/tclCompCmds.c: location of literal procedure arguments, and
- * generic/tclCompile.c: making this information available to uplevel
- * generic/tclCompile.h: eval, and siblings. This allows proper
- * generic/tclInterp.c: tracking of absolute location through custom
- * generic/tclInt.h: (Tcl-coded) control structures based on uplevel,
- * generic/tclNamesp.c: etc.
- * generic/tclProc.c:
- * tests/info.test:
-
-2008-07-21 Jan Nijtmans <nijtmans@users.sf.net>
-
- * generic/*.c: Fix [2021443] inconsistant "wrong # args" messages
- * win/tclWinReg.c
- * win/tclWinTest.c
- * tests/*.test
-
-2008-07-21 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-
- TIP #304 IMPLEMENTATION
-
- * generic/tcl.decls: Public API
- * generic/tclIOCmds.c: Generic part
- * unix/tclUnixPipe.c: OS part
- * win/tclWinPipe.c: OS part
- * tests/chan.test: [chan pipe] tests
- * tests/ioCmd.test: Modernized checks
- * tests/ioTrans.test:
-
-2008-07-21 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * generic/tclFCmd.c: Inodes on windows are unreliable. [Bug 2015723]
- * tests/winFCmd.test: test rename with inode collision
-
-2008-07-21 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tcl.decls: Changed the implementation of
- * generic/tclBasic.c: [namespace import]; removed
- * generic/tclDecls.h: Tcl_NRObjProc, replaced with
- * generic/tclExecute.c: Tcl_NRCmdSwap (proposed public
- * generic/tclInt.h: NRE API). This should fix
- * generic/tclNRE.h: [Bug 582506].
- * generic/tclNamesp.c:
- * generic/tclStubInit.c:
-
- * generic/tclBasic.c: NRE: enabled calling NR commands
- * generic/tclExecute.c: from the callbacks. Completely
- * generic/tclInt.h: redone tailcall implementation
- * generic/tclNRE.h: using the new feature. [Bug 2021489]
- * generic/tclProc.c:
- * tests/NRE.test:
-
-2008-07-20 Kevin B. Kenny <kenykb@acm.org>
-
- * tests/fileName.test: Repaired the failing test fileName-15.7 from
- dkf's commit earlier today.
-
-2008-07-20 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclDictObj.c (SetDictFromAny): Make the list->dict
- transformation a bit more efficient; modern dicts are ordered and so
- we can round-trip through lists without needing the string rep at all.
- * generic/tclListObj.c (SetListFromAny): Make the dict->list
- transformation not lossy of internal representations and hence more
- efficient. [Bug 2008248] (ajpasadyn) but using a more efficient patch.
-
- * tests/fileName.test: Revise to reduce the obscurity of tests. In
- particular, all tests should now produce informative messages on
- failure and the quantity of [catch]-based obscurity is now greatly
- reduced; non-erroring is now checked for directly.
-
-2008-07-19 Donal K. Fellows <dkf@users.sf.net>
-
- * tests/env.test: Add LANG to the list of variables that are not
- touched by the environment variable tests, so that subprocesses can
- get their system encoding correct.
-
- * tests/exec.test, tests/env.test: Rewrite so that non-ASCII
- characters are not used in the final comparison. Part of fixing [Bug
- 1513659].
-
-2008-07-18 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Optimization: replace calls to
- * generic/tclDictObj.c: Tcl_NRAddCallback with the macro
- * generic/tclExecute.c: TclNRAddCallback.
- * generic/tclInterp.c:
- * generic/tclNRE.h:
- * generic/tclNamesp.c:
- * generic/tclOO.c:
- * generic/tclOOBasic.c:
- * generic/tclOOCall.c:
- * generic/tclOOInt.h:
- * generic/tclOOMethod.c:
- * generic/tclProc.c:
-
-2008-07-18 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOO.c (TclNRNewObjectInstance, FinalizeAlloc):
- * generic/tclOOBasic.c (TclOO_Class_Create, TclOO_Class_CreateNs)
- (TclOO_Class_New, FinalizeConstruction, AddConstructionFinalizer):
- NRE-enablement of the class construction methods.
-
-2008-07-18 Miguel Sofer <msofer@users.sf.net>
-
- * tests/NRE.test: Added basic tests for deep TclOO calls
-
- * generic/tcl.decls: Change the public api prefix from
- * generic/tcl.h: TclNR_foo to Tcl_NRfoo
- * generic/tclBasic.c:
- * generic/tclDecls.h:
- * generic/tclDictObj.c:
- * generic/tclExecute.c:
- * generic/tclInterp.c:
- * generic/tclNRE.h:
- * generic/tclNamesp.c:
- * generic/tclOO.c:
- * generic/tclOOBasic.c:
- * generic/tclOOCall.c:
- * generic/tclOOMethod.c:
- * generic/tclProc.c:
- * generic/tclStubInit.c:
-
-2008-07-18 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOOBasic.c (TclOO_Object_Eval, FinalizeEval): NRE-enable
- the oo::object.eval method.
-
-2008-07-18 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclDictObj.c (DictWithCmd, DictUpdateCmd): Fix refcounting
- bugs that caused crashes [Bug 2017857].
-
- * generic/tclBasic.c (TclNREvalObjEx): Streamline the management of
- the command frame (opt).
-
-2008-07-17 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclDictObj.c (DictWithCmd, FinalizeDictWith): Split the
- implementation of [dict with] so that it works with NRE.
- (DictUpdateCmd, FinalizeDictUpdate): Similarly for the non-compiled
- version of [dict update].
-
-2008-07-16 George Peter Staplin <georgeps@users.sf.net>
-
- * win/tclWinThrd.c: Test for TLS_OUT_OF_INDEXES to make certain that
- thread key creation is successful.
-
-2008-07-16 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOO.c, generic/tclOOInt.h, generic/tclOOBasic.c:
- * generic/tclOOCall.c, generic/tclOOMethod.c: NRE-enable the TclOO
- implementation in Tcl. No change to public APIs, except that method
- implementations can now be NRE-aware if they choose (which normal
- methods and forwards are). On the other hand, callers of
- TclOOInvokeObject (which is only in the internal stub table) will need
- to deal with the fact that it's only safe to call inside an NRE-aware
- context.
- ***POTENTIAL INCOMPATIBILITY***
-
-2008-07-15 Miguel Sofer <msofer@users.sf.net>
-
- * tests/NRE.test: Better constraint for testing the existence of
- * tests/stack.test: teststacklimit, to insure that the test suite
- runs under tclsh.
-
- * generic/tclParse.c: Fixing incomplete reversion of "fix" for [Bug
- 2017583], missing TclResetCancellation call.
-
-2008-07-15 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclBasic.c (Tcl_CancelEval): Fix blunder. [Bug 2018603]
-
- * doc/DictObj.3: Fix error in example. [Bug 2016740]
-
- * generic/tclNamesp.c (EnsembleUnknownCallback): Factor out some of
- the more complex parts of the ensemble code to make it easier to
- understand and hence to permit tighter compilation of code on the
- critical path.
-
-2008-07-14 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclParse.c: Reverting the "fix" for [Bug 2017583], numLevel
- * tests/parse.test: management and TclInterpReady check seems to be
- necessary after all.
-
-2008-07-14 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclProc.c (TclNRApplyObjCmd, TclObjInterpProcCore):
- * generic/tclBasic.c (TclNR_AddCallback, TclEvalObjv_NR2):
- * generic/tclNRE.h (TEOV_callback): Change the callback storage type
- to use an array, so guaranteeing correct inter-member spacing and
- memory layout.
-
-2008-07-14 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c: Remove unneeded TclInterpReady calls
- * generic/tclParse.c:
-
- * generic/tclBasic.c.: Embedded Tcl_Canceled() calls into
- * generic/tclExecute.c: TclInterpReady().
- * generic/tclParse.c:
-
- * generic/tclVar.c: Fix error message
-
- * generic/tclParse.c: Remove unnecessary numLevel management
- * tests/parse.test: [Bug 2017583]
-
- * generic/tclBasic.c.: NRE left too many calls to
- * generic/tclExecute.c: TclResetCancellation lying around: it
- * generic/tclProc.c: only needs to be called prior to any
- iPtr->numLevels++. Thanks mistachkin.
-
- * generic/tclBasic.c: TclResetCancellation() calls were misplaced
- (merge mishap); stray //. Thanks patthoyts.
-
- * generic/tclInt.h: The new macros TclSmallAlloc and TclSmallFree
- were badly defined under mem debugging [Bug 2017240] (thx das)
-
-2008-07-13 Miguel Sofer <msofer@users.sf.net>
-
- NRE implementation [Patch 2017110]
-
- * generic/tcl.decls: The NRE infrastructure
- * generic/tcl.h:
- * generic/tclBasic.c:
- * generic/tclCmdAH.c:
- * generic/tclCompile.h:
- * generic/tclDecls.h:
- * generic/tclExecute.c:
- * generic/tclHistory.c:
- * generic/tclInt.decls:
- * generic/tclInt.h:
- * generic/tclIntDecls.h:
- * generic/tclNRE.h:
- * generic/tclStubInit.c:
- * unix/Makefile.in:
-
- * generic/tclInterp.c: NRE-enabling: procs, lambdas, uplevel,
- * generic/tclNamesp.c: same-interp aliases, ensembles, imports
- * generic/tclProc.c: and namespace_eval.
-
- * generic/tclTestProcBodyObj.c: New NRE specific tests (few, but
- * tests/NRE.test: note that the thing is actually
- tested by the whole testsuite.
-
- * tests/interp.test: Fixed numLevel counting.
- * tests/parse.test:
- * tests/stack.test:
-
- * unix/configure: Removing support for the hacky nonportable
- * unix/configure.in: stack check: it is not needed anymore, Tcl
- * unix/tclConfig.h.in: is very thrifty on the C stack.
- * unix/tclUnixInit.c:
- * unix/tclUnixTest.c:
- * win/tclWin32Dll.c:
-
-2008-07-08 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclGet.c: Corrected out of date comments and removed
- * generic/tclInt.decls: internal routine TclGetLong() that's no
- longer used. If an extension is using this from the internal stubs
- table, it can shift to the public routine Tcl_GetLongFromObj() or
- can request addition of a public Tcl_GetLong().
- ***POTENTIAL INCOMPATIBILITY***
-
- * generic/tclIntDecls.h: make genstubs
- * generic/tclStubInit.c:
-
-2008-07-08 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/CrtInterp.3: Tighten up the descriptions of behaviour to make
- this page easier to read for a "Tcl 8.6" audience.
-
-2008-07-07 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclCmdIL.c (InfoFrameCmd): Fixed unsafe idiom of setting
- the interp result found by Don Porter.
-
-2008-07-07 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/regexp.n, doc/regsub.n: Correct examples. [Bug 1982642]
-
-2008-07-06 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/lindex.n: Improve examples.
-
-2008-07-03 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclIORChan.c (InvokeTclMethod): Fixed the memory leak
- reported in [Bug 1987821]. Thanks to Miguel for the report and Don
- Porter for tracking the cause down.
-
-2008-07-03 Don Porter <dgp@users.sourceforge.net>
-
- * library/package.tcl: Removed [file readable] testing from
- [tclPkgUnknown] and friends. We find out soon enough whether a file is
- readable when we try to [source] it, and not testing before allows us
- to workaround the bugs on some common filesystems where [file
- readable] lies to us. [Patch 1969717]
-
-2008-07-01 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/regc_nfa.c (duptraverse): Impose a maximum stack depth on
- the single most recursive part of the RE engine. The actual maximum
- may need tuning, but that needs a system with a small stack to carry
- out. [Bug 1905562]
-
- * tests/string.test: Eliminate non-ASCII characters from the actual
- test script. [Bug 2006884]
-
-2008-06-30 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/ObjectType.3: Clean up typedef formatting.
-
-2008-06-30 Don Porter <dgp@users.sourceforge.net>
-
- * doc/ObjectType.3: Updated documentation of the Tcl_ObjType
- struct to match expectations of Tcl 8.5. [Bug 1917650]
-
-2008-06-30 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-
- * generic/tclCmdIL.c: Lrange cleanup and in-place optimization. [Patch
- 1890831]
-
- * generic/tclExecute.c: Avoid useless String conversion for CONCAT1 of
- pure byte arrays. [Patch 1953758]
-
-2008-06-29 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/*.1, doc/*.3, doc/*.n: Many small updates, purging out of date
- change bars and cleaning up the formatting of typedefs. Added a few
- missing bits of documentation in the process.
-
-2008-06-29 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclPathObj.c: Plug memory leak in [Bug 1999176] fix. Thanks
- to Rolf Ade for detecting.
-
-2008-06-29 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/interp.n: Corrected order of subcommands. [Bug 2004256]
- Removed obsolete (i.e. 8.5) .VS/.VE pairs.
-
- * doc/object.n (EXAMPLES): Fix incorrect usage of oo::define to be
- done with oo::objdefine instead. [Bug 2004480]
-
-2008-06-28 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclPathObj.c: Plug memory leak in [Bug 1972879] fix. Thanks
- to Rolf Ade for detecting and Dan Steffen for the fix. [Bug 2004654]
-
-2008-06-26 Andreas Kupries <andreask@activestate.com>
-
- * unix/Makefile.in: Followup to my change of 2008-06-25, make code
- generated by the Makefile and put into the installed tm.tcl
- conditional on interpreter safeness as well. Thanks to Daniel Steffen
- for reminding me of that code.
-
-2008-06-25 Don Porter <dgp@users.sourceforge.net>
-
- *** 8.6a1 TAGGED FOR RELEASE ***
-
- * changes: Updates for 8.6a1 release.
-
- * generic/tclOO.h: Bump to TclOO 0.5.
-
-2008-06-25 Andreas Kupries <andreask@activestate.com>
-
- * library/tm.tcl: Modified the handling of Tcl Modules and of the
- * library/safe.tcl: Safe Base to interact nicely with each other,
- * library/init.tcl: enabling requiring Tcl Modules in safe
- * tests/safe.test: interpreters. [Bug 1999119]
-
-2008-06-25 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * win/rules.vc: Fix versions of dde and registry dlls
- * win/makefile.vc: Fix problem building with staticpkg option
-
-2008-06-24 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclPathObj.c: Fixed some internals management in the "path"
- Tcl_ObjType for the empty string value. Problem led to a crash in the
- command [glob -dir {} a]. [Bug 1999176]
-
-2008-06-24 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * doc/fileevent.n: Fix examples and comment on eof use. [Bug 1995063]
-
-2008-06-23 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclPathObj.c: Fixed bug in Tcl_GetTranslatedPath() when
- operating on the "Special path" variant of the "path" Tcl_ObjType
- intrep. A full normalization was getting done, in particular, coercing
- relative paths to absolute, contrary to what the function of producing
- the "translated path" is supposed to do. [Bug 1972879]
-
-2008-06-20 Don Porter <dgp@users.sourceforge.net>
-
- * changes: Updates for 8.6a1 release.
-
- * generic/tclInterp.c: Fixed completely boneheaded mistake that
- * tests/interp.test: [interp bgerror $slave] and [$slave bgerror]
- would always act like [interp bgerror {}]. [Bug 1999035]
-
- * tests/chanio.test: Corrected flawed tests revealed by a -debug 1
- * tests/cmdAH.test: -singleproc 1 test suite run.
- * tests/event.test:
- * tests/interp.test:
- * tests/io.test:
- * tests/ioTrans.test:
- * tests/namespace.test:
-
- * tests/encoding.test: Make failing tests pass again. [Bug 1972867]
-
-2008-06-19 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOO.c (Tcl_ObjectContextInvokeNext): Corrected 'next' (at
- * tests/oo.test (oo-7.8): end of a call chain) to make it
- * doc/next.n: consistent with the TIP. [Bug 1998244]
-
- * generic/tclOOCall.c (AddSimpleClassChainToCallContext): Make sure
- * tests/oo.test (oo-14.8): that class mixins are processed in the
- documented order. [Bug 1998221]
-
-2008-06-19 Don Porter <dgp@users.sourceforge.net>
-
- * changes: Updates for 8.6a1 release.
-
- * README: Bump version number to 8.6a1
- * generic/tcl.h:
- * library/init.tcl:
- * tools/tcl.wse.in:
- * unix/configure.in:
- * unix/tcl.spec:
- * win/configure.in:
-
- * unix/configure: autoconf-2.59
- * win/configure:
-
-2008-06-17 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclClock.c (ClockConvertlocaltoutcObjCmd): Removed left
- over debug output.
-
-2008-06-17 Andreas Kupries <andreask@activestate.com>
-
- * doc/tm.n: Followup to changelog entry 2008-03-18 regarding
- ::tcl::tm::Defaults. Updated the documentation to not only mention the
- new (underscored) form of environment variable names, but make it the
- encouraged form as well. [Bug 1914604]
-
-2008-06-17 Kevin Kenny <kennykb@acm.org>
-
- * generic/tclClock.c (ConvertLocalToUTC):
- * tests/clock.test (clock-63.1): Fixed a bug where the internal
- ConvertLocalToUTC command segfaulted if passed a dictionary without
- the 'localSeconds' key. To the best of my knowledge, the bug was not
- observable in the [clock] command itself.
-
-2008-06-16 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclCmdIL.c (TclInfoFrame): Moved the code looking up the
- * tests/info.test: information for key 'proc' out of the
- TCL_LOCATION_BC branch to after the switch, this is common to all
- frame types. Updated the testsuite to match. This was exposed by the
- 2008-06-08 commit (Miguel), switching uplevel from direct eval to
- compilation. [Bug 1987851]
-
-2008-06-16 Andreas Kupries <andreask@activestate.com>
-
- * tests/ioTrans.test (iortrans-11.*): Fixed same issue as for
- iortrans.tf-11.*, cleanup of temp file, making this a followup to the
- entry on 2008-06-10 by myself.
-
-2008-06-13 David Gravereaux <davygrvy@pobox.com>
-
- * win/rules.vc: SYMBOLS macro is now being set to zero when $(OPTS) is
- not available.
- * win/makefile.vc: The Stubs source files (tclStubLib.c and
- tclOOStubLib.c) should not be compiled with the -GL flag.
-
-2008-06-13 Joe Mistachkin <joe@mistachkin.com>
-
- TIP #285 IMPLEMENTATION
-
- * doc/Eval.3: Added documentation for the Tcl_CancelEval and
- Tcl_Canceled functions and the TCL_CANCEL_UNWIND flag bit.
- * doc/after.n: Corrected the spelling of 'canceled' in the
- documentation.
- * doc/interp.n: Added documentation for [interp cancel].
- * generic/tcl.decls: Added the Tcl_CancelEval and Tcl_Canceled
- functions to the stubs table.
- * generic/tcl.h: Added the TCL_CANCEL_UNWIND flag bit.
- * generic/tclBasic.c: The bulk of the script cancellation
- functionality is defined here. Added code to initialize and manage the
- script cancellation hash table in a thread-safe manner. Reset script
- cancellation flags prior to increasing the nesting level (if the
- nesting level is currently zero) and always cooperatively check for
- script cancellation near the start of TclEvalObjvInternal and after
- invoking async handlers.
- * generic/tclDecls.h: Regenerated.
- * generic/tclEvent.c: Call TclFinalizeEvaluation during finalization
- to cleanup the script cancellation hash table. During [vwait], always
- cooperatively check for script cancellation. Corrected the spelling of
- 'canceled' in comments to be consistent with the documentation.
- * generic/tclExecute.c: Reset script cancellation flags prior to
- increasing the nesting level (if the nesting level is currently zero)
- and always cooperatively check for script cancellation after invoking
- async handlers. Prevent [catch] from catching script cancellation when
- the TCL_CANCEL_UNWIND flag is set (similar to the manner used by TIP
- 143 when a limit has been exceeded).
- * generic/tclInt.decls: Added TclResetCancellation to the internal
- stubs table.
- * generic/tclInt.h: Added asyncCancel and asyncCancelMsg fields to the
- private Interp structure. Added private interp flag value CANCELED to
- help control script cancellation.
- * generic/tclIntDecls.h: Regenerated.
- * generic/tclInterp.c (Tcl_InterpObjCmd): Added [interp cancel]
- subcommand.
- * generic/tclNotify.c (Tcl_DeleteEventSource): Corrected the spelling
- of 'canceled' in comments to be consistent with the documentation.
- * generic/tclParse.c: Reset script cancellation flags prior to
- * generic/tclProc.c: increasing the nesting level (if the nesting
- level is currently zero) and cooperatively check for script
- cancellation prior to evaluating commands.
- * generic/tclStubInit.c: Regenerated.
- * generic/tclThreadTest.c (Tcl_ThreadObjCmd): Added script
- cancellation support ([testthread cancel]).
- Modified [testthread id] to allow querying of the 'main' thread ID.
- Corrected comments to reflect the actual command syntax. Made
- [testthread wait] cooperatively check for script cancellation. Added
- [testthread event] to allow for processing one pending event without
- blocking.
- * generic/tclTimer.c: Delay for a maximum of 500 milliseconds prior to
- checking for async handlers and script cancellation.
- * tests/cmdAH.test: Changed [interp c] to [interp create].
- * tests/interp.test: Added and fixed tests for [interp cancel].
- * tests/thread.test: Added tests for script cancellation via
- [testthread cancel].
- * tools/man2help2.tcl: Fixed problems with WinHelp target (see
- * tools/man2tcl.c: [Bug 1934200], [Bug 1934265], and [Bug 1934272]).
- * win/makefile.vc: Added 'pdbs' option for Windows build rules to
- * win/rules.vc: allow for non-debug builds with full symbols.
- * win/tcl.hpj.in: Corrected version for WinHelp target.
- * win/tclWinNotify.c: Used SleepEx and WaitForSingleObjectEx on
- * win/tclWinThrd.c: Windows because they are alertable.
-
-2008-06-12 Daniel Steffen <das@users.sourceforge.net>
-
- * unix/Makefile.in: Add complete deps on tclDTrace.h.
-
- * generic/tclOO.c: Use TclOOStubs hooks field to retrieve
- * generic/tclOODecls.h: TclOOIntStubs pointer. [Bug 1980953]
- * generic/tclOOIntDecls.h:
- * generic/tclOOStubInit.c:
- * generic/tclOOStubLib.c:
-
- * generic/tclIORTrans.c: Fix signed <-> unsigned cast warnings.
-
- * unix/Makefile.in: Clean generated tclDTrace.h file.
- * unix/configure.in (SunOS): Fix static DTrace-enabled build.
-
- * unix/tcl.m4 (SunOS-5.11): Fix 64bit amd64 support with gcc & Sun cc.
- * unix/configure: autoconf-2.59
-
- * macosx/Tcl.xcodeproj/project.pbxproj: Add tclIORTrans.c; updates and
- cleanup for Xcode 3.1/Leopard.
- * macosx/Tcl.xcode/project.pbxproj: Sync Tcl.xcodeproj changes.
- * macosx/README: Document new build configs.
-
-2008-06-10 Joe English <jenglish@users.sourceforge.net>
-
- * generic/tclEncoding.c(UtfToUtfProc): Avoid unwanted sign extension
- when converting incomplete UTF-8 sequences. See [Bug 1908443] for
- details.
-
-2008-06-10 Andreas Kupries <andreask@activestate.com>
-
- * tests/ioTrans.test (iortrans.tf-6.1): Fixed the [Bug 1988552],
- reported by Kevin. Have to close the channel before removal of the
- file. Fixed same bug in test 'iortrans.tf-11.0', after fixing missing
- cleanup of the file in 'iortrans.tf-11.*'. Lastly fixed the names of
- the threaded tests 'iortrans-8.*' to the correct 'iortrans.tf-8.*'.
-
-2008-06-09 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-
- * generic/tclIORTrans.c (ReflectInput): Fixed a bug triggered by Pat
- Thoyts <patthoyts@users.sourceforge.net>. Reset the EOF flag after
- draining the Tcl level into the result buffer, to make sure that the
- result buffer will be drained as well by repeated calls to
- ReflectInput should it contain more than one buffer-full of data.
- Without that reset the higher I/O system will not call on ReflectInput
- anymore due to the assumed EOF, thus losing the data which did not fit
- in the buffer of the call which caused the eof and drain.
-
-2008-06-09 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOOCall.c (TclOOGetSortedMethodList): Plug memory leak
- that occurred when all methods were hidden. [Bug 1987817]
-
-2008-06-08 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Compilation of uplevel scripts, allow
- * generic/tclCompCmds.c: non-body compiled scripts to access the
- * generic/tclCompile.c: LVT (but not to extend it) and enable the
- * generic/tclCompile.h: canonical list opt to sidestep the
- * generic/tclExecute.c: compiler. [Patch 1973096]
- * generic/tclProc.c:
- * tests/uplevel.test:
-
-2008-06-06 Andreas Kupries <andreask@activestate.com>
-
- TIP #230 IMPLEMENTATION
-
- * generic/tclIOCmd.c: Integration of transform commands into 'chan'
- ensemble.
- * generic/tclInt.h: Definitions of the transform commands.
- * generic/tclIORTrans.c: Implementation of the reflection transforms.
- * tests/chan.test: Tests updated for new sub-commands of 'chan'.
- * tests/ioCmd.test: Tests updated for new sub-commands of 'chan'.
- * tests/ioTrans.test: Whole new set of tests for the reflection
- transform.
- * unix/Makefile.in: Integration of new files into build rules.
- * win/Makefile.in: Integration of new files into build rules.
- * win/makefile.vc: Integration of new files into build rules.
-
- NOTE: The file 'tclIORTrans.c' has a lot of code in common with the
- file 'tclIORChan.c', as that made it much easier to develop the
- reference implementation as a separate module. Now that the
- transforms have been committed the one thing left to do is to go
- over both modules and see which of the common parts we can
- factor out and share.
-
-2008-06-04 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * generic/tclBinary.c: TIP #317 implementation
- * tests/binary.test:
-
-2008-06-02 Kevin B. Kenny <kennykb@acm.org>
-
- * generic/tclOO.c (ReleaseClassContents): Fix the one remaining
- valgrind complaint about oo.test, caused by failing to protect the
- Object as well as the Class corresponding to a subclass being deleted
- and hence getting a freed-memory read when attempting to delete the
- class command. [Bug 1981001]
-
-2008-06-01 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOOMethod.c (Tcl_NewMethod): Complete the fix of [Bug
- 1981001], previous fix was incomplete though helpful in telling me
- where to look.
-
-2008-06-01 Joe Mistachkin <joe@mistachkin.com>
-
- * win/Makefile.in: Add tclOO genstubs to Windows makefiles and remove
- * win/makefile.vc: -DBUILD_tcloo because it is no longer required.
-
-2008-06-01 Kevin B. Kenny <kennykb@acm.org>
-
- * generic/tclOODecls.h: Added the swizzling of DLLEXPORT and
- * generic/tclOOIntDecls.h: DLLIMPORT needed to make EXTERN work.
-
- * generic/tclDictObj.c: Added missing initializers to the ensemble
- map to silence a compiler warning. Thanks to
- George Peter Staplin for the report.
-
- * generic/tclOOMethod.c: Fix a bug where the refcount of a method was
- reset if the method was redefined while there
- was an active invocation. [Bug 1981001]
-
-2008-06-01 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOO.decls, unix/Makefile.in (genstubs): Make generation of
- stub tables correct.
- * generic/tclOO{Decls.h,IntDecls.h,StubInit.c,StubLib.c}: Fixes to
- make the generation work correctly, removing subtle differences
- between output of different versions of stub generator.
-
-2008-06-01 Daniel Steffen <das@users.sourceforge.net>
-
- * generic/tclOOStubLib.c: Ensure use of tcl stubs; include in
- * unix/Makefile.in: stub lib; disable broken tclOO
- genstubs
-
- * generic/tclOO.c: Make tclOO stubs tables 'static const'
- * generic/tclOODecls.h: and stub table pointers MODULE_SCOPE
- * generic/tclOOIntDecls.h: (change generated files manually
- * generic/tclOOStubInit.c: pending genstubs support for tclOO).
- * generic/tclOOStubLib.c:
-
- * generic/tclOO.c: Fix warnings for 'int<->ptr
- * generic/tclOOCall.c: conversion' and 'signed vs unsigned
- * generic/tclOOMethod.c: comparison'.
-
- * tests/msgcat.test: Fix for ::tcl::mac::locale with @modifier.
-
- * tools/tsdPerf.tcl: Use [info sharedlibextension]
-
- * unix/tclConfig.h.in: autoheader-2.59
-
- * macosx/Tcl.xcodeproj/project.pbxproj: Add new tclOO files; add debug
- * macosx/README: configs with corefoundation
- disabled and with gcov; update
- to Xcode 3.1.
-
-2008-05-31 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclOO.c (InitFoundation): Correct reference counting for
- strings used when creating the constructor for classes.
- * generic/tclOOMethod.c (TclOODelMethodRef): Correct fencepost error
- in reference counting of method implementation structures.
- * tests/oo.test (oo-0.5): Added a test to detect a memory leak problem
- relating to disposal of the core object system.
-
- TIP#257 IMPLEMENTATION
-
- * generic/tclBasic.c, generic/tclOOInt.h: Correct declarations.
- * win/Makefile.in, win/makefile.bc, win/makefile.vc: Build support for
- Win32, from Joe Mistachkin. [Patch 1980861]
-
- * generic/tclOO*, doc/*, tests/oo.test: Port of implementation of
- TclOO to sit directly inside Tcl. Note that this is incomplete (e.g.
- no build support yet for Windows).
-
-2008-05-26 Jeff Hobbs <jeffh@ActiveState.com>
-
- * tests/io.test (io-53.9): Need to close chan before removing file.
-
-2008-05-26 Donal K. Fellows <dkf@users.sf.net>
-
- * win/makefile.bc: Remove deprecated winhelp target.
- * win/Makefile.in, win/makefile.vc: It didn't work correctly anyway.
-
-2008-05-23 Andreas Kupries <andreask@activestate.com>
-
- * win/tclWinChan.c (FileWideSeekProc): Accepted a patch by Alexandre
- Ferrieux <ferrieux@users.sourceforge.net> to fix the [Bug 1965787].
- 'tell' now works for locations > 2 GB as well instead of going
- negative.
-
- * generic/tclIO.c (Tcl_SetChannelBufferSize): Accepted a patch by
- * tests/io.test: Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * tests/chanio.test: to fix the [Bug 1969953]. Buffersize outside of
- the supported range are now clipped to nearest boundary instead of
- ignored.
-
-2008-05-22 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclNamesp.c (Tcl_LogCommandInfo): Restored ability to
- handle the argument value length = -1. Thanks to Chris Darroch for
- discovering the bug and providing the fix. [Bug 1968245]
-
-2008-05-21 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclParse.c (ParseComment): The new TclParseAllWhiteSpace
- * tests/parse.test (parse-15.60): routine has no mechanism to
- return the "incomplete" status of "\\\n" so calling this routine
- anywhere that can be reached within a Tcl_ParseCommand() call is a
- mistake. In particular, ParseComment() must not use it. [Bug 1968882]
-
-2008-05-20 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclNamesp.c (Tcl_SetNamespaceUnknownHandler): Corrected odd
- logic for handling installation of namespace unknown handlers which
- could lead too very strange things happening in the error case.
-
-2008-05-16 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclCompile.c: Fix crash with tcl_traceExec. Found and fixed
- by Alexander Pasadyn. [Bug 1964803]
-
-2008-05-15 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * win/makefile.vc: We should use the thread allocator for threaded
- * win/rules.vc: builds. Added 'tclalloc' option to disable.
-
-2008-05-09 George Peter Staplin <georgeps@xmission.com>
-
- * tools/tsdPerf.c: A loadable Tcl extension for testing TSD
- performance.
- * tools/tsdPerf.tcl: A simplistic tool that uses the thread
- extension and tsdPerf.so to get some performance metrics by,
- simulating, simple TSD contention.
-
-2008-05-09 George Peter Staplin <georgeps@xmission.com>
-
- * generic/tcl.h: Make Tcl_ThreadDataKey a void *.
- * generic/tclInt.h: Change around some function names and add some
- new per-platform declarations for thread-specific data functions.
- * generic/tclThread.c: Make use of of the new function names that no
- longer have a Tclp prefix.
- * generic/tclThreadStorage.c: Replace the core thread-specific data
- (TSD) mechanism with an array offset solution that eliminates the hash
- tables, and only uses one slot of native TSD. Many thanks to Kevin B.
- Kenny for his help with this.
-
- * unix/tclUnixThrd.c: Add platform-specific TSD functions for use by
- * win/tclWinThrd.c: tclThreadStorage.c.
-
-2008-05-09 Kevin B. Kenny <kennykb@acm.org>
-
- * tests/dict.test (dict-19.2): Corrected a bug where the test was
- changed to use [apply] instead of a temporary proc, but the cleanup
- script still attempted to delete the temporary proc.
-
-2008-05-07 Donal K. Fellows <dkf@cspool38.cs.man.ac.uk>
-
- * generic/tclCompCmds.c (TclCompileDictAppendCmd): Fix silly off-by
- one error that caused a crash every time a compiled 'dict append' with
- more than one argument was used. Found by Colin McCormack.
-
-2008-05-02 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * generic/tclBasic.c: Converted the [binary] command into an
- * generic/tclBinary.c: ensemble.
- * generic/tclInt.h:
- * test/binary.test: Updated the error tests for ensemble errors.
-
- * generic/tclFileName.c: Reverted accidental commit of TIP 316 APIs.
-
-2008-04-27 Donal K. Fellows <dkf@users.sf.net>
-
- * */*.c: A large tranche of getting rid of pre-C89-isms; if your
- compiler doesn't support things like proper function declarations,
- 'void' and 'const', borrow a proper one when building Tcl. (The header
- files allow building things that link against Tcl with really ancient
- compilers still; the requirement is just when building Tcl itself.)
-
-2008-04-26 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
-
- * generic/tclAsync.c: Tcl_AsyncDelete(): panic if attempt to locate
- handler token fails. Happens when some other thread attempts to delete
- somebody else's token.
-
- Also, panic early if we find out the wrong thread attempting to delete
- the async handler (common trap). As, only the one that created the
- handler is allowed to delete it.
-
-2008-04-24 Andreas Kupries <andreask@activestate.com>
-
- * tests/ioCmd.test: Extended testsuite for reflected channel
- implementation. Added test cases about how it handles if the rug is
- pulled out from under a channel (= killing threads, interpreters
- containing the tcl command for a channel, and channel sitting in a
- different interpreter/thread.)
-
- * generic/tclIORChan.c: Fixed the bugs exposed by the new testcases,
- redone most of the cleanup and exit handling.
-
-2008-04-21 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclIOUtil.c: Removed all code delimited by
- * generic/tclTest.c: USE_OBSOLETE_FS_HOOKS, completing
- * tests/ioCmd.test: the deprecation path for these
- * tests/ioUtil.test (removed): obsolete interfaces. (Code was active
- in Tcl 8.4, present but enabled only by customized compile switch in
- Tcl 8.5, and now completely gone for Tcl 8.6). Also removed all tests
- relevant only to the removed interfaces.
-
-2008-04-19 George Peter Staplin <georgeps@xmission.com>
-
- * doc/Ensemble.3: Fix a typo: s/defiend/defined/
- Thanks to hat0 for spotting this.
-
-2008-04-16 Daniel Steffen <das@users.sourceforge.net>
-
- * generic/tclInt.h: Make stubs tables 'static const' and
- * generic/tclStubInit.c: export only module-scope pointers to
- * generic/tclStubLib.c: the main stubs tables (for package
- * tools/genStubs.tcl: initialization). [Patch 1938497]
- * generic/tclBasic.c (Tcl_CreateInterp):
- * generic/tclTomMathInterface.c (TclTommath_Init):
-
- * generic/tclInt.h: Revise Tcl_SetNotifier() to use a
- * generic/tclNotify.c: module-scope hooks table instead of
- * generic/tclStubInit.c: runtime stubs-table modification;
- * macosx/tclMacOSXNotify.c: ensure all hookable notifier functions
- * win/tclWinNotify.c: check for hooks; remove hook checks in
- * unix/tclUnixNotfy.c: notifier API callers. [Patch 1938497]
-
-2008-04-15 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclIO.c (CopyData): Applied another patch by Alexandre
- * io.test (io-53.8a): Ferrieux <ferrieux@users.sf.net>,
- * chanio.test (chan-io-53.8a): to shift EOF handling to the async
- part of the command if a callback is specified, should the channel be
- at EOF already when fcopy is called. Testcase by myself.
-
-2008-04-15 Daniel Steffen <das@users.sourceforge.net>
-
- * unix/Makefile.in: Adjust tclDTrace.h dependencies for removal
- of tclStubLib.o from TCL_OBJS. [Bug 1942795]
-
-2008-04-14 Kevin B. Kenny <kennykb@acm.org>
-
- * unix/tclUnixTime.c (NativeGetTime): Removed obsolete use of
- 'struct timezone' in the call to 'gettimeofday'. [Bug 1942197]
-
- * tests/clock.test (clock-33.5, clock-33.5a, clock-33.8, clock-33.8a):
- Added comments to the test that it can fail on a heavily loaded
- system.
-
-2008-04-10 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Keeping check for negative
- values, changed to not be an error, but behave like the special value
- -1 (copy all, default).
-
- * tests/iocmd.test (iocmd-15.{12,13}): Removed.
-
- * tests/io.test (io-52.5{,a,b}): Reverted last change, added
- * tests/chanio.test (chan-io-52.5{,a,b}): comment regarding the
- meaning of -1, added two more testcases for other negative values,
- and input wrapped to negative.
-
-2008-04-09 Donal K. Fellows <dkf@users.sf.net>
-
- * tests/{fCmd,unixFCmd,winFCmd,winFile}.test: Tidying up of the test
- suite to make better use of tcltest2 and be clearer about what is
- being tested.
-
- * win/Makefile.in (html): Added target for doing convenient
- documentation builds, mirroring the one from unix/Makefile.
-
-2008-04-09 Andreas Kupries <andreask@activestate.com>
-
- * tests/chanio.test (chan-io-52.5): Removed '-size -1' from test,
- * tests/io.test (io-52.5): does not seem to have any bearing, and was
- an illegal value. Test case is not affected by the value of -size,
- test flag restoration and that evrything was properly copied.
-
- * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Added checking of -size value
- * tests/ioCmd.test (iocmd-15.{13,14}): to reject negative values, and
- values overflowing 32-bit signed. Basic patch by Alexandre Ferrieux
- <ferrieux@users.sourceforge.net>, with modifications from me to
- separate overflow from true negative value. Extended testsuite. [Bug
- 1557855]
-
-2008-04-09 Daniel Steffen <das@users.sourceforge.net>
-
- * tests/chanio.test (chan-io-53.8,53.9,53.10): Fix typo & quoting for
- * tests/io.test (io-53.8,53.9,53.10): spaces in builddir path
-
-2008-04-08 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c: Added comments to the alignment macros used in
- GrowEvaluationStack() and friends.
-
-2008-04-08 Daniel Steffen <das@users.sourceforge.net>
-
- * tools/genStubs.tcl: Revert erroneous 2008-04-02 change marking
- *StubsPtr as EXTERN instead of extern.
-
- * generic/tclDecls.h: make genstubs
- * generic/tclIntDecls.h:
- * generic/tclIntPlatDecls.h:
- * generic/tclPlatDecls.h:
- * generic/tclTomMathDecls.h:
-
-2008-04-07 Andreas Kupries <andreask@activestate.com>
-
- * tests/io.test (io-53.10): Testcase for bi-directional fcopy.
- * tests/chanio.test:
- * generic/tclIO.c: Additional changes to data structures for fcopy and
- * generic/tclIO.h: channels to perform proper cleanup in case of a
- channel having two background copy operations running as is now
- possible.
-
- * generic/tclIO.c (BUSY_STATE, CheckChannelErrors, TclCopyChannel):
- New macro, and the places using it. This change allows for
- bi-directional fcopy on channels. Thanks to Alexandre Ferrieux
- <ferrieux@users.sourceforge.net> for the patch. [Bug 1350564]
-
-2008-04-07 Reinhard Max <max@suse.de>
-
- * generic/tclStringObj.c (Tcl_AppendFormatToObj): Fix [format {% d}]
- so that it behaves the same way as in 8.4 and as C's printf().
- * tests/format.test: Add a test for '% d' and '%+d'.
-
-2008-04-05 Kevin B. Kenny <kennykb@acm.org>
-
- * win/tclWinFile.c: (WinSymLinkDirectory): Fixed a problem that Tcl
- was creating an NTFS junction point (IO_REPARSE_TAG_MOUNT_POINT) but
- filling in the union member for a Vista symbolic link. We had gotten
- away with this error because the union member
- (SymbolicLinkReparseBuffer) was misdefined in this file and in the
- 'winnt.h' in early versions of MinGW. MinGW 3.4.2 has the correct
- definition of SymbolicLinkReparseBuffer, exposing the mismatch, and
- making tests cmdAH-19.4.1, fCmd-28.*, and filename-11.* fail.
- * tests/chanio.test (chan-io-53.9):
- * tests/io.test (io-53.9): Made test cleanup robust against the
- possibility of slow process shutdown on Windows.
-
- * win/tcl.m4: Added -D_CRT_SECURE_NO_DEPRECATE and
- -DCRT_NONSTDC_NO_DEPRECATE to the MSVC compilation flags so that the
- compilation doesn't barf on perfectly reasonable Posix system calls.
- * win/configure: Manually patched (don't have the right autoconf to
- hand).
-
-2008-04-04 Andreas Kupries <andreask@activestate.com>
-
- * tests/io.test (io-53.9): Added testcase for [Bug 780533], based
- * tests/chanio.test: on Alexandre's test script. Also fixed problem
- with timer in preceding test, was not canceled properly in the ok case
-
-2008-04-04 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclIORChan.c (ReflectOutput): Allow zero return from write
- when input was zero-length anyway. Otherwise keept it an error, and
- separate the message from 'written too much'.
-
- * tests/ioCmd.test (iocmd-24.6): Testcase updated for changed message.
-
- * generic/tclIORChan.c (ReflectClose): Added missing removal of the
- now closed channel from the reflection map. Before we could crash the
- system by invoking 'chan postevent' on a closed reflected channel,
- dereferencing the dangling pointer in the map.
-
- * tests/ioCmd.test (iocmd-31.8): Testcase for the above.
-
-2008-04-03 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclIO.c (CopyData): Applied patch [Bug 1932639] to
- * tests/io.test: prevent fcopy from calling -command synchronously
- * tests/chanio.test: the first time. Thanks to Alexandre Ferrieux
- <ferrieux@users.sourceforge.net> for report and patch.
-
-2008-04-02 Daniel Steffen <das@users.sourceforge.net>
-
- * generic/tcl.decls: Remove 'export' declarations of symbols now
- only in libtclstub and no longer in libtcl.
-
- * generic/tclStubLib.c: Make symbols in libtclstub.a MODULE_SCOPE to
- * tools/genStubs.tcl: avoid exporting them from libraries that link
- with -ltclstub; constify tcl*StubsPtr and stub
- table hook pointers. [Bug 1819422]
-
- * generic/tclDecls.h: make genstubs
- * generic/tclIntDecls.h:
- * generic/tclIntPlatDecls.h:
- * generic/tclPlatDecls.h:
- * generic/tclStubInit.c:
- * generic/tclTomMathDecls.h:
-
-2008-04-02 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclIO.c (CopyData): Applied patch for fcopy problem [Bug
- 780533], with many thanks to Alexandre Ferrieux
- <ferrieux@users.sourceforge.net> for tracking it down and providing a
- solution. Still have to convert his test script into a proper test
- case.
-
-2008-04-01 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclStrToD.c: Applied patch for [Bug 1839067] (fp rounding
- * unix/tcl.m4: setup on solaris x86, native cc), provided by
- Michael Schlenker.
-
-2008-04-01 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclStubLib.c: Removed needless #ifdef complexity.
-
- * generic/tclStubLib.c (Tcl_InitStubs): Added missing error message.
- * generic/tclPkg.c (Tcl_PkgInitStubsCheck):
-
- * README: Bump version number to 8.6a0
- * generic/tcl.h:
- * library/init.tcl:
- * macosx/Tcl-Common.xcconfig:
- * macosx/Tcl.pbproj/default.pbxuser:
- * macosx/Tcl.pbproj/project.pbxproj:
- * tools/tcl.wse.in:
- * unix/configure.in:
- * unix/tcl.spec:
- * win/README:
- * win/configure.in:
- * win/makefile.bc:
- * win/tcl.m4:
-
- * unix/configure: autoconf-2.59
- * win/configure:
-
- * generic/tclBasic.c: Revised stubs-generation tool and interp
- * tools/genStubs.tcl: creation so that "tclStubsPtr" is not present
- * unix/Makefile.in: in libtcl.so, but is present only in
- * win/Makefile.in: libtclstub.a. This tightens up the rules for
- * win/makefile.bc: users of the stubs interfaces. [Bug 1819422]
- * win/makefile.vc:
-
- * generic/tclDecls.h: make genstubs
- * generic/tclIntDecls.h:
- * generic/tclIntPlatDecls.h:
- * generic/tclPlatDecls.h:
- * generic/tclTomMathDecls.h:
-
-2008-03-30 Kevin Kenny <kennykb@acm.org>
-
- * generic/tclInt.h (TclIsNaN):
- * unix/configure.in: Added code to the configurator to check for a
- standard isnan() macro and use it if one is
- found. This change avoids bugs where the test of
- ((d) != (d)) is optimized away by an
- overaggressive compiler. [Bug 1783544]
- * generic/tclObj.c: Added missing #include <math.h> needed to locate
- isnan() after the above change.
-
- * unix/configure: autoconf-2.61
-
- * tests/mathop.test (mathop-25.9, mathop-25.14): Modified tests to
- deal with (slightly buggy) math libraries in which pow() returns an
- incorrectly rounded result. [Bug 1808174]
-
-2008-03-26 Don Porter <dgp@users.sourceforge.net>
-
- *** 8.5.2 TAGGED FOR RELEASE ***
-
- * generic/tcl.h: Bump to 8.5.2 for release.
- * library/init.tcl:
- * tools/tcl.wse.in:
- * unix/configure.in:
- * unix/tcl.spec:
- * win/configure.in:
-
- * unix/configure: autoconf-2.59
- * win/configure:
-
- * changes: Updated for 8.5.2 release.
-
-2008-03-28 Donal K. Fellows <dkf@users.sf.net>
-
- * tests/fCmd.test: Substantial rewrite to use many more tcltest
- features. Great reduction in quantity of [catch] gymnastics. Several
- buggy tests fixed, including one where the result of the previous test
- was being checked!
-
-2008-03-27 Kevin B. Kenny <kennykb@acm.org>
-
- * library/tzdata/America/Marigot:
- * library/tztata/America/St_Barthelemy:
- * library/tzdata/America/Argentina/San_Luis:
- * library/tzdata/Asia/Ho_Chi_Minh:
- * library/tzdata/Asia/Kolkata: (new files)
- * library/tzdata/America/Caracas:
- * library/tzdata/America/Havana:
- * library/tzdata/America/Santiago:
- * library/tzdata/America/Argentina/Buenos_Aires:
- * library/tzdata/America/Argentina/Catamarca:
- * library/tzdata/America/Argentina/Cordoba:
- * library/tzdata/America/Argentina/Jujuy:
- * library/tzdata/America/Argentina/La_Rioja:
- * library/tzdata/America/Argentina/Mendoza:
- * library/tzdata/America/Argentina/Rio_Gallegos:
- * library/tzdata/America/Argentina/San_Juan:
- * library/tzdata/America/Argentina/Tucuman:
- * library/tzdata/America/Argentina/Ushuaia:
- * library/tzdata/Asia/Baghdad:
- * library/tzdata/Asia/Calcutta:
- * library/tzdata/Asia/Damascus:
- * library/tzdata/Asia/Saigon:
- * library/tzdata/Pacific/Easter:
- Changes up to and including Olson's tzdata2008b.
-
-2008-03-27 Daniel Steffen <das@users.sourceforge.net>
-
- * unix/tcl.m4 (SunOS-5.1x): Fix 64bit support for Sun cc. [Bug
- 1921166]
-
- * unix/configure: autoconf-2.59
-
-2008-03-26 Don Porter <dgp@users.sourceforge.net>
-
- * changes: Updated for 8.5.2 release.
-
-2008-03-24 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * generic/tclBinary.c: [Bug 1923966] - crash in binary format
- * tests/binary.test: Added tests for the above crash condition.
-
-2008-03-21 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/switch.n: Clarified documentation in respect of two-argument
- invokation. [Bug 1899962]
-
- * tests/switch.test: Added more tests of regexp-mode compilation of
- the [switch] command. [Bug 1854435]
-
-2008-03-20 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tcl.h, generic/tclThreadAlloc.c: Tidied up the declarations
- of Tcl_GetMemoryInfo so that it is always defined. Will panic when
- called against a Tcl that was previously built without it at all,
- which is OK because that also indicates a serious mismatch between
- memory configuration options.
-
-2008-03-19 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tcl.h, generic/tclThreadAlloc.c (Tcl_GetMemoryInfo): Make
- sure this function is available when direct linking. [Bug 1868171]
-
- * tests/reg.test (reg-33.14): Marked nonPortable because some
- environments have small default stack sizes. [Bug 1905562]
-
-2008-03-18 Andreas Kupries <andreask@activestate.com>
-
- * library/tm.tcl (::tcl::tm::UnknownHandler): Changed 'source' to
- 'source -encoding utf-8'. This fixes a portability problem of Tcl
- Modules pointed out by Don Porter. By using plain 'source' we were at
- the mercy of 'encoding system', making modules less portable than they
- could be. The exact scenario: A writes a TM in some weird encoding
- which is A's system encoding, distributes it, and somewhere else it
- cannot be read/used because the system encoding is different. Forcing
- the use of utf-8 makes the module portable.
-
- ***INCOMPATIBILITY*** for all Tcl Modules already written in non-utf-8
- compatible encodings.
-
-2008-03-18 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclExecute.c: Patch from Miguel Sofer to correct the
- alignment of memory allocated by GrowEvaluationStack(). [Bug 1914503]
-
-2008-03-18 Andreas Kupries <andreask@activestate.com>
-
- * library/tm.tcl (::tcl::tm::Defaults): Modified handling of
- environment variables. Solution slightly different than proposed in
- the report. Using the underscored form TCLX_y_TM_PATH even if
- TCLX.y_TM_PATH exists. Also using a loop to cut prevent code
- replication. [Bug 1914604]
-
-2008-03-16 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclCompCmds.c (TclCompileDictForCmd): Correct the handling
- of stack space calculation (the jump pattern used was confusing the
- simple-minded code doing the calculations). [Bug 1903325]
-
- * doc/lreplace.n: Clarified documentation of what happens with
- negative indices. [Bug 1905809] Added example, tidied up formatting.
-
-2008-03-14 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclBasic.c (OldMathFuncProc): Same workaround protection
- from bad TclStackAlloc() alignment. Thanks George Peter Staplin.
-
- * generic/tclCmdIL.c (Tcl_LsortObjCmd): Use ckalloc() to allocate
- SortElement arrays instead of TclStackAlloc() which isn't getting
- alignment right. Workaround for [Bug 1914503].
-
-2008-03-14 Reinhard Max <max@suse.de>
-
- * generic/tclTest.c: Ignore the return value of write() when we are
- * unix/tclUnixPipe.c: about to exit anyways.
-
-2008-03-13 Daniel Steffen <das@users.sourceforge.net>
-
- * unix/configure.in: Use backslash-quoting instead of double-quoting
- * unix/tcl.m4: for lib paths in tclConfig.sh. [Bug 1913622]
- * unix/configure: autoconf-2.59
-
-2008-03-13 Don Porter <dgp@users.sourceforge.net>
-
- * changes: Updated for 8.5.2 release.
-
- * generic/tclStrToD.c: Resolve identifier conflict over "pow10" with
- libm in Cygwin and DJGPP. Thanks to Gordon Schumacher and Philip
- Moore. [Patch 1800636]
-
-2008-03-12 Daniel Steffen <das@users.sourceforge.net>
-
- * macosx/Tcl.xcodeproj/project.pbxproj: Add support for Xcode 3.1
- * macosx/Tcl.xcodeproj/default.pbxuser: CODE_SIGN_IDENTITY and
- * macosx/Tcl-Common.xcconfig: 'xcodebuild install'.
-
-2008-03-12 Andreas Kupries <andreask@activestate.com>
-
- * doc/info.n: Replaced {expand} with {*}.
-
-2008-03-12 Jeff Hobbs <jeffh@ActiveState.com>
-
- * unix/Makefile.in (install-libraries): Bump http to 2.7
- * win/Makefile.in (install-libraries): Added -myaddr option to allow
- * library/http/http.tcl (http::geturl): control of selected socket
- * library/http/pkgIndex.tcl: interface. [Bug 559898]
- * doc/http.n, tests/http.test: Added -keepalive and
- -protocol 1.1 with chunked transfer encoding support. [Bug 1063703,
- 1470377, 219225] (default keepalive is 0)
- Added ability to override Host in -headers. [Bug 928154]
- Added -strict option to control URL validation on per-call basis.
- [Bug 1560506]
-
-2008-03-11 Jeff Hobbs <jeffh@ActiveState.com>
-
- * library/http/http.tcl (http::geturl): Add -method option to support
- * tests/http.test (http-3.1): http PUT and DELETE requests.
- * doc/http.n: [Bug 1599901, 862554]
-
- * library/http/http.tcl: Whitespace changes, code cleanup. Allow http
- to be re-sourced without overwriting http state.
-
-2008-03-11 Daniel Steffen <das@users.sourceforge.net>
-
- * generic/tclEncoding.c (LoadEscapeEncoding): Avoid leaking escape
- sub-encodings, fixes encoding-11.1 failing after iso2022-jp loaded.
- [Bug 1893053]
-
- * macosx/tclMacOSXNotify.c: Avoid using CoreFoundation after fork() on
- Darwin 9 even when TclpCreateProcess() uses vfork().
-
- * macosx/Tcl.xcodeproj/project.pbxproj: Add support for Xcode 3.1 and
- * macosx/Tcl.xcodeproj/default.pbxuser: configs for building with
- * macosx/Tcl-Common.xcconfig: gcc-4.2 and llvm-gcc-4.2.
-
- * unix/tclUnixPort.h: Workaround vfork() problems in
- llvm-gcc-4.2.1 -O4 build.
-
- * unix/tclUnixPort.h: Move MODULE_SCOPE compat
- define to top. [Bug 1911102]
-
- * macosx/GNUmakefile: Fix quoting to allow paths
- * macosx/Tcl-Common.xcconfig: to ${builddir} and
- * unix/Makefile.in: ${INSTALL_ROOT} to contain
- * unix/configure.in: spaces.
- * unix/install-sh:
- * unix/tcl.m4:
- * tests/ioCmd.test:
-
- * unix/configure: autoconf-2.59
-
- * unix/Makefile.in (install-strip): Strip non-global symbols from
- dynamic library.
-
- * unix/tclUnixNotfy.c: Fix warning.
-
- * tests/exec.test (exec-9.7): Reduce timing sensitivity
- * tests/socket.test (socket-2.11): (esp. on multi-proc machines).
-
- * tests/fCmd.test (fCmd-9.4): Skip on Darwin 9 (xfail).
-
-2008-03-11 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclVar.c (TclDeleteNamespaceVars):
- * tests/var.test (var-8.2): Unset traces on vars should be called with
- a FQ named during namespace deletion. This was causing infinite loops
- when unset traces recreated the var, as reported by Julian Noble. [Bug
- 1911919]
-
-2008-03-10 Don Porter <dgp@users.sourceforge.net>
-
- * changes: Updated for 8.5.2 release.
-
- * doc/http.n: Revised to indicate that [package require http 2.5.5]
- is needed to get all the documented commands ([http::meta]).
-
- * generic/tclEvent.c (TclDefaultBgErrorHandlerObjCmd): Added error
- * tests/event.test (event-5.*): checking to protect against callers
- passing invalid return options dictionaries. [Bug 1901113]
-
- * generic/tclBasic.c (ExprAbsFunc): Revised so that the abs()
- * tests/expr.test: function and the [::tcl::mathfunc::abs]
- command do not return the value of -0, or equivalent values with more
- alarming string reps like -1e-350. [Bug 1893815]
-
-2008-03-07 Andreas Kupries <andreask@activestate.com>
-
- * generic/tclResult.c (ReleaseKeys): Workaround for [Bug 1904907].
- Reset the return option keys to NULL to allow full re-initialization
- by GetKeys(). This introduces a memory leak for the key objects, but
- gets us around a crash in the finalization of reflected channels when
- handling returns, either at compile- or runtime. In both cases we
- access the keys after they have been released by their thread exit
- handler. A proper fix is entangled with the untangling of the
- finalization ordering and attendant issues. For now we choose the
- lesser evil.
-
-2008-03-07 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclExecute.c (Tcl_ExprObj): Revised expression bytecode
- compiling so that bytecodes invalid due to changing context or due to
- the difference between expressions and scripts are not reused. [Bug
- 1899164]
-
- * generic/tclCmdAH.c: Revised direct evaluation implementation of
- [expr] so that [expr $e] caches compiled bytecodes for the expression
- as the intrep of $e.
-
- * tests/execute.test (execute-6.*): More tests checking that
- script bytecode is invalidated in the right situations.
-
-2008-03-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * win/configure.in: Add AC_HEADER_STDC to support msys/win64.
-
-2008-03-06 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/namespace.n: Minor tidying up. [Bug 1909019]
-
-2008-03-04 Don Porter <dgp@users.sourceforge.net>
-
- * tests/execute.test (6.3,4): Added tests for [Bug 1899164].
-
-2008-03-03 Reinhard Max <max@suse.de>
-
- * unix/tclUnixChan.c: Fix mark and space parity on Linux, which uses
- CMSPAR instead of PAREXT.
-
-2008-03-02 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclNamesp.c (GetNamespaceFromObj):
- * tests/interp.test (interp-28.2): Spoil the intrep of an nsNameType
- obj when the reference crosses interpreter boundaries.
-
-2008-02-29 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclResult.c (Tcl_SetReturnOptions): Revised the refcount
- management of Tcl_SetReturnOptions to become that of a conventional
- Consumer routine. Thanks to Peter Spjuth for pointing out the
- difficulties calling Tcl_SetReturnOptions with non-0-count value for
- options.
- * generic/tclExecute.c (INST_RETURN_STK): Revised the one caller
- within Tcl itself which passes a non-0-count value to
- Tcl_SetReturnOptions().
-
- * generic/tclBasic.c (Tcl_AppendObjToErrorInfo): Revised the
- refcount management of Tcl_AppendObjToErrorInfo to become that of a
- conventional Consumer routine. This preserves the ease of use for the
- overwhelming common callers who pass in a 0-count value, but makes the
- proper call with a non-0-count value less surprising.
- * generic/tclEvent.c (TclDefaultBgErrorHandlerObjCmd): Revised the
- one caller within Tcl itself which passes a non-0-count value to
- Tcl_AppendObjToErrorInfo().
-
-2008-02-28 Joe English <jenglish@users.sourceforge.net>
-
- * unix/tclPort.h, unix/tclCompat.h, unix/tclUnixChan.h: Reduce scope
- of <sys/filio.h> and <sys/ioctl.h> #includes. [Patch 1903339]
-
-2008-02-28 Joe English <jenglish@users.sourceforge.net>
-
- * unix/tclUnixChan.c, unix/tclUnixNotfy.c, unix/tclUnixPipe.c:
- Consolidate all code conditionalized on -DUSE_FIONBIO into one place.
- * unix/tclUnixPort.h, unix/tclUnixCompat.c: New routine
- TclUnixSetBlockingMode(). [Patch 1903339]
-
-2008-02-28 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclBasic.c (TclEvalObjvInternal): Plug memory leak when
- an enter trace deletes or changes the command, prompting a reparsing.
- Don't let the second pass lose commandPtr value allocated during the
- first pass.
-
- * generic/tclCompExpr.c (ParseExpr): Plug memory leak in error
- message generation.
-
- * generic/tclStringObj.c (Tcl_AppendFormatToObj): [format %llx $big]
- leaked an mp_int.
-
- * generic/tclCompCmds.c (TclCompileReturnCmd): The 2007-10-18 commit
- to optimize compiled [return -level 0 $x] [RFE 1794073] introduced a
- memory leak of the return options dictionary. Fixing that.
-
-2008-02-27 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * library/http/http.tcl: [Bug 705956] - fix inverted logic when
- cleaning up socket error in geturl.
-
-2008-02-27 Kevin B. Kenny <kennykb@acm.org>
-
- * doc/clock.n: Corrected minor indentation gaffe in the penultimate
- paragraph. [Bug 1898025]
- * generic/tclClock.c (ParseClockFormatArgs): Changed to check that the
- clock value is in the range of a 64-bit integer. [Bug 1862555]
- * library/clock.tcl (::tcl::clock::format, ::tcl::clock::scan,
- (::tcl::clock::add, ::tcl::clock::LocalizeFormat): Fixed bugs in
- caching of localized strings that caused weird results when localized
- date/time formats were used. [Bug 1902423]
- * tests/clock.test (clock-61.*, clock-62.1): Regression tests for [Bug
- 1862555] and [Bug 1902423].
-
-2008-02-26 Joe English <jenglish@users.sourceforge.net>
-
- * generic/tclIOUtil.c, unix/tclUnixPort.h, unix/tclUnixChan.c:
- Remove dead/unused portability-related #defines and unused conditional
- code. See [Patch 1901828] for discussion.
-
-2008-02-26 Joe English <jenglish@users.sourceforge.net>
-
- * generic/tclIORChan.c (enum MethodName),
- * generic/tclCompExpr.c (enum Marks): More stray trailing ","s
-
-2008-02-26 Joe English <jenglish@users.sourceforge.net>
-
- * unix/configure.in(socklen_t test): Define socklen_t as "int" if
- missing, not "unsigned". Use AC_TRY_COMPILE instead of
- AC_EGREP_HEADER.
- * unix/configure: regenerated.
-
-2008-02-26 Joe English <jenglish@users.sourceforge.net>
-
- * generic/tclCompile.h: Remove stray trailing "," from enum
- InstOperandType definition (C99ism).
-
-2008-02-26 Jeff Hobbs <jeffh@ActiveState.com>
-
- * generic/tclUtil.c (TclReToGlob): Fix the handling of the last star
- * tests/regexpComp.test: possibly being escaped in
- determining right anchor. [Bug 1902436]
-
-2008-02-26 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * library/http/pkgIndex.tcl: Set version 2.5.5
- * library/http/http.tcl: It is better to do the [eof] check after
- trying to read from the socket. No clashes found in testing. Added
- http::meta command to access the http headers. [Bug 1868845]
-
-2008-02-22 Pat Thoyts <patthoyts@users.sourceforge.net>
-
- * library/http/pkgIndex.tcl: Set version 2.5.4
- * library/http/http.tcl: Always check that the state array exists
- in the http::status command. [Bug 1818565]
-
-2008-02-13 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tcl.h: Bump version number to 8.5.2b1 to distinguish
- * library/init.tcl: CVS development snapshots from the 8.5.1 and
- * unix/configure.in: 8.5.2 releases.
- * unix/tcl.spec:
- * win/configure.in:
- * README
-
- * unix/configure: autoconf (2.59)
- * win/configure:
-
-2008-02-12 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * generic/tclCompCmds.c (TclCompileSwitchCmd): Corrected logic for
- * tests/switch.test (switch-10.15): handling -nocase compilation; the
- -exact -nocase option cannot be compiled currently. [Bug 1891827]
-
- * unix/README: Documented missing configure flags. [Bug 1799011]
-
-2008-02-06 Kevin B. Kenny <kennykb@acm.org>
-
- * doc/clock.n (%N): Corrected an error in the explanation of the %N
- format group.
- * generic/tclClock.c (ClockParseformatargsObjCmd):
- * library/clock.tcl (::tcl::clock::format):
- * tests/clock.test (clock-1.0, clock-1.4):
- Performance enhancements in [clock format] (moving the analysis of
- $args into C code, holding on to Tcl_Objs with resolved command names,
- [lassign] in place of [foreach], avoiding [namespace which] for
- command resolution).
-
-2008-02-04 Don Porter <dgp@users.sourceforge.net>
-
- *** 8.5.1 TAGGED FOR RELEASE ***
-
- * changes: Updated for 8.5.1 release.
-
- * generic/tcl.h: Bump to 8.5.1 for release.
- * library/init.tcl:
- * tools/tcl.wse.in:
- * unix/configure.in:
- * unix/tcl.spec:
- * win/configure.in:
-
- * unix/configure: autoconf-2.59
- * win/configure:
-
-2008-02-04 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c (INST_CONCAT1): Fix optimisation for in-place
- concatenation (was going over String type)
-
-2008-02-02 Daniel Steffen <das@users.sourceforge.net>
-
- * unix/configure.in (Darwin): Correct Info.plist year substitution
- in non-framework builds.
-
- * unix/configure: autoconf-2.59
-
-2008-01-30 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclInterp.c (Tcl_GetAlias): Fix for [Bug 1882373], thanks go
- to an00na.
-
-2008-01-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * tools/tcltk-man2html.tcl: Reworked manual page scraper to do a
- proper job of handling references to Ttk options. [Tk Bug 1876493]
-
-2008-01-29 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * doc/man.macros (SO, SE): Adjusted macros so that it is possible for
- Ttk to have its "standard options" on a manual page that is not called
- "options". [Tk Bug 1876493]
-
-2008-01-25 Don Porter <dgp@users.sourceforge.net>
-
- * changes: Updated for 8.5.1 release.
-
-2008-01-23 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclInt.h: New macro TclGrowParseTokenArray() to
- * generic/tclCompCmds.c: simplify code that might need to grow
- * generic/tclCompExpr.c: an array of Tcl_Tokens in the parsePtr
- * generic/tclParse.c: field of a Tcl_Parse. Replaces the
- TclExpandTokenArray() routine via replacing:
- int needed = parsePtr->numTokens + growth;
- while (needed > parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- with:
- TclGrowParseTokenArray(parsePtr, growth);
- This revision merged over from dgp-refactor branch.
-
- * generic/tclCompile.h: Demote TclCompEvalObj() from internal stubs to
- * generic/tclInt.decls: a MODULE_SCOPE routine declared in
- tclCompile.h.
-
- * generic/tclIntDecls.h: make genstubs
- * generic/tclStubInit.c:
-
-2008-01-22 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclTimer.c (AfterProc): Replace Tcl_EvalEx() with
- Tcl_EvalObjEx() to evaluate [after] callbacks. Part of trend to favor
- compiled execution over direct evaluation.
-
-2008-01-22 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclCmdIl.c (Tcl_LreverseObjCmd):
- * tests/cmdIL.test (cmdIL-7.7): Fix crash on reversing an empty list.
- [Bug 1876793]
-
-2008-01-20 Jeff Hobbs <jeffh@ActiveState.com>
-
- * unix/README: Minor typo fixes [Bug 1853072]
-
- * generic/tclIO.c (TclGetsObjBinary): Operate on topmost channel.
- [Bug 1869405] (Ficicchia)
-
-2008-01-17 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclCompExpr.c: Revision to preserve parsed intreps of
- numeric and boolean literals when compiling expressions with (optimize
- == 1).
-
-2008-01-15 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclCompExpr.c: Add an 'optimize' argument to
- * generic/tclCompile.c: TclCompileExpr() to profit from better
- * generic/tclCompile.h: literal management according to usage.
- * generic/tclExecute.c:
-
- * generic/tclCompExpr.c: Fix literal leak in exprs [Bug 1869989] (dgp)
- * generic/tclExecute.c:
- * tests/compExpr.test:
-
- * doc/proc.n: Changed wording for access to non-local variables; added
- mention to [namespace upvar]. Lame attempt at dealing with
- documentation. [Bug 1872708]
-
-2008-01-15 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c: Replacing 'operator' by 'op' in the def of
- * generic/tclCompExpr.c: struct TclOpCmdClientData to accommodate C++
- * generic/tclCompile.h: compilers. [Bug 1855644]
-
-2008-01-13 Jeff Hobbs <jeffh@ActiveState.com>
-
- * win/tclWinSerial.c (SerialCloseProc, TclWinOpenSerialChannel): Use
- critical section for read & write side. [Bug 1353846] (newman)
-
-2008-01-11 Miguel Sofer <msofer@users.sf.net>
-
- * unix/tclUnixThrd.c (TclpThreadGetStackSize): Restore stack checking
- functionality in freebsd. [Bug 1850424]
-
- * unix/tclUnixThrd.c (TclpThreadGetStackSize): Fix for crash in
- freebsd. [Bug 1860425]
-
-2008-01-10 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclStringObj.c (Tcl_AppendFormatToObj): Correct failure to
- * tests/format.test: account for big.used == 0 corner case in the
- %ll(idox) format directives. [Bug 1867855]
-
-2008-01-09 George Peter Staplin <georgeps@xmission.com>
-
- * doc/vwait.n: Add a missing be to fix a typo.
-
-2008-01-04 Jeff Hobbs <jeffh@ActiveState.com>
-
- * tools/tcltk-man2html.tcl (make-man-pages): Make man page title use
- more specific info on lhs to improve tabbed browser view titles.
-
-2008-01-02 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/binary.n: Fixed documentation bug reported on tcl-core, and
- reordered documentation to discourage people from using the hex
- formatter that is hardly ever useful.
-
-2008-01-02 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tcl.h: Bump version number to 8.5.1b1 to distinguish
- * library/init.tcl: CVS development snapshots from the 8.5.0 and
- * unix/configure.in: 8.5.1 releases.
- * unix/tcl.spec:
- * win/configure.in:
- * README
-
- * unix/configure: autoconf (2.59)
- * win/configure:
+ * compat/mkstemp.c (new file): [Bug 741967]: Added a compatibility
+ implementation of the mkstemp() function, which is apparently needed
+ on some platforms.
+
+ ******************************************************************
+ *** CHANGELOG ENTRIES FOR 2008 IN "ChangeLog.2008" ***
+ *** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007" ***
+ *** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005" ***
+ *** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004" ***
+ *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" ***
+ *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" ***
+ *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" ***
+ *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" ***
+ *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
+ ******************************************************************
- ******************************************************************
- *** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007" ***
- *** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005" ***
- *** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004" ***
- *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" ***
- *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" ***
- *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" ***
- *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" ***
- *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
- ******************************************************************
diff --git a/ChangeLog.2000 b/ChangeLog.2000
index 2ebdd23..0d20eaf 100644
--- a/ChangeLog.2000
+++ b/ChangeLog.2000
@@ -746,7 +746,7 @@
* doc/trace.n: minor doc cleanup
-2000-09-06 André Pönitz <poenitz@htwm.de>
+2000-09-06 André Pönitz <poenitz@htwm.de>
* doc/*.n: added or changed "SEE ALSO:" section
@@ -1086,7 +1086,7 @@
* unix/tcl.m4 (SC_ENABLE_GCC): Don't set CC=gcc before running
AC_PROG_CC if CC is already set.
-2000-07-13 André Pönitz <poenitz@mathematik.tu-chemnitz.de>
+2000-07-13 André Pönitz <poenitz@mathematik.tu-chemnitz.de>
* doc/lappend.n:
* doc/lindex.n:
diff --git a/ChangeLog.2001 b/ChangeLog.2001
index 6579651..06e7c36 100644
--- a/ChangeLog.2001
+++ b/ChangeLog.2001
@@ -939,7 +939,7 @@
version of Tcl with Cygwin gcc. Users should compile with Mingw gcc
instead.
-2001-11-06 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+2001-11-06 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* generic/tclIO.c (ReadChars): Fixed [Bug 478856] reported by Stuart
Cassoff <stwo@users.sourceforge.net>. The bug caused loss of
diff --git a/ChangeLog.2003 b/ChangeLog.2003
index b12cd2c..c586ba9 100644
--- a/ChangeLog.2003
+++ b/ChangeLog.2003
@@ -3284,7 +3284,7 @@
2003-01-10 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclIOUtil.c:
+ * generic/tclIOUtil.c:
* win/tclWinInt.h:
* win/tclWinInit.c: fix to new WinTcl crash on exit with vfs,
introduced on 2002-12-06. Encodings must be cleaned up after the
diff --git a/ChangeLog.2008 b/ChangeLog.2008
new file mode 100644
index 0000000..9c4e951
--- /dev/null
+++ b/ChangeLog.2008
@@ -0,0 +1,3796 @@
+2008-12-31 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/Makefile.in: Set TCLLIBPATH in SHELL_ENV so that targets
+ like `make shell` have access to builds of bundled packages.
+
+2008-12-28 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclZlib.c (Tcl_ZlibStreamPut): Plug a memory leak.
+
+2008-12-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclZlib.c (ZlibStreamCmd): Fix compilation consistency. [Bug
+ * generic/tcl.decls: 2470237]
+
+ * generic/tclZlib.c (Tcl_ZlibStreamGet): Corrected the semantics of
+ this function to be useful to the PNG implementation. If the argument
+ object is empty, this gives the previous semantics.
+ (Tcl_ZlibStreamChecksum): Corrected name to be less misleading; it
+ only produced Adler-32 checksums when the stream was processing the
+ right type of compressed data format.
+ (Tcl_ZlibAdler32, Tcl_ZlibCRC32): Corrected types so that they work
+ naturally with the results of Tcl_GetByteArrayFromObj().
+ *** POTENTIAL INCOMPATIBILITY *** for all above changes, but very
+ unlikely to be difficult for anyone to deal with.
+
+2008-12-26 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tcl.decls: Tidy up the commenting style, adding markers for
+ each of the big release points under TCT stewardship and noting the
+ general purpose of each TIP that added C API. Overall effect is to
+ make this file much more informative to read without having to spend
+ effort correlating with TIPs and ChangeLogs.
+
+2008-12-23 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/Makefile.in: Fix build of zlib objects with msvc
+ * win/tcl.m4:
+ * win/configure: autoconf-2.59
+
+2008-12-23 Donal K. Fellows <dkf@users.sf.net>
+
+ * win/Makefile.in: Handle file extensions correctly. [Bug 2459725]
+
+2008-12-22 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ *** 8.6b1 TAGGED FOR RELEASE ***
+
+ * win/makefile.vc: Ensure pkgs directories are suitable and quote the
+ paths. [Bug 2458395]
+
+2008-12-22 Joe Mistachkin <joe@mistachkin.com>
+
+ * tools/man2help2.tcl: Added support for "\(mi" nroff macro. [Bug
+ 2330040]
+
+2008-12-22 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/makefile.vc: Support the pkgs tree in the NMAKE builds.
+
+2008-12-21 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/Makefile.in: Fix broken build of bundled packages when path
+ to build dir contains spaces by switching to
+ relative paths to toplevel build dir.
+
+ * unix/configure.in: Preserve configure environment variables for
+ sub-configures of bundled packages; reuse
+ configure cache file for sub-configures.
+
+ * unix/configure: autoconf-2.59
+
+2008-12-21 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/TclZlib.3: Fix minor typo. [Bug 2455165]
+
+2008-12-20 Kevin B. Kenny <kennykb@acm.org>
+
+ * win/Makefile.in: Renamed the static library libtcl86s.a to
+ * win/configure.in: have a name distinct from the import library
+ libtcl86.a. This renaming dodges an ancient
+ bug in the Makefile revealed by the last
+ commit where the $(TCL_LIB_FILE) rule can
+ fire to try to build the static library in a
+ --enable-shared build (and create a static
+ library that subsequently fails to link).
+ Revised the zlib objects so that they are
+ built directly into the build dir, without
+ building an intermediate static library.
+ *** POTENTIAL INCOMPATIBILITY *** for
+ embedders who link to the static library, but
+ I couldn't figure out how to sort this out
+ any other way.
+ * win/configure: Autoconf 2.59
+
+2008-12-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * win/Makefile.in: Minor updates to make building work better with
+ msys on Windows. (Apparently the gcc used doesn't like a / at the end
+ of a -I argument...)
+
+2008-12-20 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updates for 8.6b1 release.
+
+2008-12-20 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/Makefile.in: Make package install directory of bundled
+ * unix/configure.in: packages configurable via PACKAGE_DIR makefile
+ variable (set to platform-specific default).
+
+ * unix/Makefile.in (*-packages): Ensure toplevel targets fail if
+ sub-make/configure fails; fix quoting when
+ builddir path contains spaces.
+
+ * macosx/GNUmakefile: Add install-packages to install targets.
+
+ * unix/configure: autoconf-2.59
+
+2008-12-19 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/NRE.3: Formatting errors found by `make html`
+ * doc/Tcl_Main.3:
+ * doc/zlib.n:
+
+ * tests/chanio.test: Add missing [removeFile] cleanups.
+ * tests/io.test: Add missing [close $f] to io-73.2.
+
+ * unix/Makefile.in: Update `make dist' target to include the files
+ from the compat/zlib directory as well as all the bundled packages
+ found under the pkgs directory, according to their individual `make
+ dist' targets. Change includes breaking a `configure-packages' target
+ out of the `packages` target.
+
+ * README: Bump version number to 8.6b1
+ * generic/tcl.h:
+ * library/init.tcl:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/configure.in:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+2008-12-19 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.decls: CONSTify TclGetLoadedPackages second param
+ * generic/tclLoad.c
+ * generic/tclIntDecls.h (regenerated)
+
+2008-12-19 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclExecute.c: Fix compile warnings when --enable-symbols=all
+
+ * win/configure.in:
+ * win/Makefile.in: Added build of packages in the 'pkgs/' directory.
+ * win/configure: Autoconf 2.59
+
+2008-12-19 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/makefile.vc: Added build of compat/zlib
+
+2008-12-18 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (Tcl_CloseEx, CloseWrite, CloseChannelPart)
+ (ChanCloseHalf): Rewrite the half-close to properly flush the channel,
+ like is done for a full close, going through FlushChannel, and using
+ the flag BG_FLUSH_SCHEDULED (async flush during close). New functions
+ CloseWrite, CloseChannelPart, new flag CHANNEL_CLOSEDWRITE.
+
+ * tests/chanio.test (chanio-28.[67]): Reactivated these tests.
+ Replaced tclsh -> [interpreter] to get correct executable for the pipe
+ process, and added after cancel to kill the fail timers when we are
+ done. Removed the explicits calls to [flush], now that [close] handles
+ this correctly.
+
+2008-12-18 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/chanio.test: Replaced [chan event] handlers that returned
+ TCL_RETURN return code, with more conventional ones that return TCL_OK
+ to suppress otherwise strange writes of outdated $::errorInfo values
+ to stderr. [Bug 2444274]
+
+ * generic/tclExecute.c: Disabled apparently faulty assertion. [Bug
+ 2415422]
+
+2008-12-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/configure.in, unix/Makefile.in: Autoconf wizardry.
+ * compat/zlib/*: Import of zlib 1.2.3. The license is directly
+ compatible with Tcl's. This import omits the obsolete and contributed
+ parts (i.e. selected directories) and the supplied examples.
+
+ * generic/tclZlib.c: First implementation of the compressing and
+ * doc/zlib.n: decompressing channel transformations.
+ * tests/zlib.test (zlib-8.*):
+
+2008-12-18 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.decls: VOID -> void
+ * generic/tclInt.decls:
+ * compat/dlfcn.h:
+ * generic/tclDecls.h: (regenerated)
+ * generic/tclIntDecls.h:
+
+2008-12-18 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ TIP #332 IMPLEMENTATION - Half-Close for Bidirectional Channels
+
+ * doc/close.n, generic/tclIO.c, generic/tclIOCmd.c:
+ * unix/tclUnixChan.c, unix/tclUnixPipe.c, win/tclWinSock.c:
+ * generic/tcl.decls, generic/tclDecls.h, generic/tclStubInit.c:
+ * tests/chan.test, tests/chanio.test, tests/ioCmd.test:
+
+2008-12-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/SetChanErr.3: General improvements in nroff rendering and some
+ corrections to language issues.
+
+2008-12-17 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclResult.c: Move variable "length" inside if()
+ * generic/tclStringObj.c: Don't use ckfree((void *)...) but
+ * generic/tclVar.c: ckfree((char *)...)
+ * generic/tclZlib.c
+ * generic/tclBasic.c
+
+2008-12-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/namespace.test (namespace-28.1): Make tests not
+ * tests/namespace-old.test (namespace-old-9.5): dependent on the
+ global namespace's particular imports. [Bug 2433936]
+
+2008-12-17 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/Makefile.in: Modify the distclean-packages target so that
+ empty build directories are deleted.
+
+ * unix/Makefile.in: Add build support for collections of TEA
+ * unix/configure.in: packages found under the pkgs directory.
+ [Patch 1163406]. Still needs porting to Windows.
+
+ * unix/configure: autoconf-2.59
+
+2008-12-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tcl.h, generic/tclZlib.c: Removed undocumented flag.
+
+2008-12-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclThreadTest.c: Eliminate -Wwrite-strings warnings in
+ --enable-threads build.
+ * generic/tclExecute.c: Use TclNewLiteralStringObj()
+ * unix/tclUnixFCmd.c: Use TclNewLiteralStringObj()
+ * win/tclWinFCmd.c: Use TclNewLiteralStringObj()
+
+2008-12-16 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP #329 IMPLEMENTATION
+
+ * tests/error.test: Tests for the new commands.
+ * doc/throw.n, doc/try.n: Documentation of the new commands.
+ * library/init.tcl (throw, try): Implementation of commands documented
+ in TIP. This implementation is in Tcl and is a stop-gap until
+ higher-performance ones can be written.
+
+2008-12-16 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Add TIP 338 routines to stub table.
+ * generic/tcl.decls: [Bug 2431338]
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+2008-12-15 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TEBC:INST_DICT_GET): Make sure that the result
+ is empty when generating an error message. [Bug 2431847]
+
+2008-12-15 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclBinary.c: Redefine non-strict decoding to ignore only
+ * doc/binary.n: whitespace. [Bug 2380293]
+ * tests/binary.test:
+
+2008-12-15 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/AddErrInfo.3: Documented Tcl_(Set|Get)ErrorLine (TIP 336).
+ * doc/CrtCommand.3: Various other documentation updates to
+ * doc/CrtInterp.3: reflect the lack of access to Tcl_Interp
+ * doc/Interp.3: fields by default.
+ * doc/SetResult.3:
+ * doc/tcl.decls:
+
+ TIP #338 IMPLEMENTATION
+
+ * doc/AppInit.c: Made routines Tcl_SetStartupScript and
+ * doc/Tcl_Main.3: Tcl_GetStartupScript public. Removed all
+ * generic/tcl.h: internal stub access to Tcl*Startup* routines,
+ * generic/tclInt.decls: and removed their implementations. Their
+ * generic/tclMain.c: function can now be completely performed with
+ the new public interface.
+ *** POTENTIAL INCOMPATIBILITY for callers of the internal
+ Tcl*Startup* routines. ***
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+ * generic/tclDecls.h:
+
+2008-12-14 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/zlib.test: Added constraint so that tests don't fail where
+ they cannot work due to zlib support being missing.
+
+ * unix/configure.in, win/configure.in: Improve the autodetection code.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Remove the assumption of the presence
+ of zlib library on Windows.
+ * win/makefile.vc, win/makefile.bc: Add support for building tclZlib.o
+ but only in stubbed-out mode for now.
+
+2008-12-13 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/TclZlib.3: Basic documentation of the C-level API.
+ * doc/zlib.n: Substantially improve documentation of Tcl-level API.
+ * generic/tclZlib.c (ZlibCmd): Flesh out the argument parsing for the
+ command to integrate with channels.
+
+2008-12-12 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclZlib.c (Tcl_ZlibInflate): Change PATH_MAX to MAXPATHLEN,
+ since MSVC doesn't have PATH_MAX.
+
+ * doc/clock.n: Document new DST fallback rules.
+ * library/clock.tcl (ProcessPosixTimeZone): Fix time change in Eastern
+ Europe (not 3:00 but 4:00 local time). [Bug 2207436]
+
+2008-12-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclZlib.c, unix/configure.in: Added stubs to use when the
+ version of zlib is not capable enough, and automagic to detect when
+ that is the case. [Bug 2421265]
+
+2008-12-12 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * unix/tclUnixNotfy.c: Fix missing CLOEXEC on internal pipes [2417695]
+ * unix/tclUnixPipe.c: Fix missing CLOEXEC on [chan pipe] fds.
+
+2008-12-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclZlib.c (Tcl_ZlibDeflate): Add a bit of extra space for
+ the gzip header. [Bug 2419061]
+ (Tcl_ZlibInflate): Ensure that gzip header extraction is done
+ correctly.
+
+2008-12-12 Kevin Kenny <kennykb@acm.org>
+
+ TIP #322 IMPLEMENTATION
+
+ * doc/NRE.3 (new file): Added documentation of the published API for
+ Non-Recursive Evaluation (NRE).
+
+2008-12-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclZlib.c: Eliminate warning: different 'const' qualifiers
+ with msvc compiler. A few more 'const' optimizations.
+ * win/tcl.m4: Fix Windows build (msvc) for TIP #234 implementation
+ * win/Makefile.in:
+ * win/configure:
+
+2008-12-11 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (SetChannelFromAny and related): Modified the
+ * tests/io.test: internal representation of the tclChannelType to
+ contain not only the ChannelState pointer, but also a reference to
+ the interpreter it was made in. Invalidate and recompute the
+ internal representation when it is used in a different interpreter,
+ like cmdName intrep's. Added testcase. [Bug 2407783]
+
+2008-12-11 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclZlib.c (ConvertError): Factor out code to turn zlib
+ errors into Tcl errors.
+
+ * doc/zlib.n: Added a start at the documentation. Still very rough.
+
+2008-12-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/Makefile.in: Fix Windows build (mingw) for TIP #234
+ implementation (additionally, first make sure that zlib is available,
+ and rename the standard zdll.lib to libz.a, but at least this works so
+ far).
+
+2008-12-11 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/zlib.test: Start of test suite for zlib command.
+
+2008-12-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * library/clock.tcl (ProcessPosixTimeZone): Fallback to European time
+ zone DST rules, when the timezone is between 0 and -12. [Bug 2207436]
+ * tests/clock.test (clock-52.[23]): Test cases for [Bug 2207436]
+
+2008-12-11 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP #234 IMPLEMENTATION
+
+ * generic/tclZlib.c: A very preliminary hack at an interface to the
+ zlib library, based on code from Pascal Scheffers.
+ WARNING! The C API may be subect to change without much warning! USE
+ AT YOUR OWN RISK!
+
+2008-12-10 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata/*: Update from Olson's tzdata2008i.
+
+2008-12-10 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ TIP #343 IMPLEMENTATION - A Binary Specifier for [format/scan]
+
+ * doc/format.n
+ * doc/scan.n
+ * generic/tclInt.h
+ * generic/tclScan.c
+ * generic/tclStrToD.c
+ * generic/tclStringObj.c
+ * tests/format.test
+ * tests/scan.test
+
+2008-12-10 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP #341 IMPLEMENTATION
+
+ * generic/tclDictObj.c (DictFilterCmd): Made key and value filtering
+ * tests/dict.test, doc/dict.n: accept arbitrary numbers of
+ glob arguments.
+
+2008-12-09 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.decls: Restore source and binary compatibility for
+ TIP #337 implementation. (When it is _that_
+ simple, there is no excuse not to do it! :-))
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+2008-12-09 Don Porter <dgp@users.sourceforge.net>
+
+ TIP #337 IMPLEMENTATION
+
+ * doc/BackgdErr.3: Converted internal routine
+ * doc/interp.n: TclBackgroundException() into public routine
+ * generic/tcl.decls: Tcl_BackgroundException().
+ * generic/tclEvent.c:
+ * generic/tclInt.decls:
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+
+ * generic/tclIO.c: Update callers.
+ * generic/tclIOCmd.c:
+ * generic/tclInterp.c:
+ * generic/tclTimer.c:
+ *** POTENTIAL INCOMPATIBILITY only for extensions using the converted
+ internal routine ***
+
+2008-12-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclIO.c (ChanClose,ChanRead,...): Factored out some of the
+ code to connect to channel drivers that was common in multiple
+ locations so as to make code more readable.
+
+2008-12-06 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdAH.c (FileTempfileCmd): Force temporary files to be
+ created in the native filesystem. Attempting to provide a template
+ that puts it elsewhere will result in the directory part of the
+ template being ignored. Partial address of [Bug 2388866] concerns.
+
+2008-12-05 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP #335 IMPLEMENTATION
+
+ * generic/tclBasic.c (Tcl_InterpActive): Added function for working
+ * doc/CrtInterp.3: out if an interp is in use.
+
+ TIP #307 IMPLEMENTATION
+
+ * generic/tclResult.c (Tcl_TransferResult): Renamed function from
+ * generic/tcl.decls: TclTransferResult. Added
+ * doc/SetResult.3: to public stubs table.
+
+2008-12-04 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPathObj.c (Tcl_FSGetNormalizedPath): Added another
+ flag value TCLPATH_NEEDNORM to mark those intreps which need more
+ complete normalization attention for correct results. [Bug 2385549]
+
+2008-12-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * win/tclWinPipe.c (TclpOpenTemporaryFile): Avoid an infinite loop due
+ to GetTempFileName/CreateFile interaction. [Bug 2380318]
+
+2008-12-03 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclFileName.c (DoGlob): One of the Tcl_FSMatchInDirectory
+ calls did not have its return code checked. This caused error messages
+ returned by some Tcl_Filesystem drivers to be swallowed.
+
+2008-12-02 Don Porter <dgp@users.sourceforge.net>
+
+ TIP #336 IMPLEMENTATION
+
+ * generic/tcl.decls: New routines Tcl_(Get|Set)ErrorLine.
+ * generic/tcl.h: Dropped default access to interp->errorLine.
+ * generic/tclCmdAH.c: Restore it with -DUSE_INTERP_ERRORLINE.
+ * generic/tclCmdMZ.c: Updated callers.
+ * generic/tclDictObj.c:
+ * generic/tclIOUtil.c:
+ * generic/tclNamesp.c:
+ * generic/tclOOBasic.c:
+ * generic/tclOODefinedCmds.c:
+ * generic/tclOOMethod.c:
+ * generic/tclProc.c:
+ * generic/tclResult.c:
+ *** POTENTIAL INCOMPATIBILITY for C code directly using the
+ interp->errorLine field ***
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+2008-12-02 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (TclFinalizeIOSubsystem): Replaced Alexandre
+ Ferrieux's first patch for [Bug 2270477] with a gentler version, also
+ supplied by him.
+
+2008-12-01 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParse.c: Coding standards fixups.
+
+2008-12-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/cmdAH.test (cmdAH-32.6): Test was not portable; depended on a
+ C API function not universally available. [Bug 2371623]
+
+2008-11-30 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl (format, ParseClockScanFormat): Added a [string
+ map] to get rid of namespace delimiters before caching a scan or
+ format procedure. [Bug 2362156]
+ * tests/clock.test (clock-64.[12]): Added test cases for the bug that
+ was tickled by a namespace delimiter inside a format string.
+
+2008-11-29 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP #210 IMPLEMENTATION
+
+ * generic/tclCmdAH.c (FileTempfileCmd):
+ * unix/tclUnixFCmd.c (TclpOpenTemporaryFile, DefaultTempDir):
+ * win/tclWinPipe.c (TclpOpenTemporaryFile):
+ * doc/file.n, tests/cmdAH.test: Implementation of [file tempfile]. I
+ do not claim that this is a brilliant implementation, especially on
+ Windows, but it covers the main points.
+
+ * generic/tclThreadStorage.c: General revisions to make code clearer
+ and more like the style used in the rest of the core. Includes adding
+ more comments and explanation of what is going on. Reduce the amount
+ of locking required.
+
+2008-11-27 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tcl.h: Alternate fix for [Bug 2251175]: missing
+ * generic/tclCompile.c: backslash substitution on expanded literals.
+ * generic/tclParse.c:
+ * generic/tclTest.c:
+ * tests/parse.test:
+
+2008-11-26 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclIndexObj.c: Eliminate warning: unused variable
+ * generic/tclTest.c: A few more (harmless) Tcl_SetResult
+ eliminations.
+
+2008-11-26 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tclIndex: Removed reference to no-longer-extant procedure
+ 'tclLdAout'.
+ * doc/library.n: Corrected mention of 'auto_exec' to 'auto_execok'.
+ [Patch 2114900] thanks to Stuart Cassoff <stwo@users.sf.net>
+
+2008-11-25 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclIndexObj.c: Eliminate 3 calls to Tcl_SetResult, as
+ * generic/tclIO.c: examples how it should have been done.
+ * generic/tclTestObj.c: purpose: contribute in the TIP #340
+ discussion.
+
+2008-11-25 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (TclFinalizeIOSubsystem): Applied Alexandre
+ Ferrieux's patch for [Bug 2270477] to prevent infinite looping during
+ finalization of channels not bound to interpreters.
+
+2008-11-25 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclTest.c: Don't assume that Tcl_SetResult sets
+ interp->result, especially not in a DString test, in preparation for
+ TIP #340
+
+2008-11-24 Donal K. Fellows <dkf@users.sf.net>
+
+ * tools/tcltk-man2html.tcl: Improvements to tackle tricky aspects of
+ cross references and new entities to map. [Bug 2330040]
+
+2008-11-19 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclThreadTest.c: Convert Tcl_SetResult(......, TCL_DYNAMIC)
+ to Tcl_SetResult(......, TCL_VOLATILE), in preparation for TIP #340
+
+2008-11-17 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.decls: Fix signature and implementation of
+ * generic/tclDecls.h: Tcl_HashStats, such that it conforms to the
+ * generic/tclHash.c: documentation. [Bug 2308236]
+ * generic/tclVar.c:
+ * doc/Hash.3:
+ * generic/tclDictObj.c: Convert Tcl_SetResult call to
+ Tcl_SetObjResult.
+
+2008-11-17 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * tests/for.test: Check for uncompiled-for-continue [Bug 2186888]
+ fixed earlier.
+
+ * generic/tcl.h: Fix [Bug 2251175]: missing backslash
+ * generic/tclCompCmds.c: substitution on expanded literals.
+ * generic/tclCompile.c
+ * generic/tclParse.c
+ * generic/tclTest.c
+ * tests/compile.test
+ * tests/parse.test
+
+2008-11-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclTest.c: Replace two times Tcl_SetResult with
+ Tcl_SetObjResult, a little simplification in preparation for the TIP
+ #340 patch.
+
+2008-11-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.h: Rename static function FSUnloadTempFile to
+ * generic/tclIOUtil.c: TclFSUnloadTempFile, needed in tclLoad.c
+
+ * generic/tclLoad.c: Fixed [Bug 2269431]: Load of shared
+ objects leaves temporary files on windows.
+
+2008-11-12 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/registry.test: Use HKCU to avoid requiring admin access for
+ registry testing on Vista/Server2008
+
+2008-11-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclNamesp.c: Eliminate warning: passing arg 4 of
+ Tcl_SplitList from incompatible pointer type.
+ * win/tcl.m4: Reverted change from 2008-11-06 (was under the
+ impression that "-Wno-implicit-int" added an extra
+ warning)
+ * win/configure: (regenerated)
+ * unix/tcl.m4: Use -O2 as gcc optimization compiler flag, and get rid
+ of -Wno-implicit-int for UNIX.
+ * unix/configure: (regenerated)
+
+2008-11-10 Andreas Kupries <andreask@activestate.com>
+
+ * doc/platform_shell.n: Fixed [Bug 2255235], reported by Ulrich
+ * library/platform/pkgIndex.tcl: Ring <uring@users.sourceforge.net>.
+ * library/platform/shell.tcl: Updated the LOCATE command in the
+ * library/tm.tcl: package 'platform::shell' to handle the new form
+ * unix/Makefile.in: of 'provide' commands generated by tm.tcl. Bumped
+ * win/Makefile.in: package to version 1.1.4. Added cross-references
+ to the relevant parts of the code to avoid future desynchronization.
+
+2008-11-07 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tclInt.h: Applied [Patch 2215022] from Duoas to clean up
+ * generic/tclBinary.c: the binary ensemble initiailization code.
+ * generic/tclNamesp.c: Extends the TclMakeEnsemble to do
+ * doc/ByteArrObj.3: sub-ensembles from tables.
+
+2008-11-06 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tcl.m4: Add "-Wno-implicit-int" flag for gcc, as on UNIX
+ * win/configure: (regenerated)
+ * generic/tclIO.c: Eliminate an 'array index out of bounds' warning
+ on HP-UX.
+
+2008-11-04 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclPort.h: Remove the ../win/ header dir as the build system
+ already has it, and it confuses builds when used with private headers
+ installed.
+
+2008-11-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.h (TCLOO_VERSION): Bump version of TclOO.
+
+2008-10-31 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOBasic.c (TclOONRUpcatch): Reworked the code that does
+ * generic/tclOO.c (InitFoundation): class constructor handling so
+ that it is more robust and runs the constructor call in the context of
+ the caller of the class's constructor method. Needed because the
+ previously used code did not work at all after applying the fix below;
+ no Tcl existing command could reliably do what was needed any more.
+
+ * generic/tclOODefineCmds.c (GetClassInOuterContext): Rework and
+ factor out the code to resolve class names in definitions so that
+ classes are resolved from the perspective of the caller of the
+ [oo::define] command, rather than from the oo::define namespace! This
+ makes much code simpler by reducing how often fully-qualified names
+ are required (previously always in practice, so no back-compat issues
+ exist). [Bug 2200824]
+
+2008-10-28 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclCompile.h: CONSTify TclDTraceInfo
+ * generic/tclBasic.c:
+ * generic/tclProc.c:
+ * generic/tclEnv.c: Eliminate some -Wwrite-strings warnings
+ * generic/tclLink.c:
+
+2008-10-27 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclEncoding.c: Use "iso8859-1" and not "identity" as
+ the default and original [encoding system] value. Since "iso8859-1" is
+ built in to the C source code for Tcl now, there's no availability
+ issue, and it has the good feature of "identity" that we must have
+ ("bytes in" == "bytes out") without the bad feature of "identity"
+ ("broken as designed") that makes us want to abandon it. [RFE 2008609]
+ *** POTENTIAL INCOMPATIBILITY for older releases of Tclkit and any
+ other code expecting a particular value for Tcl's default system
+ encoding ***
+
+2008-10-24 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/http/http.tcl: Fixed a failure to read SHOUTcast streams
+ with the new 2.7 package. Introduced a new intial state as the first
+ response may not be HTTP*.
+
+2008-10-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdAH.c (ForNextCallback): handle TCL_CONTINUE in the for
+ body. [Bug 2186888]
+
+2008-10-22 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: CONST -> const and white-spacing
+ * generic/tclCompile.h:
+ * generic/tclEncoding.c:
+ * generic/tclStubInit.c:
+ * generic/tclStubLib.c:
+ * generic/tcl.decls
+ * generic/tclInt.decls
+ * generic/tclTomMath.decls
+ * generic/tclDecls.h: (regenerated)
+ * generic/tclIntDecls.h: (regenerated)
+ * generic/tclIntPlatDecls.h: (regenerated)
+ * generic/tclOODecls.h: (regenerated)
+ * generic/tclOOIntDecls.h: (regenerated)
+ * generic/tclPlatDecls.h: (regenerated)
+ * generic/tclTomMathDecls.h: (regenerated)
+ * generic/tclIntDecls.h: (regenerated)
+ * tools/genStubs.tcl: CONST -> const and white-spacing
+
+2008-10-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclProc.c: Reset -level and -code values to defaults
+ after they are used. [Bug 2152286]
+
+2008-10-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c (TclInfoCoroutineCmd): Added code to make this
+ check for being invoked in a syntactically correct way.
+
+ * doc/info.n: Added documentation of [info coroutine].
+
+ * doc/prefix.n: Improved the documentation by fixing formatting,
+ adding good-practice recommendations and cross-references, etc.
+
+2008-10-17 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclOO.decls: CONST -> const.
+ * generic/tclOODecls.h: (regenerated)
+ * generic/tclOOIntDecls.h: (regenerated)
+
+2008-10-17 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIORTrans.c (DeleteReflectedTransformMap): Removed debug
+ output in C++ comment.
+
+2008-10-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.h: Declare the internal tclInstructionTable to
+ * generic/tclExecute.c: simply be "const", not CONST86.
+
+ * generic/tclCmdAH.c: whitespace.
+ * generic/tclCmdIL.c: Uninitialized variable warning.
+ * generic/tclTest.c: const correctness warning.
+
+2008-10-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/*: Many very small formatting fixes.
+ * doc/{glob,http,if}.n: More substantial reformatting for clarity.
+ * doc/split.n: Remove mention of defunct c.l.t.announce
+
+2008-10-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/regc_locale.c: Add "const" to many internal const tables.
+ * generic/tclClock.c: No functional or API change.
+ * generic/tclCmdIL.c
+ * generic/tclConfig.c
+ * generic/tclDate.c
+ * generic/tclEncoding.c
+ * generic/tclEvent.c
+ * generic/tclExecute.c
+ * generic/tclFileName.c
+ * generic/tclGetDate.y
+ * generic/tclInterp.c
+ * generic/tclIO.c
+ * generic/tclIOCmd.c
+ * generic/tclIORChan.c
+ * generic/tclIORTrans.c
+ * generic/tclLoad.c
+ * generic/tclObj.c
+ * generic/tclOOBasic.c
+ * generic/tclOOCall.c
+ * generic/tclOOInfo.c
+ * generic/tclPathObj.c
+ * generic/tclPkg.c
+ * generic/tclResult.c
+ * generic/tclStringObj.c
+ * generic/tclTest.c
+ * generic/tclTestObj.c
+ * generic/tclThreadTest.c
+ * generic/tclTimer.c
+ * generic/tclTrace.c
+ * macosx/tclMacOSXFCmd.c
+ * win/cat.c
+ * win/tclWinInit.c
+ * win/tclWinTest.c
+
+2008-10-16 Don Porter <dgp@users.sourceforge.net>
+
+ * library/init.tcl: Revised [unknown] so that it carefully
+ preserves the state of the ::errorInfo and ::errorCode variables at
+ the start of auto-loading and restores that state before the
+ autoloaded command is evaluated. [Bug 2140628]
+
+2008-10-15 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.h: Add "const" to many internal const tables, so
+ * generic/tclBinary.c: those will be put by the C-compiler in the
+ * generic/tclCompile.c: TEXT segment in stead of the DATA segment.
+ * generic/tclDictObj.c: This makes those tables sharable in shared
+ * generic/tclHash.c: libraries.
+ * generic/tclListObj.c:
+ * generic/tclNamesp.c:
+ * generic/tclObj.c:
+ * generic/tclProc.c:
+ * generic/tclRegexp.c:
+ * generic/tclStringObj.c:
+ * generic/tclUtil.c:
+ * generic/tclVar.c:
+
+2008-10-14 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclCmdAH.c: Fix minor compiler warnings when compiling
+ * generic/tclCmdMZ.c: with -Wwrite-strings.
+ * generic/tclIndexObj.c:
+ * generic/tclProc.c:
+ * generic/tclStubLib.c:
+ * generic/tclUtil.c:
+ * win/tclWinChan.c:
+ * win/tclWinDde.c:
+ * win/tclWinInit.c:
+ * win/tclWinReg.c:
+ * win/tclWinSerial.c:
+
+2008-10-14 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/binary.n: Formatting fix.
+
+2008-10-14 Don Porter <dgp@users.sourceforge.net>
+
+ * README: Bump version number to 8.6a4
+ * generic/tcl.h:
+ * library/init.tcl:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/configure.in:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+ * generic/tclExecute.c: Fix compile warnings when --enable-symbols=all
+
+ * generic/tclCmdIL.c: Fix write to unallocated memory whenever
+ [lrepeat] returns an empty list.
+
+2008-10-14 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/chan.n, doc/fconfigure.n: Added even more emphatic text to
+ direct people to the correct manual pages for specific channel types,
+ suitable for the hard-of-reading. Following discussion on tcl-core.
+
+2008-10-13 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/tclWinThrd.c (TclpThreadCreate): We need to initialize the
+ thread id variable to 0 as on 64 bit windows this is a pointer sized
+ field while windows only fills it with a 32 bit value. The result is
+ an inability to join the threads as the ids cannot be matched.
+
+ * generic/tclTest.c (TestNRELevels): Set array to the right size.
+
+2008-10-13 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOInfo.c (InfoClassDestrCmd): Handle error case.
+
+ * generic/tclOOInt.h: Added macro magic to make things work with
+ Objective C. [Bug 2163447]
+
+2008-10-12 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c: Fix bug in srcDelta encoding within ByteCodes.
+ The bug can only be triggered under conditions that cannot happen in
+ Tcl, but were met during development of L. Thanks go to Robert Netzer
+ for diagnosis and fix.
+
+2008-10-10 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.6a3 TAGGED FOR RELEASE ***
+
+ * changes: Updates for 8.6a3 release.
+
+2008-10-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOODefineCmds.c (TclOODefineUnexportObjCmd)
+ (TclOODefineExportObjCmd): Corrected export/unexport record synthesis.
+ [Bug 2155658]
+
+2008-10-08 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tclUnixChan.c: Fix minor compiler warning.
+ * unix/tcl.m4: Fix for [Bug 2073255]
+ * unix/configure: Regenerated
+
+2008-10-08 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic (TclInfoCoroutineCmd):
+ * tests/unsupported.test: Arrange for [info coroutine] to return {}
+ when a coroutine is running but the resume command has been deleted.
+ [Bug 2153080]
+
+2008-10-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclTrace.c: Corrected handling of errors returned by
+ variable traces so that the errorInfo value contains the original
+ error message. [Bug 2151707]
+
+ * generic/tclVar.c: Revised implementation of TclObjVarErrMsg so
+ that error message construction does not disturb an existing
+ iPtr->errorInfo that may be in progress.
+
+2008-10-07 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/binary.n: Added better documentation of the [binary encode] and
+ [binary decode] subcommands.
+
+2008-10-07 Miguel Sofer <msofer@users.sf.net>
+
+ TIP #327,#328 IMPLEMENTATIONS
+
+ * generic/tclBasic.c: Move [tailcall], [coroutine] and
+ * generic/tclCmdIL.c: [yield] out of ::tcl::unsupported
+ * tclInt.h:
+ * tests/info.test: and into global scope: TIPs #327
+ * tests/unsupported.test: and #328
+
+2008-10-07 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/chan.n, doc/transchan.n: Documented the channel transformation
+ API of TIP #230.
+
+2008-10-06 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/winFCmd.test: Fixed some erroneous tests on Vista+.
+ * generic/tclFCmd.c: Fix constness for msvc of last commit
+
+2008-10-06 Joe Mistachkin <joe@mistachkin.com>
+
+ * tools/man2tcl.c: Added missing line from patch by Harald Oehlmann.
+ [Bug 1934200]
+
+2008-10-05 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * doc/FileSystem.3: CONSTified Tcl_FSFileAttrStringsProc
+ * generic/tclFCmd.c: and tclpFileAttrStrings. This allows
+ * generic/tclIOUtil.c: FileSystems to report their attributes
+ * generic/tclTest.c: as const strings, without worrying that
+ * unix/tclUnixFCmd.c: Tcl modifies them (which Tcl should not
+ * win/tclWinFCmd.c: do anyway, but the API didn't indicate that)
+ * generic/tcl.decls
+ * generic/tclDecls.h: regenerated
+ * generic/tcl.h: Make sure that if CONST84 is defined as empty,
+ CONST86 should be defined as empty as well
+ (unless overridden). This change complies with
+ TIP #27
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2008-10-05 Kevin B, Kenny <kennykb@acm.org>
+
+ * libtommath/bn_mp_sqrt.c (bn_mp_sqrt): Handle the case where a
+ * tests/expr.test (expr-47.13): number's square root is
+ between n<<DIGIT_BIT and n<<DIGIT_BIT+1. [Bug 2143288]
+ Thanks to Malcolm Boffey (malcolm.boffey@virgin.net) for the patch.
+
+ TIP #331 IMPLEMENTATION
+
+ * doc/lset.n:
+ * generic/tclListObj.c (TclLsetFlat):
+ * tests/lset.test: Modified the [lset] command so that it allows for
+ an index of 'end+1', which has the effect of appending an element to
+ the list.
+
+2008-10-05 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.decls: CONSTified the AuxDataType argument
+ * generic/tclCompCmds.c: of TclCreateAuxData and
+ * generic/tclCompile.c: TclRegisterAuxDataType and the return
+ * generic/tclCompile.h: values of TclGetAuxDataType and
+ * generic/tclExecute.c: TclGetInstructionTable
+ * generic/tclIntDecls.h: regenerated
+ This change complies with TIP #27 (even though it only involves
+ internal function, so this is not even necessary).
+
+2008-10-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclIndexObj.c (TclInitPrefixCmd): Make the [tcl::prefix]
+ into an exported command. [Bug 2144595]
+
+2008-10-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdIL.c (InfoFrameCmd): Improved hygiene of result
+ * generic/tclRegexp.c (TclRegAbout): handling.
+
+2008-10-04 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclLoad.c: Make sure that any library which doesn't have an
+ unloadproc is only really unloaded when no library code is executed
+ yet. [Bug 2059262]
+
+2008-10-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOInfo.c (GetClassFromObj): Factor out the code to parse
+ a Tcl_Obj and get a class. Also make result handling hygienic.
+ * generic/tclOOBasic.c (TclOOSelfObjCmd): Better hygiene of results,
+ and stop allocating quite so much memory by sharing special "method"
+ names.
+
+2008-10-04 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * doc/ChnlStack.3: CONSTified the typePtr argument
+ * doc/CrtChannel.3: of Tcl_CreateChannel and Tcl_StackChannel
+ * generic/tcl.decls: and the return value of Tcl_GetChannelType
+ * generic/tcl.h
+ * generic/tclIO.h
+ * generic/tclIO.c
+ * generic/tclDecls.h: regenerated
+ This change complies with TIP #27.
+
+ * doc/Hash.3: CONSTified the typePtr argument
+ * generic/tcl.decls: of Tcl_InitCustomHashTable.
+ * generic/tcl.h
+ * generic/tclHash.c
+ * generic/tclDecls.h: regenerated
+ This change complies with TIP #27.
+
+ * doc/RegConfig.3: CONSTified the configuration argument
+ * generic/tcl.decls: of Tcl_RegisterConfig.
+ * generic/tcl.h
+ * generic/tclConfig.c
+ * generic/tclPkgConfig.c
+ * generic/tclDecls.h: regenerated
+ This change complies with TIP #27.
+
+ * doc/GetIndex.3: CONSTified the tablePtr argument
+ * generic/tcl.decls: of Tcl_GetIndexFromObj.
+ * generic/tclIndexObj.c
+ * generic/tclDecls.h: regenerated
+ This change complies with TIP #27.
+
+2008-10-03 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/stack.test:
+ * unix/tclUnixTest.c: Removed test command teststacklimit and the
+ corresponding constraint: it is not needed with NRE
+
+2008-10-03 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP #195 IMPLEMENTATION
+
+ * generic/tclIndexObj.c (TclGetIndexFromObjList, PrefixMatchObjCmd)
+ * doc/prefix.n, tests/string.test: Added [tcl::prefix] command for
+ working with prefixes of strings at the Tcl level. [Patch 1040206]
+
+ TIP #265 IMPLEMENTATION
+
+ * generic/tclIndexObj.c (Tcl_ParseArgsObjv, PrintUsage):
+ * generic/tcl.h (Tcl_ArgvInfo): Added function for simple parsing of
+ * doc/ParseArgs.3 (new file): optional arguments to commands. Still
+ needs tests and the like. [FRQ 1446696] Note that some of the type
+ signatures are changed a bit from the proposed implementation so that
+ they better reflect codified good practice for argument order.
+
+2008-10-02 Andreas Kupries <andreask@activestate.com>
+
+ * tests/info.test (info-23.3): Updated output of the test to handle
+ the NRE-enabled eval and the proper propagation of location
+ information through it. [Bug 2017632]
+
+ * doc/info.n: Rephrased the documentation of 'info frame' for positive
+ numbers as level argument. [Bug 2134049]
+
+ * tests/info.test (info-22.8): Made pattern for file containing
+ tcltest less specific to accept both .tcl and .tm variants of the file
+ during matching. [Bug 2129828]
+
+2008-10-02 Don Porter <dgp@users.sourceforge.net>
+
+ TIP #330 IMPLEMENTATION
+
+ * generic/tcl.h: Remove the "result" and "freeProc" fields
+ * generic/tclBasic.c: from the default public declaration of the
+ * generic/tclResult.c: Tcl_Interp struct. Code should no longer
+ * generic/tclStubLib.c: be accessing these fields. Access can be
+ * generic/tclTest.c: restored by defining USE_INTERP_RESULT, but
+ * generic/tclUtil.c: that should only be a temporary migration aid.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2008-10-02 Joe Mistachkin <joe@mistachkin.com>
+
+ * doc/info.n: Fix unmatched font change.
+ * doc/tclvars.n: Fix unmatched font change.
+ * doc/variable.n: Fix unmatched font change.
+ * tools/man2help2.tcl: Integrated patch from Harald Oehlmann.
+ [Bug 1934272]
+ * tools/man2tcl.c: Increase MAX_LINE_SIZE to fix "Too long line" error.
+ * win/buildall.vc.bat: Prefer the HtmlHelp target over the WinHelp
+ target. [Bug 2072891]
+ * win/makefile.vc: Fix the HtmlHelp and WinHelp targets to not be
+ mutually exclusive.
+
+2008-09-29 Don Porter <dgp@users.sourceforge.net>
+
+ TIP #323 IMPLEMENTATION (partial)
+
+ * doc/glob.n: Revise [glob] to accept zero patterns.
+ * generic/tclFileName.c:
+ * tests fileName.test:
+
+ * doc/linsert.n: Revise [linsert] to accept zero elements.
+ * generic/tclCmdIL.c:
+ * tests/linsert.test:
+
+2008-09-29 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP #326 IMPLEMENTATION
+
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): Added -stride option to carry
+ * doc/lsort.n, tests/cmdIL.test: out sorting of lists where the
+ elements are grouped. Adapted from [Patch 2082681]
+
+ TIP #313 IMPLEMENTATION
+
+ * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Added -bisect option to
+ * doc/lsearch.n, tests/lsearch.test: allow the finding of the
+ place to insert an element in a sorted list when that element is
+ not already there. [Patch 1894241]
+
+ TIP #318 IMPLEMENTATION
+
+ * generic/tclCmdMZ.c (StringTrimCmd,StringTrimLCmd,StringTrimRCmd):
+ Update the default set of trimmed characters to include some from the
+ larger UNICODE space. Factor out the default trim set into a macro so
+ that it is easier to keep them in synch.
+
+2008-09-28 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP #314 IMPLEMENTATION
+
+ * generic/tclCompCmds.c (TclCompileEnsemble)
+ * generic/tclNamesp.c (NamespaceEnsembleCmd)
+ (Tcl_SetEnsembleParameterList, Tcl_GetEnsembleParameterList)
+ (NsEnsembleImplementationCmdNR):
+ * generic/tcl.decls, doc/Ensemble.3, doc/namespace.n
+ * tests/namespace.test: Allow the handling of a (fixed) number of
+ formal parameters between an ensemble's command and subcommand at
+ invokation time. [Patch 1901783]
+
+2008-09-28 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Fix the numLevels computations on
+ * generic/tclInt.h: coroutine yield/resume
+ * tests/unsupported.test:
+
+2008-09-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclFileName.c (Tcl_GetBlock*FromStat): Made this work
+ acceptably when working with OSes that don't support reporting the
+ block size from the stat() call. [Bug 2130726]
+
+ * generic/tclCmdIL.c (Tcl_LrepeatObjCmd): Improve the handling of the
+ case where the combination of number of elements and repeat count
+ causes the resulting list to be too large. [Bug 2130992]
+
+2008-09-26 Don Porter <dgp@users.sourceforge.net>
+
+ TIP #323 IMPLEMENTATION (partial)
+
+ * doc/lrepeat.n: Revise [lrepeat] to accept both zero
+ * generic/tclCmdIL.c: repetitions and zero elements to be repeated.
+ * tests/lrepeat.test:
+
+ * doc/object.n: Revise standard oo method [my variable] to
+ * generic/tclOOBasic.c: accept zero variable names.
+ * tests/oo.test:
+
+ * doc/tm.n: Revise [tcl::tm::path add] and
+ * library/tm.tcl: [tcl::tm::path remove] to accept zero paths.
+ * tests/tm.test:
+
+ * doc/namespace.n: Revise [namespace upvar] to accept zero
+ * generic/tclNamesp.c: variable names.
+ * tests/upvar.test:
+
+ * doc/lassign.n: Revise [lassign] to accept zero variable names.
+ * generic/tclCmdIL.c:
+ * tests/cmdIL.test:
+
+2008-09-26 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.h (TCLOO_VERSION): Bump the version.
+
+2008-09-25 Don Porter <dgp@users.sourceforge.net>
+
+ TIP #323 IMPLEMENTATION (partial)
+
+ * doc/global.n: Revise [global] to accept zero variable names.
+ * doc/variable.n: Revise [variable] likewise.
+ * generic/tclVar.c:
+ * tests/proc-old.test:
+ * tests/var.test:
+
+ * doc/global.n: Correct false claim about [info locals].
+
+2008-09-25 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP #315 IMPLEMENTATION
+
+ * tests/platform.test: Update tests to expect revised results
+ * tests/safe.test: corresponding to the TIP 315 change.
+
+ * unix/tclUnixInit.c, win/tclWinInit.c (TclpSetVariables):
+ * doc/tclvars.n (tcl_platform): Define what character is used for
+ separating PATH-like lists. Forms part of the tcl_platform array.
+
+ * generic/tclOOCall.c (InitCallChain, IsStillValid):
+ * tests/oo.test (oo-25.2): Revise call chain cache management so that
+ it takes into account class-wide caching correctly. [Bug 2120903]
+
+2008-09-24 Don Porter <dgp@users.sourceforge.net>
+
+ TIP #323 IMPLEMENTATION (partial)
+
+ * doc/file.n: Revise [file delete] and [file mkdir] to
+ * generic/tclCmdAH.c: accept zero "pathname" arguments (the
+ * generic/tclFCmd.c: no-op case).
+ * tests/cmdAH.test:
+ * tests/fCmd.test:
+
+2008-09-24 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOMethod.c (DBPRINT): Remove obsolete debugging macro.
+ [Bug 2124814]
+
+ TIP #316 IMPLEMENTATION
+
+ * generic/tcl.decls, generic/tclFileName.c (Tcl_GetSizeFromStat, etc):
+ * doc/FileSystem.3: Added reader functions for Tcl_StatBuf.
+
+2008-09-23 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/Method.3: Corrected documentation. [Patch 2082450]
+
+ * doc/lreverse.n, mathop.n, regexp.n, regsub.n: Make sure that the
+ initial line of the manpage includes nothing that chokes old versions
+ of man. [Bug 2118123]
+
+2008-09-22 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP #320 IMPLEMENTATION
+
+ * generic/tclOODefineCmds.c (TclOODefineVariablesObjCmd):
+ * generic/tclOOInfo.c (InfoObjectVariablesCmd, InfoClassVariablesCmd):
+ * generic/tclOOMethod.c (TclOOSetupVariableResolver, etc):
+ * doc/define.n, doc/ooInfo.n, benchmarks/cps.tcl:
+ * tests/oo.test (oo-26.*): Allow the declaration of the common
+ variables used in methods of a class or object. These are then mapped
+ in using a variable resolver. This makes many class declarations much
+ simpler overall, encourages good usage of variable names, and also
+ boosts speed a bit.
+
+ * generic/tclOOMethod.c (TclOOGetMethodBody): Factor out the code to
+ get the body of a procedure-like method. Reduces the amount of "poking
+ inside the abstraction" that is done by the introspection code.
+
+2008-09-22 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * doc/chan.n: Clean up paragraph order.
+
+2008-09-18 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (NEXT_INST_F):
+ * generic/tclInt.h (TCL_CT_ASSERT): New compile-time assertions,
+ adapted from www.pixelbeat.org/programming/gcc/static_assert.html
+
+2008-09-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: Correct the TclGetLongFromObj, TclGetIntFromObj,
+ and TclGetIntForIndexM macros so that they retrieve the longValue
+ field from the internalRep instead of casting the otherValuePtr field
+ to type long.
+
+2008-09-17 Miguel Sofer <msofer@users.sf.net>
+
+ * library/init.tcl: Export min and max commands from the mathfunc
+ namespace. [Bug 2116053]
+
+2008-09-16 Joe Mistachkin <joe@mistachkin.com>
+
+ * generic/tclParse.c: Move TclResetCancellation to be called on
+ returning to level 0, as opposed to it being called on starting a
+ substitution at level 0.
+
+2008-09-16 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Move TclResetCancellation to be called on
+ returning to level 0, as opposed to it being called on starting a
+ command at level 0. Add a call on returning via Tcl_EvalObjEx to fix
+ [Bug 2114165].
+
+2008-09-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/binary.n: Added partial documentation of [binary encode] and
+ [binary decode].
+
+ * tests/binary.test,cmdAH.test,cmdIL.test,cmdMZ.test,fileSystem.test:
+ More use of tcltest2 to simplify the tests as exposed to people.
+ * tests/compile.test (compile-18.*): Added *some* tests of the
+ disassmbler, though not of its output format.
+
+2008-09-10 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/nre.test: Add missing constraints; enable test of foreach
+ recursion.
+
+ * generic/tclBasic.c:
+ * generic/tclCompile.h:
+ * generic/tclExecute.c (INST_EVAL_STK): Wrong numLevels when evaling a
+ canonical list. [Bug 2102930]
+
+2008-09-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclListObj.c (Tcl_ListObjGetElements): Make this list->dict
+ transformation - encountered when using [foreach] with dicts - not as
+ expensive as it was before. Spotted by Kieran Elby and reported on
+ tcl-core.
+
+2008-09-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/append.test, appendComp.test, cmdAH.test: Use the powers of
+ tcltest2 to make these files simpler.
+
+2008-09-07 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c (TclCompileTokens):
+ * generic/tclExecute.c (CompileExprObj): Fix a perf bug (found by Alex
+ Ferrieux) where some variables in the LVT where not being accessed by
+ index. Fix missing localCache management in compiled expressions found
+ while analyzing the bug.
+
+2008-09-07 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/namespace.n: Fix [Bug 2098441]
+
+2008-09-04 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclTrace.test (TraceVarProc):
+ * generic/unsupported.test: Insure that unset traces are run even when
+ the coroutine is unwinding. [Bug 2093947]
+
+ * generic/tclExecute.c (CACHE_STACK_INFO):
+ * tests/unsupported.test: Restore execEnv's bottomPtr. [Bug 2093188]
+
+2008-09-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Stripped "callers" of the _ANSI_ARGS_ macro
+ * compat/dirent2.h: to support a TCL_NO_DEPRECATED build.
+ * compat/dlfcn.h:
+ * unix/tclUnixPort.h:
+
+ * generic/tcl.h: Removed the conditional #define of
+ _ANSI_ARGS_ that would support pre-prototype C compilers. Since
+ _ANSI_ARGS_ is no longer used in tclDecls.h, it's clear no one
+ compiling against Tcl 8.5 headers is making use of a -DNO_PROTOTYPES
+ configuration.
+
+2008-09-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/socket.test: Rewrote so as to use tcltest2 better.
+
+2008-09-01 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdAH.c: NRE-enabling [eval]; eval scripts are now
+ * generic/tclOOBasic.c: bytecompiled. Adapted recursion limit tests
+ * tests/interp.test: that were relying on eval not being
+ * tests/nre.test: compiled. Part of the [Bug 2017632] project.
+ * tests/unsupported.test:
+
+2008-09-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOMethod.c (InvokeProcedureMethod):
+ * generic/tclOO.c (ObjectRenamedTrace): Arrange for only methods that
+ involve callbacks into the Tcl interpreter to be skipped when the
+ interpreter is being torn down. Allows the semantics of destructors in
+ a dying interpreter to be more useful when they're implemented in C.
+
+2008-08-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/Makefile.in: Ensure that all TclOO headers get installed.
+ * win/Makefile.in: [Bug 2082299]
+ * win/makefile.bc:
+ * win/makefile.vc:
+
+2008-08-28 Don Porter <dgp@users.sourceforge.net>
+
+ * README: Bump version number to 8.6a3
+ * generic/tcl.h:
+ * library/init.tcl:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/configure.in:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+2008-08-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/tclvars.n, doc/library.n: Ensured that these two manual pages
+ properly cross-reference each other. Issue reported on Tcler's Chat.
+
+2008-08-26 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (InfoCoroutine):
+ * tests/unsupported.test: New command that returns the FQN of the
+ currently executing coroutine. Lives as infoCoroutine under
+ unsupported, but is designed to become a subcommand of [info]
+
+2008-08-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (NRInterpCoroutine): Store the caller's eePtr,
+ stop assuming the coroutine is invoked from the same execEnv where it
+ was created.
+
+2008-08-24 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdAH.c (TclNRForeachCmd): Converted the [foreach]
+ command to have an NRE-aware non-compiled implementation. Part of the
+ [Bug 2017632] project. Also restructured the code so as to manage its
+ temporary memory more efficiently.
+
+2008-08-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Removed unused var; fixed function pointer
+ * generic/tclOOInt.h: declarations (why did gcc start complaining
+ * generic/tclOOMethod.c: all of a sudden?)
+ * generic/tclProc.c:
+
+2008-08-23 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclInt.h (EnsembleImplMap): Added extra field to make it
+ * generic/tclNamesp.c (TclMakeEnsemble): easier to build non-recursive
+ ensembles in the core.
+
+ * generic/tclDictObj.c (DictForNRCmd): Converted the [dict for]
+ command to have an NRE-aware non-compiled implementation. Part of the
+ [Bug 2017632] project.
+
+2008-08-22 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c:
+ * generic/tclExecute.c: Set special errocodes: COROUTINE_BUSY,
+ COROUTINE_CANT_YIELD, COROUTINE_ILLEGAL_YIELD.
+
+2008-08-22 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.6a2 TAGGED FOR RELEASE ***
+
+ * changes: Updates for 8.6a2 release.
+
+ * generic/tcl.h: Drop use of USE_COMPAT85_CONST. That added
+ indirection without value. Use -DCONST86="" to engage source compat
+ support for code written for 8.5 headers.
+
+ * generic/tclUtil.c (TclReToGlob): Added missing set of the
+ *exactPtr value to really fix [Bug 2065115]. Also avoid possible
+ DString overflow.
+ * tests/regexpComp.test: Correct duplicate test names.
+
+2008-08-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Previous fix, now done right.
+ * generic/tclCmdIL.c:
+ * generic/tclInt.h:
+ * tests/unsupported.test:
+
+2008-08-21 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/regexp.test, tests/regexpComp.test: Correct re2glob ***=
+ * generic/tclUtil.c (TclReToGlob): translation from exact
+ to anywhere-in-string match. [Bug 2065115]
+
+2008-08-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Reduced the use of CONST86 and eliminated
+ * generic/tcl.decls: the use of CONST86_RETURN to support source
+ code compatibility with Tcl 8.5 on those public routines passing
+ (Tcl_Filesystem *), (Tcl_Timer *), and (Tcl_Objtype *) values which
+ have been const-ified. What remains is the minimum configurability
+ needed to support code written for pre-8.6 headers via the new
+ -DUSE_COMPAT85_CONST compiler directive.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+ * generic/tclDecls.h: make genstubs
+
+2008-08-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Fix the cmdFrame level count in
+ * generic/tclCmdIL.c: coroutines. Fix small bug on coroutine
+ * generic/tclInt.h: rewind.
+
+2008-08-21 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclProc.c (Tcl_DisassembleObjCmd): Added ability to
+ disassemble TclOO methods. The code to do this is very ugly.
+
+2008-08-21 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tclOOMethod.c: Added casts to make MSVC happy
+ * generic/tclBasic.c:
+
+2008-08-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c (AllocObject): Suppress compilation of commands in
+ the namespace allocated for each object.
+ * generic/tclOOMethod.c (PushMethodCallFrame): Restore some of the
+ hackery that makes calling methods of classes fast. Fixes performance
+ problem introduced by the fix of [Bug 2037727].
+
+ * generic/tclCompile.c (TclCompileScript): Allow the suppression of
+ * generic/tclInt.h (NS_SUPPRESS_COMPILATION): compilation of commands
+ * generic/tclNamesp.c (Tcl_CreateNamespace): from a namespace or its
+ children.
+
+2008-08-20 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclTest.c (TestconcatobjCmd): Fix use of internal-only
+ TclInvalidateStringRep macro. [Bug 2057479]
+
+2008-08-17 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Implementation of [coroutine] and [yield]
+ * generic/tclCmdAH.c: commands (in tcl::unsupported).
+ * generic/tclCompile.h:
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * tests/unsupported.test:
+
+ * generic/tclTest.c (TestconcatobjCmd):
+ * generic/tclUtil.c (Tcl_ConcatObj):
+ * tests/util.test (util-4.7):
+ Fix [Bug 1447328]; the original "fix" turned Tcl_ConcatObj() into a
+ hairy monster. This was exposed by [Bug 2055782]. Additionally,
+ Tcl_ConcatObj could corrupt its input under certain conditions!
+
+ *** NASTY BUG FIXED ***
+
+2008-08-16 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: Better cmdFrame management
+
+2008-08-14 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/fileName.test: Revise new tests for portability to case
+ insensitive filesystems.
+
+2008-08-14 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclBasic.c (TclNREvalObjv, Tcl_NRCallObjProc):
+ * generic/tclProc.c (TclNRInterpProcCore, InterpProcNR2):
+ DTrace probes for NRE. [Bug 2017160]
+
+ * generic/tclBasic.c (TclDTraceInfo): Add two extra arguments to
+ * generic/tclCompile.h: DTrace 'info' probes for tclOO
+ * generic/tclDTrace.d: method & class/object info.
+
+ * generic/tclCompile.h: Add support for debug logging of DTrace
+ * generic/tclBasic.c: 'proc', 'cmd' and 'inst' probes (does _not_
+ require a platform with DTrace).
+
+ * generic/tclCmdIL.c (TclInfoFrame): Check fPtr->line before
+ dereferencing as line info may
+ not exists when TclInfoFrame()
+ is called from a DTrace probe.
+
+ * tests/fCmd.test (fCmd-6.23): Made result matching robust when test
+ workdir and /tmp are not on same FS.
+
+ * unix/tclUnixThrd.c: Remove unused TclpThreadGetStackSize()
+ * generic/tclInt.h: and related ifdefs and autoconf tests.
+ * unix/tclUnixPort.h: [Bug 2017264] (jenglish)
+ * unix/tcl.m4:
+
+ * unix/Makefile.in: Ensure Makefile shell is /bin/bash for
+ * unix/configure.in (SunOS): DTrace-enabled build on Solaris.
+ (followup to 2008-06-12) [Bug 2016584]
+
+ * unix/tcl.m4 (SC_PATH_X): Check for libX11.dylib in addition to
+ libX11.so et al.
+
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+2008-08-13 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/nre.test: Added test for large {*}-expansion effects
+
+2008-08-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclFileName.c: Fix for errors handling -types {}
+ * tests/fileName.test: option to [glob]. [Bug 1750300]
+ Thanks to Matthias Kraft and George Peter Staplin.
+
+2008-08-12 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclOOInfo.c (InfoObjectDefnCmd, InfoObjectMixinsCmd):
+ Fix # args displayed. [Bug 2048676]
+
+2008-08-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclOOMethod.c (PushMethodCallFrame): Added missing check
+ for bytecode validity. [Bug 2037727]
+
+ * generic/tclProc.c (TclProcCompileProc): On recompile of a
+ proc, clear away any entries on the CompiledLocal list from the
+ previous compile. This will prevent compile of temporary variables in
+ the proc body from growing the localCache arbitrarily large.
+
+ * README: Bump version number to 8.6a2
+ * generic/tcl.h:
+ * library/init.tcl:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/configure.in:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+ * changes: Updates for 8.6a2 release.
+
+2008-08-11 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/http/http.tcl: Remove 8.5 requirement.
+ * library/http/pkgIndex.tcl:
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc:
+
+2008-08-11 Andreas Kupries <andreask@activestate.com>
+
+ * library/tm.tcl: Added a 'package provide' command to the generated
+ ifneeded scripts of Tcl Modules, for early detection of conflicts
+ between the version specified through the file name and a 'provide'
+ command in the module implementation, if any. Note that this change
+ also now allows Tcl Modules to not provide a 'provide' command at all,
+ and declaring their version only through their filename.
+
+ * generic/tclProc.c (Tcl_ProcObjCmd): Fixed memory leak triggered by
+ * tests/proc.test: procbody::test::proc. See [Bug 2043636]. Added a
+ test case demonstrating the leak before the fix. Fixed a few spelling
+ errors in test descriptions as well.
+
+2008-08-11 Don Porter <dgp@users.sourceforge.net>
+
+ * library/http/http.tcl: Bump http version to 2.7.1 to account
+ * library/http/pkgIndex.tcl: for [Bug 2046486] bug fix. This
+ * unix/Makefile.in: release of http now requires a
+ * win/Makefile.in: dependency on Tcl 8.5 to be able to
+ * win/makefile.bc: use the unsigned formats in the
+ * win/makefile.vc: [binary scan] command.
+
+2008-08-11 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/http/http.tcl: CRC field from zlib data should be treated as
+ unsigned for 64bit support. [Bug 2046846]
+
+2008-08-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclProc.c: Completely removed ProcCompileProc, which was a
+ fix for [Bug 1482718]. This is not needed at least since varReform,
+ where the local variable data at runtime is read from the CallFrame
+ and/or the LocalCache.
+
+2008-08-09 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Slight cleanup
+ * generic/tclCompile.h:
+ * generic/tclExecute.c:
+
+2008-08-09 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclExecute.c: Fix warnings.
+
+ * generic/tclOOMethod.c (PushMethodCallFrame): Fix uninitialized efi
+ name field.
+
+ * tests/lrange.test (lrange-1.17): Add test cleanup; whitespace.
+
+2008-08-08 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updates for 8.6a2 release.
+
+2008-08-08 Kevin Kenny <kennykb@acm.org>
+
+ * library/tzdata/CET:
+ * library/tzdata/MET:
+ * library/tzdata/Africa/Casablanca:
+ * library/tzdata/America/Eirunepe:
+ * library/tzdata/America/Rio_Branco:
+ * library/tzdata/America/Santarem:
+ * library/tzdata/America/Argentina/San_Luis:
+ * library/tzdata/Asia/Karachi:
+ * library/tzdata/Europe/Belgrade:
+ * library/tzdata/Europe/Berlin:
+ * library/tzdata/Europe/Budapest:
+ * library/tzdata/Europe/Sofia:
+ * library/tzdata/Indian/Mauritius: Olson's tzdata2008e.
+
+2008-08-07 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Fix tailcalls falling out of tebc into
+ * generic/tclExecute.c: Tcl_EvalEx. [Bug 2017946]
+ * generic/tclInt.h:
+
+2008-08-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclOO.c: Revised TclOO's check for an interp being
+ deleted during handling of object command deletion. The old code was
+ relying on documented features of command delete traces that do not in
+ fact work. [Bug 2039178]
+
+ * tests/oo.test (oo-26.*): Added tests that demonstrate failure
+ of TclOO to check for various kinds of invalid bytecode during method
+ dispatch. [Bug 2037727]
+
+2008-08-06 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (TclLookupSimpleVar): Fix bug that the core could
+ not trigger before TclOO: the number of locals was being read from the
+ Proc, which can under some circumstance be out of sync with the
+ localCache's. Found by dgp while investigating [Bug 2037727].
+
+ * library/init.tcl (::unknown): Removed the [namespace inscope]
+ hack that was maintained for Itcl
+
+ *** POTENTIAL INCOMPATIBILITY *** for Itcl
+ Itcl users will need a new release with Itcl's [Patch 2040295], or
+ else load the tiny script in that patch by themselves (rewrite
+ ::unknown). Note that it is a script-only patch.
+
+2008-08-05 Joe English <jenglish@users.sourceforge.net>
+
+ * unix/tclUnixChan.c: Streamline async connect logic [Patch 1994512]
+
+2008-08-05 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: Fix for [Bug 2038069] by dgp.
+ * tests/execute.test:
+
+2008-08-04 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/nre.test: Added tests for [if], [while] and [for]. A test
+ for [foreach] has been added and marked as knownbug, awaiting for it
+ to be NR-enabled.
+
+ * generic/tclBasic.c: Made atProcExit commands run
+ * generic/tclCompile.h: unconditionally, streamlined
+ * generic/tclExecute.c: atProcExit/tailcall processing in TEBC.
+ * generic/tclProc.c:
+ * tests/unsupported.test:
+
+2008-08-04 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Stopped faulty double-logging of errors to
+ * tests/execute.test: stack trace when a compile epoch bump triggers
+ fallback to direct evaluation of commands in a compiled script.
+ [Bug 2037338]
+
+2008-08-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: New unsupported command atProcExit that
+ * generic/tclCompile.h: shares the implementation with tailcall.
+ * generic/tclExecute.c: Fixed a segfault in tailcalls. Tests added.
+ * generic/tclInt.h:
+ * generic/tclInterp.c:
+ * generic/tclNamesp.c:
+ * tests/unsupported.test:
+
+2008-08-02 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/NRE.test (removed): Migrated tests to standard locations,
+ * tests/nre.test (new): separating core functionality from the
+ * tests/unsupported.test (new): experimental commands.
+
+2008-08-01 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/Exit.3: Do not call Tcl_Finalize implicitly
+ * generic/tclEvent.c: on DLL_PROCESS_DETACH as it may lead
+ * win/tclWin32Dll.c (DllMain): to issues and the user should be
+ explicitly calling Tcl_Finalize before unloading regardless. Clarify
+ the docs to note the explicit need in embedded use.
+
+2008-08-01 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Revised timing of the CmdFrame stack
+ * tests/info.test: management in TclEvalEx so that the CmdFrame
+ will still be on the stack at the time Tcl_LogCommandInfo is called to
+ append another level of -errorinfo information. Sets the stage to add
+ file and line data to the stack trace. Added test to check that [info
+ frame] functioning remains unchanged by the revision.
+
+2008-07-31 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/NRE.test: Replaced all deep-recursing tests by shallower
+ tests that actually measure the C-stack depth. This makes them
+ bearable again (even under memdebug) and avoid crashing on failure.
+
+ * generic/tclBasic.c: NR-enabling [catch], [if] and [for] and
+ * generic/tclCmdAH.c: [while] (the script, not the tests)
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclInt.h:
+ * tests/NRE.test:
+
+ * generic/tclBasic.c: Moved the few remaining defs from tclNRE.h to
+ * generic/tclDictObj.c: tclInt.h, eliminated inclusion of tclNRE.h
+ * generic/tclExecute.c: everywhere.
+ * generic/tclInt.h:
+ * generic/tclInterp.c:
+ * generic/tclNRE.h (removed):
+ * generic/tclNamesp.c:
+ * generic/tclOOBasic.c:
+ * generic/tclOOInt.h:
+ * generic/tclProc.c:
+ * generic/tclTest.c:
+ * unix/Makefile.in:
+
+2008-07-30 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Improved tailcalls.
+ * generic/tclCompile.h:
+ * generic/tclExecute.c:
+ * generic/tclTest.c:
+ * tests/NRE.test:
+
+ * generic/tclBasic.c (TclNREvalObjEx): New comments and code reorg
+ to clarify what is happening.
+
+ * generic/tclBasic.c: Guard against the value of iPtr->evalFlags
+ changing between the times where TEOV and TEOV_exception run. Thanks
+ dgp for catching this.
+
+2008-07-29 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/NRE.test: New tests that went MIA in the NRE revamping
+
+ * generic/tclBasic.c: Clean up
+ * generic/tclNRE.h:
+ * generic/tclExecute.c:
+
+ * generic/tclBasic.c: Made use of the thread's alloc cache stored in
+ * generic/tclInt.h: the ekeko at interp creation to avoid hitting
+ * generic/tclNRE.h: the TSD each time an NRE callback is pushed or
+ * generic/tclThreadAlloc.c: pulled; the approach is suitably general
+ to extend to every other obj allocation where an interp is know; this
+ is left for some other time, requires a lot of grunt work.
+
+ * generic/tclExecute.c: Fix [Bug 2030670] that cause TclStackRealloc
+ to panic on rare corner cases. Thx ajpasadyn for diagnose and patch.
+
+ * generic/tcl.decls: Completely revamped NRE implementation, with
+ * generic/tclBasic.c: (almost) unchanged API.
+ * generic/tclCompile.h:
+ * generic/tclExecute.c: TEBC will require a bit of a facelift, but
+ * generic/tclInt.decls: TEOV at least looks great now. There are new
+ * generic/tclInt.h: tests (incomplete!) to verify that execution
+ * generic/tclInterp.c: is indeed in the same TEBC instance, at the
+ * generic/tclNRE.h: same level in all stacks involved. Tailcalls
+ * generic/tclNamesp.c: are still a bit leaky, still deserving to be
+ * generic/tclOOBasic.c: in tcl::unsupported.
+ * generic/tclOOMethod.c:
+ * generic/tclProc.c: Uninit'd var warnings in TEBC with -O2, no
+ * generic/tclTest.c: warnings otherwise.
+
+2008-07-28 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * doc/FileSystem.3: CONSTified many functions using
+ * generic/tcl.decls: Tcl_FileSystem which all are supposed
+ * generic/tclDecls.h: to be a constant, but this was not
+ * generic/tclFileSystem.h: reflected in the API: Tcl_FSData,
+ * generic/tclIOUtil.c: Tcl_FSGetInternalRep, Tcl_FSRegister,
+ * generic/tclPathObj.c: Tcl_FSNewNativePath, Tcl_FSUnregister,
+ * generic/tclTest.c: Tcl_FSGetFileSystemForPath ...
+ This change complies with TIP #27.
+ ***POTENTIAL INCOMPATIBILITY***
+
+2008-07-28 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclBasic.c: Added missing ref count when creating an empty
+ string as path (TclEvalEx). In 8.4 the missing code caused panics in
+ the testsuite. It doesn't in 8.5. I am guessing that the code path
+ with the missing the incr-refcount is not invoked any longer. Because
+ the bug in itself is certainly the same.
+
+2008-07-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOMethod.c (PushMethodCallFrame): Remove hack that should
+ have gone when this code was merged into Tcl.
+
+2008-07-27 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * doc/Object.3: CONSTified 3 functions using Tcl_ObjType
+ * doc/ObjectType.3: which all are supposed to be a constant, but
+ * generic/tcl.decls: this was not reflected in the API:
+ * generic/tcl.h: Tcl_RegisterObjType, Tcl_ConvertToType,
+ * generic/tclDecls.h: Tcl_GetObjType
+ * generic/tclObj.c: Introduced a CONST86_RETURN, so extensions
+ * generic/tclCompCmds.c: which use Tcl_ObjType directly can be
+ * generic/tclOOMethod.c: modified to compile against both Tcl 8.5 and
+ * generic/tclTestobj.c: Tcl 8.6. tclDecls.h regenerated
+ This change complies with TIP #27.
+ ***POTENTIAL INCOMPATIBILITY***
+
+2008-07-25 Andreas Kupries <andreask@activestate.com>
+
+ * test/info.test: More work on singleTestInterp usability. [1605269]
+
+ * tests/info.test: Tests 38.* added, exactly testing the tracking of
+ location for uplevel scripts. Resolved merge conflict on info-37.0,
+ switched !singleTestInterp constraint to glob matching instead. Ditto
+ info-22.8, removed constraint, more glob matching, and reduced the
+ depth of the stack we check. More is coming, right now I want to
+ commit the bug fixes.
+
+ * tests/oo.test: Updated oo-22.1 for expanded location tracking.
+
+ * generic/tclCompile.c (TclInitCompileEnv): Reorganized the
+ initialization of the #280 location information to match the flow in
+ TclEvalObjEx to get more absolute contexts.
+
+ * generic/tclBasic.c (TclEvalObjEx): Added missing cleanup of extended
+ location information.
+
+2008-07-25 Daniel Steffen <das@users.sourceforge.net>
+
+ * tests/info.test (info-37.0): Add !singleTestInterp constraint;
+ (info-22.8, info-23.0): switch to glob matching to avoid sensitivity
+ to tcltest.tcl line number changes, remove knownBug constraint, fix
+ expected result. [Bug 1605269]
+
+2008-07-24 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * doc/Notifier.3: CONSTified 4 functions in the Notifier which
+ * doc/Thread.3: all have a Tcl_Time* in it which is supposed
+ * generic/tcl.decls: to be a constant, but this was not reflected
+ * generic/tcl.h: reflected in the API:
+ * generic/tclDecls.h: Tcl_SetTimer, Tcl_WaitForEvent,
+ * generic/tclNotify.c: Tcl_ConditionWait, Tcl_SetMaxBlockTime
+ * macosx/tclMacOSXNotify.c:
+ * generic/tclThread.c: Introduced a CONST86, so extensions which have
+ * unix/tclUnixNotfy.c: have their own Notifier (are there any?) can
+ * unix/tclUnixThrd.c: can be modified to compile against both Tcl
+ * win/tclWinNotify.c: Tcl 8.5 and Tcl 8.6
+ * win/tclWinThrd.c: Regenerated tclDecls.h with "make stubs".
+ This change complies with TIP #27
+ ***POTENTIAL INCOMPATIBILITY***
+
+2008-07-23 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * tests/lrange.test: Added relative speed test to check for lrange
+ in-place optimization committed 2008-06-30.
+ * tests/binary.test: Added relative speed test to check for pure byte
+ array CONCAT1 optimization committed 2008-06-30.
+
+2008-07-23 Andreas Kupries <andreask@activestate.com>
+
+ * tests/info.test: Reordered the tests to have monotonously increasing
+ numbers.
+
+ * generic/tclBasic.c: Modified TclArgumentGet to reject pure lists
+ * generic/tclCmdIL.c: immediately, without search. Reworked setup of
+ * generic/tclCompile.c: eoFramePtr, doesn't need the line information,
+ * tests/info.test: more sensible to have everything on line 1 when
+ eval'ing a pure list. Updated the users of the line information to
+ special case this based on the frame type (i.e.
+ TCL_LOCATION_EVAL_LIST). Added a testcase demonstrating the new
+ behaviour.
+
+2008-07-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (GetCommandSource): Added comment with
+ explanation and warning for waintainers.
+
+2008-07-22 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclCompile.c: Made the new TclEnterCmdWordIndex static, and
+ * generic/tclCompile.h: ansified.
+
+ * generic/tclBasic.c: Ansified the new functions. Added missing
+ function comments.
+
+ * generic/tclBasic.c: Reworked the handling of bytecode literals for
+ * generic/tclCompile.c: #280 to fix the abysmal performance for deep
+ * generic/tclCompile.h: recursion, replaced the linear search through
+ * generic/tclExecute.c: the whole stack with another hashtable and
+ * generic/tclInt.h: simplified the data structure used by the compiler
+ by using an array instead of a hashtable. Incidentially this also
+ fixes the memory leak reported via [Bug 2024937].
+
+2008-07-22 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Added numLevels field to CommandFrame, let
+ * generic/tclExecute.c: GetCommandSource use it. This solves [Bug
+ * generic/tclInt.h: 2017146]. Thx dgp for the analysis.
+
+2008-07-21 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclBasic.c: Extended the existing TIP #280 system (info
+ * generic/tclCmdAH.c: frame), added the ability to track the absolute
+ * generic/tclCompCmds.c: location of literal procedure arguments, and
+ * generic/tclCompile.c: making this information available to uplevel
+ * generic/tclCompile.h: eval, and siblings. This allows proper
+ * generic/tclInterp.c: tracking of absolute location through custom
+ * generic/tclInt.h: (Tcl-coded) control structures based on uplevel,
+ * generic/tclNamesp.c: etc.
+ * generic/tclProc.c:
+ * tests/info.test:
+
+2008-07-21 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/*.c: Fix [2021443] inconsistant "wrong # args" messages
+ * win/tclWinReg.c
+ * win/tclWinTest.c
+ * tests/*.test
+
+2008-07-21 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ TIP #304 IMPLEMENTATION
+
+ * generic/tcl.decls: Public API
+ * generic/tclIOCmds.c: Generic part
+ * unix/tclUnixPipe.c: OS part
+ * win/tclWinPipe.c: OS part
+ * tests/chan.test: [chan pipe] tests
+ * tests/ioCmd.test: Modernized checks
+ * tests/ioTrans.test:
+
+2008-07-21 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tclFCmd.c: Inodes on windows are unreliable. [Bug 2015723]
+ * tests/winFCmd.test: test rename with inode collision
+
+2008-07-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tcl.decls: Changed the implementation of
+ * generic/tclBasic.c: [namespace import]; removed
+ * generic/tclDecls.h: Tcl_NRObjProc, replaced with
+ * generic/tclExecute.c: Tcl_NRCmdSwap (proposed public
+ * generic/tclInt.h: NRE API). This should fix
+ * generic/tclNRE.h: [Bug 582506].
+ * generic/tclNamesp.c:
+ * generic/tclStubInit.c:
+
+ * generic/tclBasic.c: NRE: enabled calling NR commands
+ * generic/tclExecute.c: from the callbacks. Completely
+ * generic/tclInt.h: redone tailcall implementation
+ * generic/tclNRE.h: using the new feature. [Bug 2021489]
+ * generic/tclProc.c:
+ * tests/NRE.test:
+
+2008-07-20 Kevin B. Kenny <kenykb@acm.org>
+
+ * tests/fileName.test: Repaired the failing test fileName-15.7 from
+ dkf's commit earlier today.
+
+2008-07-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclDictObj.c (SetDictFromAny): Make the list->dict
+ transformation a bit more efficient; modern dicts are ordered and so
+ we can round-trip through lists without needing the string rep at all.
+ * generic/tclListObj.c (SetListFromAny): Make the dict->list
+ transformation not lossy of internal representations and hence more
+ efficient. [Bug 2008248] (ajpasadyn) but using a more efficient patch.
+
+ * tests/fileName.test: Revise to reduce the obscurity of tests. In
+ particular, all tests should now produce informative messages on
+ failure and the quantity of [catch]-based obscurity is now greatly
+ reduced; non-erroring is now checked for directly.
+
+2008-07-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/env.test: Add LANG to the list of variables that are not
+ touched by the environment variable tests, so that subprocesses can
+ get their system encoding correct.
+
+ * tests/exec.test, tests/env.test: Rewrite so that non-ASCII
+ characters are not used in the final comparison. Part of fixing [Bug
+ 1513659].
+
+2008-07-18 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Optimization: replace calls to
+ * generic/tclDictObj.c: Tcl_NRAddCallback with the macro
+ * generic/tclExecute.c: TclNRAddCallback.
+ * generic/tclInterp.c:
+ * generic/tclNRE.h:
+ * generic/tclNamesp.c:
+ * generic/tclOO.c:
+ * generic/tclOOBasic.c:
+ * generic/tclOOCall.c:
+ * generic/tclOOInt.h:
+ * generic/tclOOMethod.c:
+ * generic/tclProc.c:
+
+2008-07-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c (TclNRNewObjectInstance, FinalizeAlloc):
+ * generic/tclOOBasic.c (TclOO_Class_Create, TclOO_Class_CreateNs)
+ (TclOO_Class_New, FinalizeConstruction, AddConstructionFinalizer):
+ NRE-enablement of the class construction methods.
+
+2008-07-18 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/NRE.test: Added basic tests for deep TclOO calls
+
+ * generic/tcl.decls: Change the public api prefix from
+ * generic/tcl.h: TclNR_foo to Tcl_NRfoo
+ * generic/tclBasic.c:
+ * generic/tclDecls.h:
+ * generic/tclDictObj.c:
+ * generic/tclExecute.c:
+ * generic/tclInterp.c:
+ * generic/tclNRE.h:
+ * generic/tclNamesp.c:
+ * generic/tclOO.c:
+ * generic/tclOOBasic.c:
+ * generic/tclOOCall.c:
+ * generic/tclOOMethod.c:
+ * generic/tclProc.c:
+ * generic/tclStubInit.c:
+
+2008-07-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOBasic.c (TclOO_Object_Eval, FinalizeEval): NRE-enable
+ the oo::object.eval method.
+
+2008-07-18 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclDictObj.c (DictWithCmd, DictUpdateCmd): Fix refcounting
+ bugs that caused crashes [Bug 2017857].
+
+ * generic/tclBasic.c (TclNREvalObjEx): Streamline the management of
+ the command frame (opt).
+
+2008-07-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclDictObj.c (DictWithCmd, FinalizeDictWith): Split the
+ implementation of [dict with] so that it works with NRE.
+ (DictUpdateCmd, FinalizeDictUpdate): Similarly for the non-compiled
+ version of [dict update].
+
+2008-07-16 George Peter Staplin <georgeps@users.sf.net>
+
+ * win/tclWinThrd.c: Test for TLS_OUT_OF_INDEXES to make certain that
+ thread key creation is successful.
+
+2008-07-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c, generic/tclOOInt.h, generic/tclOOBasic.c:
+ * generic/tclOOCall.c, generic/tclOOMethod.c: NRE-enable the TclOO
+ implementation in Tcl. No change to public APIs, except that method
+ implementations can now be NRE-aware if they choose (which normal
+ methods and forwards are). On the other hand, callers of
+ TclOOInvokeObject (which is only in the internal stub table) will need
+ to deal with the fact that it's only safe to call inside an NRE-aware
+ context.
+ ***POTENTIAL INCOMPATIBILITY***
+
+2008-07-15 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/NRE.test: Better constraint for testing the existence of
+ * tests/stack.test: teststacklimit, to insure that the test suite
+ runs under tclsh.
+
+ * generic/tclParse.c: Fixing incomplete reversion of "fix" for [Bug
+ 2017583], missing TclResetCancellation call.
+
+2008-07-15 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c (Tcl_CancelEval): Fix blunder. [Bug 2018603]
+
+ * doc/DictObj.3: Fix error in example. [Bug 2016740]
+
+ * generic/tclNamesp.c (EnsembleUnknownCallback): Factor out some of
+ the more complex parts of the ensemble code to make it easier to
+ understand and hence to permit tighter compilation of code on the
+ critical path.
+
+2008-07-14 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclParse.c: Reverting the "fix" for [Bug 2017583], numLevel
+ * tests/parse.test: management and TclInterpReady check seems to be
+ necessary after all.
+
+2008-07-14 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclProc.c (TclNRApplyObjCmd, TclObjInterpProcCore):
+ * generic/tclBasic.c (TclNR_AddCallback, TclEvalObjv_NR2):
+ * generic/tclNRE.h (TEOV_callback): Change the callback storage type
+ to use an array, so guaranteeing correct inter-member spacing and
+ memory layout.
+
+2008-07-14 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: Remove unneeded TclInterpReady calls
+ * generic/tclParse.c:
+
+ * generic/tclBasic.c.: Embedded Tcl_Canceled() calls into
+ * generic/tclExecute.c: TclInterpReady().
+ * generic/tclParse.c:
+
+ * generic/tclVar.c: Fix error message
+
+ * generic/tclParse.c: Remove unnecessary numLevel management
+ * tests/parse.test: [Bug 2017583]
+
+ * generic/tclBasic.c.: NRE left too many calls to
+ * generic/tclExecute.c: TclResetCancellation lying around: it
+ * generic/tclProc.c: only needs to be called prior to any
+ iPtr->numLevels++. Thanks mistachkin.
+
+ * generic/tclBasic.c: TclResetCancellation() calls were misplaced
+ (merge mishap); stray //. Thanks patthoyts.
+
+ * generic/tclInt.h: The new macros TclSmallAlloc and TclSmallFree
+ were badly defined under mem debugging [Bug 2017240] (thx das)
+
+2008-07-13 Miguel Sofer <msofer@users.sf.net>
+
+ NRE implementation [Patch 2017110]
+
+ * generic/tcl.decls: The NRE infrastructure
+ * generic/tcl.h:
+ * generic/tclBasic.c:
+ * generic/tclCmdAH.c:
+ * generic/tclCompile.h:
+ * generic/tclDecls.h:
+ * generic/tclExecute.c:
+ * generic/tclHistory.c:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclNRE.h:
+ * generic/tclStubInit.c:
+ * unix/Makefile.in:
+
+ * generic/tclInterp.c: NRE-enabling: procs, lambdas, uplevel,
+ * generic/tclNamesp.c: same-interp aliases, ensembles, imports
+ * generic/tclProc.c: and namespace_eval.
+
+ * generic/tclTestProcBodyObj.c: New NRE specific tests (few, but
+ * tests/NRE.test: note that the thing is actually
+ tested by the whole testsuite.
+
+ * tests/interp.test: Fixed numLevel counting.
+ * tests/parse.test:
+ * tests/stack.test:
+
+ * unix/configure: Removing support for the hacky nonportable
+ * unix/configure.in: stack check: it is not needed anymore, Tcl
+ * unix/tclConfig.h.in: is very thrifty on the C stack.
+ * unix/tclUnixInit.c:
+ * unix/tclUnixTest.c:
+ * win/tclWin32Dll.c:
+
+2008-07-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclGet.c: Corrected out of date comments and removed
+ * generic/tclInt.decls: internal routine TclGetLong() that's no
+ longer used. If an extension is using this from the internal stubs
+ table, it can shift to the public routine Tcl_GetLongFromObj() or
+ can request addition of a public Tcl_GetLong().
+ ***POTENTIAL INCOMPATIBILITY***
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+2008-07-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/CrtInterp.3: Tighten up the descriptions of behaviour to make
+ this page easier to read for a "Tcl 8.6" audience.
+
+2008-07-07 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclCmdIL.c (InfoFrameCmd): Fixed unsafe idiom of setting
+ the interp result found by Don Porter.
+
+2008-07-07 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/regexp.n, doc/regsub.n: Correct examples. [Bug 1982642]
+
+2008-07-06 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/lindex.n: Improve examples.
+
+2008-07-03 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIORChan.c (InvokeTclMethod): Fixed the memory leak
+ reported in [Bug 1987821]. Thanks to Miguel for the report and Don
+ Porter for tracking the cause down.
+
+2008-07-03 Don Porter <dgp@users.sourceforge.net>
+
+ * library/package.tcl: Removed [file readable] testing from
+ [tclPkgUnknown] and friends. We find out soon enough whether a file is
+ readable when we try to [source] it, and not testing before allows us
+ to workaround the bugs on some common filesystems where [file
+ readable] lies to us. [Patch 1969717]
+
+2008-07-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/regc_nfa.c (duptraverse): Impose a maximum stack depth on
+ the single most recursive part of the RE engine. The actual maximum
+ may need tuning, but that needs a system with a small stack to carry
+ out. [Bug 1905562]
+
+ * tests/string.test: Eliminate non-ASCII characters from the actual
+ test script. [Bug 2006884]
+
+2008-06-30 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/ObjectType.3: Clean up typedef formatting.
+
+2008-06-30 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/ObjectType.3: Updated documentation of the Tcl_ObjType
+ struct to match expectations of Tcl 8.5. [Bug 1917650]
+
+2008-06-30 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclCmdIL.c: Lrange cleanup and in-place optimization. [Patch
+ 1890831]
+
+ * generic/tclExecute.c: Avoid useless String conversion for CONCAT1 of
+ pure byte arrays. [Patch 1953758]
+
+2008-06-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/*.1, doc/*.3, doc/*.n: Many small updates, purging out of date
+ change bars and cleaning up the formatting of typedefs. Added a few
+ missing bits of documentation in the process.
+
+2008-06-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPathObj.c: Plug memory leak in [Bug 1999176] fix. Thanks
+ to Rolf Ade for detecting.
+
+2008-06-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/interp.n: Corrected order of subcommands. [Bug 2004256]
+ Removed obsolete (i.e. 8.5) .VS/.VE pairs.
+
+ * doc/object.n (EXAMPLES): Fix incorrect usage of oo::define to be
+ done with oo::objdefine instead. [Bug 2004480]
+
+2008-06-28 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPathObj.c: Plug memory leak in [Bug 1972879] fix. Thanks
+ to Rolf Ade for detecting and Dan Steffen for the fix. [Bug 2004654]
+
+2008-06-26 Andreas Kupries <andreask@activestate.com>
+
+ * unix/Makefile.in: Followup to my change of 2008-06-25, make code
+ generated by the Makefile and put into the installed tm.tcl
+ conditional on interpreter safeness as well. Thanks to Daniel Steffen
+ for reminding me of that code.
+
+2008-06-25 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.6a1 TAGGED FOR RELEASE ***
+
+ * changes: Updates for 8.6a1 release.
+
+ * generic/tclOO.h: Bump to TclOO 0.5.
+
+2008-06-25 Andreas Kupries <andreask@activestate.com>
+
+ * library/tm.tcl: Modified the handling of Tcl Modules and of the
+ * library/safe.tcl: Safe Base to interact nicely with each other,
+ * library/init.tcl: enabling requiring Tcl Modules in safe
+ * tests/safe.test: interpreters. [Bug 1999119]
+
+2008-06-25 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/rules.vc: Fix versions of dde and registry dlls
+ * win/makefile.vc: Fix problem building with staticpkg option
+
+2008-06-24 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPathObj.c: Fixed some internals management in the "path"
+ Tcl_ObjType for the empty string value. Problem led to a crash in the
+ command [glob -dir {} a]. [Bug 1999176]
+
+2008-06-24 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * doc/fileevent.n: Fix examples and comment on eof use. [Bug 1995063]
+
+2008-06-23 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPathObj.c: Fixed bug in Tcl_GetTranslatedPath() when
+ operating on the "Special path" variant of the "path" Tcl_ObjType
+ intrep. A full normalization was getting done, in particular, coercing
+ relative paths to absolute, contrary to what the function of producing
+ the "translated path" is supposed to do. [Bug 1972879]
+
+2008-06-20 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updates for 8.6a1 release.
+
+ * generic/tclInterp.c: Fixed completely boneheaded mistake that
+ * tests/interp.test: [interp bgerror $slave] and [$slave bgerror]
+ would always act like [interp bgerror {}]. [Bug 1999035]
+
+ * tests/chanio.test: Corrected flawed tests revealed by a -debug 1
+ * tests/cmdAH.test: -singleproc 1 test suite run.
+ * tests/event.test:
+ * tests/interp.test:
+ * tests/io.test:
+ * tests/ioTrans.test:
+ * tests/namespace.test:
+
+ * tests/encoding.test: Make failing tests pass again. [Bug 1972867]
+
+2008-06-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c (Tcl_ObjectContextInvokeNext): Corrected 'next' (at
+ * tests/oo.test (oo-7.8): end of a call chain) to make it
+ * doc/next.n: consistent with the TIP. [Bug 1998244]
+
+ * generic/tclOOCall.c (AddSimpleClassChainToCallContext): Make sure
+ * tests/oo.test (oo-14.8): that class mixins are processed in the
+ documented order. [Bug 1998221]
+
+2008-06-19 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updates for 8.6a1 release.
+
+ * README: Bump version number to 8.6a1
+ * generic/tcl.h:
+ * library/init.tcl:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/configure.in:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+2008-06-17 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclClock.c (ClockConvertlocaltoutcObjCmd): Removed left
+ over debug output.
+
+2008-06-17 Andreas Kupries <andreask@activestate.com>
+
+ * doc/tm.n: Followup to changelog entry 2008-03-18 regarding
+ ::tcl::tm::Defaults. Updated the documentation to not only mention the
+ new (underscored) form of environment variable names, but make it the
+ encouraged form as well. [Bug 1914604]
+
+2008-06-17 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclClock.c (ConvertLocalToUTC):
+ * tests/clock.test (clock-63.1): Fixed a bug where the internal
+ ConvertLocalToUTC command segfaulted if passed a dictionary without
+ the 'localSeconds' key. To the best of my knowledge, the bug was not
+ observable in the [clock] command itself.
+
+2008-06-16 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclCmdIL.c (TclInfoFrame): Moved the code looking up the
+ * tests/info.test: information for key 'proc' out of the
+ TCL_LOCATION_BC branch to after the switch, this is common to all
+ frame types. Updated the testsuite to match. This was exposed by the
+ 2008-06-08 commit (Miguel), switching uplevel from direct eval to
+ compilation. [Bug 1987851]
+
+2008-06-16 Andreas Kupries <andreask@activestate.com>
+
+ * tests/ioTrans.test (iortrans-11.*): Fixed same issue as for
+ iortrans.tf-11.*, cleanup of temp file, making this a followup to the
+ entry on 2008-06-10 by myself.
+
+2008-06-13 David Gravereaux <davygrvy@pobox.com>
+
+ * win/rules.vc: SYMBOLS macro is now being set to zero when $(OPTS) is
+ not available.
+ * win/makefile.vc: The Stubs source files (tclStubLib.c and
+ tclOOStubLib.c) should not be compiled with the -GL flag.
+
+2008-06-13 Joe Mistachkin <joe@mistachkin.com>
+
+ TIP #285 IMPLEMENTATION
+
+ * doc/Eval.3: Added documentation for the Tcl_CancelEval and
+ Tcl_Canceled functions and the TCL_CANCEL_UNWIND flag bit.
+ * doc/after.n: Corrected the spelling of 'canceled' in the
+ documentation.
+ * doc/interp.n: Added documentation for [interp cancel].
+ * generic/tcl.decls: Added the Tcl_CancelEval and Tcl_Canceled
+ functions to the stubs table.
+ * generic/tcl.h: Added the TCL_CANCEL_UNWIND flag bit.
+ * generic/tclBasic.c: The bulk of the script cancellation
+ functionality is defined here. Added code to initialize and manage the
+ script cancellation hash table in a thread-safe manner. Reset script
+ cancellation flags prior to increasing the nesting level (if the
+ nesting level is currently zero) and always cooperatively check for
+ script cancellation near the start of TclEvalObjvInternal and after
+ invoking async handlers.
+ * generic/tclDecls.h: Regenerated.
+ * generic/tclEvent.c: Call TclFinalizeEvaluation during finalization
+ to cleanup the script cancellation hash table. During [vwait], always
+ cooperatively check for script cancellation. Corrected the spelling of
+ 'canceled' in comments to be consistent with the documentation.
+ * generic/tclExecute.c: Reset script cancellation flags prior to
+ increasing the nesting level (if the nesting level is currently zero)
+ and always cooperatively check for script cancellation after invoking
+ async handlers. Prevent [catch] from catching script cancellation when
+ the TCL_CANCEL_UNWIND flag is set (similar to the manner used by TIP
+ 143 when a limit has been exceeded).
+ * generic/tclInt.decls: Added TclResetCancellation to the internal
+ stubs table.
+ * generic/tclInt.h: Added asyncCancel and asyncCancelMsg fields to the
+ private Interp structure. Added private interp flag value CANCELED to
+ help control script cancellation.
+ * generic/tclIntDecls.h: Regenerated.
+ * generic/tclInterp.c (Tcl_InterpObjCmd): Added [interp cancel]
+ subcommand.
+ * generic/tclNotify.c (Tcl_DeleteEventSource): Corrected the spelling
+ of 'canceled' in comments to be consistent with the documentation.
+ * generic/tclParse.c: Reset script cancellation flags prior to
+ * generic/tclProc.c: increasing the nesting level (if the nesting
+ level is currently zero) and cooperatively check for script
+ cancellation prior to evaluating commands.
+ * generic/tclStubInit.c: Regenerated.
+ * generic/tclThreadTest.c (Tcl_ThreadObjCmd): Added script
+ cancellation support ([testthread cancel]).
+ Modified [testthread id] to allow querying of the 'main' thread ID.
+ Corrected comments to reflect the actual command syntax. Made
+ [testthread wait] cooperatively check for script cancellation. Added
+ [testthread event] to allow for processing one pending event without
+ blocking.
+ * generic/tclTimer.c: Delay for a maximum of 500 milliseconds prior to
+ checking for async handlers and script cancellation.
+ * tests/cmdAH.test: Changed [interp c] to [interp create].
+ * tests/interp.test: Added and fixed tests for [interp cancel].
+ * tests/thread.test: Added tests for script cancellation via
+ [testthread cancel].
+ * tools/man2help2.tcl: Fixed problems with WinHelp target (see
+ * tools/man2tcl.c: [Bug 1934200], [Bug 1934265], and [Bug 1934272]).
+ * win/makefile.vc: Added 'pdbs' option for Windows build rules to
+ * win/rules.vc: allow for non-debug builds with full symbols.
+ * win/tcl.hpj.in: Corrected version for WinHelp target.
+ * win/tclWinNotify.c: Used SleepEx and WaitForSingleObjectEx on
+ * win/tclWinThrd.c: Windows because they are alertable.
+
+2008-06-12 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/Makefile.in: Add complete deps on tclDTrace.h.
+
+ * generic/tclOO.c: Use TclOOStubs hooks field to retrieve
+ * generic/tclOODecls.h: TclOOIntStubs pointer. [Bug 1980953]
+ * generic/tclOOIntDecls.h:
+ * generic/tclOOStubInit.c:
+ * generic/tclOOStubLib.c:
+
+ * generic/tclIORTrans.c: Fix signed <-> unsigned cast warnings.
+
+ * unix/Makefile.in: Clean generated tclDTrace.h file.
+ * unix/configure.in (SunOS): Fix static DTrace-enabled build.
+
+ * unix/tcl.m4 (SunOS-5.11): Fix 64bit amd64 support with gcc & Sun cc.
+ * unix/configure: autoconf-2.59
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: Add tclIORTrans.c; updates and
+ cleanup for Xcode 3.1/Leopard.
+ * macosx/Tcl.xcode/project.pbxproj: Sync Tcl.xcodeproj changes.
+ * macosx/README: Document new build configs.
+
+2008-06-10 Joe English <jenglish@users.sourceforge.net>
+
+ * generic/tclEncoding.c(UtfToUtfProc): Avoid unwanted sign extension
+ when converting incomplete UTF-8 sequences. See [Bug 1908443] for
+ details.
+
+2008-06-10 Andreas Kupries <andreask@activestate.com>
+
+ * tests/ioTrans.test (iortrans.tf-6.1): Fixed the [Bug 1988552],
+ reported by Kevin. Have to close the channel before removal of the
+ file. Fixed same bug in test 'iortrans.tf-11.0', after fixing missing
+ cleanup of the file in 'iortrans.tf-11.*'. Lastly fixed the names of
+ the threaded tests 'iortrans-8.*' to the correct 'iortrans.tf-8.*'.
+
+2008-06-09 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * generic/tclIORTrans.c (ReflectInput): Fixed a bug triggered by Pat
+ Thoyts <patthoyts@users.sourceforge.net>. Reset the EOF flag after
+ draining the Tcl level into the result buffer, to make sure that the
+ result buffer will be drained as well by repeated calls to
+ ReflectInput should it contain more than one buffer-full of data.
+ Without that reset the higher I/O system will not call on ReflectInput
+ anymore due to the assumed EOF, thus losing the data which did not fit
+ in the buffer of the call which caused the eof and drain.
+
+2008-06-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOCall.c (TclOOGetSortedMethodList): Plug memory leak
+ that occurred when all methods were hidden. [Bug 1987817]
+
+2008-06-08 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Compilation of uplevel scripts, allow
+ * generic/tclCompCmds.c: non-body compiled scripts to access the
+ * generic/tclCompile.c: LVT (but not to extend it) and enable the
+ * generic/tclCompile.h: canonical list opt to sidestep the
+ * generic/tclExecute.c: compiler. [Patch 1973096]
+ * generic/tclProc.c:
+ * tests/uplevel.test:
+
+2008-06-06 Andreas Kupries <andreask@activestate.com>
+
+ TIP #230 IMPLEMENTATION
+
+ * generic/tclIOCmd.c: Integration of transform commands into 'chan'
+ ensemble.
+ * generic/tclInt.h: Definitions of the transform commands.
+ * generic/tclIORTrans.c: Implementation of the reflection transforms.
+ * tests/chan.test: Tests updated for new sub-commands of 'chan'.
+ * tests/ioCmd.test: Tests updated for new sub-commands of 'chan'.
+ * tests/ioTrans.test: Whole new set of tests for the reflection
+ transform.
+ * unix/Makefile.in: Integration of new files into build rules.
+ * win/Makefile.in: Integration of new files into build rules.
+ * win/makefile.vc: Integration of new files into build rules.
+
+ NOTE: The file 'tclIORTrans.c' has a lot of code in common with the
+ file 'tclIORChan.c', as that made it much easier to develop the
+ reference implementation as a separate module. Now that the
+ transforms have been committed the one thing left to do is to go
+ over both modules and see which of the common parts we can
+ factor out and share.
+
+2008-06-04 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tclBinary.c: TIP #317 implementation
+ * tests/binary.test:
+
+2008-06-02 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclOO.c (ReleaseClassContents): Fix the one remaining
+ valgrind complaint about oo.test, caused by failing to protect the
+ Object as well as the Class corresponding to a subclass being deleted
+ and hence getting a freed-memory read when attempting to delete the
+ class command. [Bug 1981001]
+
+2008-06-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOMethod.c (Tcl_NewMethod): Complete the fix of [Bug
+ 1981001], previous fix was incomplete though helpful in telling me
+ where to look.
+
+2008-06-01 Joe Mistachkin <joe@mistachkin.com>
+
+ * win/Makefile.in: Add tclOO genstubs to Windows makefiles and remove
+ * win/makefile.vc: -DBUILD_tcloo because it is no longer required.
+
+2008-06-01 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclOODecls.h: Added the swizzling of DLLEXPORT and
+ * generic/tclOOIntDecls.h: DLLIMPORT needed to make EXTERN work.
+
+ * generic/tclDictObj.c: Added missing initializers to the ensemble
+ map to silence a compiler warning. Thanks to
+ George Peter Staplin for the report.
+
+ * generic/tclOOMethod.c: Fix a bug where the refcount of a method was
+ reset if the method was redefined while there
+ was an active invocation. [Bug 1981001]
+
+2008-06-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.decls, unix/Makefile.in (genstubs): Make generation of
+ stub tables correct.
+ * generic/tclOO{Decls.h,IntDecls.h,StubInit.c,StubLib.c}: Fixes to
+ make the generation work correctly, removing subtle differences
+ between output of different versions of stub generator.
+
+2008-06-01 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclOOStubLib.c: Ensure use of tcl stubs; include in
+ * unix/Makefile.in: stub lib; disable broken tclOO
+ genstubs
+
+ * generic/tclOO.c: Make tclOO stubs tables 'static const'
+ * generic/tclOODecls.h: and stub table pointers MODULE_SCOPE
+ * generic/tclOOIntDecls.h: (change generated files manually
+ * generic/tclOOStubInit.c: pending genstubs support for tclOO).
+ * generic/tclOOStubLib.c:
+
+ * generic/tclOO.c: Fix warnings for 'int<->ptr
+ * generic/tclOOCall.c: conversion' and 'signed vs unsigned
+ * generic/tclOOMethod.c: comparison'.
+
+ * tests/msgcat.test: Fix for ::tcl::mac::locale with @modifier.
+
+ * tools/tsdPerf.tcl: Use [info sharedlibextension]
+
+ * unix/tclConfig.h.in: autoheader-2.59
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: Add new tclOO files; add debug
+ * macosx/README: configs with corefoundation
+ disabled and with gcov; update
+ to Xcode 3.1.
+
+2008-05-31 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c (InitFoundation): Correct reference counting for
+ strings used when creating the constructor for classes.
+ * generic/tclOOMethod.c (TclOODelMethodRef): Correct fencepost error
+ in reference counting of method implementation structures.
+ * tests/oo.test (oo-0.5): Added a test to detect a memory leak problem
+ relating to disposal of the core object system.
+
+ TIP#257 IMPLEMENTATION
+
+ * generic/tclBasic.c, generic/tclOOInt.h: Correct declarations.
+ * win/Makefile.in, win/makefile.bc, win/makefile.vc: Build support for
+ Win32, from Joe Mistachkin. [Patch 1980861]
+
+ * generic/tclOO*, doc/*, tests/oo.test: Port of implementation of
+ TclOO to sit directly inside Tcl. Note that this is incomplete (e.g.
+ no build support yet for Windows).
+
+2008-05-26 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/io.test (io-53.9): Need to close chan before removing file.
+
+2008-05-26 Donal K. Fellows <dkf@users.sf.net>
+
+ * win/makefile.bc: Remove deprecated winhelp target.
+ * win/Makefile.in, win/makefile.vc: It didn't work correctly anyway.
+
+2008-05-23 Andreas Kupries <andreask@activestate.com>
+
+ * win/tclWinChan.c (FileWideSeekProc): Accepted a patch by Alexandre
+ Ferrieux <ferrieux@users.sourceforge.net> to fix the [Bug 1965787].
+ 'tell' now works for locations > 2 GB as well instead of going
+ negative.
+
+ * generic/tclIO.c (Tcl_SetChannelBufferSize): Accepted a patch by
+ * tests/io.test: Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+ * tests/chanio.test: to fix the [Bug 1969953]. Buffersize outside of
+ the supported range are now clipped to nearest boundary instead of
+ ignored.
+
+2008-05-22 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclNamesp.c (Tcl_LogCommandInfo): Restored ability to
+ handle the argument value length = -1. Thanks to Chris Darroch for
+ discovering the bug and providing the fix. [Bug 1968245]
+
+2008-05-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParse.c (ParseComment): The new TclParseAllWhiteSpace
+ * tests/parse.test (parse-15.60): routine has no mechanism to
+ return the "incomplete" status of "\\\n" so calling this routine
+ anywhere that can be reached within a Tcl_ParseCommand() call is a
+ mistake. In particular, ParseComment() must not use it. [Bug 1968882]
+
+2008-05-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclNamesp.c (Tcl_SetNamespaceUnknownHandler): Corrected odd
+ logic for handling installation of namespace unknown handlers which
+ could lead too very strange things happening in the error case.
+
+2008-05-16 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c: Fix crash with tcl_traceExec. Found and fixed
+ by Alexander Pasadyn. [Bug 1964803]
+
+2008-05-15 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/makefile.vc: We should use the thread allocator for threaded
+ * win/rules.vc: builds. Added 'tclalloc' option to disable.
+
+2008-05-09 George Peter Staplin <georgeps@xmission.com>
+
+ * tools/tsdPerf.c: A loadable Tcl extension for testing TSD
+ performance.
+ * tools/tsdPerf.tcl: A simplistic tool that uses the thread
+ extension and tsdPerf.so to get some performance metrics by,
+ simulating, simple TSD contention.
+
+2008-05-09 George Peter Staplin <georgeps@xmission.com>
+
+ * generic/tcl.h: Make Tcl_ThreadDataKey a void *.
+ * generic/tclInt.h: Change around some function names and add some
+ new per-platform declarations for thread-specific data functions.
+ * generic/tclThread.c: Make use of of the new function names that no
+ longer have a Tclp prefix.
+ * generic/tclThreadStorage.c: Replace the core thread-specific data
+ (TSD) mechanism with an array offset solution that eliminates the hash
+ tables, and only uses one slot of native TSD. Many thanks to Kevin B.
+ Kenny for his help with this.
+
+ * unix/tclUnixThrd.c: Add platform-specific TSD functions for use by
+ * win/tclWinThrd.c: tclThreadStorage.c.
+
+2008-05-09 Kevin B. Kenny <kennykb@acm.org>
+
+ * tests/dict.test (dict-19.2): Corrected a bug where the test was
+ changed to use [apply] instead of a temporary proc, but the cleanup
+ script still attempted to delete the temporary proc.
+
+2008-05-07 Donal K. Fellows <dkf@cspool38.cs.man.ac.uk>
+
+ * generic/tclCompCmds.c (TclCompileDictAppendCmd): Fix silly off-by
+ one error that caused a crash every time a compiled 'dict append' with
+ more than one argument was used. Found by Colin McCormack.
+
+2008-05-02 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tclBasic.c: Converted the [binary] command into an
+ * generic/tclBinary.c: ensemble.
+ * generic/tclInt.h:
+ * test/binary.test: Updated the error tests for ensemble errors.
+
+ * generic/tclFileName.c: Reverted accidental commit of TIP 316 APIs.
+
+2008-04-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * */*.c: A large tranche of getting rid of pre-C89-isms; if your
+ compiler doesn't support things like proper function declarations,
+ 'void' and 'const', borrow a proper one when building Tcl. (The header
+ files allow building things that link against Tcl with really ancient
+ compilers still; the requirement is just when building Tcl itself.)
+
+2008-04-26 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * generic/tclAsync.c: Tcl_AsyncDelete(): panic if attempt to locate
+ handler token fails. Happens when some other thread attempts to delete
+ somebody else's token.
+
+ Also, panic early if we find out the wrong thread attempting to delete
+ the async handler (common trap). As, only the one that created the
+ handler is allowed to delete it.
+
+2008-04-24 Andreas Kupries <andreask@activestate.com>
+
+ * tests/ioCmd.test: Extended testsuite for reflected channel
+ implementation. Added test cases about how it handles if the rug is
+ pulled out from under a channel (= killing threads, interpreters
+ containing the tcl command for a channel, and channel sitting in a
+ different interpreter/thread.)
+
+ * generic/tclIORChan.c: Fixed the bugs exposed by the new testcases,
+ redone most of the cleanup and exit handling.
+
+2008-04-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIOUtil.c: Removed all code delimited by
+ * generic/tclTest.c: USE_OBSOLETE_FS_HOOKS, completing
+ * tests/ioCmd.test: the deprecation path for these
+ * tests/ioUtil.test (removed): obsolete interfaces. (Code was active
+ in Tcl 8.4, present but enabled only by customized compile switch in
+ Tcl 8.5, and now completely gone for Tcl 8.6). Also removed all tests
+ relevant only to the removed interfaces.
+
+2008-04-19 George Peter Staplin <georgeps@xmission.com>
+
+ * doc/Ensemble.3: Fix a typo: s/defiend/defined/
+ Thanks to hat0 for spotting this.
+
+2008-04-16 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclInt.h: Make stubs tables 'static const' and
+ * generic/tclStubInit.c: export only module-scope pointers to
+ * generic/tclStubLib.c: the main stubs tables (for package
+ * tools/genStubs.tcl: initialization). [Patch 1938497]
+ * generic/tclBasic.c (Tcl_CreateInterp):
+ * generic/tclTomMathInterface.c (TclTommath_Init):
+
+ * generic/tclInt.h: Revise Tcl_SetNotifier() to use a
+ * generic/tclNotify.c: module-scope hooks table instead of
+ * generic/tclStubInit.c: runtime stubs-table modification;
+ * macosx/tclMacOSXNotify.c: ensure all hookable notifier functions
+ * win/tclWinNotify.c: check for hooks; remove hook checks in
+ * unix/tclUnixNotfy.c: notifier API callers. [Patch 1938497]
+
+2008-04-15 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (CopyData): Applied another patch by Alexandre
+ * io.test (io-53.8a): Ferrieux <ferrieux@users.sf.net>,
+ * chanio.test (chan-io-53.8a): to shift EOF handling to the async
+ part of the command if a callback is specified, should the channel be
+ at EOF already when fcopy is called. Testcase by myself.
+
+2008-04-15 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/Makefile.in: Adjust tclDTrace.h dependencies for removal
+ of tclStubLib.o from TCL_OBJS. [Bug 1942795]
+
+2008-04-14 Kevin B. Kenny <kennykb@acm.org>
+
+ * unix/tclUnixTime.c (NativeGetTime): Removed obsolete use of
+ 'struct timezone' in the call to 'gettimeofday'. [Bug 1942197]
+
+ * tests/clock.test (clock-33.5, clock-33.5a, clock-33.8, clock-33.8a):
+ Added comments to the test that it can fail on a heavily loaded
+ system.
+
+2008-04-10 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Keeping check for negative
+ values, changed to not be an error, but behave like the special value
+ -1 (copy all, default).
+
+ * tests/iocmd.test (iocmd-15.{12,13}): Removed.
+
+ * tests/io.test (io-52.5{,a,b}): Reverted last change, added
+ * tests/chanio.test (chan-io-52.5{,a,b}): comment regarding the
+ meaning of -1, added two more testcases for other negative values,
+ and input wrapped to negative.
+
+2008-04-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/{fCmd,unixFCmd,winFCmd,winFile}.test: Tidying up of the test
+ suite to make better use of tcltest2 and be clearer about what is
+ being tested.
+
+ * win/Makefile.in (html): Added target for doing convenient
+ documentation builds, mirroring the one from unix/Makefile.
+
+2008-04-09 Andreas Kupries <andreask@activestate.com>
+
+ * tests/chanio.test (chan-io-52.5): Removed '-size -1' from test,
+ * tests/io.test (io-52.5): does not seem to have any bearing, and was
+ an illegal value. Test case is not affected by the value of -size,
+ test flag restoration and that evrything was properly copied.
+
+ * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Added checking of -size value
+ * tests/ioCmd.test (iocmd-15.{13,14}): to reject negative values, and
+ values overflowing 32-bit signed. Basic patch by Alexandre Ferrieux
+ <ferrieux@users.sourceforge.net>, with modifications from me to
+ separate overflow from true negative value. Extended testsuite. [Bug
+ 1557855]
+
+2008-04-09 Daniel Steffen <das@users.sourceforge.net>
+
+ * tests/chanio.test (chan-io-53.8,53.9,53.10): Fix typo & quoting for
+ * tests/io.test (io-53.8,53.9,53.10): spaces in builddir path
+
+2008-04-08 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: Added comments to the alignment macros used in
+ GrowEvaluationStack() and friends.
+
+2008-04-08 Daniel Steffen <das@users.sourceforge.net>
+
+ * tools/genStubs.tcl: Revert erroneous 2008-04-02 change marking
+ *StubsPtr as EXTERN instead of extern.
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclIntDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclPlatDecls.h:
+ * generic/tclTomMathDecls.h:
+
+2008-04-07 Andreas Kupries <andreask@activestate.com>
+
+ * tests/io.test (io-53.10): Testcase for bi-directional fcopy.
+ * tests/chanio.test:
+ * generic/tclIO.c: Additional changes to data structures for fcopy and
+ * generic/tclIO.h: channels to perform proper cleanup in case of a
+ channel having two background copy operations running as is now
+ possible.
+
+ * generic/tclIO.c (BUSY_STATE, CheckChannelErrors, TclCopyChannel):
+ New macro, and the places using it. This change allows for
+ bi-directional fcopy on channels. Thanks to Alexandre Ferrieux
+ <ferrieux@users.sourceforge.net> for the patch. [Bug 1350564]
+
+2008-04-07 Reinhard Max <max@suse.de>
+
+ * generic/tclStringObj.c (Tcl_AppendFormatToObj): Fix [format {% d}]
+ so that it behaves the same way as in 8.4 and as C's printf().
+ * tests/format.test: Add a test for '% d' and '%+d'.
+
+2008-04-05 Kevin B. Kenny <kennykb@acm.org>
+
+ * win/tclWinFile.c: (WinSymLinkDirectory): Fixed a problem that Tcl
+ was creating an NTFS junction point (IO_REPARSE_TAG_MOUNT_POINT) but
+ filling in the union member for a Vista symbolic link. We had gotten
+ away with this error because the union member
+ (SymbolicLinkReparseBuffer) was misdefined in this file and in the
+ 'winnt.h' in early versions of MinGW. MinGW 3.4.2 has the correct
+ definition of SymbolicLinkReparseBuffer, exposing the mismatch, and
+ making tests cmdAH-19.4.1, fCmd-28.*, and filename-11.* fail.
+ * tests/chanio.test (chan-io-53.9):
+ * tests/io.test (io-53.9): Made test cleanup robust against the
+ possibility of slow process shutdown on Windows.
+
+ * win/tcl.m4: Added -D_CRT_SECURE_NO_DEPRECATE and
+ -DCRT_NONSTDC_NO_DEPRECATE to the MSVC compilation flags so that the
+ compilation doesn't barf on perfectly reasonable Posix system calls.
+ * win/configure: Manually patched (don't have the right autoconf to
+ hand).
+
+2008-04-04 Andreas Kupries <andreask@activestate.com>
+
+ * tests/io.test (io-53.9): Added testcase for [Bug 780533], based
+ * tests/chanio.test: on Alexandre's test script. Also fixed problem
+ with timer in preceding test, was not canceled properly in the ok case
+
+2008-04-04 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIORChan.c (ReflectOutput): Allow zero return from write
+ when input was zero-length anyway. Otherwise keept it an error, and
+ separate the message from 'written too much'.
+
+ * tests/ioCmd.test (iocmd-24.6): Testcase updated for changed message.
+
+ * generic/tclIORChan.c (ReflectClose): Added missing removal of the
+ now closed channel from the reflection map. Before we could crash the
+ system by invoking 'chan postevent' on a closed reflected channel,
+ dereferencing the dangling pointer in the map.
+
+ * tests/ioCmd.test (iocmd-31.8): Testcase for the above.
+
+2008-04-03 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (CopyData): Applied patch [Bug 1932639] to
+ * tests/io.test: prevent fcopy from calling -command synchronously
+ * tests/chanio.test: the first time. Thanks to Alexandre Ferrieux
+ <ferrieux@users.sourceforge.net> for report and patch.
+
+2008-04-02 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tcl.decls: Remove 'export' declarations of symbols now
+ only in libtclstub and no longer in libtcl.
+
+ * generic/tclStubLib.c: Make symbols in libtclstub.a MODULE_SCOPE to
+ * tools/genStubs.tcl: avoid exporting them from libraries that link
+ with -ltclstub; constify tcl*StubsPtr and stub
+ table hook pointers. [Bug 1819422]
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclIntDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclPlatDecls.h:
+ * generic/tclStubInit.c:
+ * generic/tclTomMathDecls.h:
+
+2008-04-02 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (CopyData): Applied patch for fcopy problem [Bug
+ 780533], with many thanks to Alexandre Ferrieux
+ <ferrieux@users.sourceforge.net> for tracking it down and providing a
+ solution. Still have to convert his test script into a proper test
+ case.
+
+2008-04-01 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclStrToD.c: Applied patch for [Bug 1839067] (fp rounding
+ * unix/tcl.m4: setup on solaris x86, native cc), provided by
+ Michael Schlenker.
+
+2008-04-01 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStubLib.c: Removed needless #ifdef complexity.
+
+ * generic/tclStubLib.c (Tcl_InitStubs): Added missing error message.
+ * generic/tclPkg.c (Tcl_PkgInitStubsCheck):
+
+ * README: Bump version number to 8.6a0
+ * generic/tcl.h:
+ * library/init.tcl:
+ * macosx/Tcl-Common.xcconfig:
+ * macosx/Tcl.pbproj/default.pbxuser:
+ * macosx/Tcl.pbproj/project.pbxproj:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/README:
+ * win/configure.in:
+ * win/makefile.bc:
+ * win/tcl.m4:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+ * generic/tclBasic.c: Revised stubs-generation tool and interp
+ * tools/genStubs.tcl: creation so that "tclStubsPtr" is not present
+ * unix/Makefile.in: in libtcl.so, but is present only in
+ * win/Makefile.in: libtclstub.a. This tightens up the rules for
+ * win/makefile.bc: users of the stubs interfaces. [Bug 1819422]
+ * win/makefile.vc:
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclIntDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclPlatDecls.h:
+ * generic/tclTomMathDecls.h:
+
+2008-03-30 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclInt.h (TclIsNaN):
+ * unix/configure.in: Added code to the configurator to check for a
+ standard isnan() macro and use it if one is
+ found. This change avoids bugs where the test of
+ ((d) != (d)) is optimized away by an
+ overaggressive compiler. [Bug 1783544]
+ * generic/tclObj.c: Added missing #include <math.h> needed to locate
+ isnan() after the above change.
+
+ * unix/configure: autoconf-2.61
+
+ * tests/mathop.test (mathop-25.9, mathop-25.14): Modified tests to
+ deal with (slightly buggy) math libraries in which pow() returns an
+ incorrectly rounded result. [Bug 1808174]
+
+2008-03-26 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.5.2 TAGGED FOR RELEASE ***
+
+ * generic/tcl.h: Bump to 8.5.2 for release.
+ * library/init.tcl:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/configure.in:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+ * changes: Updated for 8.5.2 release.
+
+2008-03-28 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/fCmd.test: Substantial rewrite to use many more tcltest
+ features. Great reduction in quantity of [catch] gymnastics. Several
+ buggy tests fixed, including one where the result of the previous test
+ was being checked!
+
+2008-03-27 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata/America/Marigot:
+ * library/tztata/America/St_Barthelemy:
+ * library/tzdata/America/Argentina/San_Luis:
+ * library/tzdata/Asia/Ho_Chi_Minh:
+ * library/tzdata/Asia/Kolkata: (new files)
+ * library/tzdata/America/Caracas:
+ * library/tzdata/America/Havana:
+ * library/tzdata/America/Santiago:
+ * library/tzdata/America/Argentina/Buenos_Aires:
+ * library/tzdata/America/Argentina/Catamarca:
+ * library/tzdata/America/Argentina/Cordoba:
+ * library/tzdata/America/Argentina/Jujuy:
+ * library/tzdata/America/Argentina/La_Rioja:
+ * library/tzdata/America/Argentina/Mendoza:
+ * library/tzdata/America/Argentina/Rio_Gallegos:
+ * library/tzdata/America/Argentina/San_Juan:
+ * library/tzdata/America/Argentina/Tucuman:
+ * library/tzdata/America/Argentina/Ushuaia:
+ * library/tzdata/Asia/Baghdad:
+ * library/tzdata/Asia/Calcutta:
+ * library/tzdata/Asia/Damascus:
+ * library/tzdata/Asia/Saigon:
+ * library/tzdata/Pacific/Easter:
+ Changes up to and including Olson's tzdata2008b.
+
+2008-03-27 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tcl.m4 (SunOS-5.1x): Fix 64bit support for Sun cc. [Bug
+ 1921166]
+
+ * unix/configure: autoconf-2.59
+
+2008-03-26 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updated for 8.5.2 release.
+
+2008-03-24 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tclBinary.c: [Bug 1923966] - crash in binary format
+ * tests/binary.test: Added tests for the above crash condition.
+
+2008-03-21 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/switch.n: Clarified documentation in respect of two-argument
+ invokation. [Bug 1899962]
+
+ * tests/switch.test: Added more tests of regexp-mode compilation of
+ the [switch] command. [Bug 1854435]
+
+2008-03-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tcl.h, generic/tclThreadAlloc.c: Tidied up the declarations
+ of Tcl_GetMemoryInfo so that it is always defined. Will panic when
+ called against a Tcl that was previously built without it at all,
+ which is OK because that also indicates a serious mismatch between
+ memory configuration options.
+
+2008-03-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tcl.h, generic/tclThreadAlloc.c (Tcl_GetMemoryInfo): Make
+ sure this function is available when direct linking. [Bug 1868171]
+
+ * tests/reg.test (reg-33.14): Marked nonPortable because some
+ environments have small default stack sizes. [Bug 1905562]
+
+2008-03-18 Andreas Kupries <andreask@activestate.com>
+
+ * library/tm.tcl (::tcl::tm::UnknownHandler): Changed 'source' to
+ 'source -encoding utf-8'. This fixes a portability problem of Tcl
+ Modules pointed out by Don Porter. By using plain 'source' we were at
+ the mercy of 'encoding system', making modules less portable than they
+ could be. The exact scenario: A writes a TM in some weird encoding
+ which is A's system encoding, distributes it, and somewhere else it
+ cannot be read/used because the system encoding is different. Forcing
+ the use of utf-8 makes the module portable.
+
+ ***INCOMPATIBILITY*** for all Tcl Modules already written in non-utf-8
+ compatible encodings.
+
+2008-03-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Patch from Miguel Sofer to correct the
+ alignment of memory allocated by GrowEvaluationStack(). [Bug 1914503]
+
+2008-03-18 Andreas Kupries <andreask@activestate.com>
+
+ * library/tm.tcl (::tcl::tm::Defaults): Modified handling of
+ environment variables. Solution slightly different than proposed in
+ the report. Using the underscored form TCLX_y_TM_PATH even if
+ TCLX.y_TM_PATH exists. Also using a loop to cut prevent code
+ replication. [Bug 1914604]
+
+2008-03-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileDictForCmd): Correct the handling
+ of stack space calculation (the jump pattern used was confusing the
+ simple-minded code doing the calculations). [Bug 1903325]
+
+ * doc/lreplace.n: Clarified documentation of what happens with
+ negative indices. [Bug 1905809] Added example, tidied up formatting.
+
+2008-03-14 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (OldMathFuncProc): Same workaround protection
+ from bad TclStackAlloc() alignment. Thanks George Peter Staplin.
+
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): Use ckalloc() to allocate
+ SortElement arrays instead of TclStackAlloc() which isn't getting
+ alignment right. Workaround for [Bug 1914503].
+
+2008-03-14 Reinhard Max <max@suse.de>
+
+ * generic/tclTest.c: Ignore the return value of write() when we are
+ * unix/tclUnixPipe.c: about to exit anyways.
+
+2008-03-13 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/configure.in: Use backslash-quoting instead of double-quoting
+ * unix/tcl.m4: for lib paths in tclConfig.sh. [Bug 1913622]
+ * unix/configure: autoconf-2.59
+
+2008-03-13 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updated for 8.5.2 release.
+
+ * generic/tclStrToD.c: Resolve identifier conflict over "pow10" with
+ libm in Cygwin and DJGPP. Thanks to Gordon Schumacher and Philip
+ Moore. [Patch 1800636]
+
+2008-03-12 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: Add support for Xcode 3.1
+ * macosx/Tcl.xcodeproj/default.pbxuser: CODE_SIGN_IDENTITY and
+ * macosx/Tcl-Common.xcconfig: 'xcodebuild install'.
+
+2008-03-12 Andreas Kupries <andreask@activestate.com>
+
+ * doc/info.n: Replaced {expand} with {*}.
+
+2008-03-12 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/Makefile.in (install-libraries): Bump http to 2.7
+ * win/Makefile.in (install-libraries): Added -myaddr option to allow
+ * library/http/http.tcl (http::geturl): control of selected socket
+ * library/http/pkgIndex.tcl: interface. [Bug 559898]
+ * doc/http.n, tests/http.test: Added -keepalive and
+ -protocol 1.1 with chunked transfer encoding support. [Bug 1063703,
+ 1470377, 219225] (default keepalive is 0)
+ Added ability to override Host in -headers. [Bug 928154]
+ Added -strict option to control URL validation on per-call basis.
+ [Bug 1560506]
+
+2008-03-11 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * library/http/http.tcl (http::geturl): Add -method option to support
+ * tests/http.test (http-3.1): http PUT and DELETE requests.
+ * doc/http.n: [Bug 1599901, 862554]
+
+ * library/http/http.tcl: Whitespace changes, code cleanup. Allow http
+ to be re-sourced without overwriting http state.
+
+2008-03-11 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclEncoding.c (LoadEscapeEncoding): Avoid leaking escape
+ sub-encodings, fixes encoding-11.1 failing after iso2022-jp loaded.
+ [Bug 1893053]
+
+ * macosx/tclMacOSXNotify.c: Avoid using CoreFoundation after fork() on
+ Darwin 9 even when TclpCreateProcess() uses vfork().
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: Add support for Xcode 3.1 and
+ * macosx/Tcl.xcodeproj/default.pbxuser: configs for building with
+ * macosx/Tcl-Common.xcconfig: gcc-4.2 and llvm-gcc-4.2.
+
+ * unix/tclUnixPort.h: Workaround vfork() problems in
+ llvm-gcc-4.2.1 -O4 build.
+
+ * unix/tclUnixPort.h: Move MODULE_SCOPE compat
+ define to top. [Bug 1911102]
+
+ * macosx/GNUmakefile: Fix quoting to allow paths
+ * macosx/Tcl-Common.xcconfig: to ${builddir} and
+ * unix/Makefile.in: ${INSTALL_ROOT} to contain
+ * unix/configure.in: spaces.
+ * unix/install-sh:
+ * unix/tcl.m4:
+ * tests/ioCmd.test:
+
+ * unix/configure: autoconf-2.59
+
+ * unix/Makefile.in (install-strip): Strip non-global symbols from
+ dynamic library.
+
+ * unix/tclUnixNotfy.c: Fix warning.
+
+ * tests/exec.test (exec-9.7): Reduce timing sensitivity
+ * tests/socket.test (socket-2.11): (esp. on multi-proc machines).
+
+ * tests/fCmd.test (fCmd-9.4): Skip on Darwin 9 (xfail).
+
+2008-03-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (TclDeleteNamespaceVars):
+ * tests/var.test (var-8.2): Unset traces on vars should be called with
+ a FQ named during namespace deletion. This was causing infinite loops
+ when unset traces recreated the var, as reported by Julian Noble. [Bug
+ 1911919]
+
+2008-03-10 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updated for 8.5.2 release.
+
+ * doc/http.n: Revised to indicate that [package require http 2.5.5]
+ is needed to get all the documented commands ([http::meta]).
+
+ * generic/tclEvent.c (TclDefaultBgErrorHandlerObjCmd): Added error
+ * tests/event.test (event-5.*): checking to protect against callers
+ passing invalid return options dictionaries. [Bug 1901113]
+
+ * generic/tclBasic.c (ExprAbsFunc): Revised so that the abs()
+ * tests/expr.test: function and the [::tcl::mathfunc::abs]
+ command do not return the value of -0, or equivalent values with more
+ alarming string reps like -1e-350. [Bug 1893815]
+
+2008-03-07 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclResult.c (ReleaseKeys): Workaround for [Bug 1904907].
+ Reset the return option keys to NULL to allow full re-initialization
+ by GetKeys(). This introduces a memory leak for the key objects, but
+ gets us around a crash in the finalization of reflected channels when
+ handling returns, either at compile- or runtime. In both cases we
+ access the keys after they have been released by their thread exit
+ handler. A proper fix is entangled with the untangling of the
+ finalization ordering and attendant issues. For now we choose the
+ lesser evil.
+
+2008-03-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c (Tcl_ExprObj): Revised expression bytecode
+ compiling so that bytecodes invalid due to changing context or due to
+ the difference between expressions and scripts are not reused. [Bug
+ 1899164]
+
+ * generic/tclCmdAH.c: Revised direct evaluation implementation of
+ [expr] so that [expr $e] caches compiled bytecodes for the expression
+ as the intrep of $e.
+
+ * tests/execute.test (execute-6.*): More tests checking that
+ script bytecode is invalidated in the right situations.
+
+2008-03-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * win/configure.in: Add AC_HEADER_STDC to support msys/win64.
+
+2008-03-06 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/namespace.n: Minor tidying up. [Bug 1909019]
+
+2008-03-04 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/execute.test (6.3,4): Added tests for [Bug 1899164].
+
+2008-03-03 Reinhard Max <max@suse.de>
+
+ * unix/tclUnixChan.c: Fix mark and space parity on Linux, which uses
+ CMSPAR instead of PAREXT.
+
+2008-03-02 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclNamesp.c (GetNamespaceFromObj):
+ * tests/interp.test (interp-28.2): Spoil the intrep of an nsNameType
+ obj when the reference crosses interpreter boundaries.
+
+2008-02-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclResult.c (Tcl_SetReturnOptions): Revised the refcount
+ management of Tcl_SetReturnOptions to become that of a conventional
+ Consumer routine. Thanks to Peter Spjuth for pointing out the
+ difficulties calling Tcl_SetReturnOptions with non-0-count value for
+ options.
+ * generic/tclExecute.c (INST_RETURN_STK): Revised the one caller
+ within Tcl itself which passes a non-0-count value to
+ Tcl_SetReturnOptions().
+
+ * generic/tclBasic.c (Tcl_AppendObjToErrorInfo): Revised the
+ refcount management of Tcl_AppendObjToErrorInfo to become that of a
+ conventional Consumer routine. This preserves the ease of use for the
+ overwhelming common callers who pass in a 0-count value, but makes the
+ proper call with a non-0-count value less surprising.
+ * generic/tclEvent.c (TclDefaultBgErrorHandlerObjCmd): Revised the
+ one caller within Tcl itself which passes a non-0-count value to
+ Tcl_AppendObjToErrorInfo().
+
+2008-02-28 Joe English <jenglish@users.sourceforge.net>
+
+ * unix/tclPort.h, unix/tclCompat.h, unix/tclUnixChan.h: Reduce scope
+ of <sys/filio.h> and <sys/ioctl.h> #includes. [Patch 1903339]
+
+2008-02-28 Joe English <jenglish@users.sourceforge.net>
+
+ * unix/tclUnixChan.c, unix/tclUnixNotfy.c, unix/tclUnixPipe.c:
+ Consolidate all code conditionalized on -DUSE_FIONBIO into one place.
+ * unix/tclUnixPort.h, unix/tclUnixCompat.c: New routine
+ TclUnixSetBlockingMode(). [Patch 1903339]
+
+2008-02-28 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (TclEvalObjvInternal): Plug memory leak when
+ an enter trace deletes or changes the command, prompting a reparsing.
+ Don't let the second pass lose commandPtr value allocated during the
+ first pass.
+
+ * generic/tclCompExpr.c (ParseExpr): Plug memory leak in error
+ message generation.
+
+ * generic/tclStringObj.c (Tcl_AppendFormatToObj): [format %llx $big]
+ leaked an mp_int.
+
+ * generic/tclCompCmds.c (TclCompileReturnCmd): The 2007-10-18 commit
+ to optimize compiled [return -level 0 $x] [RFE 1794073] introduced a
+ memory leak of the return options dictionary. Fixing that.
+
+2008-02-27 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/http/http.tcl: [Bug 705956] - fix inverted logic when
+ cleaning up socket error in geturl.
+
+2008-02-27 Kevin B. Kenny <kennykb@acm.org>
+
+ * doc/clock.n: Corrected minor indentation gaffe in the penultimate
+ paragraph. [Bug 1898025]
+ * generic/tclClock.c (ParseClockFormatArgs): Changed to check that the
+ clock value is in the range of a 64-bit integer. [Bug 1862555]
+ * library/clock.tcl (::tcl::clock::format, ::tcl::clock::scan,
+ (::tcl::clock::add, ::tcl::clock::LocalizeFormat): Fixed bugs in
+ caching of localized strings that caused weird results when localized
+ date/time formats were used. [Bug 1902423]
+ * tests/clock.test (clock-61.*, clock-62.1): Regression tests for [Bug
+ 1862555] and [Bug 1902423].
+
+2008-02-26 Joe English <jenglish@users.sourceforge.net>
+
+ * generic/tclIOUtil.c, unix/tclUnixPort.h, unix/tclUnixChan.c:
+ Remove dead/unused portability-related #defines and unused conditional
+ code. See [Patch 1901828] for discussion.
+
+2008-02-26 Joe English <jenglish@users.sourceforge.net>
+
+ * generic/tclIORChan.c (enum MethodName),
+ * generic/tclCompExpr.c (enum Marks): More stray trailing ","s
+
+2008-02-26 Joe English <jenglish@users.sourceforge.net>
+
+ * unix/configure.in(socklen_t test): Define socklen_t as "int" if
+ missing, not "unsigned". Use AC_TRY_COMPILE instead of
+ AC_EGREP_HEADER.
+ * unix/configure: regenerated.
+
+2008-02-26 Joe English <jenglish@users.sourceforge.net>
+
+ * generic/tclCompile.h: Remove stray trailing "," from enum
+ InstOperandType definition (C99ism).
+
+2008-02-26 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclUtil.c (TclReToGlob): Fix the handling of the last star
+ * tests/regexpComp.test: possibly being escaped in
+ determining right anchor. [Bug 1902436]
+
+2008-02-26 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/http/pkgIndex.tcl: Set version 2.5.5
+ * library/http/http.tcl: It is better to do the [eof] check after
+ trying to read from the socket. No clashes found in testing. Added
+ http::meta command to access the http headers. [Bug 1868845]
+
+2008-02-22 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/http/pkgIndex.tcl: Set version 2.5.4
+ * library/http/http.tcl: Always check that the state array exists
+ in the http::status command. [Bug 1818565]
+
+2008-02-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Bump version number to 8.5.2b1 to distinguish
+ * library/init.tcl: CVS development snapshots from the 8.5.1 and
+ * unix/configure.in: 8.5.2 releases.
+ * unix/tcl.spec:
+ * win/configure.in:
+ * README
+
+ * unix/configure: autoconf (2.59)
+ * win/configure:
+
+2008-02-12 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCompCmds.c (TclCompileSwitchCmd): Corrected logic for
+ * tests/switch.test (switch-10.15): handling -nocase compilation; the
+ -exact -nocase option cannot be compiled currently. [Bug 1891827]
+
+ * unix/README: Documented missing configure flags. [Bug 1799011]
+
+2008-02-06 Kevin B. Kenny <kennykb@acm.org>
+
+ * doc/clock.n (%N): Corrected an error in the explanation of the %N
+ format group.
+ * generic/tclClock.c (ClockParseformatargsObjCmd):
+ * library/clock.tcl (::tcl::clock::format):
+ * tests/clock.test (clock-1.0, clock-1.4):
+ Performance enhancements in [clock format] (moving the analysis of
+ $args into C code, holding on to Tcl_Objs with resolved command names,
+ [lassign] in place of [foreach], avoiding [namespace which] for
+ command resolution).
+
+2008-02-04 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.5.1 TAGGED FOR RELEASE ***
+
+ * changes: Updated for 8.5.1 release.
+
+ * generic/tcl.h: Bump to 8.5.1 for release.
+ * library/init.tcl:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/configure.in:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+2008-02-04 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_CONCAT1): Fix optimisation for in-place
+ concatenation (was going over String type)
+
+2008-02-02 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/configure.in (Darwin): Correct Info.plist year substitution
+ in non-framework builds.
+
+ * unix/configure: autoconf-2.59
+
+2008-01-30 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInterp.c (Tcl_GetAlias): Fix for [Bug 1882373], thanks go
+ to an00na.
+
+2008-01-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tools/tcltk-man2html.tcl: Reworked manual page scraper to do a
+ proper job of handling references to Ttk options. [Tk Bug 1876493]
+
+2008-01-29 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/man.macros (SO, SE): Adjusted macros so that it is possible for
+ Ttk to have its "standard options" on a manual page that is not called
+ "options". [Tk Bug 1876493]
+
+2008-01-25 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updated for 8.5.1 release.
+
+2008-01-23 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: New macro TclGrowParseTokenArray() to
+ * generic/tclCompCmds.c: simplify code that might need to grow
+ * generic/tclCompExpr.c: an array of Tcl_Tokens in the parsePtr
+ * generic/tclParse.c: field of a Tcl_Parse. Replaces the
+ TclExpandTokenArray() routine via replacing:
+ int needed = parsePtr->numTokens + growth;
+ while (needed > parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ with:
+ TclGrowParseTokenArray(parsePtr, growth);
+ This revision merged over from dgp-refactor branch.
+
+ * generic/tclCompile.h: Demote TclCompEvalObj() from internal stubs to
+ * generic/tclInt.decls: a MODULE_SCOPE routine declared in
+ tclCompile.h.
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+2008-01-22 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclTimer.c (AfterProc): Replace Tcl_EvalEx() with
+ Tcl_EvalObjEx() to evaluate [after] callbacks. Part of trend to favor
+ compiled execution over direct evaluation.
+
+2008-01-22 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdIl.c (Tcl_LreverseObjCmd):
+ * tests/cmdIL.test (cmdIL-7.7): Fix crash on reversing an empty list.
+ [Bug 1876793]
+
+2008-01-20 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/README: Minor typo fixes [Bug 1853072]
+
+ * generic/tclIO.c (TclGetsObjBinary): Operate on topmost channel.
+ [Bug 1869405] (Ficicchia)
+
+2008-01-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Revision to preserve parsed intreps of
+ numeric and boolean literals when compiling expressions with (optimize
+ == 1).
+
+2008-01-15 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompExpr.c: Add an 'optimize' argument to
+ * generic/tclCompile.c: TclCompileExpr() to profit from better
+ * generic/tclCompile.h: literal management according to usage.
+ * generic/tclExecute.c:
+
+ * generic/tclCompExpr.c: Fix literal leak in exprs [Bug 1869989] (dgp)
+ * generic/tclExecute.c:
+ * tests/compExpr.test:
+
+ * doc/proc.n: Changed wording for access to non-local variables; added
+ mention to [namespace upvar]. Lame attempt at dealing with
+ documentation. [Bug 1872708]
+
+2008-01-15 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Replacing 'operator' by 'op' in the def of
+ * generic/tclCompExpr.c: struct TclOpCmdClientData to accommodate C++
+ * generic/tclCompile.h: compilers. [Bug 1855644]
+
+2008-01-13 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tclWinSerial.c (SerialCloseProc, TclWinOpenSerialChannel): Use
+ critical section for read & write side. [Bug 1353846] (newman)
+
+2008-01-11 Miguel Sofer <msofer@users.sf.net>
+
+ * unix/tclUnixThrd.c (TclpThreadGetStackSize): Restore stack checking
+ functionality in freebsd. [Bug 1850424]
+
+ * unix/tclUnixThrd.c (TclpThreadGetStackSize): Fix for crash in
+ freebsd. [Bug 1860425]
+
+2008-01-10 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStringObj.c (Tcl_AppendFormatToObj): Correct failure to
+ * tests/format.test: account for big.used == 0 corner case in the
+ %ll(idox) format directives. [Bug 1867855]
+
+2008-01-09 George Peter Staplin <georgeps@xmission.com>
+
+ * doc/vwait.n: Add a missing be to fix a typo.
+
+2008-01-04 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tools/tcltk-man2html.tcl (make-man-pages): Make man page title use
+ more specific info on lhs to improve tabbed browser view titles.
+
+2008-01-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/binary.n: Fixed documentation bug reported on tcl-core, and
+ reordered documentation to discourage people from using the hex
+ formatter that is hardly ever useful.
+
+2008-01-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Bump version number to 8.5.1b1 to distinguish
+ * library/init.tcl: CVS development snapshots from the 8.5.0 and
+ * unix/configure.in: 8.5.1 releases.
+ * unix/tcl.spec:
+ * win/configure.in:
+ * README
+
+ * unix/configure: autoconf (2.59)
+ * win/configure:
+
+ ******************************************************************
+ *** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007" ***
+ *** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005" ***
+ *** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004" ***
+ *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" ***
+ *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" ***
+ *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" ***
+ *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" ***
+ *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
+ ******************************************************************
diff --git a/README b/README
index 5236585..f8965b4 100644
--- a/README
+++ b/README
@@ -1,12 +1,9 @@
README: Tcl
- This is the Tcl 8.6b1 source distribution.
- Tcl/Tk is also available through NetCVS:
+ This is the Tcl 8.6.0 source distribution.
http://tcl.sourceforge.net/
You can get any source release of Tcl from the file distributions
link at the above URL.
-RCS: @(#) $Id: README,v 1.73 2008/12/19 03:54:44 dgp Exp $
-
Contents
--------
1. Introduction
@@ -14,10 +11,10 @@ Contents
3. Compiling and installing Tcl
4. Development tools
5. Tcl newsgroup
- 6. Tcl contributed archive
- 7. Tcl Resource Center
- 8. Mailing lists
- 9. Support and Training
+ 6. The Tcler's Wiki
+ 7. Mailing lists
+ 8. Support and Training
+ 9. Tracking Development
10. Thank You
1. Introduction
@@ -30,7 +27,7 @@ Tcl can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.
Tcl is maintained, enhanced, and distributed freely by the Tcl community.
-The home for Tcl/Tk sources and bug/patch database is on SourceForge:
+The home for Tcl/Tk releases and bug/patch database is on SourceForge:
http://tcl.sourceforge.net/
@@ -52,13 +49,17 @@ The home page for this release, including new features, is
Detailed release notes can be found at the file distributions page
by clicking on the relevant version.
- http://sourceforge.net/project/showfiles.php?group_id=10894
+ http://sourceforge.net/projects/tcl/files/
Information about Tcl itself can be found at
- http://www.tcl.tk/scripting/
+ http://www.tcl.tk/about/
There have been many Tcl books on the market. Many are mentioned in the Wiki:
- http://wiki.tcl.tk/book
+ http://wiki.tcl.tk/_/ref?N=25206
+
+To view the complete set of reference manual entries for Tcl 8.6 online,
+visit the URL:
+ http://www.tcl.tk/man/tcl8.6/
2a. Unix Documentation
----------------------
@@ -171,6 +172,12 @@ Tcl/Tk training:
http://wiki.tcl.tk/training
+9. Tracking Development
+-----------------------
+
+Tcl is developed in public. To keep an eye on how Tcl is changing, see
+ http://core.tcl.tk/
+
10. Thank You
-------------
diff --git a/changes b/changes
index cdc2033..63c3877 100644
--- a/changes
+++ b/changes
@@ -1,7 +1,5 @@
Recent user-visible changes to Tcl:
-RCS: @(#) $Id: changes,v 1.149 2010/08/10 20:36:39 dgp Exp $
-
1. No more [command1] [command2] construct for grouping multiple
commands on a single command line.
@@ -128,7 +126,7 @@ Tcl_Eval.
that came after version 3.3 was released.
40. 5/17/91 Changed tests to conform to Mary Ann May-Pumphrey's approach.
-
+
41. 5/23/91 Massive revision to Tcl parser to simplify the implementation
of string and floating-point support in expressions. Newlines inside
[] are now treated as command separators rather than word separators
@@ -262,7 +260,7 @@ argument (before file name), for consistency with other Tcl commands.
*** POTENTIAL INCOMPATIBILITY ***
72. 8/20/91 Changed format of information in $errorInfo variable:
-comments such as
+comments such as
("while" body line 1)
are now on separate lines from commands being executed.
*** POTENTIAL INCOMPATIBILITY ***
@@ -1194,7 +1192,7 @@ under some dynamic loading systems (e.g. SunOS 4.1 and Windows).
6/8/95 (feature change) Modified interface to Tcl_Main to pass in the
address of the application-specific initialization procedure.
Tcl_AppInit is no longer hardwired into Tcl_Main. This is needed
-in order to make Tcl a shared library.
+in order to make Tcl a shared library.
6/8/95 (feature change) Modified Makefile so that the installed versions
of tclsh and libtcl.a have version number in them (e.g. tclsh7.4 and
@@ -1618,7 +1616,7 @@ file name. Under Windows '95, this is incorrectly interpreted as a UNC
path. They delays came from the network timeouts needed to determine that
the file name was invalid. Tcl_TranslateFileName now suppresses duplicate
slashes that aren't at the beginning of the file name. (SS)
-
+
1/25/96 (bug fix) Changed exec and open to create children so they are
attached to the application's console if it exists. (SS)
@@ -2256,21 +2254,21 @@ version of Tcl. It's quite a bit faster than MetroWerk's version. (RJ)
8/26/96 (documentation update) Removed old change bars (for all changes
in Tcl 7.5 and earlier releases) from manual entries. (JO)
-8/27/96 (enhancement) The exec and open commands behave better and work in
-more situations under Windows NT and Windows 95. Documentation describes
+8/27/96 (enhancement) The exec and open commands behave better and work in
+more situations under Windows NT and Windows 95. Documentation describes
what is still lacking. (CS)
8/27/96 (enhancement) The Windows makefiles will now compile even if the
compiler is not in the path and/or the compiler's environment variables
-have not been set up. (CS)
+have not been set up. (CS)
-8/27/96 (configuration improvement) The Windows resource files are
+8/27/96 (configuration improvement) The Windows resource files are
automatically updated when the version/patch level changes. The header file
now has a comment that reminds the user which other files must be manually
updated when the version/patch level changes. (CS)
8/28/96 (new feature) Added file manipulation features (copy, rename, delete,
-mkdir) that are supported on all platforms. They are implemented as
+mkdir) that are supported on all platforms. They are implemented as
subcommands to the "file" command. See the documentation for the "file"
command for more information. (JH)
@@ -2373,7 +2371,7 @@ the Tcl script in the fileevent wasn't closing the socket immediately. (JL)
package goes in a separate subdirectory of a directory in
$tcl_pkgPath). These directories are included in auto_path by
default.
- - Changed the package auto-loader to look for pkgIndex.tcl files
+ - Changed the package auto-loader to look for pkgIndex.tcl files
not only in the auto_path directories but also in their immediate
children. This should make it easier to install and uninstall
packages (don't have to change auto_path or merge pkgIndex.tcl
@@ -2623,7 +2621,7 @@ lookups of keyword arguments. (JO)
1/12/97 (new feature) Serial IO channel drivers for Windows and Unix,
available by using Tcl open command to open pseudo-files like "com1:" or
-"/dev/ttya". New option to Tcl fconfigure command for serial files:
+"/dev/ttya". New option to Tcl fconfigure command for serial files:
"-mode baud,parity,data,stop" to specify baud rate, parity, data bits, and
stop bits. Serial IO is not yet available on Mac.
@@ -2703,7 +2701,7 @@ to Feb 31.) The code now will return the last valid day of the
month in these situations. Thanks to Hume Smith for sending in
this bug fix. (RJ)
-2/10/97 (feature change) Eliminated Tcl_StringObjAppend and
+2/10/97 (feature change) Eliminated Tcl_StringObjAppend and
Tcl_StringObjAppendObj procedures, replaced them with Tcl_AppendToObj
and Tcl_AppendStringsToObj procedures. Added new procedure
Tcl_SetObjLength. (JO)
@@ -3070,7 +3068,7 @@ compilation errors from "invoked from within" to "while compiling". (BL)
modified the interpreter result even if there was no error.
- The argument parsing procedure used by several compile procedures
always treated "]" as end of a command: e.g., "set a ]" would fail.
- - Changed errorInfo traceback message for compilation errors from
+ - Changed errorInfo traceback message for compilation errors from
"invoked from within" to "while compiling".
- Problem initializing Tcl object managers during interpreter creation.
- Added check and error message if formal parameter to a procedure is
@@ -3145,7 +3143,7 @@ is leaked to safe interps. Error message fixes for interp sub commands.
Likewise changes in safealias.tcl; tcl_safeCreateInterp can now be called
without argument to generate the slave name (like in interp create). (DL)
-7/10/97 (bug fixes) Bytecode compiler now generates more detailed
+7/10/97 (bug fixes) Bytecode compiler now generates more detailed
command location information: subcommands as well as commands now have
location information. This means command trace procedures now get the
correct source string for each command in their command parameter. (BL)
@@ -3183,7 +3181,7 @@ malloc and free. (SS)
sourcing/loading (see safe.n) to hide pathnames, use virtual
paths tokens instead, improved security in several respects and made it
more tunable. Multi level interp loading can work too now. Package auto
-loading now works in safe interps as long as the package directory is in
+loading now works in safe interps as long as the package directory is in
the auto_path (no deep crawling allowed in safe interps). (DL)
*** POTENTIAL INCOMPATIBILITY with previous alpha and beta releases ***
@@ -3211,7 +3209,7 @@ exists" command returns 0 for them. (BL)
7/29/97 (feature change) Changed the http package to use the ::http
namespace. http_get renamed to http::geturl, http_config renamed to
http::config, http_formatQuery renamed to http::formatQuery.
-It now provides the 2.0 version of the package.
+It now provides the 2.0 version of the package.
The 1.0 version is still available with the old names.
*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b2 but not with Tcl 7.6 ***
@@ -3275,7 +3273,7 @@ except that the default precision is 12 instead of 6. (JO)
----------------- Released 8.0, 8/18/97 -----------------------
8/19/97 (bug fix) Minimal fix for glob -nocomplain bugs:
-"glob -nocomplain unreadableDir/*" was generating an anonymous
+"glob -nocomplain unreadableDir/*" was generating an anonymous
error. More in depth fixes will come with 8.1. (DL).
8/20/97 (bug fix) Removed check for FLT_MIN in binary command so
@@ -3320,7 +3318,7 @@ does not prevent stack overflow by multi-interps recursion or aliasing} (DL)
9/11/97 (bug fix) An uninitialized variable in Tcl_WaitPid caused
pipes to fail to report eof properly under Windows. (SS)
-9/12/97 (bug fix) "exec" was misidentifying some DOS executables as not
+9/12/97 (bug fix) "exec" was misidentifying some DOS executables as not
executable. (CCS)
9/14/97 (bug fix) Was using the wrong structure in sizeof operation in
@@ -3344,7 +3342,7 @@ Roseman for the pointer on the fix.) (RJ)
cause the compare function to run off the end of an array if the
number only contained 0's. (Thanks to Greg Couch for the report.) (RJ)
-9/18/97 (bug fix) TclFinalizeEnvironment was not cleaning up
+9/18/97 (bug fix) TclFinalizeEnvironment was not cleaning up
properly. (DL, JI)
9/18/97 (bug fix) Fixed long-standing bug where an "array get" command
@@ -3380,9 +3378,9 @@ Now you can "join $list \0" for instance. (DL)
non-existent directory, exec would fail when trying to create its temporary
files. (CCS)
-10/9/97 (bug fix) Under mac and windows, "info hostname" would crash if
+10/9/97 (bug fix) Under mac and windows, "info hostname" would crash if
sockets were installed but the hostname could not be determined anyhow.
-Tcl_GetHostName() was returning NULL when it should have been returning
+Tcl_GetHostName() was returning NULL when it should have been returning
an empty string. (CCS)
10/10/97 (bug fix) "file attribute /" returned error on windows. (CCS)
@@ -3470,7 +3468,7 @@ around to be really closed in this case. (JL)
12/8/97 (bug fix) Need to protect the channel in a fileevent so that it
is not deleted before the fileevent handler returns. (CS, JL)
-12/18/97 (bug fix) In the opt argument parsing package: if the description
+12/18/97 (bug fix) In the opt argument parsing package: if the description
had only flags, the "too many arguments" case was not detected. The default
value was not used for the special "args" ending argument. (DL)
@@ -3513,7 +3511,7 @@ that could lead to a crash. (SS)
non-local variable references. (SS)
6/25/98 (new features) Added name resolution hooks to support [incr Tcl].
-There are new internal Tcl_*Resolver* APIs to add, query and remove the hooks.
+There are new internal Tcl_*Resolver* APIs to add, query and remove the hooks.
With this changes it should be possible to dynamically load [incr Tcl]
as an extension. (MM)
@@ -3541,7 +3539,7 @@ TclAccessInsertProc, TclStatInsertProc, & TclOpenFileChannelInsertProc
insert pointers to such routines; TclAccessDeleteProc, TclStatDeleteProc,
& TclOpenFileChannelDeleteProc delete pointers to such routines. See
the file generic/tclIOUtils.c for more details. (SKS)
-
+
7/1/98 (enhancement) Added a new internal C variable
tclPreInitScript. This is a pointer to a string that may hold an
initialization script; If this pointer is non-NULL it is evaluated in
@@ -3625,7 +3623,7 @@ internal representation holds a pointer to a Proc structure. Extended
TclCreateProc to take both strings and "procbody". (EMS)
10/13/98 (bug fix) The "info complete" command can now handle strings
-with NULLs embedded. Thanks to colin@field.medicine.adelaide.edu.au
+with NULLs embedded. Thanks to colin@field.medicine.adelaide.edu.au
for providing this fix. (RJ)
10/13/98 (bug fix) The "lsort -dictionary" command did not properly
@@ -3693,7 +3691,7 @@ by default. Fixed socket code so it turns off this bit right after
creation so sockets aren't kept open by exec'ed processes. [Bug: 892]
Thanks to Kevin Kenny for this fix. (SS)
-1/11/98 (bug fix) On HP, "info sharedlibextension" was returning
+1/11/98 (bug fix) On HP, "info sharedlibextension" was returning
empty string on static apps. It now always returns ".sl". (RJ)
1/28/99 (configure change) Now support -pipe option on gcc. (RJ)
@@ -3738,7 +3736,7 @@ panic. (stanton)
2/2/99 (feature change/bug fix) Changed the behavior of "file
extension" so that it splits at the last period. Now the extension of
-a file like "foo..o" is ".o" instead of "..o" as in previous versions.
+a file like "foo..o" is ".o" instead of "..o" as in previous versions.
*** POTENTIAL INCOMPATIBILITY ***
----------------- Released 8.0.5, 3/9/99 -------------------------
@@ -3759,15 +3757,15 @@ a file like "foo..o" is ".o" instead of "..o" as in previous versions.
of a UTF-8 string remains \0. Thus Tcl strings once again do not
contain null bytes, except for termination bytes.
- For Java compatibility, "\uXXXX" is used in Tcl to enter a Unicode
- character. "\u0000" through "\uffff" are acceptable Unicode
- characters.
+ character. "\u0000" through "\uffff" are acceptable Unicode
+ characters.
- "\xXX" is used to enter a small Unicode character (between 0 and 255)
in Tcl.
- Tcl automatically translates between UTF-8 and the normal encoding for
the platform during interactions with the system.
- The fconfigure command now supports a -encoding option for specifying
the encoding of an open file or socket. Tcl will automatically
- translate between the specified encoding and UTF-8 during I/O.
+ translate between the specified encoding and UTF-8 during I/O.
See the directory library/encoding to find out what encodings are
supported (eventually there will be an "encoding" command that
makes this information more accessible).
@@ -3841,7 +3839,7 @@ imported procedures as well as procedures defined in a namespace. (BL)
in place of Tcl_GetStringFromObj() if the string representation's length
isn't needed. (BL)
-12/18/97 (bug fix) In the opt argument parsing package: if the description
+12/18/97 (bug fix) In the opt argument parsing package: if the description
had only flags, the "too many arguments" case was not detected. The default
value was not used for the special "args" ending argument. (DL)
@@ -3851,11 +3849,11 @@ procs now in auto.tcl and package.tcl can be autoloaded if needed. (DL)
1/7/98 (enhancement) tcltest made at install time will search for it's
init.tcl where it is, even when using virtual path compilation. (DL)
-1/8/98 (os bug workaround) when needed, using a replacement for memcmp so
+1/8/98 (os bug workaround) when needed, using a replacement for memcmp so
string compare "char with high bit set" "char w/o high bit set" returns
the expected value on all platforms. (DL)
-1/8/98 (unix portability/configure) building from .../unix/targetName/
+1/8/98 (unix portability/configure) building from .../unix/targetName/
subdirectories and simply using "../configure" should now work fine. (DL)
1/14/98 (enhancement) Added new regular expression package that
@@ -3887,7 +3885,7 @@ to generate direct loading package indexes (such those you need
if you use namespaces and plan on using namespace import just after
package require). pkg_mkIndex still has limitations regarding
package dependencies but errors are now ignored and with -direct, correct
-package indexes can be generated even if there are dependencies as long
+package indexes can be generated even if there are dependencies as long
as the "package provide" are done early enough in the files. (DL)
1/28/98 (enhancement) Performance tuning of regexp and regsub. (CCS)
@@ -3911,7 +3909,7 @@ continue to use the argv array after calling Tcl_OpenCommandChannel(). (CCS)
2/1/98 (bug fix) More bugs with %Z in format string argument to strftime():
1. Borland always returned empty string.
2. MSVC always returned the timezone string for the current time, not the
- timezone string for the specified time.
+ timezone string for the specified time.
3. With MSVC, "clock format 0 -format %Z -gmt 1" would return "GMT" the first
time it was called, but would return the current timezone string on all
subsequent calls. (CCS)
@@ -3933,7 +3931,7 @@ root directory was returning error. (CCS)
determine the attributes for a file. Previously it would return different
error messages on Unix vs. Windows vs. Mac. (CCS)
-2/4/98 (bug fixes) Fixed several instances of bugs where the parser/compiler
+2/4/98 (bug fixes) Fixed several instances of bugs where the parser/compiler
would reach outside the range of allocated memory. Improved the array
lookup algorithm in set compilation. (DL)
@@ -3941,13 +3939,13 @@ lookup algorithm in set compilation. (DL)
deprecated and ignored. The part1 is always parsed when the part2 argument
is NULL. This is to avoid a pattern of errors for extension writers converting
from string based Tcl_SetVar() to new Tcl_SetObjVar2() and who could easily
-forget to provide the flag and thus get code working for normal variables
+forget to provide the flag and thus get code working for normal variables
but not for array elements. The performance hit is minimal. A side effect
of that change is that is is no longer possible to create scalar variables
-that can't be accessed by tcl scripts because of their invalid name
-(ending with parenthesis). Likewise it is also parsed and checked to
-ensure that you don't create array elements of array whose name is a valid
-array element because they would not be accessible from scripts anyway.
+that can't be accessed by tcl scripts because of their invalid name
+(ending with parenthesis). Likewise it is also parsed and checked to
+ensure that you don't create array elements of array whose name is a valid
+array element because they would not be accessible from scripts anyway.
Note: There is still duplicate array elements parsing code. (DL)
*** POTENTIAL INCOMPATIBILITY ***
@@ -3993,7 +3991,7 @@ registry call. (CCS)
2/11/98 (enhancement) Eliminate the TCL_USE_TIMEZONE_VAR definition from
configure.in, because it was the same information as the already existing
HAVE_TM_ZONE definition. The lack of HAVE_TM_ZONE is used to work around a
-Solaris and Windows bug where "clock format [clock sec] -format %Z -gmt 1"
+Solaris and Windows bug where "clock format [clock sec] -format %Z -gmt 1"
produces the local timezone string instead of "GMT". (CCS)
2/11/98 (bug fix) Memleaks and dereferencing of uninitialized memory in
@@ -4351,7 +4349,7 @@ strings that are already null terminated. [Bug: 1793] (stanton)
5/3/99 (new feature) Applied Jeff Hobbs's string patch which includes
the following changes:
- - added new subcommands: equal, repeat, map, is, replace
+ - added new subcommands: equal, repeat, map, is, replace
- added -length option to "string compare|equal"
- added -nocase option to "string compare|equal|match"
- string and list indices can be an integer or end?-integer?.
@@ -4380,7 +4378,7 @@ improvements for many Tcl scripts. [Bug: 1063] (stanton)
encoding subfield from the LANG/LC_ALL environment variables in cases
where the locale is not found in the built-in locale table. It also
attempts to initialize the locale subsystem so X11 is happy. [Bug: 1989]
-(stanton)
+(stanton)
5/14/99 (bug fix) Applied the patch to fix 100-year and 400-year
boundaries in leap year code, from Isaac Hollander. [Bug: 2066] (redman)
@@ -4468,7 +4466,7 @@ harness package. Modified test files to use new tcltest package.
6/26/99 (new feature) Applied patch from Peter Hardie to add poke
command to dde and changed the dde package version number to
-1.1. (redman)
+1.1. (redman)
6/28/99 (bug fix) Applied patch from Peter Hardie to fix problem in
Tcl_GetIndexFromObj() when the key being passed is the empty string.
@@ -4531,7 +4529,7 @@ notation for opening serial ports on Windows. (redman)
instead of the platform-specific "size_t", primarily after SunOS 4
users could no longer compile. (redman)
-7/22/99 (bug fix) Fixed crashing during "array set a(b) {}".
+7/22/99 (bug fix) Fixed crashing during "array set a(b) {}".
[Bug: 2427] (redman)
7/22/99 (bug fix) The install-sh script must be given execute
@@ -4566,7 +4564,7 @@ pack-old.n [Bug: 2469]. Patches from Don Porter. (redman)
7/29/99 (bug fix) Allow tcl to open CON and NUL, even for redirection
of std channels. [Bug: 2393 2392 2209 2458] (redman)
-7/30/99 (bug fix) Applied fixed Trf patch from Andreas Kupries.
+7/30/99 (bug fix) Applied fixed Trf patch from Andreas Kupries.
[Bug: 2386] (hobbs)
7/30/99 (bug fix) Fixed bug in info complete. [Bug: 2383 2466] (hobbs)
@@ -4576,7 +4574,7 @@ provided by James Dennett. [Bug: 2450] (redman)
7/30/99 (bug fix) Fixed launching of 16bit applications on Win9x from
wish. The command line was being primed with tclpip82.dll, but it was
-ignored later.
+ignored later.
7/30/99 (bug fix) Added functions to stub table, patch provided by Jan
Nijtmans. [Bug: 2445] (hobbs)
@@ -4589,7 +4587,7 @@ thread's stack space. (redman)
--------------- Released 8.2b2, August 5, 1999 ----------------------
8/4/99 (bug fix) Applied patches supplied by Henry Spencer to greatly
-enhance performance of certain classes of regular expressions.
+enhance performance of certain classes of regular expressions.
[Bug: 2440 2447] (stanton)
8/5/99 (doc change) Made it clear that tcl_pkgPath was not set for
@@ -4603,7 +4601,7 @@ terminated in tclLiteral.c. [Bug: 2496] (hobbs)
8/9/99 (bug fix) Fixed test suite to handle larger integers
(64bit). Patch from Don Porter. (hobbs)
-8/9/99 (documentation fix) Clarified Tcl_DecrRefCount docs
+8/9/99 (documentation fix) Clarified Tcl_DecrRefCount docs
[Bug: 1952]. Clarified array pattern docs [Bug: 1330]. Fixed clock docs
[Bug: 693]. Fixed formatting errors [Bug: 2188 2189]. Fixed doc error
in tclvars.n [Bug: 2042]. (hobbs)
@@ -4663,7 +4661,7 @@ and in testthread code. No more known (reported) mem leaks for Tcl
built using gcc on Solaris 2.5.1. Also none reported for Tcl on NT
(using Purify 6.0). (hobbs)
-10/30/99 (bug fix) fixed improper bytecode handling of
+10/30/99 (bug fix) fixed improper bytecode handling of
'eval {set array($unknownvar) 5}' (also for incr) (hobbs)
10/30/99 (bug fix) fixed event/io threading problems by making
@@ -5117,7 +5115,7 @@ bits for Tcl_UniChar though) (hobbs)
2001-05-30 (new feature)[TIP 15] Tcl_GetMathFuncInfo, Tcl_ListMathFuncs,
Tcl_InfoObjCmd, InfoFunctionsCmd APIs (fellows)
-2001-06-08 (bug fix,feature enhancement)[219170,414936] all Tcl_Panic
+2001-06-08 (bug fix,feature enhancement)[219170,414936] all Tcl_Panic
definitions brought into agreement (porter)
2001-06-12 (bug fix)[219232] regexp returned non-matching sub-pairs to have
@@ -5286,7 +5284,7 @@ compiles to 0 bytecodes (sofer)
2001-09-13 (new feature) Old ChangeLog entries => ChangeLog.1999 (hobbs)
-2001-09-17 (new feature) compiling with TCL_COMPILE_DEBUG now required to
+2001-09-17 (new feature) compiling with TCL_COMPILE_DEBUG now required to
enable all compile and execution tracing (sofer)
*** POTENTIAL INCOMPATIBILITY ***
@@ -5568,7 +5566,7 @@ options to configure (max)
2002-07-30 (bug fix)[584603] WriteChars infinite loop non-UTF-8 string (kupries)
-2002-08-04 (new feature)[584051,580433,585105,582429][TIP 27] Tcl interfaces
+2002-08-04 (new feature)[584051,580433,585105,582429][TIP 27] Tcl interfaces
are now fully CONST-ified. Use the symbols USE_NON_CONST or
USE_COMPAT_CONST to select interfaces with fewer changes.
*** POTENTIAL INCOMPATIBILITY ***
@@ -5578,7 +5576,7 @@ options to configure (max)
=> tcltest 2.2
2002-08-07 (bug fix)[587488] mem leak with USE_THREAD_ALLOC (sofer,sass)
-
+
2002-08-07 (feature enhancement)[584794,584650,472576] boolean values
are no longer always re-parsed from string. (sofer)
@@ -5712,7 +5710,7 @@ packages in multiple interps.
2003-02-01 (bug fix)[675356] [clock clicks {}]; [clock clicks -] - syntax errs
-2003-02-01 (bug fix)[656660] MT-safety for [clock format]
+2003-02-01 (bug fix)[656660] MT-safety for [clock format]
2003-02-03 (bug fix)[651271] command rename traces get fully-qualified names
*** POTENTIAL INCOMPATIBILITY ***
@@ -5931,7 +5929,7 @@ various odd regexp "can't happen" bugs.
2003-12-09 (platform support)[852369] update errno usage for recent glibc
-2003-12-12 (bug fix)[858937] fix for [file normalize ~nobody]
+2003-12-12 (bug fix)[858937] fix for [file normalize ~nobody]
2003-12-17 (bug fix)[839519] fixed two memory leaks (vasiljevic)
@@ -5946,7 +5944,7 @@ various odd regexp "can't happen" bugs.
2004-02-12 (feature enhancement) update HP-11 build libs setup
-2004-02-17 (bug fix)[849514,859251] corrected [file normailze] of $link/..
+2004-02-17 (bug fix)[849514,859251] corrected [file normailze] of $link/..
2004-02-17 (bug fix)[772288] Unix std channels forced to exist at startup.
@@ -6039,7 +6037,7 @@ in this changeset (new minor version) rather than bug fixes:
* [TIP #139] documented portions of Tcl's namespace C APIs
* [TIP #148] correct [list]-quoting of the '#' character
- *** POTENTIAL INCOMPATIBILITY ***
+ *** POTENTIAL INCOMPATIBILITY ***
For scripts that assume a particular (buggy) string rep for lists.
* [TIP #156] add "root locale" to msgcat
@@ -6534,7 +6532,7 @@ Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2005-05-17.
2005-07-22 (enhancement)[1237755] 8.4 features in script library (fradin,porter)
-2005-07-24 (new feature) configure macros SC_PROG_TCLSH, SC_BUILD_TCLSH (dejong)
+2005-07-24 (new feature) configure macros SC_PROG_TCLSH, SC_BUILD_TCLSH (dejong)
2005-07-26 (bug fix)[1047286] cmd delete traces during namespace delete (porter)
2005-07-26 (new unix feature)[1231015] ${prefix}/share on ::tcl_pkgPath (dejong)
@@ -6629,7 +6627,7 @@ registered by [package ifneeded] provides the version it claims (lavana,porter)
2005-11-09 (bug fix)[1350293,1350291] [after $negative $script] fixed (kenny)
-2005-11-12 (bug fix)[1352734,1354540,1355942,1355342] [namespace delete]
+2005-11-12 (bug fix)[1352734,1354540,1355942,1355342] [namespace delete]
issues with [namespace path] and command delete traces (sofer,fellows)
2005-11-18 (bug fix)[1358369] URL parsing standards compliance (wu,fellows)
@@ -6758,7 +6756,7 @@ naked-fork safe on Tiger (steffen)
2006-06-20 (internal change) Dropped the internal routines used to hook into
filesystem operations back in the pre-Tcl_Filesystem days. (porter)
***POTENTIAL INCOMPATIBILITY***
-For extensions and programs that have never migrated to the supported Tcl 8.4
+For extensions and programs that have never migrated to the supported Tcl 8.4
interface for virtual filesystems
2006-07-05 (enhancement) Expression parser rewrite avoids stack overflow,
@@ -7534,7 +7532,7 @@ evaluation in extensions (sofer,kenny)
2009-05-08 (bug fix)[2414858] tailcall in oo constructor (fellows)
-2009-05-14 (new subcommand) [info object namespace] (fellows)
+2009-05-14 (new subcommand)[TIP 354] [info object namespace] (fellows)
2009-05-29 (platform support) account for ia64_32 (kupries)
=> platform 1.0.5
@@ -7565,7 +7563,7 @@ avoid otherwise very tricky multi-thread finalization bugs. (staplin,ferrieux)
2009-07-16 (bug fix)[2819200] underflow settings on MIPS systems (porter)
-2009-07-19 (interface) new public routine Tcl_GetObjectName() (fellows)
+2009-07-19 (interface)[TIP 354] new routine Tcl_GetObjectName() (fellows)
2009-07-20 (performance) favor [string is] success cases over empty (fellows)
@@ -7605,7 +7603,7 @@ avoid otherwise very tricky multi-thread finalization bugs. (staplin,ferrieux)
2009-10-04 (bug fix)[2569449] Core Foundation memory bug in Tiger (steffen)
-2009-10-06 (bug fix) repair intrep loss in slave interp evaluations
+2009-10-06 (bug fix) repair intrep loss in slave interp evaluations
introduced by first versions of the NRE conversion (nadkarni,porter)
2009-10-06 (bug fix)[1941434] broken tclTomMath.h includes (porter)
@@ -7767,8 +7765,6 @@ memory with buffer backup (ferrieux)
2010-07-28 (bug fix)[3037525] crash deleting vars @ callframe pop (sofer)
-2010-08-02 tzdata updated to Olson's tzdata2010k (kenny)
-
2010-08-04 (bug fix)[3034840] mem corrupt when refchan loses interp (kupries)
2010-08-04 (enhancement) Win [load] use LOAD_WITH_ALTERED_SEARCH_PATH (hobbs)
@@ -7776,4 +7772,394 @@ memory with buffer backup (ferrieux)
2010-08-04 (platform support) panic on detection of win9x system (hobbs)
*** POTENTIAL INCOMPATIBILITY ***
---- Released 8.6b2, September ??, 2010 --- See ChangeLog for details ---
+2010-08-10 (fix) Handle non-null-terminated bytearrys in glob matching (hobbs)
+
+2010-08-11 (fix) copy-paste bug in [yield] implementation (sofer, goth)
+
+2010-08-11 (platform) Drop pre-aix 4.2 support, ldAix (hobbs)
+
+2010-08-14 (frq)[2819611] changed signatures of hash fnctions, delete-file, and get-native-path (nijtmans)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2010-08-15 (bug fix)[3045010] tweaked error message for wrong#args of lambda's (fellows)
+
+2010-08-18 (bug fix)[3004191] fixed safe [glob] (fellows)
+
+2010-08-21 (patch)[3034251] genStubs steal features of ttkGenStubs (nijtmans)
+
+2010-08-26 (bug fix)[1230554] configure, OSF-1 problems, windows manifest issues (hobbs)
+
+2010-08-30 (bug fix) [3046594,3047235,3048771] reimplemented tailcall (sofer)
+
+2010-08-31 fixed manifest handling on windows (hobbs, kupries)
+
+2010-08-31 windows makefile and stub changes (nijtmans)
+
+2010-09-01 (bug fix)[3057639] compiled lappend trace consistency (hobbs,kupries)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2010-09-01 fixed safe glob handling of -directory (kupries)
+
+2010-09-02 fixed safe glob handling of -join (kupries)
+
+2010-09-08 (bug fix)[3059922] build with mingw on amd64 (porter, mescalinum)
+
+2010-09-15 (bug fix)[3067036] stop hang in bytearray append (fellows)
+
+2010-09-22 unified set of link libraries between mingw and vc (nijtmans)
+
+2010-09-22 (bug fix)[3072640] protect writes to ::error* variables (sofer)
+
+2010-09-23 fix leak of return options [catch $err m constant] (porter, hobbs)
+
+2010-09-24 (bugfix)[3056775] fixed race condition in windows sockets (kupries)
+
+2010-09-24 (performance) string eq/cmp (hobbs)
+
+2010-09-26 (patch)[3072080] rewritten NRE core (sofer)
+
+2010-09-28 (new feature)[TIP 162] implementation of ipv6 sockets (max)
+
+2010-10-02 (bug fix)[3079830] properly invalidate string rep of dicts (fellows)
+
+2010-10-06 (bug fix)[3081065] fix writing to freed Tcl_Obj (porter)
+
+2010-10-08 fix in ipv6 code on windows (nijtmans)
+
+2010-10-09 fixed overallocation of execution stack (sofer)
+
+2010-10-11 windows unicode changes (nijtmans)
+
+2010-10-12 (bug fix)[3084338] fixed meamleak in ipv6 code (max)
+
+2010-10-13 (bug fix)[467523,983660] alt fix allows empty literal share (porter)
+
+2010-10-15 (bugfix)[3085863] updated unicode tables (nijtmans)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2010-10-16 refactored implementation of dict iteration (fellows)
+
+2010-10-17 (patch)[2995655] report inner contexts on error stack (ferrieux)
+
+2010-10-19 (bug fix)[3081008] fixed bytearray zlib interaction (fellows)
+
+2010-10-19 improved crc, appending to bytearray (fellows)
+
+2010-10-20 improved compilation of [dict for] (fellows)
+
+2010-10-26 Added private support to disable reverse dns (max)
+
+2010-10-26 Prevent crashes when querying socket options (fellows, max)
+
+2010-10-28 (bug fix)[3093120] prevent freeaddrinfo(NULL) (porter, virden)
+
+2010-10-29 (bug fix)[2905784] stop cycle waste in short [after] (ferrieux)
+
+2010-11-01 tzdata updated to Olson's tzdata2010o (kenny)
+
+2010-11-04 (bug fix)[3099086] Clarified docs of var substitution (fellows)
+
+2010-11-04 improved install targets (cassof)
+
+2010-11-04 improved testing of sockets (max)
+
+2010-11-05 (frq)[491789] setargv/unicode cmdline for MSVC (nijtmans)
+
+2010-11-09 (bug fix)[3105999] fixed memleak in OO var resolver (fellows)
+
+2010-11-15 (TIP 378)[3081184] improved TIP 280 performance (kupries)
+
+2010-11-16 (platform) VS 2005 SP1 MSVC compiler (nijtmans)
+
+2010-11-18 (bug fix)[3111059] leak in [namespace delete] w coroutines (sofer)
+
+2010-11-28 [3120139,3105247] Tcl_PrintDouble improvements (kenny)
+
+2010-11-29 (new cmd) [tcl::unsupported::inject] (ferrieux,sofer)
+
+2010-11-30 (enhancement) Restore TclFormatInt for performance (hobbs)
+
+2010-12-09 (new feature) [file] is now a [namespace ensemble] (fellows)
+
+2010-12-19 (bug fix) [fcopy -size 1 -command] asynchronous (ferrieux)
+
+2010-12-12 (platform) OpenBSD build improvements (cassoff)
+
+2010-12-17 (platform) Revisions to support rpm 4.4.2 (cassoff)
+
+2010-12-27 (bug fix) crash in [lsort] w multiple -index options (fellows)
+
+2010-12-30 (bug fix)[3142026] GrowEvaluationStack OBOE (harder,sofer)
+
+2011-01-18 (bug fix)[3001438] [info frame -1] crash (mccormack,fellows)
+
+2011-03-01 (performance)[3168398] optimize [interp cancel] (mistachkin)
+
+2011-03-05 (bug fix)[3185009] crash in OO variables (danckaert,fellows)
+
+2011-03-05 (new cmd) [tcl::unsupported::assemble] (ugurlu,kenny)
+
+2011-03-06 (bug fix)[3200987,3192636] parser buffer overruns (porter)
+
+2011-03-08 (bug fix)[3202905] failed intrep release of interp result (mccormack)
+
+2011-03-09 (bug fix)[3202171] repair [namespace inscope] optimizer (porter)
+
+2011-03-10 (new version) better tcltest reporting from child interps (fellows)
+=> tcltest 2.3.3
+
+2011-03-10 (new feature) [namespace] is now a [namespace ensemble] (fellows)
+
+2011-03-12 (interface) reduce casting by ckalloc(), ckfree() callers (fellows)
+
+2011-03-14 (bug fix) Fixes from libtommath 0.42.0 release (fellows)
+
+2011-03-21 (bug fix)[3216070] [load] extension from embed Tcl apps (nijtmans)
+ ***POTENTIAL INCOMPATIBILITY***
+
+2011-03-27 (performance) NRE: LIST lset foreach benchmark (twylite)
+
+2011-04-11 (bug fix)[3282869] coroutine + eval + locals crash (ferrieux,sofer)
+
+2011-04-13 (bug fix)[2662380] crash when variable append trace unsets (sofer)
+
+2011-04-13 (bug fix)[3285375] Buffer overflow in [concat] (porter)
+
+2011-05-02 (internals change) revised TclFindElement() interface (porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2011-05-05 (enhancement) dict->list w/o string rep generation (porter)
+
+2011-05-10 (bug fix)[3173086] Crash parsing long lists (rogers,porter)
+
+2011-05-24 (enhancement) msgcat internal improvements (fellows)
+=> msgcat 1.4.4
+
+2011-05-25 (TIP 381) [info object|class call] [self call] [nextto] (fellows)
+
+2011-05-31 (bug fix)[3293874] let lists grow all the way to the limit (porter)
+
+2011-06-02 (bug fix)[3185407] cmd resolution epoch flaw (nadkarni,fellows)
+
+2011-06-13 (bug fix)[3315098] mem leak generating double string rep (neumann)
+
+2011-06-22 (new feature) DEB_HOST_MULTIARCH support (kupries)
+=> platform 1.0.10
+
+2011-07-15 (bug fix)[3357771] Prevent circular refs in bytecode (porter)
+
+2011-07-28 tzdata updated to Olson's tzdata2011h (porter)
+
+2011-08-01 (bug fix)[3383616] memleak exposed by XOTcl (neumann,sofer)
+
+Many more Tcl built-in command errors now set an -errorcode.
+
+--- Released 8.6b2, August 8, 2011 --- See ChangeLog for details ---
+
+2011-07-02 (bug fix)[3349507] correct double(1[string repeat 0 23]) (kenny)
+
+2011-07-19 (bug fix)[3371644] Tcl_ConvertElement() segfault (sader, ferrieux)
+
+2011-07-21 (bug fix)[3372130] hypot(.) segfault (nijtmans)
+
+2011-08-12 (bug fix)[3389764] memleaks due to reference cycles in dup'd paths
+
+2011-08-15 (bug fix)[3390272] leak of [info script] value (porter)
+
+2011-08-17 (bug fix)[3393150] bignum leaks in Tcl_Get*() routines (porter)
+
+2011-08-18 (bug fix)[3393714] [string toupper] overflow (nijtmans)
+
+2011-08-30 (bug fix)[3398794] panic in interp limit setting (gavlian,fellows)
+
+2011-09-08 (bug fix)[3401704] revised expr parser to permit function names
+like "nano()" instead of parsing as "nan o()" with missing op (duquette,porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2011-09-10 (bug fix)[3400658] wrong num args msg with TclOO (rsooltan,fellows)
+
+2011-09-13 (bug fix)[3390638] solaris studio cc workaround (kechel,porter)
+
+2011-09-13 (bug fix)[3405652] DTrace workaround (michelson,porter)
+
+2011-09-16 (bug fix)[3391977] -headers overrides -type (ziegenhagen,fellows)
+=> http 2.8.3
+
+2011-09-16 (TIP 388) New \Uhhhhhhhh syntax (nijtmans)
+
+2011-10-06 (enhancement) bytecode compile [dict with] (fellows)
+
+2011-10-11 (bug fix)[2935503] [file stat] returns bad mode (nadkarni,nijtmans)
+
+2011-10-20 (bug fix)[3418547] cmd lits and custom resolvers (soberning,fellows)
+
+2011-10-31 (bug fix)[3414754] EIAS violation in fs paths (porter)
+
+2011-11-22 (bug fix)[3354324] Win: [file mtime] sets wrong time (nijtmans)
+
+2011-11-30 (bug fix)[967195] Simply args passed to child processes (nijtmans)
+=> tcltest 2.3.4
+
+2011-12-07 (bug fix)[3444754] fix [string tolower \u01C5] (nijtmans)
+
+2011-12-11 (update)[3457031] Update [[:print:]] to Unicode 6.0 (nijtmans)
+
+2011-12-24 (bug fix)[3464428] fix [string is graph \u0120] (nijtmans)
+
+2012-01-08 (bug fix)[3470928] zoneinfo trouble with Windhoek data file (kenny)
+
+2012-01-13 (bug fix)[3472316] fix retrieval of socket error (fellows)
+
+2012-01-21 (bug fix)[3475667] [regexp] buffer read overflow (sebres)
+
+2012-01-22 (bug fix)[3475264] [dict exists] return 0, not error (fellows)
+
+2012-01-25 (bug fix)[3474460] [oo::copy] var resolution list (fellows)
+
+2012-01-26 (bug fix)[3475569,3479689] mem corrupt in fs path (sebres,porter)
+
+2012-01-30 (enhancement) improve bytecode compile of [catch] (fellows)
+
+2012-02-02 (bug fix)[2974459,2879351,1951574,1852572,1661378,1613456] Fix
+problems where [file *able] would return false results on Win/Samba (porter)
+
+2012-02-06 (bug fix)[3484621] bump bytecode epoch on exec traces (kuhn,sofer)
+
+2012-02-15 (bug fix)[3487626] crash compiling [dict for] (fellows)
+
+2012-02-15 (enhancement) bytecode compile [lrange],[lreplace] (fellows)
+
+2012-02-17 (bug fix)[2233954] compile problem on AIX & Android (nijtmans)
+
+2012-02-29 (bug fix)[3466099] BOM in Unicode (nijtmans)
+
+2012-03-07 (bug fix)[3498327] RFC 3986 compliance (kupries)
+
+2012-03-26 (TIP 380) New builtin class [oo::Slot] (fellows)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2012-03-27 (TIP 397) <cloned> method to extend [oo::copy] (fellows)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2012-03-27 (TIP 395) New subcommand [string is entier] (fellows)
+
+2012-04-02 (TIP 396) New command [yieldto] (fellows)
+
+2012-04-04 (bug fix)[3514761] crash combining objects and ensembles (fellows)
+
+2012-04-09 (bug fix)[2712377] [info vars] and oo variables (fellows)
+
+2012-04-09 (bug fix)[3396896] no dups in oo var lists (fellows)
+
+2012-04-11 (bug fix)[3448512] [clock scan 1958-01-01] fail on Win (nijtmans)
+
+2012-04-15 (bug fix)[3517696] fix flush of zlib chan xform (fellows)
+
+2012-04-18 tzdata updated to Olson's tzdata2012c (kenny)
+
+2012-04-28 (TIP 398) exit non-blocking chan without flush (ferrieux)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2012-05-02 (enhancement) Better use of Intel cpuid instruction (nijtmans)
+
+2012-05-03 (bug fix)[3428753] Unbreak synchronous [socket -async] (porter)
+
+2012-05-10 (bug fix)[2812981] force consistent config of Tcl+pkgs (ferrieux)
+
+2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans)
+
+2012-05-17 (bug fix)[3445787] fix [file] ensemble in Safe Base (fellows)
+
+2012-05-17 (bug fix)[2964715] fix [glob] in Safe Base (fellows)
+
+2012-05-17 (bug fix)[3106532] proper [switch -indexvar] values (fellows)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2012-05-21 (TIP 106) New -binary option to [dde execute|poke] (oehlmann)
+=> dde 1.4.0
+
+2012-05-23 (bug fix)[3525907] [zlib push decompress] & [chan event]
+(fellows,ferrieux,kupries)
+
+2012-05-28 (bug fix)[3529949] Protect ~ paths in Safe Base (fellows)
+
+2012-06-21 (bug fix)[3362446] [registry keys] failure (nijtmans)
+=> registry 1.3.0
+
+2012-06-25 (bug fix)[3537605] [encoding dirs a b] error message (fellows)
+
+2012-06-25 (bug fix)[3024359] crash when multi-thread concurrent [file system]
+and Tcl_FSMountsChanged(). (porter)
+
+2012-06-29 (bug fix)[3536888] fix locale guessing (oehlmann,nijtmans)
+
+2012-07-05 (bug fix)[1189293] make "<<" redirect binary safe (porter)
+
+2012-07-08 (bug fix)[3531209] accept IPv6 URLs (max)
+=> http 2.8.4
+
+2012-07-24 (bug fix) stop mem corruption in stacked channel events (max,porter)
+
+2012-07-25 (bug fix)[3546275] [auto_execok] search match [exec] (danckaert)
+
+2012-07-27 (update)[3464401] Support Unicode 6.2 (nijtmans)
+
+2012-08-20 (bug fix)[3559678] [file normalize] EIAS failure (phao,dgp)
+
+2012-08-25 (bug fix)[3561330] Ukranian translation of "March" (teterin)
+
+2012-09-07 (TIP 404) New msgcat commands [mcflset], [mcflmset] (oehlmann)
+=> msgcat 1.5.0
+
+Many revisions to better support a Cygwin environment (nijtmans)
+
+Dropped support for OS X versions less than 10.4 (Tiger) (fellows)
+
+--- Released 8.6b3, September 18, 2012 --- See ChangeLog for details ---
+
+2012-09-20 (enhancement) full Unicode support (nijtmans)
+=> dde 1.4.0
+
+2012-09-20 (enhancement) update bundled zlib to 1.2.7 (nijtmans)
+
+2012-10-03 (bug fix) exit panic on stacked std channel (griffin,porter)
+
+2012-10-14 (bug fix) [tcl::Bgerror] crash on non-dict options (nijtmans)
+
+2012-10-16 (TIP 400) New [zlib] options to set compression dict (fellows)
+
+2012-10-16 (TIP 405) New commands [lmap] and [dict map] (fellows)
+
+2012-10-24 (enhancement) [dict unset] now bytecompiled (fellows)
+
+2012-11-05 (TIP 413) Revisions to default [string trim*] trimset (nijtmans)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2012-11-05 (enhancement) Now bytecompiled: [array exists], [array set],
+[array unset], [dict create], [dict exists], [dict merge], [format],
+[info commands], [info coroutine], [info level], [info object],
+[namespace current], [namespace code], [namespace qualifiers], [namespace tail],
+[namespace which], [regsub], [self], [string first], [string last],
+[string map], [string range], [tailcall], [yield]. (fellows)
+
+2012-11-06 (bug fix)[3581754] avoid multiple callback on keep-alive (fellows)
+=> http 2.8.5
+
+2012-11-07 tzdata updated to Olson's tzdata2012i (kenny)
+
+2012-11-13 (bug fix)[3567063] thread fp settings from master (mistachkin)
+
+2012-11-14 (bug fix)[2933003] tempfile creation in $TMPDIR (fellows)
+
+2012-11-15 (TIP 416) New [load] options -global and -lazy (nijtmans)
+
+2012-11-20 (bug fix)[3033307] base64 trail whitespace (kovalenko,goth)
+
+2012-12-03 (bug fix) [configure] query broke init from argv (porter)
+=> tcltest 2.3.5
+
+2012-12-13 (bug fix)[3595576] crash: [catch {} -> noSuchNs::var] (sofer,porter)
+
+2012-12-13 (bug fix) crash: [zlib gunzip $data -header noSuchNs::var] (porter)
+
+--- Released 8.6.0, December 20, 2012 --- See ChangeLog for details ---
diff --git a/compat/README b/compat/README
index 38b9b05..9af4285 100644
--- a/compat/README
+++ b/compat/README
@@ -4,5 +4,3 @@ systems. Typically, files from this directory are used to compile
Tcl when a system doesn't contain the corresponding files or when
they are known to be incorrect. When the whole world becomes POSIX-
compliant this directory should be unnecessary.
-
-RCS: @(#) $Id: README,v 1.2 1998/09/14 18:39:44 stanton Exp $
diff --git a/compat/dirent.h b/compat/dirent.h
index 1368018..fa6222a 100644
--- a/compat/dirent.h
+++ b/compat/dirent.h
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: dirent.h,v 1.2 1998/09/14 18:39:44 stanton Exp $
*/
#ifndef _DIRENT
diff --git a/compat/dirent2.h b/compat/dirent2.h
index 794a6c4..878457f 100644
--- a/compat/dirent2.h
+++ b/compat/dirent2.h
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: dirent2.h,v 1.4 2010/04/29 09:23:57 nijtmans Exp $
*/
#ifndef _DIRENT
diff --git a/compat/dlfcn.h b/compat/dlfcn.h
index ce04fb2..6940c2a 100644
--- a/compat/dlfcn.h
+++ b/compat/dlfcn.h
@@ -16,12 +16,9 @@
* this software, provided that the author is not construed to be liable
* for any results of using the software, alterations are clearly marked
* as such, and this notice is not modified.
- *
- * RCS: @(#) $Id: dlfcn.h,v 1.5 2010/04/29 09:23:57 nijtmans Exp $
*/
/*
- * @(#)dlfcn.h 1.4 revision of 95/04/25 09:36:52
* This is an unpublished work copyright (c) 1992 HELIOS Software GmbH
* 30159 Hannover, Germany
*/
diff --git a/compat/fake-rfc2553.c b/compat/fake-rfc2553.c
new file mode 100644
index 0000000..666144f
--- /dev/null
+++ b/compat/fake-rfc2553.c
@@ -0,0 +1,266 @@
+/*
+ * Copyright (C) 2000-2003 Damien Miller. All rights reserved.
+ * Copyright (C) 1999 WIDE Project. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of the project nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+/*
+ * Pseudo-implementation of RFC2553 name / address resolution functions
+ *
+ * But these functions are not implemented correctly. The minimum subset
+ * is implemented for ssh use only. For example, this routine assumes
+ * that ai_family is AF_INET. Don't use it for another purpose.
+ */
+#include "tclInt.h"
+
+TCL_DECLARE_MUTEX(netdbMutex)
+
+#ifndef HAVE_GETNAMEINFO
+#ifndef HAVE_STRLCPY
+static size_t
+strlcpy(char *dst, const char *src, size_t siz)
+{
+ char *d = dst;
+ const char *s = src;
+ size_t n = siz;
+
+ /* Copy as many bytes as will fit */
+ if (n != 0 && --n != 0) {
+ do {
+ if ((*d++ = *s++) == 0)
+ break;
+ } while (--n != 0);
+ }
+
+ /* Not enough room in dst, add NUL and traverse rest of src */
+ if (n == 0) {
+ if (siz != 0)
+ *d = '\0'; /* NUL-terminate dst */
+ while (*s++)
+ ;
+ }
+
+ return(s - src - 1); /* count does not include NUL */
+}
+#endif
+
+int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host,
+ size_t hostlen, char *serv, size_t servlen, int flags)
+{
+ struct sockaddr_in *sin = (struct sockaddr_in *)sa;
+ struct hostent *hp;
+ char tmpserv[16];
+
+ if (sa->sa_family != AF_UNSPEC && sa->sa_family != AF_INET)
+ return (EAI_FAMILY);
+ if (serv != NULL) {
+ snprintf(tmpserv, sizeof(tmpserv), "%d", ntohs(sin->sin_port));
+ if (strlcpy(serv, tmpserv, servlen) >= servlen)
+ return (EAI_MEMORY);
+ }
+
+ if (host != NULL) {
+ if (flags & NI_NUMERICHOST) {
+ int len;
+ Tcl_MutexLock(&netdbMutex);
+ len = strlcpy(host, inet_ntoa(sin->sin_addr), hostlen);
+ Tcl_MutexUnlock(&netdbMutex);
+ if (len >= hostlen) {
+ return (EAI_MEMORY);
+ } else {
+ return (0);
+ }
+ } else {
+ int ret;
+ Tcl_MutexLock(&netdbMutex);
+ hp = gethostbyaddr((char *)&sin->sin_addr,
+ sizeof(struct in_addr), AF_INET);
+ if (hp == NULL) {
+ ret = EAI_NODATA;
+ } else if (strlcpy(host, hp->h_name, hostlen)
+ >= hostlen) {
+ ret = EAI_MEMORY;
+ } else {
+ ret = 0;
+ }
+ Tcl_MutexUnlock(&netdbMutex);
+ return ret;
+ }
+ }
+ return (0);
+}
+#endif /* !HAVE_GETNAMEINFO */
+
+#ifndef HAVE_GAI_STRERROR
+const char *
+fake_gai_strerror(int err)
+{
+ switch (err) {
+ case EAI_NODATA:
+ return ("no address associated with name");
+ case EAI_MEMORY:
+ return ("memory allocation failure.");
+ case EAI_NONAME:
+ return ("nodename nor servname provided, or not known");
+ case EAI_FAMILY:
+ return ("ai_family not supported");
+ default:
+ return ("unknown/invalid error.");
+ }
+}
+#endif /* !HAVE_GAI_STRERROR */
+
+#ifndef HAVE_FREEADDRINFO
+void
+freeaddrinfo(struct addrinfo *ai)
+{
+ struct addrinfo *next;
+
+ for(; ai != NULL;) {
+ next = ai->ai_next;
+ free(ai);
+ ai = next;
+ }
+}
+#endif /* !HAVE_FREEADDRINFO */
+
+#ifndef HAVE_GETADDRINFO
+static struct
+addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints)
+{
+ struct addrinfo *ai;
+
+ ai = malloc(sizeof(*ai) + sizeof(struct sockaddr_in));
+ if (ai == NULL)
+ return (NULL);
+
+ memset(ai, '\0', sizeof(*ai) + sizeof(struct sockaddr_in));
+
+ ai->ai_addr = (struct sockaddr *)(ai + 1);
+ /* XXX -- ssh doesn't use sa_len */
+ ai->ai_addrlen = sizeof(struct sockaddr_in);
+ ai->ai_addr->sa_family = ai->ai_family = AF_INET;
+
+ ((struct sockaddr_in *)(ai)->ai_addr)->sin_port = port;
+ ((struct sockaddr_in *)(ai)->ai_addr)->sin_addr.s_addr = addr;
+
+ /* XXX: the following is not generally correct, but does what we want */
+ if (hints->ai_socktype)
+ ai->ai_socktype = hints->ai_socktype;
+ else
+ ai->ai_socktype = SOCK_STREAM;
+
+ if (hints->ai_protocol)
+ ai->ai_protocol = hints->ai_protocol;
+
+ return (ai);
+}
+
+int
+fake_getaddrinfo(const char *hostname, const char *servname,
+ const struct addrinfo *hints, struct addrinfo **res)
+{
+ struct hostent *hp;
+ struct servent *sp;
+ struct in_addr in;
+ int i;
+ long int port;
+ u_long addr;
+
+ port = 0;
+ if (hints && hints->ai_family != AF_UNSPEC &&
+ hints->ai_family != AF_INET)
+ return (EAI_FAMILY);
+ if (servname != NULL) {
+ char *cp;
+
+ port = strtol(servname, &cp, 10);
+ if (port > 0 && port <= 65535 && *cp == '\0')
+ port = htons(port);
+ else if ((sp = getservbyname(servname, NULL)) != NULL)
+ port = sp->s_port;
+ else
+ port = 0;
+ }
+
+ if (hints && hints->ai_flags & AI_PASSIVE) {
+ addr = htonl(0x00000000);
+ if (hostname && inet_aton(hostname, &in) != 0)
+ addr = in.s_addr;
+ *res = malloc_ai(port, addr, hints);
+ if (*res == NULL)
+ return (EAI_MEMORY);
+ return (0);
+ }
+
+ if (!hostname) {
+ *res = malloc_ai(port, htonl(0x7f000001), hints);
+ if (*res == NULL)
+ return (EAI_MEMORY);
+ return (0);
+ }
+
+ if (inet_aton(hostname, &in)) {
+ *res = malloc_ai(port, in.s_addr, hints);
+ if (*res == NULL)
+ return (EAI_MEMORY);
+ return (0);
+ }
+
+ /* Don't try DNS if AI_NUMERICHOST is set */
+ if (hints && hints->ai_flags & AI_NUMERICHOST)
+ return (EAI_NONAME);
+
+ Tcl_MutexLock(&netdbMutex);
+ hp = gethostbyname(hostname);
+ if (hp && hp->h_name && hp->h_name[0] && hp->h_addr_list[0]) {
+ struct addrinfo *cur, *prev;
+
+ cur = prev = *res = NULL;
+ for (i = 0; hp->h_addr_list[i]; i++) {
+ struct in_addr *in = (struct in_addr *)hp->h_addr_list[i];
+
+ cur = malloc_ai(port, in->s_addr, hints);
+ if (cur == NULL) {
+ if (*res != NULL)
+ freeaddrinfo(*res);
+ Tcl_MutexUnlock(&netdbMutex);
+ return (EAI_MEMORY);
+ }
+ if (prev)
+ prev->ai_next = cur;
+ else
+ *res = cur;
+
+ prev = cur;
+ }
+ Tcl_MutexUnlock(&netdbMutex);
+ return (0);
+ }
+ Tcl_MutexUnlock(&netdbMutex);
+ return (EAI_NODATA);
+}
+#endif /* !HAVE_GETADDRINFO */
diff --git a/compat/fake-rfc2553.h b/compat/fake-rfc2553.h
new file mode 100644
index 0000000..cc26f55
--- /dev/null
+++ b/compat/fake-rfc2553.h
@@ -0,0 +1,170 @@
+/*
+ * Copyright (C) 2000-2003 Damien Miller. All rights reserved.
+ * Copyright (C) 1999 WIDE Project. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of the project nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+/*
+ * Pseudo-implementation of RFC2553 name / address resolution functions
+ *
+ * But these functions are not implemented correctly. The minimum subset
+ * is implemented for ssh use only. For example, this routine assumes
+ * that ai_family is AF_INET. Don't use it for another purpose.
+ */
+
+#ifndef _FAKE_RFC2553_H
+#define _FAKE_RFC2553_H
+
+/*
+ * First, socket and INET6 related definitions
+ */
+#ifndef HAVE_STRUCT_SOCKADDR_STORAGE
+# define _SS_MAXSIZE 128 /* Implementation specific max size */
+# define _SS_PADSIZE (_SS_MAXSIZE - sizeof (struct sockaddr))
+struct sockaddr_storage {
+ struct sockaddr ss_sa;
+ char __ss_pad2[_SS_PADSIZE];
+};
+# define ss_family ss_sa.sa_family
+#endif /* !HAVE_STRUCT_SOCKADDR_STORAGE */
+
+#ifndef IN6_IS_ADDR_LOOPBACK
+# define IN6_IS_ADDR_LOOPBACK(a) \
+ (((uint32_t *)(a))[0] == 0 && ((uint32_t *)(a))[1] == 0 && \
+ ((uint32_t *)(a))[2] == 0 && ((uint32_t *)(a))[3] == htonl(1))
+#endif /* !IN6_IS_ADDR_LOOPBACK */
+
+#ifndef HAVE_STRUCT_IN6_ADDR
+struct in6_addr {
+ uint8_t s6_addr[16];
+};
+#endif /* !HAVE_STRUCT_IN6_ADDR */
+
+#ifndef HAVE_STRUCT_SOCKADDR_IN6
+struct sockaddr_in6 {
+ unsigned short sin6_family;
+ uint16_t sin6_port;
+ uint32_t sin6_flowinfo;
+ struct in6_addr sin6_addr;
+ uint32_t sin6_scope_id;
+};
+#endif /* !HAVE_STRUCT_SOCKADDR_IN6 */
+
+#ifndef AF_INET6
+/* Define it to something that should never appear */
+#define AF_INET6 AF_MAX
+#endif
+
+/*
+ * Next, RFC2553 name / address resolution API
+ */
+
+#ifndef NI_NUMERICHOST
+# define NI_NUMERICHOST (1)
+#endif
+#ifndef NI_NAMEREQD
+# define NI_NAMEREQD (1<<1)
+#endif
+#ifndef NI_NUMERICSERV
+# define NI_NUMERICSERV (1<<2)
+#endif
+
+#ifndef AI_PASSIVE
+# define AI_PASSIVE (1)
+#endif
+#ifndef AI_CANONNAME
+# define AI_CANONNAME (1<<1)
+#endif
+#ifndef AI_NUMERICHOST
+# define AI_NUMERICHOST (1<<2)
+#endif
+
+#ifndef NI_MAXSERV
+# define NI_MAXSERV 32
+#endif /* !NI_MAXSERV */
+#ifndef NI_MAXHOST
+# define NI_MAXHOST 1025
+#endif /* !NI_MAXHOST */
+
+#ifndef EAI_NODATA
+# define EAI_NODATA (INT_MAX - 1)
+#endif
+#ifndef EAI_MEMORY
+# define EAI_MEMORY (INT_MAX - 2)
+#endif
+#ifndef EAI_NONAME
+# define EAI_NONAME (INT_MAX - 3)
+#endif
+#ifndef EAI_SYSTEM
+# define EAI_SYSTEM (INT_MAX - 4)
+#endif
+#ifndef EAI_FAMILY
+# define EAI_FAMILY (INT_MAX - 5)
+#endif
+#ifndef EAI_SERVICE
+# define EAI_SERVICE -8 /* SERVICE not supported for `ai_socktype'. */
+#endif
+
+#ifndef HAVE_STRUCT_ADDRINFO
+struct addrinfo {
+ int ai_flags; /* AI_PASSIVE, AI_CANONNAME */
+ int ai_family; /* PF_xxx */
+ int ai_socktype; /* SOCK_xxx */
+ int ai_protocol; /* 0 or IPPROTO_xxx for IPv4 and IPv6 */
+ size_t ai_addrlen; /* length of ai_addr */
+ char *ai_canonname; /* canonical name for hostname */
+ struct sockaddr *ai_addr; /* binary address */
+ struct addrinfo *ai_next; /* next structure in linked list */
+};
+#endif /* !HAVE_STRUCT_ADDRINFO */
+
+#ifndef HAVE_GETADDRINFO
+#ifdef getaddrinfo
+# undef getaddrinfo
+#endif
+#define getaddrinfo(a,b,c,d) (fake_getaddrinfo(a,b,c,d))
+int getaddrinfo(const char *, const char *,
+ const struct addrinfo *, struct addrinfo **);
+#endif /* !HAVE_GETADDRINFO */
+
+#ifndef HAVE_GAI_STRERROR
+#define gai_strerror(a) (fake_gai_strerror(a))
+const char *gai_strerror(int);
+#endif /* !HAVE_GAI_STRERROR */
+
+#ifndef HAVE_FREEADDRINFO
+#define freeaddrinfo(a) (fake_freeaddrinfo(a))
+void freeaddrinfo(struct addrinfo *);
+#endif /* !HAVE_FREEADDRINFO */
+
+#ifndef HAVE_GETNAMEINFO
+#define getnameinfo(a,b,c,d,e,f,g) (fake_getnameinfo(a,b,c,d,e,f,g))
+int getnameinfo(const struct sockaddr *, size_t, char *, size_t,
+ char *, size_t, int);
+#endif /* !HAVE_GETNAMEINFO */
+
+
+#endif /* !_FAKE_RFC2553_H */
diff --git a/compat/fixstrtod.c b/compat/fixstrtod.c
index a779e22..91f309e 100644
--- a/compat/fixstrtod.c
+++ b/compat/fixstrtod.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: fixstrtod.c,v 1.3 2007/04/16 13:36:34 dkf Exp $
*/
#include <stdio.h>
diff --git a/compat/float.h b/compat/float.h
index 049f4a8..411edbf 100644
--- a/compat/float.h
+++ b/compat/float.h
@@ -11,6 +11,4 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: float.h,v 1.2 1998/09/14 18:39:44 stanton Exp $
*/
diff --git a/compat/gettod.c b/compat/gettod.c
index 179491b..28e1432 100644
--- a/compat/gettod.c
+++ b/compat/gettod.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: gettod.c,v 1.4 2007/04/16 13:36:34 dkf Exp $
*/
#include "tclPort.h"
diff --git a/compat/limits.h b/compat/limits.h
index 96b0b50..2cb082b 100644
--- a/compat/limits.h
+++ b/compat/limits.h
@@ -12,8 +12,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: limits.h,v 1.2 1998/09/14 18:39:44 stanton Exp $
*/
#define LONG_MIN 0x80000000
diff --git a/compat/memcmp.c b/compat/memcmp.c
index a0666f3..c4e25a8 100644
--- a/compat/memcmp.c
+++ b/compat/memcmp.c
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: memcmp.c,v 1.5 2008/04/27 22:21:27 dkf Exp $
*/
#include "tclPort.h"
diff --git a/compat/mkstemp.c b/compat/mkstemp.c
index f396993..eaa0b66 100644
--- a/compat/mkstemp.c
+++ b/compat/mkstemp.c
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: mkstemp.c,v 1.3 2009/07/09 22:28:38 dkf Exp $
*/
#include <errno.h>
diff --git a/compat/opendir.c b/compat/opendir.c
index 1822261..a18f96b 100644
--- a/compat/opendir.c
+++ b/compat/opendir.c
@@ -4,8 +4,6 @@
* This file provides dirent-style directory-reading procedures for V7
* Unix systems that don't have such procedures. The origin of this code
* is unclear, but it seems to have come originally from Larry Wall.
- *
- * RCS: @(#) $Id: opendir.c,v 1.5 2009/12/10 09:21:37 dkf Exp $
*/
#include "tclInt.h"
diff --git a/compat/stdlib.h b/compat/stdlib.h
index 2c19c7f..0ad4c1d 100644
--- a/compat/stdlib.h
+++ b/compat/stdlib.h
@@ -12,8 +12,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: stdlib.h,v 1.5 2010/04/29 09:23:57 nijtmans Exp $
*/
#ifndef _STDLIB
diff --git a/compat/string.h b/compat/string.h
index 0be1ec1..84ee094 100644
--- a/compat/string.h
+++ b/compat/string.h
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: string.h,v 1.9 2010/04/29 09:23:57 nijtmans Exp $
*/
#ifndef _STRING
diff --git a/compat/strncasecmp.c b/compat/strncasecmp.c
index 6a17b32..299715d 100644
--- a/compat/strncasecmp.c
+++ b/compat/strncasecmp.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: strncasecmp.c,v 1.5 2010/03/04 22:29:05 nijtmans Exp $
*/
#include "tclPort.h"
diff --git a/compat/strstr.c b/compat/strstr.c
index 8679fe3..6698c9f 100644
--- a/compat/strstr.c
+++ b/compat/strstr.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: strstr.c,v 1.7 2007/04/16 13:36:34 dkf Exp $
*/
#include "tcl.h"
diff --git a/compat/strtod.c b/compat/strtod.c
index 89ad625..cb9f76d 100644
--- a/compat/strtod.c
+++ b/compat/strtod.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: strtod.c,v 1.11 2010/04/27 12:36:23 nijtmans Exp $
*/
#include "tclInt.h"
diff --git a/compat/strtol.c b/compat/strtol.c
index 1c52a9e..b111d97 100644
--- a/compat/strtol.c
+++ b/compat/strtol.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: strtol.c,v 1.8 2010/04/27 12:36:23 nijtmans Exp $
*/
#include "tclInt.h"
diff --git a/compat/strtoul.c b/compat/strtoul.c
index 0b2b625..d572c2b 100644
--- a/compat/strtoul.c
+++ b/compat/strtoul.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: strtoul.c,v 1.9 2010/03/04 22:29:05 nijtmans Exp $
*/
#include "tclInt.h"
diff --git a/compat/unistd.h b/compat/unistd.h
index 44ca64a..6779e74 100644
--- a/compat/unistd.h
+++ b/compat/unistd.h
@@ -9,8 +9,6 @@
* copyright notice appear in all copies. The University of California makes
* no representations about the suitability of this software for any purpose.
* It is provided "as is" without express or implied warranty.
- *
- * RCS: @(#) $Id: unistd.h,v 1.5 2010/04/29 09:23:57 nijtmans Exp $
*/
#ifndef _UNISTD
diff --git a/compat/waitpid.c b/compat/waitpid.c
index 0e9e6d6..8f65799 100644
--- a/compat/waitpid.c
+++ b/compat/waitpid.c
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: waitpid.c,v 1.5 2007/04/16 13:36:35 dkf Exp $
*/
#include "tclPort.h"
diff --git a/compat/zlib/CMakeLists.txt b/compat/zlib/CMakeLists.txt
index a64fe0b..7ee3bc4 100644
--- a/compat/zlib/CMakeLists.txt
+++ b/compat/zlib/CMakeLists.txt
@@ -3,9 +3,13 @@ set(CMAKE_ALLOW_LOOSE_LOOP_CONSTRUCTS ON)
project(zlib C)
-if(NOT DEFINED BUILD_SHARED_LIBS)
- option(BUILD_SHARED_LIBS "Build a shared library form of zlib" ON)
-endif()
+set(VERSION "1.2.7")
+
+set(INSTALL_BIN_DIR "${CMAKE_INSTALL_PREFIX}/bin" CACHE PATH "Installation directory for executables")
+set(INSTALL_LIB_DIR "${CMAKE_INSTALL_PREFIX}/lib" CACHE PATH "Installation directory for libraries")
+set(INSTALL_INC_DIR "${CMAKE_INSTALL_PREFIX}/include" CACHE PATH "Installation directory for headers")
+set(INSTALL_MAN_DIR "${CMAKE_INSTALL_PREFIX}/share/man" CACHE PATH "Installation directory for manual pages")
+set(INSTALL_PKGCONFIG_DIR "${CMAKE_INSTALL_PREFIX}/share/pkgconfig" CACHE PATH "Installation directory for pkgconfig (.pc) files")
include(CheckTypeSize)
include(CheckFunctionExists)
@@ -56,23 +60,27 @@ if(MSVC)
set(CMAKE_DEBUG_POSTFIX "d")
add_definitions(-D_CRT_SECURE_NO_DEPRECATE)
add_definitions(-D_CRT_NONSTDC_NO_DEPRECATE)
+ include_directories(${CMAKE_CURRENT_SOURCE_DIR})
endif()
if(NOT CMAKE_CURRENT_SOURCE_DIR STREQUAL CMAKE_CURRENT_BINARY_DIR)
# If we're doing an out of source build and the user has a zconf.h
# in their source tree...
if(EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/zconf.h)
- message(FATAL_ERROR
- "You must remove ${CMAKE_CURRENT_SOURCE_DIR}/zconf.h "
- "from the source tree. This file is included with zlib "
- "but CMake generates this file for you automatically "
- "in the build directory.")
+ message(STATUS "Renaming")
+ message(STATUS " ${CMAKE_CURRENT_SOURCE_DIR}/zconf.h")
+ message(STATUS "to 'zconf.h.included' because this file is included with zlib")
+ message(STATUS "but CMake generates it automatically in the build directory.")
+ file(RENAME ${CMAKE_CURRENT_SOURCE_DIR}/zconf.h ${CMAKE_CURRENT_SOURCE_DIR}/zconf.h.included)
endif()
endif()
-configure_file(${CMAKE_CURRENT_SOURCE_DIR}/zconf.h.cmakein
- ${CMAKE_CURRENT_BINARY_DIR}/zconf.h @ONLY)
-include_directories(${CMAKE_CURRENT_BINARY_DIR})
+set(ZLIB_PC ${CMAKE_CURRENT_BINARY_DIR}/zlib.pc)
+configure_file( ${CMAKE_CURRENT_SOURCE_DIR}/zlib.pc.cmakein
+ ${ZLIB_PC} @ONLY)
+configure_file( ${CMAKE_CURRENT_SOURCE_DIR}/zconf.h.cmakein
+ ${CMAKE_CURRENT_BINARY_DIR}/zconf.h @ONLY)
+include_directories(${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_SOURCE_DIR})
#============================================================================
@@ -110,18 +118,27 @@ set(ZLIB_SRCS
trees.c
uncompr.c
zutil.c
- win32/zlib1.rc
)
+if(NOT MINGW)
+ set(ZLIB_SRCS ${ZLIB_SRCS}
+ win32/zlib1.rc # If present will override custom build rule below.
+ )
+endif()
+
# parse the full version number from zlib.h and include in ZLIB_FULL_VERSION
file(READ ${CMAKE_CURRENT_SOURCE_DIR}/zlib.h _zlib_h_contents)
-string(REGEX REPLACE ".*#define[ \t]+ZLIB_VERSION[ \t]+\"([0-9A-Za-z.]+)\".*"
+string(REGEX REPLACE ".*#define[ \t]+ZLIB_VERSION[ \t]+\"([-0-9A-Za-z.]+)\".*"
"\\1" ZLIB_FULL_VERSION ${_zlib_h_contents})
if(MINGW)
# This gets us DLL resource information when compiling on MinGW.
+ if(NOT CMAKE_RC_COMPILER)
+ SET(CMAKE_RC_COMPILER windres.exe)
+ endif()
+
add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/zlib1rc.obj
- COMMAND windres.exe
+ COMMAND ${CMAKE_RC_COMPILER}
-D GCC_WINDRES
-I ${CMAKE_CURRENT_SOURCE_DIR}
-I ${CMAKE_CURRENT_BINARY_DIR}
@@ -130,9 +147,9 @@ if(MINGW)
set(ZLIB_SRCS ${ZLIB_SRCS} ${CMAKE_CURRENT_BINARY_DIR}/zlib1rc.obj)
endif(MINGW)
-add_library(zlib ${ZLIB_SRCS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS})
+add_library(zlib SHARED ${ZLIB_SRCS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS})
+add_library(zlibstatic STATIC ${ZLIB_SRCS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS})
set_target_properties(zlib PROPERTIES DEFINE_SYMBOL ZLIB_DLL)
-
set_target_properties(zlib PROPERTIES SOVERSION 1)
if(NOT CYGWIN)
@@ -148,43 +165,47 @@ endif()
if(UNIX)
# On unix-like platforms the library is almost always called libz
- set_target_properties(zlib PROPERTIES OUTPUT_NAME z)
+ set_target_properties(zlib zlibstatic PROPERTIES OUTPUT_NAME z)
+ set_target_properties(zlib PROPERTIES LINK_FLAGS "-Wl,--version-script,${CMAKE_CURRENT_SOURCE_DIR}/zlib.map")
elseif(BUILD_SHARED_LIBS AND WIN32)
# Creates zlib1.dll when building shared library version
set_target_properties(zlib PROPERTIES SUFFIX "1.dll")
endif()
if(NOT SKIP_INSTALL_LIBRARIES AND NOT SKIP_INSTALL_ALL )
- install(TARGETS zlib
- RUNTIME DESTINATION bin
- ARCHIVE DESTINATION lib
- LIBRARY DESTINATION lib )
+ install(TARGETS zlib zlibstatic
+ RUNTIME DESTINATION "${INSTALL_BIN_DIR}"
+ ARCHIVE DESTINATION "${INSTALL_LIB_DIR}"
+ LIBRARY DESTINATION "${INSTALL_LIB_DIR}" )
endif()
if(NOT SKIP_INSTALL_HEADERS AND NOT SKIP_INSTALL_ALL )
- install(FILES ${ZLIB_PUBLIC_HDRS} DESTINATION include)
+ install(FILES ${ZLIB_PUBLIC_HDRS} DESTINATION "${INSTALL_INC_DIR}")
+endif()
+if(NOT SKIP_INSTALL_FILES AND NOT SKIP_INSTALL_ALL )
+ install(FILES zlib.3 DESTINATION "${INSTALL_MAN_DIR}/man3")
endif()
if(NOT SKIP_INSTALL_FILES AND NOT SKIP_INSTALL_ALL )
- install(FILES zlib.3 DESTINATION share/man/man3)
+ install(FILES ${ZLIB_PC} DESTINATION "${INSTALL_PKGCONFIG_DIR}")
endif()
#============================================================================
# Example binaries
#============================================================================
-add_executable(example example.c)
+add_executable(example test/example.c)
target_link_libraries(example zlib)
add_test(example example)
-add_executable(minigzip minigzip.c)
+add_executable(minigzip test/minigzip.c)
target_link_libraries(minigzip zlib)
if(HAVE_OFF64_T)
- add_executable(example64 example.c)
+ add_executable(example64 test/example.c)
target_link_libraries(example64 zlib)
set_target_properties(example64 PROPERTIES COMPILE_FLAGS "-D_FILE_OFFSET_BITS=64")
add_test(example64 example64)
- add_executable(minigzip64 minigzip.c)
+ add_executable(minigzip64 test/minigzip.c)
target_link_libraries(minigzip64 zlib)
set_target_properties(minigzip64 PROPERTIES COMPILE_FLAGS "-D_FILE_OFFSET_BITS=64")
endif()
diff --git a/compat/zlib/ChangeLog b/compat/zlib/ChangeLog
index fc61964..c2c643a 100644
--- a/compat/zlib/ChangeLog
+++ b/compat/zlib/ChangeLog
@@ -1,12 +1,213 @@
ChangeLog file for zlib
+Changes in 1.2.7 (2 May 2012)
+- Replace use of memmove() with a simple copy for portability
+- Test for existence of strerror
+- Restore gzgetc_ for backward compatibility with 1.2.6
+- Fix build with non-GNU make on Solaris
+- Require gcc 4.0 or later on Mac OS X to use the hidden attribute
+- Include unistd.h for Watcom C
+- Use __WATCOMC__ instead of __WATCOM__
+- Do not use the visibility attribute if NO_VIZ defined
+- Improve the detection of no hidden visibility attribute
+- Avoid using __int64 for gcc or solo compilation
+- Cast to char * in gzprintf to avoid warnings [Zinser]
+- Fix make_vms.com for VAX [Zinser]
+- Don't use library or built-in byte swaps
+- Simplify test and use of gcc hidden attribute
+- Fix bug in gzclose_w() when gzwrite() fails to allocate memory
+- Add "x" (O_EXCL) and "e" (O_CLOEXEC) modes support to gzopen()
+- Fix bug in test/minigzip.c for configure --solo
+- Fix contrib/vstudio project link errors [Mohanathas]
+- Add ability to choose the builder in make_vms.com [Schweda]
+- Add DESTDIR support to mingw32 win32/Makefile.gcc
+- Fix comments in win32/Makefile.gcc for proper usage
+- Allow overriding the default install locations for cmake
+- Generate and install the pkg-config file with cmake
+- Build both a static and a shared version of zlib with cmake
+- Include version symbols for cmake builds
+- If using cmake with MSVC, add the source directory to the includes
+- Remove unneeded EXTRA_CFLAGS from win32/Makefile.gcc [Truta]
+- Move obsolete emx makefile to old [Truta]
+- Allow the use of -Wundef when compiling or using zlib
+- Avoid the use of the -u option with mktemp
+- Improve inflate() documentation on the use of Z_FINISH
+- Recognize clang as gcc
+- Add gzopen_w() in Windows for wide character path names
+- Rename zconf.h in CMakeLists.txt to move it out of the way
+- Add source directory in CMakeLists.txt for building examples
+- Look in build directory for zlib.pc in CMakeLists.txt
+- Remove gzflags from zlibvc.def in vc9 and vc10
+- Fix contrib/minizip compilation in the MinGW environment
+- Update ./configure for Solaris, support --64 [Mooney]
+- Remove -R. from Solaris shared build (possible security issue)
+- Avoid race condition for parallel make (-j) running example
+- Fix type mismatch between get_crc_table() and crc_table
+- Fix parsing of version with "-" in CMakeLists.txt [Snider, Ziegler]
+- Fix the path to zlib.map in CMakeLists.txt
+- Force the native libtool in Mac OS X to avoid GNU libtool [Beebe]
+- Add instructions to win32/Makefile.gcc for shared install [Torri]
+
+Changes in 1.2.6.1 (12 Feb 2012)
+- Avoid the use of the Objective-C reserved name "id"
+- Include io.h in gzguts.h for Microsoft compilers
+- Fix problem with ./configure --prefix and gzgetc macro
+- Include gz_header definition when compiling zlib solo
+- Put gzflags() functionality back in zutil.c
+- Avoid library header include in crc32.c for Z_SOLO
+- Use name in GCC_CLASSIC as C compiler for coverage testing, if set
+- Minor cleanup in contrib/minizip/zip.c [Vollant]
+- Update make_vms.com [Zinser]
+- Remove unnecessary gzgetc_ function
+- Use optimized byte swap operations for Microsoft and GNU [Snyder]
+- Fix minor typo in zlib.h comments [Rzesniowiecki]
+
+Changes in 1.2.6 (29 Jan 2012)
+- Update the Pascal interface in contrib/pascal
+- Fix function numbers for gzgetc_ in zlibvc.def files
+- Fix configure.ac for contrib/minizip [Schiffer]
+- Fix large-entry detection in minizip on 64-bit systems [Schiffer]
+- Have ./configure use the compiler return code for error indication
+- Fix CMakeLists.txt for cross compilation [McClure]
+- Fix contrib/minizip/zip.c for 64-bit architectures [Dalsnes]
+- Fix compilation of contrib/minizip on FreeBSD [Marquez]
+- Correct suggested usages in win32/Makefile.msc [Shachar, Horvath]
+- Include io.h for Turbo C / Borland C on all platforms [Truta]
+- Make version explicit in contrib/minizip/configure.ac [Bosmans]
+- Avoid warning for no encryption in contrib/minizip/zip.c [Vollant]
+- Minor cleanup up contrib/minizip/unzip.c [Vollant]
+- Fix bug when compiling minizip with C++ [Vollant]
+- Protect for long name and extra fields in contrib/minizip [Vollant]
+- Avoid some warnings in contrib/minizip [Vollant]
+- Add -I../.. -L../.. to CFLAGS for minizip and miniunzip
+- Add missing libs to minizip linker command
+- Add support for VPATH builds in contrib/minizip
+- Add an --enable-demos option to contrib/minizip/configure
+- Add the generation of configure.log by ./configure
+- Exit when required parameters not provided to win32/Makefile.gcc
+- Have gzputc return the character written instead of the argument
+- Use the -m option on ldconfig for BSD systems [Tobias]
+- Correct in zlib.map when deflateResetKeep was added
+
+Changes in 1.2.5.3 (15 Jan 2012)
+- Restore gzgetc function for binary compatibility
+- Do not use _lseeki64 under Borland C++ [Truta]
+- Update win32/Makefile.msc to build test/*.c [Truta]
+- Remove old/visualc6 given CMakefile and other alternatives
+- Update AS400 build files and documentation [Monnerat]
+- Update win32/Makefile.gcc to build test/*.c [Truta]
+- Permit stronger flushes after Z_BLOCK flushes
+- Avoid extraneous empty blocks when doing empty flushes
+- Permit Z_NULL arguments to deflatePending
+- Allow deflatePrime() to insert bits in the middle of a stream
+- Remove second empty static block for Z_PARTIAL_FLUSH
+- Write out all of the available bits when using Z_BLOCK
+- Insert the first two strings in the hash table after a flush
+
+Changes in 1.2.5.2 (17 Dec 2011)
+- fix ld error: unable to find version dependency 'ZLIB_1.2.5'
+- use relative symlinks for shared libs
+- Avoid searching past window for Z_RLE strategy
+- Assure that high-water mark initialization is always applied in deflate
+- Add assertions to fill_window() in deflate.c to match comments
+- Update python link in README
+- Correct spelling error in gzread.c
+- Fix bug in gzgets() for a concatenated empty gzip stream
+- Correct error in comment for gz_make()
+- Change gzread() and related to ignore junk after gzip streams
+- Allow gzread() and related to continue after gzclearerr()
+- Allow gzrewind() and gzseek() after a premature end-of-file
+- Simplify gzseek() now that raw after gzip is ignored
+- Change gzgetc() to a macro for speed (~40% speedup in testing)
+- Fix gzclose() to return the actual error last encountered
+- Always add large file support for windows
+- Include zconf.h for windows large file support
+- Include zconf.h.cmakein for windows large file support
+- Update zconf.h.cmakein on make distclean
+- Merge vestigial vsnprintf determination from zutil.h to gzguts.h
+- Clarify how gzopen() appends in zlib.h comments
+- Correct documentation of gzdirect() since junk at end now ignored
+- Add a transparent write mode to gzopen() when 'T' is in the mode
+- Update python link in zlib man page
+- Get inffixed.h and MAKEFIXED result to match
+- Add a ./config --solo option to make zlib subset with no libary use
+- Add undocumented inflateResetKeep() function for CAB file decoding
+- Add --cover option to ./configure for gcc coverage testing
+- Add #define ZLIB_CONST option to use const in the z_stream interface
+- Add comment to gzdopen() in zlib.h to use dup() when using fileno()
+- Note behavior of uncompress() to provide as much data as it can
+- Add files in contrib/minizip to aid in building libminizip
+- Split off AR options in Makefile.in and configure
+- Change ON macro to Z_ARG to avoid application conflicts
+- Facilitate compilation with Borland C++ for pragmas and vsnprintf
+- Include io.h for Turbo C / Borland C++
+- Move example.c and minigzip.c to test/
+- Simplify incomplete code table filling in inflate_table()
+- Remove code from inflate.c and infback.c that is impossible to execute
+- Test the inflate code with full coverage
+- Allow deflateSetDictionary, inflateSetDictionary at any time (in raw)
+- Add deflateResetKeep and fix inflateResetKeep to retain dictionary
+- Fix gzwrite.c to accommodate reduced memory zlib compilation
+- Have inflate() with Z_FINISH avoid the allocation of a window
+- Do not set strm->adler when doing raw inflate
+- Fix gzeof() to behave just like feof() when read is not past end of file
+- Fix bug in gzread.c when end-of-file is reached
+- Avoid use of Z_BUF_ERROR in gz* functions except for premature EOF
+- Document gzread() capability to read concurrently written files
+- Remove hard-coding of resource compiler in CMakeLists.txt [Blammo]
+
+Changes in 1.2.5.1 (10 Sep 2011)
+- Update FAQ entry on shared builds (#13)
+- Avoid symbolic argument to chmod in Makefile.in
+- Fix bug and add consts in contrib/puff [Oberhumer]
+- Update contrib/puff/zeros.raw test file to have all block types
+- Add full coverage test for puff in contrib/puff/Makefile
+- Fix static-only-build install in Makefile.in
+- Fix bug in unzGetCurrentFileInfo() in contrib/minizip [Kuno]
+- Add libz.a dependency to shared in Makefile.in for parallel builds
+- Spell out "number" (instead of "nb") in zlib.h for total_in, total_out
+- Replace $(...) with `...` in configure for non-bash sh [Bowler]
+- Add darwin* to Darwin* and solaris* to SunOS\ 5* in configure [Groffen]
+- Add solaris* to Linux* in configure to allow gcc use [Groffen]
+- Add *bsd* to Linux* case in configure [Bar-Lev]
+- Add inffast.obj to dependencies in win32/Makefile.msc
+- Correct spelling error in deflate.h [Kohler]
+- Change libzdll.a again to libz.dll.a (!) in win32/Makefile.gcc
+- Add test to configure for GNU C looking for gcc in output of $cc -v
+- Add zlib.pc generation to win32/Makefile.gcc [Weigelt]
+- Fix bug in zlib.h for _FILE_OFFSET_BITS set and _LARGEFILE64_SOURCE not
+- Add comment in zlib.h that adler32_combine with len2 < 0 makes no sense
+- Make NO_DIVIDE option in adler32.c much faster (thanks to John Reiser)
+- Make stronger test in zconf.h to include unistd.h for LFS
+- Apply Darwin patches for 64-bit file offsets to contrib/minizip [Slack]
+- Fix zlib.h LFS support when Z_PREFIX used
+- Add updated as400 support (removed from old) [Monnerat]
+- Avoid deflate sensitivity to volatile input data
+- Avoid division in adler32_combine for NO_DIVIDE
+- Clarify the use of Z_FINISH with deflateBound() amount of space
+- Set binary for output file in puff.c
+- Use u4 type for crc_table to avoid conversion warnings
+- Apply casts in zlib.h to avoid conversion warnings
+- Add OF to prototypes for adler32_combine_ and crc32_combine_ [Miller]
+- Improve inflateSync() documentation to note indeterminancy
+- Add deflatePending() function to return the amount of pending output
+- Correct the spelling of "specification" in FAQ [Randers-Pehrson]
+- Add a check in configure for stdarg.h, use for gzprintf()
+- Check that pointers fit in ints when gzprint() compiled old style
+- Add dummy name before $(SHAREDLIBV) in Makefile [Bar-Lev, Bowler]
+- Delete line in configure that adds -L. libz.a to LDFLAGS [Weigelt]
+- Add debug records in assmebler code [Londer]
+- Update RFC references to use http://tools.ietf.org/html/... [Li]
+- Add --archs option, use of libtool to configure for Mac OS X [Borstel]
+
Changes in 1.2.5 (19 Apr 2010)
- Disable visibility attribute in win32/Makefile.gcc [Bar-Lev]
- Default to libdir as sharedlibdir in configure [Nieder]
- Update copyright dates on modified source files
- Update trees.c to be able to generate modified trees.h
- Exit configure for MinGW, suggesting win32/Makefile.gcc
+- Check for NULL path in gz_open [Homurlu]
Changes in 1.2.4.5 (18 Apr 2010)
- Set sharedlibdir in configure [Torok]
@@ -261,7 +462,7 @@ Changes in 1.2.3.4 (21 Dec 2009)
- Clear bytes after deflate lookahead to avoid use of uninitialized data
- Change a limit in inftrees.c to be more transparent to Coverity Prevent
- Update win32/zlib.def with exported symbols from zlib.h
-- Correct spelling error in zlib.h [Willem]
+- Correct spelling errors in zlib.h [Willem, Sobrado]
- Allow Z_BLOCK for deflate() to force a new block
- Allow negative bits in inflatePrime() to delete existing bit buffer
- Add Z_TREES flush option to inflate() to return at end of trees
@@ -952,7 +1153,7 @@ Changes in 1.0.6 (19 Jan 1998)
- use _fdopen instead of fdopen for MSC >= 6.0 (Thomas Fanslau)
- added makelcc.bat for lcc-win32 (Tom St Denis)
- in Makefile.dj2, use copy and del instead of install and rm (Frank Donahoe)
-- Avoid expanded $Id: ChangeLog,v 1.4 2010/04/20 14:50:10 nijtmans Exp $. Use "rcs -kb" or "cvs admin -kb" to avoid Id expansion.
+- Avoid expanded $Id$. Use "rcs -kb" or "cvs admin -kb" to avoid Id expansion.
- check for unistd.h in configure (for off_t)
- remove useless check parameter in inflate_blocks_free
- avoid useless assignment of s->check to itself in inflate_blocks_new
diff --git a/compat/zlib/FAQ b/compat/zlib/FAQ
index 1a22750..99b7cf9 100644
--- a/compat/zlib/FAQ
+++ b/compat/zlib/FAQ
@@ -44,8 +44,8 @@ The lastest zlib FAQ is at http://zlib.net/zlib_faq.html
6. Where's the zlib documentation (man pages, etc.)?
- It's in zlib.h . Examples of zlib usage are in the files example.c and
- minigzip.c, with more in examples/ .
+ It's in zlib.h . Examples of zlib usage are in the files test/example.c
+ and test/minigzip.c, with more in examples/ .
7. Why don't you use GNU autoconf or libtool or ...?
@@ -84,8 +84,10 @@ The lastest zlib FAQ is at http://zlib.net/zlib_faq.html
13. How can I make a Unix shared library?
- make clean
- ./configure -s
+ By default a shared (and a static) library is built for Unix. So:
+
+ make distclean
+ ./configure
make
14. How do I install a shared zlib library on Unix?
@@ -325,7 +327,7 @@ The lastest zlib FAQ is at http://zlib.net/zlib_faq.html
correctly points to the zlib specification in RFC 1950 for the "deflate"
transfer encoding, there have been reports of servers and browsers that
incorrectly produce or expect raw deflate data per the deflate
- specficiation in RFC 1951, most notably Microsoft. So even though the
+ specification in RFC 1951, most notably Microsoft. So even though the
"deflate" transfer encoding using the zlib format would be the more
efficient approach (and in fact exactly what the zlib format was designed
for), using the "gzip" transfer encoding is probably more reliable due to
diff --git a/compat/zlib/INDEX b/compat/zlib/INDEX
index f6c51ca..2ba0641 100644
--- a/compat/zlib/INDEX
+++ b/compat/zlib/INDEX
@@ -7,6 +7,9 @@ Makefile.in template for Unix Makefile
README guess what
configure configure script for Unix
make_vms.com makefile for VMS
+test/example.c zlib usages examples for build testing
+test/minigzip.c minimal gzip-like functionality for build testing
+test/infcover.c inf*.c code coverage for build coverage testing
treebuild.xml XML description of source file dependencies
zconf.h.cmakein zconf.h template for cmake
zconf.h.in zconf.h template for configure
@@ -14,9 +17,11 @@ zlib.3 Man page for zlib
zlib.3.pdf Man page in PDF format
zlib.map Linux symbol information
zlib.pc.in Template for pkg-config descriptor
+zlib.pc.cmakein zlib.pc template for cmake
zlib2ansi perl script to convert source files for C++ compilation
amiga/ makefiles for Amiga SAS C
+as400/ makefiles for AS/400
doc/ documentation for formats and algorithms
msdos/ makefiles for MSDOS
nintendods/ makefile for Nintendo DS
@@ -56,10 +61,8 @@ uncompr.c
zutil.c
zutil.h
- source files for sample programs:
-example.c
-minigzip.c
-See examples/README.examples for more
+ source files for sample programs
+See examples/README.examples
- unsupported contribution by third parties
+ unsupported contributions by third parties
See contrib/README.contrib
diff --git a/compat/zlib/Makefile.in b/compat/zlib/Makefile.in
index 5b15bd0..241deed 100644
--- a/compat/zlib/Makefile.in
+++ b/compat/zlib/Makefile.in
@@ -1,5 +1,5 @@
# Makefile for zlib
-# Copyright (C) 1995-2010 Jean-loup Gailly.
+# Copyright (C) 1995-2011 Jean-loup Gailly.
# For conditions of distribution and use, see copyright notice in zlib.h
# To compile and test, type:
@@ -32,11 +32,12 @@ CPP=$(CC) -E
STATICLIB=libz.a
SHAREDLIB=libz.so
-SHAREDLIBV=libz.so.1.2.5
+SHAREDLIBV=libz.so.1.2.7
SHAREDLIBM=libz.so.1
LIBS=$(STATICLIB) $(SHAREDLIBV)
-AR=ar rc
+AR=ar
+ARFLAGS=rc
RANLIB=ranlib
LDCONFIG=ldconfig
LDSHAREDLIBC=-lc
@@ -53,11 +54,13 @@ mandir = ${prefix}/share/man
man3dir = ${mandir}/man3
pkgconfigdir = ${libdir}/pkgconfig
-OBJC = adler32.o compress.o crc32.o deflate.o gzclose.o gzlib.o gzread.o \
- gzwrite.o infback.o inffast.o inflate.o inftrees.o trees.o uncompr.o zutil.o
+OBJZ = adler32.o crc32.o deflate.o infback.o inffast.o inflate.o inftrees.o trees.o zutil.o
+OBJG = compress.o uncompr.o gzclose.o gzlib.o gzread.o gzwrite.o
+OBJC = $(OBJZ) $(OBJG)
-PIC_OBJC = adler32.lo compress.lo crc32.lo deflate.lo gzclose.lo gzlib.lo gzread.lo \
- gzwrite.lo infback.lo inffast.lo inflate.lo inftrees.lo trees.lo uncompr.lo zutil.lo
+PIC_OBJZ = adler32.lo crc32.lo deflate.lo infback.lo inffast.lo inflate.lo inftrees.lo trees.lo zutil.lo
+PIC_OBJG = compress.lo uncompr.lo gzclose.lo gzlib.lo gzread.lo gzwrite.lo
+PIC_OBJC = $(PIC_OBJZ) $(PIC_OBJG)
# to use the asm code: make OBJA=match.o, PIC_OBJA=match.lo
OBJA =
@@ -80,35 +83,49 @@ check: test
test: all teststatic testshared
teststatic: static
- @if echo hello world | ./minigzip | ./minigzip -d && ./example; then \
+ @TMPST=`mktemp fooXXXXXX`; \
+ if echo hello world | ./minigzip | ./minigzip -d && ./example $$TMPST ; then \
echo ' *** zlib test OK ***'; \
else \
echo ' *** zlib test FAILED ***'; false; \
- fi
- -@rm -f foo.gz
+ fi; \
+ rm -f $$TMPST
testshared: shared
@LD_LIBRARY_PATH=`pwd`:$(LD_LIBRARY_PATH) ; export LD_LIBRARY_PATH; \
LD_LIBRARYN32_PATH=`pwd`:$(LD_LIBRARYN32_PATH) ; export LD_LIBRARYN32_PATH; \
DYLD_LIBRARY_PATH=`pwd`:$(DYLD_LIBRARY_PATH) ; export DYLD_LIBRARY_PATH; \
SHLIB_PATH=`pwd`:$(SHLIB_PATH) ; export SHLIB_PATH; \
- if echo hello world | ./minigzipsh | ./minigzipsh -d && ./examplesh; then \
+ TMPSH=`mktemp fooXXXXXX`; \
+ if echo hello world | ./minigzipsh | ./minigzipsh -d && ./examplesh $$TMPSH; then \
echo ' *** zlib shared test OK ***'; \
else \
echo ' *** zlib shared test FAILED ***'; false; \
- fi
- -@rm -f foo.gz
+ fi; \
+ rm -f $$TMPSH
test64: all64
- @if echo hello world | ./minigzip64 | ./minigzip64 -d && ./example64; then \
+ @TMP64=`mktemp fooXXXXXX`; \
+ if echo hello world | ./minigzip64 | ./minigzip64 -d && ./example64 $$TMP64; then \
echo ' *** zlib 64-bit test OK ***'; \
else \
echo ' *** zlib 64-bit test FAILED ***'; false; \
- fi
- -@rm -f foo.gz
+ fi; \
+ rm -f $$TMP64
+
+infcover.o: test/infcover.c zlib.h zconf.h
+ $(CC) $(CFLAGS) -I. -c -o $@ test/infcover.c
+
+infcover: infcover.o libz.a
+ $(CC) $(CFLAGS) -o $@ infcover.o libz.a
+
+cover: infcover
+ rm -f *.gcda
+ ./infcover
+ gcov inf*.c
libz.a: $(OBJS)
- $(AR) $@ $(OBJS)
+ $(AR) $(ARFLAGS) $@ $(OBJS)
-@ ($(RANLIB) $@ || true) >/dev/null 2>&1
match.o: match.S
@@ -123,11 +140,17 @@ match.lo: match.S
mv _match.o match.lo
rm -f _match.s
-example64.o: example.c zlib.h zconf.h
- $(CC) $(CFLAGS) -D_FILE_OFFSET_BITS=64 -c -o $@ example.c
+example.o: test/example.c zlib.h zconf.h
+ $(CC) $(CFLAGS) -I. -c -o $@ test/example.c
+
+minigzip.o: test/minigzip.c zlib.h zconf.h
+ $(CC) $(CFLAGS) -I. -c -o $@ test/minigzip.c
+
+example64.o: test/example.c zlib.h zconf.h
+ $(CC) $(CFLAGS) -I. -D_FILE_OFFSET_BITS=64 -c -o $@ test/example.c
-minigzip64.o: minigzip.c zlib.h zconf.h
- $(CC) $(CFLAGS) -D_FILE_OFFSET_BITS=64 -c -o $@ minigzip.c
+minigzip64.o: test/minigzip.c zlib.h zconf.h
+ $(CC) $(CFLAGS) -I. -D_FILE_OFFSET_BITS=64 -c -o $@ test/minigzip.c
.SUFFIXES: .lo
@@ -136,7 +159,7 @@ minigzip64.o: minigzip.c zlib.h zconf.h
$(CC) $(SFLAGS) -DPIC -c -o objs/$*.o $<
-@mv objs/$*.o $@
-$(SHAREDLIBV): $(PIC_OBJS)
+placebo $(SHAREDLIBV): $(PIC_OBJS) libz.a
$(LDSHARED) $(SFLAGS) -o $@ $(PIC_OBJS) $(LDSHAREDLIBC) $(LDFLAGS)
rm -f $(SHAREDLIB) $(SHAREDLIBM)
ln -s $@ $(SHAREDLIB)
@@ -168,14 +191,16 @@ install-libs: $(LIBS)
-@if [ ! -d $(DESTDIR)$(man3dir) ]; then mkdir -p $(DESTDIR)$(man3dir); fi
-@if [ ! -d $(DESTDIR)$(pkgconfigdir) ]; then mkdir -p $(DESTDIR)$(pkgconfigdir); fi
cp $(STATICLIB) $(DESTDIR)$(libdir)
- cp $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)
- cd $(DESTDIR)$(libdir); chmod u=rw,go=r $(STATICLIB)
- -@(cd $(DESTDIR)$(libdir); $(RANLIB) libz.a || true) >/dev/null 2>&1
- -@cd $(DESTDIR)$(sharedlibdir); if test "$(SHAREDLIBV)" -a -f $(SHAREDLIBV); then \
- chmod 755 $(SHAREDLIBV); \
- rm -f $(SHAREDLIB) $(SHAREDLIBM); \
- ln -s $(SHAREDLIBV) $(SHAREDLIB); \
- ln -s $(SHAREDLIBV) $(SHAREDLIBM); \
+ chmod 644 $(DESTDIR)$(libdir)/$(STATICLIB)
+ -@($(RANLIB) $(DESTDIR)$(libdir)/libz.a || true) >/dev/null 2>&1
+ -@if test -n "$(SHAREDLIBV)"; then \
+ cp $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir); \
+ echo "cp $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)"; \
+ chmod 755 $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBV); \
+ echo "chmod 755 $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBV)"; \
+ rm -f $(DESTDIR)$(sharedlibdir)/$(SHAREDLIB) $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBM); \
+ ln -s $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)/$(SHAREDLIB); \
+ ln -s $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBM); \
($(LDCONFIG) || true) >/dev/null 2>&1; \
fi
cp zlib.3 $(DESTDIR)$(man3dir)
@@ -193,7 +218,7 @@ install: install-libs
uninstall:
cd $(DESTDIR)$(includedir); rm -f zlib.h zconf.h
cd $(DESTDIR)$(libdir); rm -f libz.a; \
- if test "$(SHAREDLIBV)" -a -f $(SHAREDLIBV); then \
+ if test -n "$(SHAREDLIBV)" -a -f $(SHAREDLIBV); then \
rm -f $(SHAREDLIBV) $(SHAREDLIB) $(SHAREDLIBM); \
fi
cd $(DESTDIR)$(man3dir); rm -f zlib.3
@@ -204,9 +229,12 @@ docs: zlib.3.pdf
zlib.3.pdf: zlib.3
groff -mandoc -f H -T ps zlib.3 | ps2pdf - zlib.3.pdf
-zconf.h.in: zconf.h.cmakein
- sed "/^#cmakedefine/D" < zconf.h.cmakein > zconf.h.in
- touch -r zconf.h.cmakein zconf.h.in
+zconf.h.cmakein: zconf.h.in
+ -@ TEMPFILE=`mktemp __XXXXXX`; \
+ echo "/#define ZCONF_H/ a\\\\\n#cmakedefine Z_PREFIX\\\\\n#cmakedefine Z_HAVE_UNISTD_H\n" >> $$TEMPFILE &&\
+ sed -f $$TEMPFILE zconf.h.in > zconf.h.cmakein &&\
+ touch -r zconf.h.in zconf.h.cmakein &&\
+ rm $$TEMPFILE
zconf: zconf.h.in
cp -p zconf.h.in zconf.h
@@ -216,13 +244,16 @@ clean:
rm -f *.o *.lo *~ \
example$(EXE) minigzip$(EXE) examplesh$(EXE) minigzipsh$(EXE) \
example64$(EXE) minigzip64$(EXE) \
+ infcover \
libz.* foo.gz so_locations \
_match.s maketree contrib/infback9/*.o
rm -rf objs
+ rm -f *.gcda *.gcno *.gcov
+ rm -f contrib/infback9/*.gcda contrib/infback9/*.gcno contrib/infback9/*.gcov
maintainer-clean: distclean
-distclean: clean zconf docs
- rm -f Makefile zlib.pc
+distclean: clean zconf zconf.h.cmakein docs
+ rm -f Makefile zlib.pc configure.log
-@rm -f .DS_Store
-@printf 'all:\n\t-@echo "Please use ./configure first. Thank you."\n' > Makefile
-@printf '\ndistclean:\n\tmake -f Makefile.in distclean\n' >> Makefile
diff --git a/compat/zlib/README b/compat/zlib/README
index d4219bf..6f1255f 100644
--- a/compat/zlib/README
+++ b/compat/zlib/README
@@ -1,22 +1,22 @@
ZLIB DATA COMPRESSION LIBRARY
-zlib 1.2.5 is a general purpose data compression library. All the code is
+zlib 1.2.7 is a general purpose data compression library. All the code is
thread safe. The data format used by the zlib library is described by RFCs
(Request for Comments) 1950 to 1952 in the files
-http://www.ietf.org/rfc/rfc1950.txt (zlib format), rfc1951.txt (deflate format)
-and rfc1952.txt (gzip format).
+http://tools.ietf.org/html/rfc1950 (zlib format), rfc1951 (deflate format) and
+rfc1952 (gzip format).
All functions of the compression library are documented in the file zlib.h
(volunteer to write man pages welcome, contact zlib@gzip.org). A usage example
-of the library is given in the file example.c which also tests that the library
-is working correctly. Another example is given in the file minigzip.c. The
-compression library itself is composed of all source files except example.c and
-minigzip.c.
+of the library is given in the file test/example.c which also tests that
+the library is working correctly. Another example is given in the file
+test/minigzip.c. The compression library itself is composed of all source
+files in the root directory.
To compile all files and run the test program, follow the instructions given at
the top of Makefile.in. In short "./configure; make test", and if that goes
-well, "make install" should work for most flavors of Unix. For Windows, use one
-of the special makefiles in win32/ or contrib/vstudio/ . For VMS, use
+well, "make install" should work for most flavors of Unix. For Windows, use
+one of the special makefiles in win32/ or contrib/vstudio/ . For VMS, use
make_vms.com.
Questions about zlib should be sent to <zlib@gzip.org>, or to Gilles Vollant
@@ -31,7 +31,7 @@ Mark Nelson <markn@ieee.org> wrote an article about zlib for the Jan. 1997
issue of Dr. Dobb's Journal; a copy of the article is available at
http://marknelson.us/1997/01/01/zlib-engine/ .
-The changes made in version 1.2.5 are documented in the file ChangeLog.
+The changes made in version 1.2.7 are documented in the file ChangeLog.
Unsupported third party contributions are provided in directory contrib/ .
@@ -44,7 +44,7 @@ http://search.cpan.org/~pmqs/IO-Compress-Zlib/ .
A Python interface to zlib written by A.M. Kuchling <amk@amk.ca> is
available in Python 1.5 and later versions, see
-http://www.python.org/doc/lib/module-zlib.html .
+http://docs.python.org/library/zlib.html .
zlib is built into tcl: http://wiki.tcl.tk/4610 .
@@ -84,7 +84,7 @@ Acknowledgments:
Copyright notice:
- (C) 1995-2010 Jean-loup Gailly and Mark Adler
+ (C) 1995-2012 Jean-loup Gailly and Mark Adler
This software is provided 'as-is', without any express or implied
warranty. In no event will the authors be held liable for any damages
diff --git a/compat/zlib/adler32.c b/compat/zlib/adler32.c
index 997020d..a868f07 100644
--- a/compat/zlib/adler32.c
+++ b/compat/zlib/adler32.c
@@ -1,17 +1,17 @@
/* adler32.c -- compute the Adler-32 checksum of a data stream
- * Copyright (C) 1995-2007 Mark Adler
+ * Copyright (C) 1995-2011 Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*/
-/* @(#) $Id: adler32.c,v 1.3 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
#include "zutil.h"
#define local static
-local uLong adler32_combine_(uLong adler1, uLong adler2, z_off64_t len2);
+local uLong adler32_combine_ OF((uLong adler1, uLong adler2, z_off64_t len2));
-#define BASE 65521UL /* largest prime smaller than 65536 */
+#define BASE 65521 /* largest prime smaller than 65536 */
#define NMAX 5552
/* NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 */
@@ -21,39 +21,44 @@ local uLong adler32_combine_(uLong adler1, uLong adler2, z_off64_t len2);
#define DO8(buf,i) DO4(buf,i); DO4(buf,i+4);
#define DO16(buf) DO8(buf,0); DO8(buf,8);
-/* use NO_DIVIDE if your processor does not do division in hardware */
+/* use NO_DIVIDE if your processor does not do division in hardware --
+ try it both ways to see which is faster */
#ifdef NO_DIVIDE
-# define MOD(a) \
+/* note that this assumes BASE is 65521, where 65536 % 65521 == 15
+ (thank you to John Reiser for pointing this out) */
+# define CHOP(a) \
+ do { \
+ unsigned long tmp = a >> 16; \
+ a &= 0xffffUL; \
+ a += (tmp << 4) - tmp; \
+ } while (0)
+# define MOD28(a) \
do { \
- if (a >= (BASE << 16)) a -= (BASE << 16); \
- if (a >= (BASE << 15)) a -= (BASE << 15); \
- if (a >= (BASE << 14)) a -= (BASE << 14); \
- if (a >= (BASE << 13)) a -= (BASE << 13); \
- if (a >= (BASE << 12)) a -= (BASE << 12); \
- if (a >= (BASE << 11)) a -= (BASE << 11); \
- if (a >= (BASE << 10)) a -= (BASE << 10); \
- if (a >= (BASE << 9)) a -= (BASE << 9); \
- if (a >= (BASE << 8)) a -= (BASE << 8); \
- if (a >= (BASE << 7)) a -= (BASE << 7); \
- if (a >= (BASE << 6)) a -= (BASE << 6); \
- if (a >= (BASE << 5)) a -= (BASE << 5); \
- if (a >= (BASE << 4)) a -= (BASE << 4); \
- if (a >= (BASE << 3)) a -= (BASE << 3); \
- if (a >= (BASE << 2)) a -= (BASE << 2); \
- if (a >= (BASE << 1)) a -= (BASE << 1); \
+ CHOP(a); \
if (a >= BASE) a -= BASE; \
} while (0)
-# define MOD4(a) \
+# define MOD(a) \
do { \
- if (a >= (BASE << 4)) a -= (BASE << 4); \
- if (a >= (BASE << 3)) a -= (BASE << 3); \
- if (a >= (BASE << 2)) a -= (BASE << 2); \
- if (a >= (BASE << 1)) a -= (BASE << 1); \
+ CHOP(a); \
+ MOD28(a); \
+ } while (0)
+# define MOD63(a) \
+ do { /* this assumes a is not negative */ \
+ z_off64_t tmp = a >> 32; \
+ a &= 0xffffffffL; \
+ a += (tmp << 8) - (tmp << 5) + tmp; \
+ tmp = a >> 16; \
+ a &= 0xffffL; \
+ a += (tmp << 4) - tmp; \
+ tmp = a >> 16; \
+ a &= 0xffffL; \
+ a += (tmp << 4) - tmp; \
if (a >= BASE) a -= BASE; \
} while (0)
#else
# define MOD(a) a %= BASE
-# define MOD4(a) a %= BASE
+# define MOD28(a) a %= BASE
+# define MOD63(a) a %= BASE
#endif
/* ========================================================================= */
@@ -92,7 +97,7 @@ uLong ZEXPORT adler32(adler, buf, len)
}
if (adler >= BASE)
adler -= BASE;
- MOD4(sum2); /* only added so many BASE's */
+ MOD28(sum2); /* only added so many BASE's */
return adler | (sum2 << 16);
}
@@ -137,8 +142,13 @@ local uLong adler32_combine_(adler1, adler2, len2)
unsigned long sum2;
unsigned rem;
+ /* for negative len, return invalid adler32 as a clue for debugging */
+ if (len2 < 0)
+ return 0xffffffffUL;
+
/* the derivation of this formula is left as an exercise for the reader */
- rem = (unsigned)(len2 % BASE);
+ MOD63(len2); /* assumes len2 >= 0 */
+ rem = (unsigned)len2;
sum1 = adler1 & 0xffff;
sum2 = rem * sum1;
MOD(sum2);
diff --git a/compat/zlib/old/as400/bndsrc b/compat/zlib/as400/bndsrc
index 9cf94bb..52cc661 100644
--- a/compat/zlib/old/as400/bndsrc
+++ b/compat/zlib/as400/bndsrc
@@ -129,4 +129,77 @@ STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('ZLIB')
EXPORT SYMBOL("zlibCompileFlags")
+/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
+/* Version 1.2.5 additional entry points. */
+/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
+
+/********************************************************************/
+/* *MODULE ADLER32 ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("adler32_combine")
+ EXPORT SYMBOL("adler32_combine64")
+
+/********************************************************************/
+/* *MODULE CRC32 ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("crc32_combine")
+ EXPORT SYMBOL("crc32_combine64")
+
+/********************************************************************/
+/* *MODULE GZLIB ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("gzbuffer")
+ EXPORT SYMBOL("gzoffset")
+ EXPORT SYMBOL("gzoffset64")
+ EXPORT SYMBOL("gzopen64")
+ EXPORT SYMBOL("gzseek64")
+ EXPORT SYMBOL("gztell64")
+
+/********************************************************************/
+/* *MODULE GZREAD ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("gzclose_r")
+
+/********************************************************************/
+/* *MODULE GZWRITE ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("gzclose_w")
+
+/********************************************************************/
+/* *MODULE INFLATE ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("inflateMark")
+ EXPORT SYMBOL("inflatePrime")
+ EXPORT SYMBOL("inflateReset2")
+ EXPORT SYMBOL("inflateUndermine")
+
+/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
+/* Version 1.2.6 additional entry points. */
+/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
+
+/********************************************************************/
+/* *MODULE DEFLATE ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("deflateResetKeep")
+ EXPORT SYMBOL("deflatePending")
+
+/********************************************************************/
+/* *MODULE GZWRITE ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("gzgetc_")
+
+/********************************************************************/
+/* *MODULE INFLATE ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("inflateResetKeep")
+
ENDPGMEXP
diff --git a/compat/zlib/as400/compile.clp b/compat/zlib/as400/compile.clp
new file mode 100644
index 0000000..8d0c58f
--- /dev/null
+++ b/compat/zlib/as400/compile.clp
@@ -0,0 +1,110 @@
+/******************************************************************************/
+/* */
+/* ZLIB */
+/* */
+/* Compile sources into modules and link them into a service program. */
+/* */
+/******************************************************************************/
+
+ PGM
+
+/* Configuration adjustable parameters. */
+
+ DCL VAR(&SRCLIB) TYPE(*CHAR) LEN(10) +
+ VALUE('ZLIB') /* Source library. */
+ DCL VAR(&SRCFILE) TYPE(*CHAR) LEN(10) +
+ VALUE('SOURCES') /* Source member file. */
+ DCL VAR(&CTLFILE) TYPE(*CHAR) LEN(10) +
+ VALUE('TOOLS') /* Control member file. */
+
+ DCL VAR(&MODLIB) TYPE(*CHAR) LEN(10) +
+ VALUE('ZLIB') /* Module library. */
+
+ DCL VAR(&SRVLIB) TYPE(*CHAR) LEN(10) +
+ VALUE('LGPL') /* Service program library. */
+
+ DCL VAR(&CFLAGS) TYPE(*CHAR) +
+ VALUE('OPTIMIZE(40)') /* Compile options. */
+
+ DCL VAR(&TGTRLS) TYPE(*CHAR) +
+ VALUE('V5R3M0') /* Target release. */
+
+
+/* Working storage. */
+
+ DCL VAR(&CMDLEN) TYPE(*DEC) LEN(15 5) VALUE(300) /* Command length. */
+ DCL VAR(&CMD) TYPE(*CHAR) LEN(512)
+ DCL VAR(&FIXDCMD) TYPE(*CHAR) LEN(512)
+
+
+/* Compile sources into modules. */
+
+ CHGVAR VAR(&FIXDCMD) VALUE('CRTCMOD' *BCAT &CFLAGS *BCAT +
+ 'SYSIFCOPT(*IFS64IO)' *BCAT +
+ 'DEFINE(''_LARGEFILE64_SOURCE''' *BCAT +
+ '''_LFS64_LARGEFILE=1'') TGTRLS(' *TCAT &TGTRLS *TCAT +
+ ') SRCFILE(' *TCAT &SRCLIB *TCAT '/' *TCAT +
+ &SRCFILE *TCAT ') MODULE(' *TCAT &MODLIB *TCAT '/')
+
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'ADLER32)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'COMPRESS)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'CRC32)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'DEFLATE)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'GZCLOSE)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'GZLIB)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'GZREAD)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'GZWRITE)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'INFBACK)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'INFFAST)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'INFLATE)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'INFTREES)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'TREES)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'UNCOMPR)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+ CHGVAR VAR(&CMD) VALUE(&FIXDCMD *TCAT 'ZUTIL)')
+ CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
+
+
+/* Link modules into a service program. */
+
+ CRTSRVPGM SRVPGM(&SRVLIB/ZLIB) +
+ MODULE(&MODLIB/ADLER32 &MODLIB/COMPRESS +
+ &MODLIB/CRC32 &MODLIB/DEFLATE +
+ &MODLIB/GZCLOSE &MODLIB/GZLIB +
+ &MODLIB/GZREAD &MODLIB/GZWRITE +
+ &MODLIB/INFBACK &MODLIB/INFFAST +
+ &MODLIB/INFLATE &MODLIB/INFTREES +
+ &MODLIB/TREES &MODLIB/UNCOMPR +
+ &MODLIB/ZUTIL) +
+ SRCFILE(&SRCLIB/&CTLFILE) SRCMBR(BNDSRC) +
+ TEXT('ZLIB 1.2.7') TGTRLS(&TGTRLS)
+
+ ENDPGM
diff --git a/compat/zlib/old/as400/readme.txt b/compat/zlib/as400/readme.txt
index beae13f..23cd1b8 100644
--- a/compat/zlib/old/as400/readme.txt
+++ b/compat/zlib/as400/readme.txt
@@ -1,4 +1,4 @@
- ZLIB version 1.2.3 for AS400 installation instructions
+ ZLIB version 1.2.7 for AS400 installation instructions
I) From an AS400 *SAVF file:
@@ -8,7 +8,7 @@ On the AS400:
_ Create the ZLIB AS400 library:
- CRTLIB LIB(ZLIB) TYPE(PROD) TEXT('ZLIB compression API library')
+ CRTLIB LIB(ZLIB) TYPE(*PROD) TEXT('ZLIB compression API library')
_ Create a work save file, for example:
@@ -52,7 +52,7 @@ II) From the original source distribution:
1) On the AS400, create the source library:
- CRTLIB LIB(ZLIB) TYPE(PROD) TEXT('ZLIB compression API library')
+ CRTLIB LIB(ZLIB) TYPE(*PROD) TEXT('ZLIB compression API library')
2) Create the source files:
@@ -70,7 +70,10 @@ II) From the original source distribution:
compress.c COMPRESS C ZLIB - Compress a memory buffer
crc32.c CRC32 C ZLIB - Compute the CRC-32 of a data stream
deflate.c DEFLATE C ZLIB - Compress data using the deflation algorithm
- gzio.c GZIO C ZLIB - IO on .gz files
+ gzclose.c GZCLOSE C ZLIB - Close .gz files
+ gzlib.c GZLIB C ZLIB - Miscellaneous .gz files IO support
+ gzread.c GZREAD C ZLIB - Read .gz files
+ gzwrite.c GZWRITE C ZLIB - Write .gz files
infback.c INFBACK C ZLIB - Inflate using a callback interface
inffast.c INFFAST C ZLIB - Fast proc. literals & length/distance pairs
inflate.c INFLATE C ZLIB - Interface to inflate modules
@@ -81,6 +84,7 @@ II) From the original source distribution:
H Original ZLIB C and ILE/RPG include files
crc32.h CRC32 C ZLIB - CRC32 tables
deflate.h DEFLATE C ZLIB - Internal compression state
+ gzguts.h GZGUTS C ZLIB - Definitions for the gzclose module
inffast.h INFFAST C ZLIB - Header to use inffast.c
inffixed.h INFFIXED C ZLIB - Table for decoding fixed codes
inflate.h INFLATE C ZLIB - Internal inflate state definitions
@@ -108,4 +112,4 @@ Notes: For AS400 ILE RPG programmers, a /copy member defining the ZLIB
implementation does not handle conversion from/to ASCII, so
text data code conversions must be done explicitely.
- Always open zipped files in binary mode.
+ Mainly for the reason above, always open zipped files in binary mode.
diff --git a/compat/zlib/old/as400/zlib.inc b/compat/zlib/as400/zlib.inc
index a9a4f5c..747c598 100644
--- a/compat/zlib/old/as400/zlib.inc
+++ b/compat/zlib/as400/zlib.inc
@@ -1,7 +1,7 @@
* ZLIB.INC - Interface to the general purpose compression library
*
* ILE RPG400 version by Patrick Monnerat, DATASPHERE.
- * Version 1.2.3.9
+ * Version 1.2.7
*
*
* WARNING:
@@ -22,16 +22,25 @@
*
* Versioning information.
*
- D ZLIB_VERSION C '1.2.3.9'
- D ZLIB_VERNUM C X'1239'
+ D ZLIB_VERSION C '1.2.7'
+ D ZLIB_VERNUM C X'1270'
+ D ZLIB_VER_MAJOR C 1
+ D ZLIB_VER_MINOR C 2
+ D ZLIB_VER_REVISION...
+ D C 7
+ D ZLIB_VER_SUBREVISION...
+ D C 0
*
* Other equates.
*
D Z_NO_FLUSH C 0
+ D Z_PARTIAL_FLUSH...
+ D C 1
D Z_SYNC_FLUSH C 2
D Z_FULL_FLUSH C 3
D Z_FINISH C 4
D Z_BLOCK C 5
+ D Z_TREES C 6
*
D Z_OK C 0
D Z_STREAM_END C 1
@@ -72,6 +81,7 @@
D z_streamp S * Stream struct ptr
D gzFile S * File pointer
D z_off_t S 10i 0 Stream offsets
+ D z_off64_t S 20i 0 Stream offsets
*
**************************************************************************
* Structures
@@ -101,15 +111,15 @@
**************************************************************************
*
D compress PR 10I 0 extproc('compress')
- D dest 32767 options(*varsize) Destination buffer
+ D dest 65535 options(*varsize) Destination buffer
D destLen 10U 0 Destination length
- D source 32767 const options(*varsize) Source buffer
+ D source 65535 const options(*varsize) Source buffer
D sourceLen 10u 0 value Source length
*
D compress2 PR 10I 0 extproc('compress2')
- D dest 32767 options(*varsize) Destination buffer
+ D dest 65535 options(*varsize) Destination buffer
D destLen 10U 0 Destination length
- D source 32767 const options(*varsize) Source buffer
+ D source 65535 const options(*varsize) Source buffer
D sourceLen 10U 0 value Source length
D level 10I 0 value Compression level
*
@@ -117,34 +127,50 @@
D sourceLen 10U 0 value
*
D uncompress PR 10I 0 extproc('uncompress')
- D dest 32767 options(*varsize) Destination buffer
+ D dest 65535 options(*varsize) Destination buffer
D destLen 10U 0 Destination length
- D source 32767 const options(*varsize) Source buffer
+ D source 65535 const options(*varsize) Source buffer
D sourceLen 10U 0 value Source length
*
+ /if not defined(LARGE_FILES)
D gzopen PR extproc('gzopen')
D like(gzFile)
D path * value options(*string) File pathname
D mode * value options(*string) Open mode
+ /else
+ D gzopen PR extproc('gzopen64')
+ D like(gzFile)
+ D path * value options(*string) File pathname
+ D mode * value options(*string) Open mode
+ *
+ D gzopen64 PR extproc('gzopen64')
+ D like(gzFile)
+ D path * value options(*string) File pathname
+ D mode * value options(*string) Open mode
+ /endif
*
D gzdopen PR extproc('gzdopen')
D like(gzFile)
- D fd 10i 0 value File descriptor
+ D fd 10I 0 value File descriptor
D mode * value options(*string) Open mode
*
+ D gzbuffer PR 10I 0 extproc('gzbuffer')
+ D file value like(gzFile) File pointer
+ D size 10U 0 value
+ *
D gzsetparams PR 10I 0 extproc('gzsetparams')
D file value like(gzFile) File pointer
D level 10I 0 value
- D strategy 10i 0 value
+ D strategy 10I 0 value
*
D gzread PR 10I 0 extproc('gzread')
D file value like(gzFile) File pointer
- D buf 32767 options(*varsize) Buffer
+ D buf 65535 options(*varsize) Buffer
D len 10u 0 value Buffer length
*
D gzwrite PR 10I 0 extproc('gzwrite')
D file value like(gzFile) File pointer
- D buf 32767 const options(*varsize) Buffer
+ D buf 65535 const options(*varsize) Buffer
D len 10u 0 value Buffer length
*
D gzputs PR 10I 0 extproc('gzputs')
@@ -153,29 +179,87 @@
*
D gzgets PR * extproc('gzgets')
D file value like(gzFile) File pointer
- D buf 32767 options(*varsize) Read buffer
+ D buf 65535 options(*varsize) Read buffer
D len 10i 0 value Buffer length
*
+ D gzputc PR 10i 0 extproc('gzputc')
+ D file value like(gzFile) File pointer
+ D c 10I 0 value Character to write
+ *
+ D gzgetc PR 10i 0 extproc('gzgetc')
+ D file value like(gzFile) File pointer
+ *
+ D gzgetc_ PR 10i 0 extproc('gzgetc_')
+ D file value like(gzFile) File pointer
+ *
+ D gzungetc PR 10i 0 extproc('gzungetc')
+ D c 10I 0 value Character to push
+ D file value like(gzFile) File pointer
+ *
D gzflush PR 10i 0 extproc('gzflush')
D file value like(gzFile) File pointer
D flush 10I 0 value Type of flush
*
+ /if not defined(LARGE_FILES)
D gzseek PR extproc('gzseek')
D like(z_off_t)
D file value like(gzFile) File pointer
D offset value like(z_off_t) Offset
D whence 10i 0 value Origin
+ /else
+ D gzseek PR extproc('gzseek64')
+ D like(z_off_t)
+ D file value like(gzFile) File pointer
+ D offset value like(z_off_t) Offset
+ D whence 10i 0 value Origin
+ *
+ D gzseek64 PR extproc('gzseek64')
+ D like(z_off64_t)
+ D file value like(gzFile) File pointer
+ D offset value like(z_off64_t) Offset
+ D whence 10i 0 value Origin
+ /endif
*
D gzrewind PR 10i 0 extproc('gzrewind')
D file value like(gzFile) File pointer
*
+ /if not defined(LARGE_FILES)
D gztell PR extproc('gztell')
D like(z_off_t)
D file value like(gzFile) File pointer
+ /else
+ D gztell PR extproc('gztell64')
+ D like(z_off_t)
+ D file value like(gzFile) File pointer
+ *
+ D gztell64 PR extproc('gztell64')
+ D like(z_off64_t)
+ D file value like(gzFile) File pointer
+ /endif
+ *
+ /if not defined(LARGE_FILES)
+ D gzoffset PR extproc('gzoffset')
+ D like(z_off_t)
+ D file value like(gzFile) File pointer
+ /else
+ D gzoffset PR extproc('gzoffset64')
+ D like(z_off_t)
+ D file value like(gzFile) File pointer
+ *
+ D gzoffset64 PR extproc('gzoffset64')
+ D like(z_off64_t)
+ D file value like(gzFile) File pointer
+ /endif
*
D gzeof PR 10i 0 extproc('gzeof')
D file value like(gzFile) File pointer
*
+ D gzclose_r PR 10i 0 extproc('gzclose_r')
+ D file value like(gzFile) File pointer
+ *
+ D gzclose_w PR 10i 0 extproc('gzclose_w')
+ D file value like(gzFile) File pointer
+ *
D gzclose PR 10i 0 extproc('gzclose')
D file value like(gzFile) File pointer
*
@@ -234,7 +318,7 @@
D deflateSetDictionary...
D PR 10I 0 extproc('deflateSetDictionary') Init. dictionary
D strm like(z_stream) Compression stream
- D dictionary 32767 const options(*varsize) Dictionary bytes
+ D dictionary 65535 const options(*varsize) Dictionary bytes
D dictLength 10U 0 value Dictionary length
*
D deflateCopy PR 10I 0 extproc('deflateCopy') Compress strm 2 strm
@@ -253,9 +337,14 @@
D strm like(z_stream) Compression stream
D sourcelen 10U 0 value Compression level
*
+ D deflatePending PR 10I 0 extproc('deflatePending') Change level & strat
+ D strm like(z_stream) Compression stream
+ D pending 10U 0 Pending bytes
+ D bits 10I 0 Pending bits
+ *
D deflatePrime PR 10I 0 extproc('deflatePrime') Change level & strat
D strm like(z_stream) Compression stream
- D bits 10I 0 value Number of bits to insert
+ D bits 10I 0 value # of bits to insert
D value 10I 0 value Bits to insert
*
D inflateInit2 PR 10I 0 extproc('inflateInit2_') Init. expansion
@@ -267,7 +356,7 @@
D inflateSetDictionary...
D PR 10I 0 extproc('inflateSetDictionary') Init. dictionary
D strm like(z_stream) Expansion stream
- D dictionary 32767 const options(*varsize) Dictionary bytes
+ D dictionary 65535 const options(*varsize) Dictionary bytes
D dictLength 10U 0 value Dictionary length
*
D inflateSync PR 10I 0 extproc('inflateSync') Sync. expansion
@@ -280,11 +369,23 @@
D inflateReset PR 10I 0 extproc('inflateReset') End and init. stream
D strm like(z_stream) Expansion stream
*
+ D inflateReset2 PR 10I 0 extproc('inflateReset2') End and init. stream
+ D strm like(z_stream) Expansion stream
+ D windowBits 10I 0 value Log2(buffer size)
+ *
+ D inflatePrime PR 10I 0 extproc('inflatePrime') Insert bits
+ D strm like(z_stream) Expansion stream
+ D bits 10I 0 value Bit count
+ D value 10I 0 value Bits to insert
+ *
+ D inflateMark PR 10I 0 extproc('inflateMark') Get inflate info
+ D strm like(z_stream) Expansion stream
+ *
D inflateBackInit...
D PR 10I 0 extproc('inflateBackInit_')
D strm like(z_stream) Expansion stream
D windowBits 10I 0 value Log2(buffer size)
- D window 32767 options(*varsize) Buffer
+ D window 65535 options(*varsize) Buffer
D version * value options(*string) Version string
D stream_size 10i 0 value Stream struct. size
*
@@ -307,12 +408,12 @@
*
D adler32 PR 10U 0 extproc('adler32') New checksum
D adler 10U 0 value Old checksum
- D buf 32767 const options(*varsize) Bytes to accumulate
+ D buf 65535 const options(*varsize) Bytes to accumulate
D len 10U 0 value Buffer length
*
D crc32 PR 10U 0 extproc('crc32') New checksum
D crc 10U 0 value Old checksum
- D buf 32767 const options(*varsize) Bytes to accumulate
+ D buf 65535 const options(*varsize) Bytes to accumulate
D len 10U 0 value Buffer length
*
**************************************************************************
@@ -328,4 +429,17 @@
*
D get_crc_table PR * extproc('get_crc_table') Ptr to ulongs
*
+ D inflateUndermine...
+ D PR 10I 0 extproc('inflateUndermine')
+ D strm like(z_stream) Expansion stream
+ D arg 10I 0 value Error code
+ *
+ D inflateResetKeep...
+ D PR 10I 0 extproc('inflateResetKeep') End and init. stream
+ D strm like(z_stream) Expansion stream
+ *
+ D deflateResetKeep...
+ D PR 10I 0 extproc('deflateResetKeep') End and init. stream
+ D strm like(z_stream) Expansion stream
+ *
/endif
diff --git a/compat/zlib/compress.c b/compat/zlib/compress.c
index 21fa4c1..ea4dfbe 100644
--- a/compat/zlib/compress.c
+++ b/compat/zlib/compress.c
@@ -3,7 +3,7 @@
* For conditions of distribution and use, see copyright notice in zlib.h
*/
-/* @(#) $Id: compress.c,v 1.3 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
#define ZLIB_INTERNAL
#include "zlib.h"
diff --git a/compat/zlib/configure b/compat/zlib/configure
index bd9edd2..36c7d8e 100755
--- a/compat/zlib/configure
+++ b/compat/zlib/configure
@@ -13,39 +13,52 @@
# If you have problems, try without defining CC and CFLAGS before reporting
# an error.
+# start off configure.log
+echo -------------------- >> configure.log
+echo $0 $* >> configure.log
+date >> configure.log
+
+# set command prefix for cross-compilation
if [ -n "${CHOST}" ]; then
- uname="$(echo "${CHOST}" | sed -e 's/^[^-]*-\([^-]*\)$/\1/' -e 's/^[^-]*-[^-]*-\([^-]*\)$/\1/' -e 's/^[^-]*-[^-]*-\([^-]*\)-.*$/\1/')"
+ uname="`echo "${CHOST}" | sed -e 's/^[^-]*-\([^-]*\)$/\1/' -e 's/^[^-]*-[^-]*-\([^-]*\)$/\1/' -e 's/^[^-]*-[^-]*-\([^-]*\)-.*$/\1/'`"
CROSS_PREFIX="${CHOST}-"
fi
+# destination name for static library
STATICLIB=libz.a
-LDFLAGS="${LDFLAGS} -L. ${STATICLIB}"
+
+# extract zlib version numbers from zlib.h
VER=`sed -n -e '/VERSION "/s/.*"\(.*\)".*/\1/p' < zlib.h`
VER3=`sed -n -e '/VERSION "/s/.*"\([0-9]*\\.[0-9]*\\.[0-9]*\).*/\1/p' < zlib.h`
VER2=`sed -n -e '/VERSION "/s/.*"\([0-9]*\\.[0-9]*\)\\..*/\1/p' < zlib.h`
VER1=`sed -n -e '/VERSION "/s/.*"\([0-9]*\)\\..*/\1/p' < zlib.h`
+
+# establish commands for library building
if "${CROSS_PREFIX}ar" --version >/dev/null 2>/dev/null || test $? -lt 126; then
AR=${AR-"${CROSS_PREFIX}ar"}
- test -n "${CROSS_PREFIX}" && echo Using ${AR}
+ test -n "${CROSS_PREFIX}" && echo Using ${AR} | tee -a configure.log
else
AR=${AR-"ar"}
- test -n "${CROSS_PREFIX}" && echo Using ${AR}
+ test -n "${CROSS_PREFIX}" && echo Using ${AR} | tee -a configure.log
fi
-AR_RC="${AR} rc"
+ARFLAGS=${ARFLAGS-"rc"}
if "${CROSS_PREFIX}ranlib" --version >/dev/null 2>/dev/null || test $? -lt 126; then
RANLIB=${RANLIB-"${CROSS_PREFIX}ranlib"}
- test -n "${CROSS_PREFIX}" && echo Using ${RANLIB}
+ test -n "${CROSS_PREFIX}" && echo Using ${RANLIB} | tee -a configure.log
else
RANLIB=${RANLIB-"ranlib"}
fi
if "${CROSS_PREFIX}nm" --version >/dev/null 2>/dev/null || test $? -lt 126; then
NM=${NM-"${CROSS_PREFIX}nm"}
- test -n "${CROSS_PREFIX}" && echo Using ${NM}
+ test -n "${CROSS_PREFIX}" && echo Using ${NM} | tee -a configure.log
else
NM=${NM-"nm"}
fi
+
+# set defaults before processing command line options
LDCONFIG=${LDCONFIG-"ldconfig"}
LDSHAREDLIBC="${LDSHAREDLIBC--lc}"
+ARCHS=
prefix=${prefix-/usr/local}
exec_prefix=${exec_prefix-'${prefix}'}
libdir=${libdir-'${exec_prefix}/lib'}
@@ -54,20 +67,25 @@ includedir=${includedir-'${prefix}/include'}
mandir=${mandir-'${prefix}/share/man'}
shared_ext='.so'
shared=1
+solo=0
+cover=0
zprefix=0
build64=0
gcc=0
old_cc="$CC"
old_cflags="$CFLAGS"
+OBJC='$(OBJZ) $(OBJG)'
+PIC_OBJC='$(PIC_OBJZ) $(PIC_OBJG)'
+# process command line options
while test $# -ge 1
do
case "$1" in
-h* | --help)
- echo 'usage:'
- echo ' configure [--zprefix] [--prefix=PREFIX] [--eprefix=EXPREFIX]'
- echo ' [--static] [--64] [--libdir=LIBDIR] [--sharedlibdir=LIBDIR]'
- echo ' [--includedir=INCLUDEDIR]'
+ echo 'usage:' | tee -a configure.log
+ echo ' configure [--zprefix] [--prefix=PREFIX] [--eprefix=EXPREFIX]' | tee -a configure.log
+ echo ' [--static] [--64] [--libdir=LIBDIR] [--sharedlibdir=LIBDIR]' | tee -a configure.log
+ echo ' [--includedir=INCLUDEDIR] [--archs="-arch i386 -arch x86_64"]' | tee -a configure.log
exit 0 ;;
-p*=* | --prefix=*) prefix=`echo $1 | sed 's/.*=//'`; shift ;;
-e*=* | --eprefix=*) exec_prefix=`echo $1 | sed 's/.*=//'`; shift ;;
@@ -81,32 +99,93 @@ case "$1" in
-i* | --includedir) includedir="$2"; shift; shift ;;
-s* | --shared | --enable-shared) shared=1; shift ;;
-t | --static) shared=0; shift ;;
+ --solo) solo=1; shift ;;
+ --cover) cover=1; shift ;;
-z* | --zprefix) zprefix=1; shift ;;
-6* | --64) build64=1; shift ;;
- --sysconfdir=*) echo "ignored option: --sysconfdir"; shift ;;
- --localstatedir=*) echo "ignored option: --localstatedir"; shift ;;
- *) echo "unknown option: $1"; echo "$0 --help for help"; exit 1 ;;
+ -a*=* | --archs=*) ARCHS=`echo $1 | sed 's/.*=//'`; shift ;;
+ --sysconfdir=*) echo "ignored option: --sysconfdir" | tee -a configure.log; shift ;;
+ --localstatedir=*) echo "ignored option: --localstatedir" | tee -a configure.log; shift ;;
+ *) echo "unknown option: $1"; echo "$0 --help for help" | tee -a configure.log; exit 1 ;;
esac
done
+# define functions for testing compiler and library characteristics and logging the results
test=ztest$$
+
+show()
+{
+ case "$*" in
+ *$test.c*)
+ echo === $test.c === >> configure.log
+ cat $test.c >> configure.log
+ echo === >> configure.log;;
+ esac
+ echo $* >> configure.log
+}
+
+cat > $test.c <<EOF
+#error error
+EOF
+if ($CC -c $CFLAGS $test.c) 2>/dev/null; then
+ try()
+ {
+ show $*
+ test "`( $* ) 2>&1 | tee -a configure.log`" = ""
+ }
+ echo - using any output from compiler to indicate an error >> configure.log
+else
+ try()
+ {
+ show $*
+ ( $* ) >> configure.log 2>&1
+ ret=$?
+ if test $ret -ne 0; then
+ echo "(exit code "$ret")" >> configure.log
+ fi
+ return $ret
+ }
+fi
+
+tryboth()
+{
+ show $*
+ got=`( $* ) 2>&1`
+ ret=$?
+ printf %s "$got" >> configure.log
+ if test $ret -ne 0; then
+ return $ret
+ fi
+ test "$got" = ""
+}
+
+echo >> configure.log
+
+# check for gcc vs. cc and set compile and link flags based on the system identified by uname
cat > $test.c <<EOF
extern int getchar();
int hello() {return getchar();}
EOF
-test -z "$CC" && echo Checking for ${CROSS_PREFIX}gcc...
+test -z "$CC" && echo Checking for ${CROSS_PREFIX}gcc... | tee -a configure.log
cc=${CC-${CROSS_PREFIX}gcc}
cflags=${CFLAGS-"-O3"}
# to force the asm version use: CFLAGS="-O3 -DASMV" ./configure
case "$cc" in
*gcc*) gcc=1 ;;
+ *clang*) gcc=1 ;;
+esac
+case `$cc -v 2>&1` in
+ *gcc*) gcc=1 ;;
esac
-if test "$gcc" -eq 1 && ($cc -c $cflags $test.c) 2>/dev/null; then
+show $cc -c $cflags $test.c
+if test "$gcc" -eq 1 && ($cc -c $cflags $test.c) >> configure.log 2>&1; then
+ echo ... using gcc >> configure.log
CC="$cc"
+ CFLAGS="${CFLAGS--O3} ${ARCHS}"
SFLAGS="${CFLAGS--O3} -fPIC"
- CFLAGS="${CFLAGS--O3}"
+ LDFLAGS="${LDFLAGS} ${ARCHS}"
if test $build64 -eq 1; then
CFLAGS="${CFLAGS} -m64"
SFLAGS="${SFLAGS} -m64"
@@ -118,13 +197,17 @@ if test "$gcc" -eq 1 && ($cc -c $cflags $test.c) 2>/dev/null; then
uname=`(uname -s || echo unknown) 2>/dev/null`
fi
case "$uname" in
- Linux* | linux* | GNU | GNU/* | *BSD | DragonFly) LDSHARED=${LDSHARED-"$cc -shared -Wl,-soname,libz.so.1,--version-script,zlib.map"} ;;
+ Linux* | linux* | GNU | GNU/* | solaris*)
+ LDSHARED=${LDSHARED-"$cc -shared -Wl,-soname,libz.so.1,--version-script,zlib.map"} ;;
+ *BSD | *bsd* | DragonFly)
+ LDSHARED=${LDSHARED-"$cc -shared -Wl,-soname,libz.so.1,--version-script,zlib.map"}
+ LDCONFIG="ldconfig -m" ;;
CYGWIN* | Cygwin* | cygwin* | OS/2*)
EXE='.exe' ;;
- MINGW*|mingw*)
+ MINGW* | mingw*)
# temporary bypass
rm -f $test.[co] $test $test$shared_ext
- echo "Please use win32/Makefile.gcc instead."
+ echo "Please use win32/Makefile.gcc instead." | tee -a configure.log
exit 1
LDSHARED=${LDSHARED-"$cc -shared"}
LDSHAREDLIBC=""
@@ -142,17 +225,21 @@ if test "$gcc" -eq 1 && ($cc -c $cflags $test.c) 2>/dev/null; then
shared_ext='.sl'
SHAREDLIB='libz.sl' ;;
esac ;;
- Darwin*) shared_ext='.dylib'
+ Darwin* | darwin*)
+ shared_ext='.dylib'
SHAREDLIB=libz$shared_ext
SHAREDLIBV=libz.$VER$shared_ext
SHAREDLIBM=libz.$VER1$shared_ext
- LDSHARED=${LDSHARED-"$cc -dynamiclib -install_name $libdir/$SHAREDLIBM -compatibility_version $VER1 -current_version $VER3"} ;;
+ LDSHARED=${LDSHARED-"$cc -dynamiclib -install_name $libdir/$SHAREDLIBM -compatibility_version $VER1 -current_version $VER3"}
+ AR="/usr/bin/libtool"
+ ARFLAGS="-o" ;;
*) LDSHARED=${LDSHARED-"$cc -shared"} ;;
esac
else
# find system name and corresponding cc options
CC=${CC-cc}
gcc=0
+ echo ... using $CC >> configure.log
if test -z "$uname"; then
uname=`(uname -sr || echo unknown) 2>/dev/null`
fi
@@ -183,19 +270,34 @@ else
CFLAGS=${CFLAGS-"-4 -O"}
LDSHARED=${LDSHARED-"cc"}
RANLIB=${RANLIB-"true"}
- AR_RC="cc -A" ;;
+ AR="cc"
+ ARFLAGS="-A" ;;
SCO_SV\ 3.2*) SFLAGS=${CFLAGS-"-O3 -dy -KPIC "}
CFLAGS=${CFLAGS-"-O3"}
LDSHARED=${LDSHARED-"cc -dy -KPIC -G"} ;;
- SunOS\ 5*) LDSHARED=${LDSHARED-"cc -G"}
- case `(uname -m || echo unknown) 2>/dev/null` in
- i86*)
- SFLAGS=${CFLAGS-"-xpentium -fast -KPIC -R."}
- CFLAGS=${CFLAGS-"-xpentium -fast"} ;;
- *)
- SFLAGS=${CFLAGS-"-fast -xcg92 -KPIC -R."}
- CFLAGS=${CFLAGS-"-fast -xcg92"} ;;
- esac ;;
+ SunOS\ 5* | solaris*)
+ LDSHARED=${LDSHARED-"cc -G -h libz$shared_ext.$VER1"}
+ SFLAGS=${CFLAGS-"-fast -KPIC"}
+ CFLAGS=${CFLAGS-"-fast"}
+ if test $build64 -eq 1; then
+ # old versions of SunPRO/Workshop/Studio don't support -m64,
+ # but newer ones do. Check for it.
+ flag64=`$CC -flags | egrep -- '^-m64'`
+ if test x"$flag64" != x"" ; then
+ CFLAGS="${CFLAGS} -m64"
+ SFLAGS="${SFLAGS} -m64"
+ else
+ case `(uname -m || echo unknown) 2>/dev/null` in
+ i86*)
+ SFLAGS="$SFLAGS -xarch=amd64"
+ CFLAGS="$CFLAGS -xarch=amd64" ;;
+ *)
+ SFLAGS="$SFLAGS -xarch=v9"
+ CFLAGS="$CFLAGS -xarch=v9" ;;
+ esac
+ fi
+ fi
+ ;;
SunOS\ 4*) SFLAGS=${CFLAGS-"-O2 -PIC"}
CFLAGS=${CFLAGS-"-O2"}
LDSHARED=${LDSHARED-"ld"} ;;
@@ -225,25 +327,25 @@ else
esac
fi
+# destination names for shared library if not defined above
SHAREDLIB=${SHAREDLIB-"libz$shared_ext"}
SHAREDLIBV=${SHAREDLIBV-"libz$shared_ext.$VER"}
SHAREDLIBM=${SHAREDLIBM-"libz$shared_ext.$VER1"}
+echo >> configure.log
+
+# see if shared library build supported
if test $shared -eq 1; then
- echo Checking for shared library support...
+ echo Checking for shared library support... | tee -a configure.log
# we must test in two steps (cc then ld), required at least on SunOS 4.x
- if test "`($CC -w -c $SFLAGS $test.c) 2>&1`" = "" &&
- test "`($LDSHARED $SFLAGS -o $test$shared_ext $test.o) 2>&1`" = ""; then
- echo Building shared library $SHAREDLIBV with $CC.
+ if try $CC -w -c $SFLAGS $test.c &&
+ try $LDSHARED $SFLAGS -o $test$shared_ext $test.o; then
+ echo Building shared library $SHAREDLIBV with $CC. | tee -a configure.log
elif test -z "$old_cc" -a -z "$old_cflags"; then
- echo No shared library support.
+ echo No shared library support. | tee -a configure.log
shared=0;
else
- echo Tested $CC -w -c $SFLAGS $test.c
- $CC -w -c $SFLAGS $test.c
- echo Tested $LDSHARED $SFLAGS -o $test$shared_ext $test.o
- $LDSHARED $SFLAGS -o $test$shared_ext $test.o
- echo 'No shared library support; try without defining CC and CFLAGS'
+ echo 'No shared library support; try without defining CC and CFLAGS' | tee -a configure.log
shared=0;
fi
fi
@@ -254,25 +356,45 @@ if test $shared -eq 0; then
SHAREDLIB=""
SHAREDLIBV=""
SHAREDLIBM=""
- echo Building static library $STATICLIB version $VER with $CC.
+ echo Building static library $STATICLIB version $VER with $CC. | tee -a configure.log
else
ALL="static shared"
TEST="all teststatic testshared"
fi
+echo >> configure.log
+
+# check for underscores in external names for use by assembler code
+CPP=${CPP-"$CC -E"}
+case $CFLAGS in
+ *ASMV*)
+ echo >> configure.log
+ show "$NM $test.o | grep _hello"
+ if test "`$NM $test.o | grep _hello | tee -a configure.log`" = ""; then
+ CPP="$CPP -DNO_UNDERLINE"
+ echo Checking for underline in external names... No. | tee -a configure.log
+ else
+ echo Checking for underline in external names... Yes. | tee -a configure.log
+ fi ;;
+esac
+
+echo >> configure.log
+
+# check for large file support, and if none, check for fseeko()
cat > $test.c <<EOF
#include <sys/types.h>
off64_t dummy = 0;
EOF
-if test "`($CC -c $CFLAGS -D_LARGEFILE64_SOURCE=1 $test.c) 2>&1`" = ""; then
+if try $CC -c $CFLAGS -D_LARGEFILE64_SOURCE=1 $test.c; then
CFLAGS="${CFLAGS} -D_LARGEFILE64_SOURCE=1"
SFLAGS="${SFLAGS} -D_LARGEFILE64_SOURCE=1"
ALL="${ALL} all64"
TEST="${TEST} test64"
- echo "Checking for off64_t... Yes."
- echo "Checking for fseeko... Yes."
+ echo "Checking for off64_t... Yes." | tee -a configure.log
+ echo "Checking for fseeko... Yes." | tee -a configure.log
else
- echo "Checking for off64_t... No."
+ echo "Checking for off64_t... No." | tee -a configure.log
+ echo >> configure.log
cat > $test.c <<EOF
#include <stdio.h>
int main(void) {
@@ -280,272 +402,367 @@ int main(void) {
return 0;
}
EOF
- if test "`($CC $CFLAGS -o $test $test.c) 2>&1`" = ""; then
- echo "Checking for fseeko... Yes."
+ if try $CC $CFLAGS -o $test $test.c; then
+ echo "Checking for fseeko... Yes." | tee -a configure.log
else
CFLAGS="${CFLAGS} -DNO_FSEEKO"
SFLAGS="${SFLAGS} -DNO_FSEEKO"
- echo "Checking for fseeko... No."
+ echo "Checking for fseeko... No." | tee -a configure.log
fi
fi
+echo >> configure.log
+
+# check for strerror() for use by gz* functions
+cat > $test.c <<EOF
+#include <string.h>
+#include <errno.h>
+int main() { return strlen(strerror(errno)); }
+EOF
+if try $CC $CFLAGS -o $test $test.c; then
+ echo "Checking for strerror... Yes." | tee -a configure.log
+else
+ CFLAGS="${CFLAGS} -DNO_STRERROR"
+ SFLAGS="${SFLAGS} -DNO_STRERROR"
+ echo "Checking for strerror... No." | tee -a configure.log
+fi
+
+# copy clean zconf.h for subsequent edits
cp -p zconf.h.in zconf.h
+echo >> configure.log
+
+# check for unistd.h and save result in zconf.h
cat > $test.c <<EOF
#include <unistd.h>
int main() { return 0; }
EOF
-if test "`($CC -c $CFLAGS $test.c) 2>&1`" = ""; then
+if try $CC -c $CFLAGS $test.c; then
sed < zconf.h "/^#ifdef HAVE_UNISTD_H.* may be/s/def HAVE_UNISTD_H\(.*\) may be/ 1\1 was/" > zconf.temp.h
mv zconf.temp.h zconf.h
- echo "Checking for unistd.h... Yes."
+ echo "Checking for unistd.h... Yes." | tee -a configure.log
else
- echo "Checking for unistd.h... No."
+ echo "Checking for unistd.h... No." | tee -a configure.log
fi
+echo >> configure.log
+
+# check for stdarg.h and save result in zconf.h
+cat > $test.c <<EOF
+#include <stdarg.h>
+int main() { return 0; }
+EOF
+if try $CC -c $CFLAGS $test.c; then
+ sed < zconf.h "/^#ifdef HAVE_STDARG_H.* may be/s/def HAVE_STDARG_H\(.*\) may be/ 1\1 was/" > zconf.temp.h
+ mv zconf.temp.h zconf.h
+ echo "Checking for stdarg.h... Yes." | tee -a configure.log
+else
+ echo "Checking for stdarg.h... No." | tee -a configure.log
+fi
+
+# if the z_ prefix was requested, save that in zconf.h
if test $zprefix -eq 1; then
sed < zconf.h "/#ifdef Z_PREFIX.* may be/s/def Z_PREFIX\(.*\) may be/ 1\1 was/" > zconf.temp.h
mv zconf.temp.h zconf.h
- echo "Using z_ prefix on all symbols."
+ echo >> configure.log
+ echo "Using z_ prefix on all symbols." | tee -a configure.log
+fi
+
+# if --solo compilation was requested, save that in zconf.h and remove gz stuff from object lists
+if test $solo -eq 1; then
+ sed '/#define ZCONF_H/a\
+#define Z_SOLO
+
+' < zconf.h > zconf.temp.h
+ mv zconf.temp.h zconf.h
+OBJC='$(OBJZ)'
+PIC_OBJC='$(PIC_OBJZ)'
+fi
+
+# if code coverage testing was requested, use older gcc if defined, e.g. "gcc-4.2" on Mac OS X
+if test $cover -eq 1; then
+ CFLAGS="${CFLAGS} -fprofile-arcs -ftest-coverage"
+ if test -n "$GCC_CLASSIC"; then
+ CC=$GCC_CLASSIC
+ fi
fi
+echo >> configure.log
+
+# conduct a series of tests to resolve eight possible cases of using "vs" or "s" printf functions
+# (using stdarg or not), with or without "n" (proving size of buffer), and with or without a
+# return value. The most secure result is vsnprintf() with a return value. snprintf() with a
+# return value is secure as well, but then gzprintf() will be limited to 20 arguments.
cat > $test.c <<EOF
#include <stdio.h>
#include <stdarg.h>
#include "zconf.h"
-
int main()
{
#ifndef STDC
choke me
#endif
-
return 0;
}
EOF
+if try $CC -c $CFLAGS $test.c; then
+ echo "Checking whether to use vs[n]printf() or s[n]printf()... using vs[n]printf()." | tee -a configure.log
-if test "`($CC -c $CFLAGS $test.c) 2>&1`" = ""; then
- echo "Checking whether to use vs[n]printf() or s[n]printf()... using vs[n]printf()."
-
+ echo >> configure.log
cat > $test.c <<EOF
#include <stdio.h>
#include <stdarg.h>
-
int mytest(const char *fmt, ...)
{
char buf[20];
va_list ap;
-
va_start(ap, fmt);
vsnprintf(buf, sizeof(buf), fmt, ap);
va_end(ap);
return 0;
}
-
int main()
{
return (mytest("Hello%d\n", 1));
}
EOF
+ if try $CC $CFLAGS -o $test $test.c; then
+ echo "Checking for vsnprintf() in stdio.h... Yes." | tee -a configure.log
- if test "`($CC $CFLAGS -o $test $test.c) 2>&1`" = ""; then
- echo "Checking for vsnprintf() in stdio.h... Yes."
-
+ echo >> configure.log
cat >$test.c <<EOF
#include <stdio.h>
#include <stdarg.h>
-
int mytest(const char *fmt, ...)
{
int n;
char buf[20];
va_list ap;
-
va_start(ap, fmt);
n = vsnprintf(buf, sizeof(buf), fmt, ap);
va_end(ap);
return n;
}
-
int main()
{
return (mytest("Hello%d\n", 1));
}
EOF
- if test "`($CC -c $CFLAGS $test.c) 2>&1`" = ""; then
- echo "Checking for return value of vsnprintf()... Yes."
+ if try $CC -c $CFLAGS $test.c; then
+ echo "Checking for return value of vsnprintf()... Yes." | tee -a configure.log
else
CFLAGS="$CFLAGS -DHAS_vsnprintf_void"
SFLAGS="$SFLAGS -DHAS_vsnprintf_void"
- echo "Checking for return value of vsnprintf()... No."
- echo " WARNING: apparently vsnprintf() does not return a value. zlib"
- echo " can build but will be open to possible string-format security"
- echo " vulnerabilities."
+ echo "Checking for return value of vsnprintf()... No." | tee -a configure.log
+ echo " WARNING: apparently vsnprintf() does not return a value. zlib" | tee -a configure.log
+ echo " can build but will be open to possible string-format security" | tee -a configure.log
+ echo " vulnerabilities." | tee -a configure.log
fi
else
CFLAGS="$CFLAGS -DNO_vsnprintf"
SFLAGS="$SFLAGS -DNO_vsnprintf"
- echo "Checking for vsnprintf() in stdio.h... No."
- echo " WARNING: vsnprintf() not found, falling back to vsprintf(). zlib"
- echo " can build but will be open to possible buffer-overflow security"
- echo " vulnerabilities."
+ echo "Checking for vsnprintf() in stdio.h... No." | tee -a configure.log
+ echo " WARNING: vsnprintf() not found, falling back to vsprintf(). zlib" | tee -a configure.log
+ echo " can build but will be open to possible buffer-overflow security" | tee -a configure.log
+ echo " vulnerabilities." | tee -a configure.log
+ echo >> configure.log
cat >$test.c <<EOF
#include <stdio.h>
#include <stdarg.h>
-
int mytest(const char *fmt, ...)
{
int n;
char buf[20];
va_list ap;
-
va_start(ap, fmt);
n = vsprintf(buf, fmt, ap);
va_end(ap);
return n;
}
-
int main()
{
return (mytest("Hello%d\n", 1));
}
EOF
- if test "`($CC -c $CFLAGS $test.c) 2>&1`" = ""; then
- echo "Checking for return value of vsprintf()... Yes."
+ if try $CC -c $CFLAGS $test.c; then
+ echo "Checking for return value of vsprintf()... Yes." | tee -a configure.log
else
CFLAGS="$CFLAGS -DHAS_vsprintf_void"
SFLAGS="$SFLAGS -DHAS_vsprintf_void"
- echo "Checking for return value of vsprintf()... No."
- echo " WARNING: apparently vsprintf() does not return a value. zlib"
- echo " can build but will be open to possible string-format security"
- echo " vulnerabilities."
+ echo "Checking for return value of vsprintf()... No." | tee -a configure.log
+ echo " WARNING: apparently vsprintf() does not return a value. zlib" | tee -a configure.log
+ echo " can build but will be open to possible string-format security" | tee -a configure.log
+ echo " vulnerabilities." | tee -a configure.log
fi
fi
else
- echo "Checking whether to use vs[n]printf() or s[n]printf()... using s[n]printf()."
+ echo "Checking whether to use vs[n]printf() or s[n]printf()... using s[n]printf()." | tee -a configure.log
+ echo >> configure.log
cat >$test.c <<EOF
#include <stdio.h>
-
int mytest()
{
char buf[20];
-
snprintf(buf, sizeof(buf), "%s", "foo");
return 0;
}
-
int main()
{
return (mytest());
}
EOF
- if test "`($CC $CFLAGS -o $test $test.c) 2>&1`" = ""; then
- echo "Checking for snprintf() in stdio.h... Yes."
+ if try $CC $CFLAGS -o $test $test.c; then
+ echo "Checking for snprintf() in stdio.h... Yes." | tee -a configure.log
+ echo >> configure.log
cat >$test.c <<EOF
#include <stdio.h>
-
int mytest()
{
char buf[20];
-
return snprintf(buf, sizeof(buf), "%s", "foo");
}
-
int main()
{
return (mytest());
}
EOF
- if test "`($CC -c $CFLAGS $test.c) 2>&1`" = ""; then
- echo "Checking for return value of snprintf()... Yes."
+ if try $CC -c $CFLAGS $test.c; then
+ echo "Checking for return value of snprintf()... Yes." | tee -a configure.log
else
CFLAGS="$CFLAGS -DHAS_snprintf_void"
SFLAGS="$SFLAGS -DHAS_snprintf_void"
- echo "Checking for return value of snprintf()... No."
- echo " WARNING: apparently snprintf() does not return a value. zlib"
- echo " can build but will be open to possible string-format security"
- echo " vulnerabilities."
+ echo "Checking for return value of snprintf()... No." | tee -a configure.log
+ echo " WARNING: apparently snprintf() does not return a value. zlib" | tee -a configure.log
+ echo " can build but will be open to possible string-format security" | tee -a configure.log
+ echo " vulnerabilities." | tee -a configure.log
fi
else
CFLAGS="$CFLAGS -DNO_snprintf"
SFLAGS="$SFLAGS -DNO_snprintf"
- echo "Checking for snprintf() in stdio.h... No."
- echo " WARNING: snprintf() not found, falling back to sprintf(). zlib"
- echo " can build but will be open to possible buffer-overflow security"
- echo " vulnerabilities."
+ echo "Checking for snprintf() in stdio.h... No." | tee -a configure.log
+ echo " WARNING: snprintf() not found, falling back to sprintf(). zlib" | tee -a configure.log
+ echo " can build but will be open to possible buffer-overflow security" | tee -a configure.log
+ echo " vulnerabilities." | tee -a configure.log
+ echo >> configure.log
cat >$test.c <<EOF
#include <stdio.h>
-
int mytest()
{
char buf[20];
-
return sprintf(buf, "%s", "foo");
}
-
int main()
{
return (mytest());
}
EOF
- if test "`($CC -c $CFLAGS $test.c) 2>&1`" = ""; then
- echo "Checking for return value of sprintf()... Yes."
+ if try $CC -c $CFLAGS $test.c; then
+ echo "Checking for return value of sprintf()... Yes." | tee -a configure.log
else
CFLAGS="$CFLAGS -DHAS_sprintf_void"
SFLAGS="$SFLAGS -DHAS_sprintf_void"
- echo "Checking for return value of sprintf()... No."
- echo " WARNING: apparently sprintf() does not return a value. zlib"
- echo " can build but will be open to possible string-format security"
- echo " vulnerabilities."
+ echo "Checking for return value of sprintf()... No." | tee -a configure.log
+ echo " WARNING: apparently sprintf() does not return a value. zlib" | tee -a configure.log
+ echo " can build but will be open to possible string-format security" | tee -a configure.log
+ echo " vulnerabilities." | tee -a configure.log
fi
fi
fi
+# see if we can hide zlib internal symbols that are linked between separate source files
if test "$gcc" -eq 1; then
+ echo >> configure.log
cat > $test.c <<EOF
-#if ((__GNUC__-0) * 10 + __GNUC_MINOR__-0 >= 33)
-# define ZLIB_INTERNAL __attribute__((visibility ("hidden")))
-#else
-# define ZLIB_INTERNAL
-#endif
+#define ZLIB_INTERNAL __attribute__((visibility ("hidden")))
int ZLIB_INTERNAL foo;
int main()
{
return 0;
}
EOF
- if test "`($CC -c $CFLAGS $test.c) 2>&1`" = ""; then
- echo "Checking for attribute(visibility) support... Yes."
+ if tryboth $CC -c $CFLAGS $test.c; then
+ CFLAGS="$CFLAGS -DHAVE_HIDDEN"
+ SFLAGS="$SFLAGS -DHAVE_HIDDEN"
+ echo "Checking for attribute(visibility) support... Yes." | tee -a configure.log
else
- CFLAGS="$CFLAGS -DNO_VIZ"
- SFLAGS="$SFLAGS -DNO_VIZ"
- echo "Checking for attribute(visibility) support... No."
+ echo "Checking for attribute(visibility) support... No." | tee -a configure.log
fi
fi
-CPP=${CPP-"$CC -E"}
-case $CFLAGS in
- *ASMV*)
- if test "`$NM $test.o | grep _hello`" = ""; then
- CPP="$CPP -DNO_UNDERLINE"
- echo Checking for underline in external names... No.
- else
- echo Checking for underline in external names... Yes.
- fi ;;
-esac
+echo >> configure.log
-rm -f $test.[co] $test $test$shared_ext
+# find a four-byte unsiged integer type for crc calculations
+cat > $test.c <<EOF
+#include <stdio.h>
+#define is32(n,t) for(n=1,k=0;n;n<<=1,k++);if(k==32){puts(t);return 0;}
+int main() {
+ int k;
+ unsigned i;
+ unsigned long l;
+ unsigned short s;
+ is32(i, "unsigned")
+ is32(l, "unsigned long")
+ is32(s, "unsigned short")
+ return 1;
+}
+EOF
+Z_U4=""
+if try $CC $CFLAGS $test.c -o $test && Z_U4=`./$test` && test -n "$Z_U4"; then
+ sed < zconf.h "/#define Z_U4/s/\/\* \.\/configure may/#define Z_U4 $Z_U4 \/* .\/configure put the/" > zconf.temp.h
+ mv zconf.temp.h zconf.h
+ echo "Looking for a four-byte integer type... Found." | tee -a configure.log
+else
+ echo "Looking for a four-byte integer type... Not found." | tee -a configure.log
+fi
-# udpate Makefile
+# clean up files produced by running the compiler and linker
+rm -f $test.[co] $test $test$shared_ext $test.gcno
+
+# show the results in the log
+echo >> configure.log
+echo ALL = $ALL >> configure.log
+echo AR = $AR >> configure.log
+echo ARFLAGS = $ARFLAGS >> configure.log
+echo CC = $CC >> configure.log
+echo CFLAGS = $CFLAGS >> configure.log
+echo CPP = $CPP >> configure.log
+echo EXE = $EXE >> configure.log
+echo LDCONFIG = $LDCONFIG >> configure.log
+echo LDFLAGS = $LDFLAGS >> configure.log
+echo LDSHARED = $LDSHARED >> configure.log
+echo LDSHAREDLIBC = $LDSHAREDLIBC >> configure.log
+echo OBJC = $OBJC >> configure.log
+echo PIC_OBJC = $PIC_OBJC >> configure.log
+echo RANLIB = $RANLIB >> configure.log
+echo SFLAGS = $SFLAGS >> configure.log
+echo SHAREDLIB = $SHAREDLIB >> configure.log
+echo SHAREDLIBM = $SHAREDLIBM >> configure.log
+echo SHAREDLIBV = $SHAREDLIBV >> configure.log
+echo STATICLIB = $STATICLIB >> configure.log
+echo TEST = $TEST >> configure.log
+echo VER = $VER >> configure.log
+echo Z_U4 = $Z_U4 >> configure.log
+echo exec_prefix = $exec_prefix >> configure.log
+echo includedir = $includedir >> configure.log
+echo libdir = $libdir >> configure.log
+echo mandir = $mandir >> configure.log
+echo prefix = $prefix >> configure.log
+echo sharedlibdir = $sharedlibdir >> configure.log
+echo uname = $uname >> configure.log
+echo -------------------- >> configure.log
+echo >> configure.log
+echo >> configure.log
+
+# udpate Makefile with the configure results
sed < Makefile.in "
/^CC *=/s#=.*#=$CC#
/^CFLAGS *=/s#=.*#=$CFLAGS#
@@ -557,7 +774,8 @@ sed < Makefile.in "
/^SHAREDLIB *=/s#=.*#=$SHAREDLIB#
/^SHAREDLIBV *=/s#=.*#=$SHAREDLIBV#
/^SHAREDLIBM *=/s#=.*#=$SHAREDLIBM#
-/^AR *=/s#=.*#=$AR_RC#
+/^AR *=/s#=.*#=$AR#
+/^ARFLAGS *=/s#=.*#=$ARFLAGS#
/^RANLIB *=/s#=.*#=$RANLIB#
/^LDCONFIG *=/s#=.*#=$LDCONFIG#
/^LDSHAREDLIBC *=/s#=.*#=$LDSHAREDLIBC#
@@ -568,10 +786,13 @@ sed < Makefile.in "
/^sharedlibdir *=/s#=.*#=$sharedlibdir#
/^includedir *=/s#=.*#=$includedir#
/^mandir *=/s#=.*#=$mandir#
+/^OBJC *=/s#=.*#= $OBJC#
+/^PIC_OBJC *=/s#=.*#= $PIC_OBJC#
/^all: */s#:.*#: $ALL#
/^test: */s#:.*#: $TEST#
" > Makefile
+# create zlib.pc with the configure results
sed < zlib.pc.in "
/^CC *=/s#=.*#=$CC#
/^CFLAGS *=/s#=.*#=$CFLAGS#
@@ -581,7 +802,8 @@ sed < zlib.pc.in "
/^SHAREDLIB *=/s#=.*#=$SHAREDLIB#
/^SHAREDLIBV *=/s#=.*#=$SHAREDLIBV#
/^SHAREDLIBM *=/s#=.*#=$SHAREDLIBM#
-/^AR *=/s#=.*#=$AR_RC#
+/^AR *=/s#=.*#=$AR#
+/^ARFLAGS *=/s#=.*#=$ARFLAGS#
/^RANLIB *=/s#=.*#=$RANLIB#
/^EXE *=/s#=.*#=$EXE#
/^prefix *=/s#=.*#=$prefix#
diff --git a/compat/zlib/contrib/ada/buffer_demo.adb b/compat/zlib/contrib/ada/buffer_demo.adb
index 8fe6e1c..46b8638 100644
--- a/compat/zlib/contrib/ada/buffer_demo.adb
+++ b/compat/zlib/contrib/ada/buffer_demo.adb
@@ -6,7 +6,7 @@
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
--
--- $Id: buffer_demo.adb,v 1.3 2010/04/20 14:50:10 nijtmans Exp $
+-- $Id: buffer_demo.adb,v 1.3 2004/09/06 06:55:35 vagul Exp $
-- This demo program provided by Dr Steve Sangwine <sjs@essex.ac.uk>
--
diff --git a/compat/zlib/contrib/ada/mtest.adb b/compat/zlib/contrib/ada/mtest.adb
index 5516952..c4dfd08 100644
--- a/compat/zlib/contrib/ada/mtest.adb
+++ b/compat/zlib/contrib/ada/mtest.adb
@@ -8,7 +8,7 @@
-- Continuous test for ZLib multithreading. If the test would fail
-- we should provide thread safe allocation routines for the Z_Stream.
--
--- $Id: mtest.adb,v 1.3 2010/04/20 14:50:10 nijtmans Exp $
+-- $Id: mtest.adb,v 1.4 2004/07/23 07:49:54 vagul Exp $
with ZLib;
with Ada.Streams;
diff --git a/compat/zlib/contrib/ada/read.adb b/compat/zlib/contrib/ada/read.adb
index 6df6a35..1f2efbf 100644
--- a/compat/zlib/contrib/ada/read.adb
+++ b/compat/zlib/contrib/ada/read.adb
@@ -6,7 +6,7 @@
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
--- $Id: read.adb,v 1.3 2010/04/20 14:50:10 nijtmans Exp $
+-- $Id: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp $
-- Test/demo program for the generic read interface.
diff --git a/compat/zlib/contrib/ada/test.adb b/compat/zlib/contrib/ada/test.adb
index 0edf1d6..90773ac 100644
--- a/compat/zlib/contrib/ada/test.adb
+++ b/compat/zlib/contrib/ada/test.adb
@@ -6,7 +6,7 @@
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
--- $Id: test.adb,v 1.3 2010/04/20 14:50:10 nijtmans Exp $
+-- $Id: test.adb,v 1.17 2003/08/12 12:13:30 vagul Exp $
-- The program has a few aims.
-- 1. Test ZLib.Ada95 thick binding functionality.
diff --git a/compat/zlib/contrib/ada/zlib-streams.adb b/compat/zlib/contrib/ada/zlib-streams.adb
index eac7440..b6497ba 100644
--- a/compat/zlib/contrib/ada/zlib-streams.adb
+++ b/compat/zlib/contrib/ada/zlib-streams.adb
@@ -6,7 +6,7 @@
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
--- $Id: zlib-streams.adb,v 1.3 2010/04/20 14:50:10 nijtmans Exp $
+-- $Id: zlib-streams.adb,v 1.10 2004/05/31 10:53:40 vagul Exp $
with Ada.Unchecked_Deallocation;
diff --git a/compat/zlib/contrib/ada/zlib-streams.ads b/compat/zlib/contrib/ada/zlib-streams.ads
index 68dc0b4..f0193c6b 100644
--- a/compat/zlib/contrib/ada/zlib-streams.ads
+++ b/compat/zlib/contrib/ada/zlib-streams.ads
@@ -6,7 +6,7 @@
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
--- $Id: zlib-streams.ads,v 1.3 2010/04/20 14:50:10 nijtmans Exp $
+-- $Id: zlib-streams.ads,v 1.12 2004/05/31 10:53:40 vagul Exp $
package ZLib.Streams is
diff --git a/compat/zlib/contrib/ada/zlib-thin.adb b/compat/zlib/contrib/ada/zlib-thin.adb
index 7e1f562..0ca4a71 100644
--- a/compat/zlib/contrib/ada/zlib-thin.adb
+++ b/compat/zlib/contrib/ada/zlib-thin.adb
@@ -6,7 +6,7 @@
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
--- $Id: zlib-thin.adb,v 1.3 2010/04/20 14:50:10 nijtmans Exp $
+-- $Id: zlib-thin.adb,v 1.8 2003/12/14 18:27:31 vagul Exp $
package body ZLib.Thin is
diff --git a/compat/zlib/contrib/ada/zlib-thin.ads b/compat/zlib/contrib/ada/zlib-thin.ads
index 7e8e074..d4407eb 100644
--- a/compat/zlib/contrib/ada/zlib-thin.ads
+++ b/compat/zlib/contrib/ada/zlib-thin.ads
@@ -6,7 +6,7 @@
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
--- $Id: zlib-thin.ads,v 1.3 2010/04/20 14:50:10 nijtmans Exp $
+-- $Id: zlib-thin.ads,v 1.11 2004/07/23 06:33:11 vagul Exp $
with Interfaces.C.Strings;
diff --git a/compat/zlib/contrib/ada/zlib.adb b/compat/zlib/contrib/ada/zlib.adb
index ec01b1d..8b6fd68 100644
--- a/compat/zlib/contrib/ada/zlib.adb
+++ b/compat/zlib/contrib/ada/zlib.adb
@@ -6,7 +6,7 @@
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
--- $Id: zlib.adb,v 1.3 2010/04/20 14:50:10 nijtmans Exp $
+-- $Id: zlib.adb,v 1.31 2004/09/06 06:53:19 vagul Exp $
with Ada.Exceptions;
with Ada.Unchecked_Conversion;
diff --git a/compat/zlib/contrib/ada/zlib.ads b/compat/zlib/contrib/ada/zlib.ads
index bdf1397..79ffc40 100644
--- a/compat/zlib/contrib/ada/zlib.ads
+++ b/compat/zlib/contrib/ada/zlib.ads
@@ -25,7 +25,7 @@
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
--- $Id: zlib.ads,v 1.3 2010/04/20 14:50:10 nijtmans Exp $
+-- $Id: zlib.ads,v 1.26 2004/09/06 06:53:19 vagul Exp $
with Ada.Streams;
diff --git a/compat/zlib/contrib/asm586/README.586 b/compat/zlib/contrib/asm586/README.586
deleted file mode 100644
index 6bb78f3..0000000
--- a/compat/zlib/contrib/asm586/README.586
+++ /dev/null
@@ -1,43 +0,0 @@
-This is a patched version of zlib modified to use
-Pentium-optimized assembly code in the deflation algorithm. The files
-changed/added by this patch are:
-
-README.586
-match.S
-
-The effectiveness of these modifications is a bit marginal, as the the
-program's bottleneck seems to be mostly L1-cache contention, for which
-there is no real way to work around without rewriting the basic
-algorithm. The speedup on average is around 5-10% (which is generally
-less than the amount of variance between subsequent executions).
-However, when used at level 9 compression, the cache contention can
-drop enough for the assembly version to achieve 10-20% speedup (and
-sometimes more, depending on the amount of overall redundancy in the
-files). Even here, though, cache contention can still be the limiting
-factor, depending on the nature of the program using the zlib library.
-This may also mean that better improvements will be seen on a Pentium
-with MMX, which suffers much less from L1-cache contention, but I have
-not yet verified this.
-
-Note that this code has been tailored for the Pentium in particular,
-and will not perform well on the Pentium Pro (due to the use of a
-partial register in the inner loop).
-
-If you are using an assembler other than GNU as, you will have to
-translate match.S to use your assembler's syntax. (Have fun.)
-
-Brian Raiter
-breadbox@muppetlabs.com
-April, 1998
-
-
-Added for zlib 1.1.3:
-
-The patches come from
-http://www.muppetlabs.com/~breadbox/software/assembly.html
-
-To compile zlib with this asm file, copy match.S to the zlib directory
-then do:
-
-CFLAGS="-O3 -DASMV" ./configure
-make OBJA=match.o
diff --git a/compat/zlib/contrib/asm586/match.S b/compat/zlib/contrib/asm586/match.S
deleted file mode 100644
index 0368b35..0000000
--- a/compat/zlib/contrib/asm586/match.S
+++ /dev/null
@@ -1,364 +0,0 @@
-/* match.s -- Pentium-optimized version of longest_match()
- * Written for zlib 1.1.2
- * Copyright (C) 1998 Brian Raiter <breadbox@muppetlabs.com>
- *
- * This is free software; you can redistribute it and/or modify it
- * under the terms of the GNU General Public License.
- */
-
-#ifndef NO_UNDERLINE
-#define match_init _match_init
-#define longest_match _longest_match
-#endif
-
-#define MAX_MATCH (258)
-#define MIN_MATCH (3)
-#define MIN_LOOKAHEAD (MAX_MATCH + MIN_MATCH + 1)
-#define MAX_MATCH_8 ((MAX_MATCH + 7) & ~7)
-
-/* stack frame offsets */
-
-#define wmask 0 /* local copy of s->wmask */
-#define window 4 /* local copy of s->window */
-#define windowbestlen 8 /* s->window + bestlen */
-#define chainlenscanend 12 /* high word: current chain len */
- /* low word: last bytes sought */
-#define scanstart 16 /* first two bytes of string */
-#define scanalign 20 /* dword-misalignment of string */
-#define nicematch 24 /* a good enough match size */
-#define bestlen 28 /* size of best match so far */
-#define scan 32 /* ptr to string wanting match */
-
-#define LocalVarsSize (36)
-/* saved ebx 36 */
-/* saved edi 40 */
-/* saved esi 44 */
-/* saved ebp 48 */
-/* return address 52 */
-#define deflatestate 56 /* the function arguments */
-#define curmatch 60
-
-/* Offsets for fields in the deflate_state structure. These numbers
- * are calculated from the definition of deflate_state, with the
- * assumption that the compiler will dword-align the fields. (Thus,
- * changing the definition of deflate_state could easily cause this
- * program to crash horribly, without so much as a warning at
- * compile time. Sigh.)
- */
-
-/* All the +zlib1222add offsets are due to the addition of fields
- * in zlib in the deflate_state structure since the asm code was first written
- * (if you compile with zlib 1.0.4 or older, use "zlib1222add equ (-4)").
- * (if you compile with zlib between 1.0.5 and 1.2.2.1, use "zlib1222add equ 0").
- * if you compile with zlib 1.2.2.2 or later , use "zlib1222add equ 8").
- */
-
-#define zlib1222add (8)
-
-#define dsWSize (36+zlib1222add)
-#define dsWMask (44+zlib1222add)
-#define dsWindow (48+zlib1222add)
-#define dsPrev (56+zlib1222add)
-#define dsMatchLen (88+zlib1222add)
-#define dsPrevMatch (92+zlib1222add)
-#define dsStrStart (100+zlib1222add)
-#define dsMatchStart (104+zlib1222add)
-#define dsLookahead (108+zlib1222add)
-#define dsPrevLen (112+zlib1222add)
-#define dsMaxChainLen (116+zlib1222add)
-#define dsGoodMatch (132+zlib1222add)
-#define dsNiceMatch (136+zlib1222add)
-
-
-.file "match.S"
-
-.globl match_init, longest_match
-
-.text
-
-/* uInt longest_match(deflate_state *deflatestate, IPos curmatch) */
-
-longest_match:
-
-/* Save registers that the compiler may be using, and adjust %esp to */
-/* make room for our stack frame. */
-
- pushl %ebp
- pushl %edi
- pushl %esi
- pushl %ebx
- subl $LocalVarsSize, %esp
-
-/* Retrieve the function arguments. %ecx will hold cur_match */
-/* throughout the entire function. %edx will hold the pointer to the */
-/* deflate_state structure during the function's setup (before */
-/* entering the main loop). */
-
- movl deflatestate(%esp), %edx
- movl curmatch(%esp), %ecx
-
-/* if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead; */
-
- movl dsNiceMatch(%edx), %eax
- movl dsLookahead(%edx), %ebx
- cmpl %eax, %ebx
- jl LookaheadLess
- movl %eax, %ebx
-LookaheadLess: movl %ebx, nicematch(%esp)
-
-/* register Bytef *scan = s->window + s->strstart; */
-
- movl dsWindow(%edx), %esi
- movl %esi, window(%esp)
- movl dsStrStart(%edx), %ebp
- lea (%esi,%ebp), %edi
- movl %edi, scan(%esp)
-
-/* Determine how many bytes the scan ptr is off from being */
-/* dword-aligned. */
-
- movl %edi, %eax
- negl %eax
- andl $3, %eax
- movl %eax, scanalign(%esp)
-
-/* IPos limit = s->strstart > (IPos)MAX_DIST(s) ? */
-/* s->strstart - (IPos)MAX_DIST(s) : NIL; */
-
- movl dsWSize(%edx), %eax
- subl $MIN_LOOKAHEAD, %eax
- subl %eax, %ebp
- jg LimitPositive
- xorl %ebp, %ebp
-LimitPositive:
-
-/* unsigned chain_length = s->max_chain_length; */
-/* if (s->prev_length >= s->good_match) { */
-/* chain_length >>= 2; */
-/* } */
-
- movl dsPrevLen(%edx), %eax
- movl dsGoodMatch(%edx), %ebx
- cmpl %ebx, %eax
- movl dsMaxChainLen(%edx), %ebx
- jl LastMatchGood
- shrl $2, %ebx
-LastMatchGood:
-
-/* chainlen is decremented once beforehand so that the function can */
-/* use the sign flag instead of the zero flag for the exit test. */
-/* It is then shifted into the high word, to make room for the scanend */
-/* scanend value, which it will always accompany. */
-
- decl %ebx
- shll $16, %ebx
-
-/* int best_len = s->prev_length; */
-
- movl dsPrevLen(%edx), %eax
- movl %eax, bestlen(%esp)
-
-/* Store the sum of s->window + best_len in %esi locally, and in %esi. */
-
- addl %eax, %esi
- movl %esi, windowbestlen(%esp)
-
-/* register ush scan_start = *(ushf*)scan; */
-/* register ush scan_end = *(ushf*)(scan+best_len-1); */
-
- movw (%edi), %bx
- movw %bx, scanstart(%esp)
- movw -1(%edi,%eax), %bx
- movl %ebx, chainlenscanend(%esp)
-
-/* Posf *prev = s->prev; */
-/* uInt wmask = s->w_mask; */
-
- movl dsPrev(%edx), %edi
- movl dsWMask(%edx), %edx
- mov %edx, wmask(%esp)
-
-/* Jump into the main loop. */
-
- jmp LoopEntry
-
-.balign 16
-
-/* do {
- * match = s->window + cur_match;
- * if (*(ushf*)(match+best_len-1) != scan_end ||
- * *(ushf*)match != scan_start) continue;
- * [...]
- * } while ((cur_match = prev[cur_match & wmask]) > limit
- * && --chain_length != 0);
- *
- * Here is the inner loop of the function. The function will spend the
- * majority of its time in this loop, and majority of that time will
- * be spent in the first ten instructions.
- *
- * Within this loop:
- * %ebx = chainlenscanend - i.e., ((chainlen << 16) | scanend)
- * %ecx = curmatch
- * %edx = curmatch & wmask
- * %esi = windowbestlen - i.e., (window + bestlen)
- * %edi = prev
- * %ebp = limit
- *
- * Two optimization notes on the choice of instructions:
- *
- * The first instruction uses a 16-bit address, which costs an extra,
- * unpairable cycle. This is cheaper than doing a 32-bit access and
- * zeroing the high word, due to the 3-cycle misalignment penalty which
- * would occur half the time. This also turns out to be cheaper than
- * doing two separate 8-bit accesses, as the memory is so rarely in the
- * L1 cache.
- *
- * The window buffer, however, apparently spends a lot of time in the
- * cache, and so it is faster to retrieve the word at the end of the
- * match string with two 8-bit loads. The instructions that test the
- * word at the beginning of the match string, however, are executed
- * much less frequently, and there it was cheaper to use 16-bit
- * instructions, which avoided the necessity of saving off and
- * subsequently reloading one of the other registers.
- */
-LookupLoop:
- /* 1 U & V */
- movw (%edi,%edx,2), %cx /* 2 U pipe */
- movl wmask(%esp), %edx /* 2 V pipe */
- cmpl %ebp, %ecx /* 3 U pipe */
- jbe LeaveNow /* 3 V pipe */
- subl $0x00010000, %ebx /* 4 U pipe */
- js LeaveNow /* 4 V pipe */
-LoopEntry: movb -1(%esi,%ecx), %al /* 5 U pipe */
- andl %ecx, %edx /* 5 V pipe */
- cmpb %bl, %al /* 6 U pipe */
- jnz LookupLoop /* 6 V pipe */
- movb (%esi,%ecx), %ah
- cmpb %bh, %ah
- jnz LookupLoop
- movl window(%esp), %eax
- movw (%eax,%ecx), %ax
- cmpw scanstart(%esp), %ax
- jnz LookupLoop
-
-/* Store the current value of chainlen. */
-
- movl %ebx, chainlenscanend(%esp)
-
-/* Point %edi to the string under scrutiny, and %esi to the string we */
-/* are hoping to match it up with. In actuality, %esi and %edi are */
-/* both pointed (MAX_MATCH_8 - scanalign) bytes ahead, and %edx is */
-/* initialized to -(MAX_MATCH_8 - scanalign). */
-
- movl window(%esp), %esi
- movl scan(%esp), %edi
- addl %ecx, %esi
- movl scanalign(%esp), %eax
- movl $(-MAX_MATCH_8), %edx
- lea MAX_MATCH_8(%edi,%eax), %edi
- lea MAX_MATCH_8(%esi,%eax), %esi
-
-/* Test the strings for equality, 8 bytes at a time. At the end,
- * adjust %edx so that it is offset to the exact byte that mismatched.
- *
- * We already know at this point that the first three bytes of the
- * strings match each other, and they can be safely passed over before
- * starting the compare loop. So what this code does is skip over 0-3
- * bytes, as much as necessary in order to dword-align the %edi
- * pointer. (%esi will still be misaligned three times out of four.)
- *
- * It should be confessed that this loop usually does not represent
- * much of the total running time. Replacing it with a more
- * straightforward "rep cmpsb" would not drastically degrade
- * performance.
- */
-LoopCmps:
- movl (%esi,%edx), %eax
- movl (%edi,%edx), %ebx
- xorl %ebx, %eax
- jnz LeaveLoopCmps
- movl 4(%esi,%edx), %eax
- movl 4(%edi,%edx), %ebx
- xorl %ebx, %eax
- jnz LeaveLoopCmps4
- addl $8, %edx
- jnz LoopCmps
- jmp LenMaximum
-LeaveLoopCmps4: addl $4, %edx
-LeaveLoopCmps: testl $0x0000FFFF, %eax
- jnz LenLower
- addl $2, %edx
- shrl $16, %eax
-LenLower: subb $1, %al
- adcl $0, %edx
-
-/* Calculate the length of the match. If it is longer than MAX_MATCH, */
-/* then automatically accept it as the best possible match and leave. */
-
- lea (%edi,%edx), %eax
- movl scan(%esp), %edi
- subl %edi, %eax
- cmpl $MAX_MATCH, %eax
- jge LenMaximum
-
-/* If the length of the match is not longer than the best match we */
-/* have so far, then forget it and return to the lookup loop. */
-
- movl deflatestate(%esp), %edx
- movl bestlen(%esp), %ebx
- cmpl %ebx, %eax
- jg LongerMatch
- movl chainlenscanend(%esp), %ebx
- movl windowbestlen(%esp), %esi
- movl dsPrev(%edx), %edi
- movl wmask(%esp), %edx
- andl %ecx, %edx
- jmp LookupLoop
-
-/* s->match_start = cur_match; */
-/* best_len = len; */
-/* if (len >= nice_match) break; */
-/* scan_end = *(ushf*)(scan+best_len-1); */
-
-LongerMatch: movl nicematch(%esp), %ebx
- movl %eax, bestlen(%esp)
- movl %ecx, dsMatchStart(%edx)
- cmpl %ebx, %eax
- jge LeaveNow
- movl window(%esp), %esi
- addl %eax, %esi
- movl %esi, windowbestlen(%esp)
- movl chainlenscanend(%esp), %ebx
- movw -1(%edi,%eax), %bx
- movl dsPrev(%edx), %edi
- movl %ebx, chainlenscanend(%esp)
- movl wmask(%esp), %edx
- andl %ecx, %edx
- jmp LookupLoop
-
-/* Accept the current string, with the maximum possible length. */
-
-LenMaximum: movl deflatestate(%esp), %edx
- movl $MAX_MATCH, bestlen(%esp)
- movl %ecx, dsMatchStart(%edx)
-
-/* if ((uInt)best_len <= s->lookahead) return (uInt)best_len; */
-/* return s->lookahead; */
-
-LeaveNow:
- movl deflatestate(%esp), %edx
- movl bestlen(%esp), %ebx
- movl dsLookahead(%edx), %eax
- cmpl %eax, %ebx
- jg LookaheadRet
- movl %ebx, %eax
-LookaheadRet:
-
-/* Restore the stack and return from whence we came. */
-
- addl $LocalVarsSize, %esp
- popl %ebx
- popl %esi
- popl %edi
- popl %ebp
-match_init: ret
diff --git a/compat/zlib/contrib/asm686/match.S b/compat/zlib/contrib/asm686/match.S
index 06817e1..fa42109 100644
--- a/compat/zlib/contrib/asm686/match.S
+++ b/compat/zlib/contrib/asm686/match.S
@@ -83,17 +83,25 @@
.text
/* uInt longest_match(deflate_state *deflatestate, IPos curmatch) */
+.cfi_sections .debug_frame
longest_match:
+.cfi_startproc
/* Save registers that the compiler may be using, and adjust %esp to */
/* make room for our stack frame. */
pushl %ebp
+ .cfi_def_cfa_offset 8
+ .cfi_offset ebp, -8
pushl %edi
+ .cfi_def_cfa_offset 12
pushl %esi
+ .cfi_def_cfa_offset 16
pushl %ebx
+ .cfi_def_cfa_offset 20
subl $LocalVarsSize, %esp
+ .cfi_def_cfa_offset LocalVarsSize+20
/* Retrieve the function arguments. %ecx will hold cur_match */
/* throughout the entire function. %edx will hold the pointer to the */
@@ -108,7 +116,7 @@ longest_match:
/* if (s->prev_length >= s->good_match) { */
/* chain_length >>= 2; */
/* } */
-
+
movl dsPrevLen(%edx), %eax
movl dsGoodMatch(%edx), %ebx
cmpl %ebx, %eax
@@ -336,8 +344,14 @@ LookaheadRet:
/* Restore the stack and return from whence we came. */
addl $LocalVarsSize, %esp
+ .cfi_def_cfa_offset 20
popl %ebx
+ .cfi_def_cfa_offset 16
popl %esi
+ .cfi_def_cfa_offset 12
popl %edi
+ .cfi_def_cfa_offset 8
popl %ebp
+ .cfi_def_cfa_offset 4
+.cfi_endproc
match_init: ret
diff --git a/compat/zlib/contrib/delphi/ZLib.pas b/compat/zlib/contrib/delphi/ZLib.pas
index 0d86fb5..f24bb3e 100644
--- a/compat/zlib/contrib/delphi/ZLib.pas
+++ b/compat/zlib/contrib/delphi/ZLib.pas
@@ -152,7 +152,7 @@ procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer;
const OutBuf: Pointer; BufSize: Integer);
const
- zlib_version = '1.2.5';
+ zlib_version = '1.2.7';
type
EZlibError = class(Exception);
diff --git a/compat/zlib/contrib/delphi/zlibd32.mak b/compat/zlib/contrib/delphi/zlibd32.mak
index 0d0699a..9bb00b7 100644
--- a/compat/zlib/contrib/delphi/zlibd32.mak
+++ b/compat/zlib/contrib/delphi/zlibd32.mak
@@ -63,9 +63,9 @@ uncompr.obj: uncompr.c zlib.h zconf.h
zutil.obj: zutil.c zutil.h zlib.h zconf.h
-example.obj: example.c zlib.h zconf.h
+example.obj: test/example.c zlib.h zconf.h
-minigzip.obj: minigzip.c zlib.h zconf.h
+minigzip.obj: test/minigzip.c zlib.h zconf.h
# For the sake of the old Borland make,
diff --git a/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs b/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
index 3bbcc8c..1090288 100644
--- a/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
+++ b/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
@@ -156,7 +156,7 @@ namespace DotZLibTests
public void Info_Version()
{
Info info = new Info();
- Assert.AreEqual("1.2.5", Info.Version);
+ Assert.AreEqual("1.2.7", Info.Version);
Assert.AreEqual(32, info.SizeOfUInt);
Assert.AreEqual(32, info.SizeOfULong);
Assert.AreEqual(32, info.SizeOfPointer);
diff --git a/compat/zlib/contrib/infback9/inftree9.c b/compat/zlib/contrib/infback9/inftree9.c
index 306c5f1..5a0b328 100644
--- a/compat/zlib/contrib/infback9/inftree9.c
+++ b/compat/zlib/contrib/infback9/inftree9.c
@@ -1,5 +1,5 @@
/* inftree9.c -- generate Huffman trees for efficient decoding
- * Copyright (C) 1995-2010 Mark Adler
+ * Copyright (C) 1995-2012 Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*/
@@ -9,7 +9,7 @@
#define MAXBITS 15
const char inflate9_copyright[] =
- " inflate9 1.2.5 Copyright 1995-2010 Mark Adler ";
+ " inflate9 1.2.7 Copyright 1995-2012 Mark Adler ";
/*
If you use the zlib library in a product, an acknowledgment is welcome
in the documentation of your product. If for some reason you cannot
@@ -64,7 +64,7 @@ unsigned short FAR *work;
static const unsigned short lext[31] = { /* Length codes 257..285 extra */
128, 128, 128, 128, 128, 128, 128, 128, 129, 129, 129, 129,
130, 130, 130, 130, 131, 131, 131, 131, 132, 132, 132, 132,
- 133, 133, 133, 133, 144, 73, 195};
+ 133, 133, 133, 133, 144, 78, 68};
static const unsigned short dbase[32] = { /* Distance codes 0..31 base */
1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49,
65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073,
diff --git a/compat/zlib/contrib/iostream2/zstream.h b/compat/zlib/contrib/iostream2/zstream.h
index ba5e328..43d2332 100644
--- a/compat/zlib/contrib/iostream2/zstream.h
+++ b/compat/zlib/contrib/iostream2/zstream.h
@@ -21,7 +21,7 @@
/*
* zstream.h - C++ interface to the 'zlib' general purpose compression library
- * $Id: zstream.h,v 1.3 2010/04/20 14:50:10 nijtmans Exp $
+ * $Id: zstream.h 1.1 1997-06-25 12:00:56+02 tyge Exp tyge $
*/
#include <strstream.h>
diff --git a/compat/zlib/contrib/masm686/match.asm b/compat/zlib/contrib/masm686/match.asm
deleted file mode 100644
index 4b03a71..0000000
--- a/compat/zlib/contrib/masm686/match.asm
+++ /dev/null
@@ -1,413 +0,0 @@
-
-; match.asm -- Pentium-Pro optimized version of longest_match()
-;
-; Updated for zlib 1.1.3 and converted to MASM 6.1x
-; Copyright (C) 2000 Dan Higdon <hdan@kinesoft.com>
-; and Chuck Walbourn <chuckw@kinesoft.com>
-; Corrections by Cosmin Truta <cosmint@cs.ubbcluj.ro>
-;
-; This is free software; you can redistribute it and/or modify it
-; under the terms of the GNU General Public License.
-
-; Based on match.S
-; Written for zlib 1.1.2
-; Copyright (C) 1998 Brian Raiter <breadbox@muppetlabs.com>
-;
-; Modified by Gilles Vollant (2005) for add gzhead and gzindex
-
- .686P
- .MODEL FLAT
-
-;===========================================================================
-; EQUATES
-;===========================================================================
-
-MAX_MATCH EQU 258
-MIN_MATCH EQU 3
-MIN_LOOKAHEAD EQU (MAX_MATCH + MIN_MATCH + 1)
-MAX_MATCH_8 EQU ((MAX_MATCH + 7) AND (NOT 7))
-
-;===========================================================================
-; STRUCTURES
-;===========================================================================
-
-; This STRUCT assumes a 4-byte alignment
-
-DEFLATE_STATE STRUCT
-ds_strm dd ?
-ds_status dd ?
-ds_pending_buf dd ?
-ds_pending_buf_size dd ?
-ds_pending_out dd ?
-ds_pending dd ?
-ds_wrap dd ?
-; gzhead and gzindex are added in zlib 1.2.2.2 (see deflate.h)
-ds_gzhead dd ?
-ds_gzindex dd ?
-ds_data_type db ?
-ds_method db ?
- db ? ; padding
- db ? ; padding
-ds_last_flush dd ?
-ds_w_size dd ? ; used
-ds_w_bits dd ?
-ds_w_mask dd ? ; used
-ds_window dd ? ; used
-ds_window_size dd ?
-ds_prev dd ? ; used
-ds_head dd ?
-ds_ins_h dd ?
-ds_hash_size dd ?
-ds_hash_bits dd ?
-ds_hash_mask dd ?
-ds_hash_shift dd ?
-ds_block_start dd ?
-ds_match_length dd ? ; used
-ds_prev_match dd ? ; used
-ds_match_available dd ?
-ds_strstart dd ? ; used
-ds_match_start dd ? ; used
-ds_lookahead dd ? ; used
-ds_prev_length dd ? ; used
-ds_max_chain_length dd ? ; used
-ds_max_laxy_match dd ?
-ds_level dd ?
-ds_strategy dd ?
-ds_good_match dd ? ; used
-ds_nice_match dd ? ; used
-
-; Don't need anymore of the struct for match
-DEFLATE_STATE ENDS
-
-;===========================================================================
-; CODE
-;===========================================================================
-_TEXT SEGMENT
-
-;---------------------------------------------------------------------------
-; match_init
-;---------------------------------------------------------------------------
- ALIGN 4
-PUBLIC _match_init
-_match_init PROC
- ; no initialization needed
- ret
-_match_init ENDP
-
-;---------------------------------------------------------------------------
-; uInt longest_match(deflate_state *deflatestate, IPos curmatch)
-;---------------------------------------------------------------------------
- ALIGN 4
-
-PUBLIC _longest_match
-_longest_match PROC
-
-; Since this code uses EBP for a scratch register, the stack frame must
-; be manually constructed and referenced relative to the ESP register.
-
-; Stack image
-; Variables
-chainlenwmask = 0 ; high word: current chain len
- ; low word: s->wmask
-window = 4 ; local copy of s->window
-windowbestlen = 8 ; s->window + bestlen
-scanend = 12 ; last two bytes of string
-scanstart = 16 ; first two bytes of string
-scanalign = 20 ; dword-misalignment of string
-nicematch = 24 ; a good enough match size
-bestlen = 28 ; size of best match so far
-scan = 32 ; ptr to string wanting match
-varsize = 36 ; number of bytes (also offset to last saved register)
-
-; Saved Registers (actually pushed into place)
-ebx_save = 36
-edi_save = 40
-esi_save = 44
-ebp_save = 48
-
-; Parameters
-retaddr = 52
-deflatestate = 56
-curmatch = 60
-
-; Save registers that the compiler may be using
- push ebp
- push edi
- push esi
- push ebx
-
-; Allocate local variable space
- sub esp,varsize
-
-; Retrieve the function arguments. ecx will hold cur_match
-; throughout the entire function. edx will hold the pointer to the
-; deflate_state structure during the function's setup (before
-; entering the main loop).
-
- mov edx, [esp+deflatestate]
-ASSUME edx:PTR DEFLATE_STATE
-
- mov ecx, [esp+curmatch]
-
-; uInt wmask = s->w_mask;
-; unsigned chain_length = s->max_chain_length;
-; if (s->prev_length >= s->good_match) {
-; chain_length >>= 2;
-; }
-
- mov eax, [edx].ds_prev_length
- mov ebx, [edx].ds_good_match
- cmp eax, ebx
- mov eax, [edx].ds_w_mask
- mov ebx, [edx].ds_max_chain_length
- jl SHORT LastMatchGood
- shr ebx, 2
-LastMatchGood:
-
-; chainlen is decremented once beforehand so that the function can
-; use the sign flag instead of the zero flag for the exit test.
-; It is then shifted into the high word, to make room for the wmask
-; value, which it will always accompany.
-
- dec ebx
- shl ebx, 16
- or ebx, eax
- mov [esp+chainlenwmask], ebx
-
-; if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;
-
- mov eax, [edx].ds_nice_match
- mov ebx, [edx].ds_lookahead
- cmp ebx, eax
- jl SHORT LookaheadLess
- mov ebx, eax
-LookaheadLess:
- mov [esp+nicematch], ebx
-
-;/* register Bytef *scan = s->window + s->strstart; */
-
- mov esi, [edx].ds_window
- mov [esp+window], esi
- mov ebp, [edx].ds_strstart
- lea edi, [esi+ebp]
- mov [esp+scan],edi
-
-;/* Determine how many bytes the scan ptr is off from being */
-;/* dword-aligned. */
-
- mov eax, edi
- neg eax
- and eax, 3
- mov [esp+scanalign], eax
-
-;/* IPos limit = s->strstart > (IPos)MAX_DIST(s) ? */
-;/* s->strstart - (IPos)MAX_DIST(s) : NIL; */
-
- mov eax, [edx].ds_w_size
- sub eax, MIN_LOOKAHEAD
- sub ebp, eax
- jg SHORT LimitPositive
- xor ebp, ebp
-LimitPositive:
-
-;/* int best_len = s->prev_length; */
-
- mov eax, [edx].ds_prev_length
- mov [esp+bestlen], eax
-
-;/* Store the sum of s->window + best_len in %esi locally, and in %esi. */
-
- add esi, eax
- mov [esp+windowbestlen], esi
-
-;/* register ush scan_start = *(ushf*)scan; */
-;/* register ush scan_end = *(ushf*)(scan+best_len-1); */
-;/* Posf *prev = s->prev; */
-
- movzx ebx, WORD PTR[edi]
- mov [esp+scanstart], ebx
- movzx ebx, WORD PTR[eax+edi-1]
- mov [esp+scanend], ebx
- mov edi, [edx].ds_prev
-
-;/* Jump into the main loop. */
-
- mov edx, [esp+chainlenwmask]
- jmp SHORT LoopEntry
-
-;/* do {
-; * match = s->window + cur_match;
-; * if (*(ushf*)(match+best_len-1) != scan_end ||
-; * *(ushf*)match != scan_start) continue;
-; * [...]
-; * } while ((cur_match = prev[cur_match & wmask]) > limit
-; * && --chain_length != 0);
-; *
-; * Here is the inner loop of the function. The function will spend the
-; * majority of its time in this loop, and majority of that time will
-; * be spent in the first ten instructions.
-; *
-; * Within this loop:
-; * %ebx = scanend
-; * %ecx = curmatch
-; * %edx = chainlenwmask - i.e., ((chainlen << 16) | wmask)
-; * %esi = windowbestlen - i.e., (window + bestlen)
-; * %edi = prev
-; * %ebp = limit
-; */
-
- ALIGN 4
-LookupLoop:
- and ecx, edx
- movzx ecx, WORD PTR[edi+ecx*2]
- cmp ecx, ebp
- jbe LeaveNow
- sub edx, 000010000H
- js LeaveNow
-
-LoopEntry:
- movzx eax, WORD PTR[esi+ecx-1]
- cmp eax, ebx
- jnz SHORT LookupLoop
-
- mov eax, [esp+window]
- movzx eax, WORD PTR[eax+ecx]
- cmp eax, [esp+scanstart]
- jnz SHORT LookupLoop
-
-;/* Store the current value of chainlen. */
-
- mov [esp+chainlenwmask], edx
-
-;/* Point %edi to the string under scrutiny, and %esi to the string we */
-;/* are hoping to match it up with. In actuality, %esi and %edi are */
-;/* both pointed (MAX_MATCH_8 - scanalign) bytes ahead, and %edx is */
-;/* initialized to -(MAX_MATCH_8 - scanalign). */
-
- mov esi, [esp+window]
- mov edi, [esp+scan]
- add esi, ecx
- mov eax, [esp+scanalign]
- mov edx, -MAX_MATCH_8
- lea edi, [edi+eax+MAX_MATCH_8]
- lea esi, [esi+eax+MAX_MATCH_8]
-
-;/* Test the strings for equality, 8 bytes at a time. At the end,
-; * adjust %edx so that it is offset to the exact byte that mismatched.
-; *
-; * We already know at this point that the first three bytes of the
-; * strings match each other, and they can be safely passed over before
-; * starting the compare loop. So what this code does is skip over 0-3
-; * bytes, as much as necessary in order to dword-align the %edi
-; * pointer. (%esi will still be misaligned three times out of four.)
-; *
-; * It should be confessed that this loop usually does not represent
-; * much of the total running time. Replacing it with a more
-; * straightforward "rep cmpsb" would not drastically degrade
-; * performance.
-; */
-
-LoopCmps:
- mov eax, DWORD PTR[esi+edx]
- xor eax, DWORD PTR[edi+edx]
- jnz SHORT LeaveLoopCmps
-
- mov eax, DWORD PTR[esi+edx+4]
- xor eax, DWORD PTR[edi+edx+4]
- jnz SHORT LeaveLoopCmps4
-
- add edx, 8
- jnz SHORT LoopCmps
- jmp LenMaximum
- ALIGN 4
-
-LeaveLoopCmps4:
- add edx, 4
-
-LeaveLoopCmps:
- test eax, 00000FFFFH
- jnz SHORT LenLower
-
- add edx, 2
- shr eax, 16
-
-LenLower:
- sub al, 1
- adc edx, 0
-
-;/* Calculate the length of the match. If it is longer than MAX_MATCH, */
-;/* then automatically accept it as the best possible match and leave. */
-
- lea eax, [edi+edx]
- mov edi, [esp+scan]
- sub eax, edi
- cmp eax, MAX_MATCH
- jge SHORT LenMaximum
-
-;/* If the length of the match is not longer than the best match we */
-;/* have so far, then forget it and return to the lookup loop. */
-
- mov edx, [esp+deflatestate]
- mov ebx, [esp+bestlen]
- cmp eax, ebx
- jg SHORT LongerMatch
- mov esi, [esp+windowbestlen]
- mov edi, [edx].ds_prev
- mov ebx, [esp+scanend]
- mov edx, [esp+chainlenwmask]
- jmp LookupLoop
- ALIGN 4
-
-;/* s->match_start = cur_match; */
-;/* best_len = len; */
-;/* if (len >= nice_match) break; */
-;/* scan_end = *(ushf*)(scan+best_len-1); */
-
-LongerMatch:
- mov ebx, [esp+nicematch]
- mov [esp+bestlen], eax
- mov [edx].ds_match_start, ecx
- cmp eax, ebx
- jge SHORT LeaveNow
- mov esi, [esp+window]
- add esi, eax
- mov [esp+windowbestlen], esi
- movzx ebx, WORD PTR[edi+eax-1]
- mov edi, [edx].ds_prev
- mov [esp+scanend], ebx
- mov edx, [esp+chainlenwmask]
- jmp LookupLoop
- ALIGN 4
-
-;/* Accept the current string, with the maximum possible length. */
-
-LenMaximum:
- mov edx, [esp+deflatestate]
- mov DWORD PTR[esp+bestlen], MAX_MATCH
- mov [edx].ds_match_start, ecx
-
-;/* if ((uInt)best_len <= s->lookahead) return (uInt)best_len; */
-;/* return s->lookahead; */
-
-LeaveNow:
- mov edx, [esp+deflatestate]
- mov ebx, [esp+bestlen]
- mov eax, [edx].ds_lookahead
- cmp ebx, eax
- jg SHORT LookaheadRet
- mov eax, ebx
-LookaheadRet:
-
-; Restore the stack and return from whence we came.
-
- add esp, varsize
- pop ebx
- pop esi
- pop edi
- pop ebp
- ret
-
-_longest_match ENDP
-
-_TEXT ENDS
-END
diff --git a/compat/zlib/contrib/masmx64/gvmat64.obj b/compat/zlib/contrib/masmx64/gvmat64.obj
deleted file mode 100644
index a49ca02..0000000
--- a/compat/zlib/contrib/masmx64/gvmat64.obj
+++ /dev/null
Binary files differ
diff --git a/compat/zlib/contrib/masmx64/inffasx64.obj b/compat/zlib/contrib/masmx64/inffasx64.obj
deleted file mode 100644
index 8df5d82..0000000
--- a/compat/zlib/contrib/masmx64/inffasx64.obj
+++ /dev/null
Binary files differ
diff --git a/compat/zlib/contrib/masmx86/gvmat32.asm b/compat/zlib/contrib/masmx86/gvmat32.asm
deleted file mode 100644
index 874bb2d..0000000
--- a/compat/zlib/contrib/masmx86/gvmat32.asm
+++ /dev/null
@@ -1,972 +0,0 @@
-; gvmat32.asm -- Asm portion of the optimized longest_match for 32 bits x86
-; Copyright (C) 1995-1996 Jean-loup Gailly and Gilles Vollant.
-; File written by Gilles Vollant, by modifiying the longest_match
-; from Jean-loup Gailly in deflate.c
-;
-; http://www.zlib.net
-; http://www.winimage.com/zLibDll
-; http://www.muppetlabs.com/~breadbox/software/assembly.html
-;
-; For Visual C++ 4.x and higher and ML 6.x and higher
-; ml.exe is in directory \MASM611C of Win95 DDK
-; ml.exe is also distributed in http://www.masm32.com/masmdl.htm
-; and in VC++2003 toolkit at http://msdn.microsoft.com/visualc/vctoolkit2003/
-;
-; this file contain two implementation of longest_match
-;
-; longest_match_7fff : written 1996 by Gilles Vollant optimized for
-; first Pentium. Assume s->w_mask == 0x7fff
-; longest_match_686 : written by Brian raiter (1998), optimized for Pentium Pro
-;
-; for using an seembly version of longest_match, you need define ASMV in project
-; There is two way in using gvmat32.asm
-;
-; A) Suggested method
-; if you want include both longest_match_7fff and longest_match_686
-; compile the asm file running
-; ml /coff /Zi /Flgvmat32.lst /c gvmat32.asm
-; and include gvmat32c.c in your project
-; if you have an old cpu (386,486 or first Pentium) and s->w_mask==0x7fff,
-; longest_match_7fff will be used
-; if you have a more modern CPU (Pentium Pro, II and higher)
-; longest_match_686 will be used
-; on old cpu with s->w_mask!=0x7fff, longest_match_686 will be used,
-; but this is not a sitation you'll find often
-;
-; B) Alternative
-; if you are not interresed in old cpu performance and want the smaller
-; binaries possible
-;
-; compile the asm file running
-; ml /coff /Zi /c /Flgvmat32.lst /DNOOLDPENTIUMCODE gvmat32.asm
-; and do not include gvmat32c.c in your project (ou define also
-; NOOLDPENTIUMCODE)
-;
-; note : as I known, longest_match_686 is very faster than longest_match_7fff
-; on pentium Pro/II/III, faster (but less) in P4, but it seem
-; longest_match_7fff can be faster (very very litte) on AMD Athlon64/K8
-;
-; see below : zlib1222add must be adjuster if you use a zlib version < 1.2.2.2
-
-;uInt longest_match_7fff(s, cur_match)
-; deflate_state *s;
-; IPos cur_match; /* current match */
-
- NbStack equ 76
- cur_match equ dword ptr[esp+NbStack-0]
- str_s equ dword ptr[esp+NbStack-4]
-; 5 dword on top (ret,ebp,esi,edi,ebx)
- adrret equ dword ptr[esp+NbStack-8]
- pushebp equ dword ptr[esp+NbStack-12]
- pushedi equ dword ptr[esp+NbStack-16]
- pushesi equ dword ptr[esp+NbStack-20]
- pushebx equ dword ptr[esp+NbStack-24]
-
- chain_length equ dword ptr [esp+NbStack-28]
- limit equ dword ptr [esp+NbStack-32]
- best_len equ dword ptr [esp+NbStack-36]
- window equ dword ptr [esp+NbStack-40]
- prev equ dword ptr [esp+NbStack-44]
- scan_start equ word ptr [esp+NbStack-48]
- wmask equ dword ptr [esp+NbStack-52]
- match_start_ptr equ dword ptr [esp+NbStack-56]
- nice_match equ dword ptr [esp+NbStack-60]
- scan equ dword ptr [esp+NbStack-64]
-
- windowlen equ dword ptr [esp+NbStack-68]
- match_start equ dword ptr [esp+NbStack-72]
- strend equ dword ptr [esp+NbStack-76]
- NbStackAdd equ (NbStack-24)
-
- .386p
-
- name gvmatch
- .MODEL FLAT
-
-
-
-; all the +zlib1222add offsets are due to the addition of fields
-; in zlib in the deflate_state structure since the asm code was first written
-; (if you compile with zlib 1.0.4 or older, use "zlib1222add equ (-4)").
-; (if you compile with zlib between 1.0.5 and 1.2.2.1, use "zlib1222add equ 0").
-; if you compile with zlib 1.2.2.2 or later , use "zlib1222add equ 8").
-
- zlib1222add equ 8
-
-; Note : these value are good with a 8 bytes boundary pack structure
- dep_chain_length equ 74h+zlib1222add
- dep_window equ 30h+zlib1222add
- dep_strstart equ 64h+zlib1222add
- dep_prev_length equ 70h+zlib1222add
- dep_nice_match equ 88h+zlib1222add
- dep_w_size equ 24h+zlib1222add
- dep_prev equ 38h+zlib1222add
- dep_w_mask equ 2ch+zlib1222add
- dep_good_match equ 84h+zlib1222add
- dep_match_start equ 68h+zlib1222add
- dep_lookahead equ 6ch+zlib1222add
-
-
-_TEXT segment
-
-IFDEF NOUNDERLINE
- IFDEF NOOLDPENTIUMCODE
- public longest_match
- public match_init
- ELSE
- public longest_match_7fff
- public cpudetect32
- public longest_match_686
- ENDIF
-ELSE
- IFDEF NOOLDPENTIUMCODE
- public _longest_match
- public _match_init
- ELSE
- public _longest_match_7fff
- public _cpudetect32
- public _longest_match_686
- ENDIF
-ENDIF
-
- MAX_MATCH equ 258
- MIN_MATCH equ 3
- MIN_LOOKAHEAD equ (MAX_MATCH+MIN_MATCH+1)
-
-
-
-IFNDEF NOOLDPENTIUMCODE
-IFDEF NOUNDERLINE
-longest_match_7fff proc near
-ELSE
-_longest_match_7fff proc near
-ENDIF
-
- mov edx,[esp+4]
-
-
-
- push ebp
- push edi
- push esi
- push ebx
-
- sub esp,NbStackAdd
-
-; initialize or check the variables used in match.asm.
- mov ebp,edx
-
-; chain_length = s->max_chain_length
-; if (prev_length>=good_match) chain_length >>= 2
- mov edx,[ebp+dep_chain_length]
- mov ebx,[ebp+dep_prev_length]
- cmp [ebp+dep_good_match],ebx
- ja noshr
- shr edx,2
-noshr:
-; we increment chain_length because in the asm, the --chain_lenght is in the beginning of the loop
- inc edx
- mov edi,[ebp+dep_nice_match]
- mov chain_length,edx
- mov eax,[ebp+dep_lookahead]
- cmp eax,edi
-; if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;
- jae nolookaheadnicematch
- mov edi,eax
-nolookaheadnicematch:
-; best_len = s->prev_length
- mov best_len,ebx
-
-; window = s->window
- mov esi,[ebp+dep_window]
- mov ecx,[ebp+dep_strstart]
- mov window,esi
-
- mov nice_match,edi
-; scan = window + strstart
- add esi,ecx
- mov scan,esi
-; dx = *window
- mov dx,word ptr [esi]
-; bx = *(window+best_len-1)
- mov bx,word ptr [esi+ebx-1]
- add esi,MAX_MATCH-1
-; scan_start = *scan
- mov scan_start,dx
-; strend = scan + MAX_MATCH-1
- mov strend,esi
-; bx = scan_end = *(window+best_len-1)
-
-; IPos limit = s->strstart > (IPos)MAX_DIST(s) ?
-; s->strstart - (IPos)MAX_DIST(s) : NIL;
-
- mov esi,[ebp+dep_w_size]
- sub esi,MIN_LOOKAHEAD
-; here esi = MAX_DIST(s)
- sub ecx,esi
- ja nodist
- xor ecx,ecx
-nodist:
- mov limit,ecx
-
-; prev = s->prev
- mov edx,[ebp+dep_prev]
- mov prev,edx
-
-;
- mov edx,dword ptr [ebp+dep_match_start]
- mov bp,scan_start
- mov eax,cur_match
- mov match_start,edx
-
- mov edx,window
- mov edi,edx
- add edi,best_len
- mov esi,prev
- dec edi
-; windowlen = window + best_len -1
- mov windowlen,edi
-
- jmp beginloop2
- align 4
-
-; here, in the loop
-; eax = ax = cur_match
-; ecx = limit
-; bx = scan_end
-; bp = scan_start
-; edi = windowlen (window + best_len -1)
-; esi = prev
-
-
-;// here; chain_length <=16
-normalbeg0add16:
- add chain_length,16
- jz exitloop
-normalbeg0:
- cmp word ptr[edi+eax],bx
- je normalbeg2noroll
-rcontlabnoroll:
-; cur_match = prev[cur_match & wmask]
- and eax,7fffh
- mov ax,word ptr[esi+eax*2]
-; if cur_match > limit, go to exitloop
- cmp ecx,eax
- jnb exitloop
-; if --chain_length != 0, go to exitloop
- dec chain_length
- jnz normalbeg0
- jmp exitloop
-
-normalbeg2noroll:
-; if (scan_start==*(cur_match+window)) goto normalbeg2
- cmp bp,word ptr[edx+eax]
- jne rcontlabnoroll
- jmp normalbeg2
-
-contloop3:
- mov edi,windowlen
-
-; cur_match = prev[cur_match & wmask]
- and eax,7fffh
- mov ax,word ptr[esi+eax*2]
-; if cur_match > limit, go to exitloop
- cmp ecx,eax
-jnbexitloopshort1:
- jnb exitloop
-; if --chain_length != 0, go to exitloop
-
-
-; begin the main loop
-beginloop2:
- sub chain_length,16+1
-; if chain_length <=16, don't use the unrolled loop
- jna normalbeg0add16
-
-do16:
- cmp word ptr[edi+eax],bx
- je normalbeg2dc0
-
-maccn MACRO lab
- and eax,7fffh
- mov ax,word ptr[esi+eax*2]
- cmp ecx,eax
- jnb exitloop
- cmp word ptr[edi+eax],bx
- je lab
- ENDM
-
-rcontloop0:
- maccn normalbeg2dc1
-
-rcontloop1:
- maccn normalbeg2dc2
-
-rcontloop2:
- maccn normalbeg2dc3
-
-rcontloop3:
- maccn normalbeg2dc4
-
-rcontloop4:
- maccn normalbeg2dc5
-
-rcontloop5:
- maccn normalbeg2dc6
-
-rcontloop6:
- maccn normalbeg2dc7
-
-rcontloop7:
- maccn normalbeg2dc8
-
-rcontloop8:
- maccn normalbeg2dc9
-
-rcontloop9:
- maccn normalbeg2dc10
-
-rcontloop10:
- maccn short normalbeg2dc11
-
-rcontloop11:
- maccn short normalbeg2dc12
-
-rcontloop12:
- maccn short normalbeg2dc13
-
-rcontloop13:
- maccn short normalbeg2dc14
-
-rcontloop14:
- maccn short normalbeg2dc15
-
-rcontloop15:
- and eax,7fffh
- mov ax,word ptr[esi+eax*2]
- cmp ecx,eax
- jnb exitloop
-
- sub chain_length,16
- ja do16
- jmp normalbeg0add16
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-normbeg MACRO rcontlab,valsub
-; if we are here, we know that *(match+best_len-1) == scan_end
- cmp bp,word ptr[edx+eax]
-; if (match != scan_start) goto rcontlab
- jne rcontlab
-; calculate the good chain_length, and we'll compare scan and match string
- add chain_length,16-valsub
- jmp iseq
- ENDM
-
-
-normalbeg2dc11:
- normbeg rcontloop11,11
-
-normalbeg2dc12:
- normbeg short rcontloop12,12
-
-normalbeg2dc13:
- normbeg short rcontloop13,13
-
-normalbeg2dc14:
- normbeg short rcontloop14,14
-
-normalbeg2dc15:
- normbeg short rcontloop15,15
-
-normalbeg2dc10:
- normbeg rcontloop10,10
-
-normalbeg2dc9:
- normbeg rcontloop9,9
-
-normalbeg2dc8:
- normbeg rcontloop8,8
-
-normalbeg2dc7:
- normbeg rcontloop7,7
-
-normalbeg2dc6:
- normbeg rcontloop6,6
-
-normalbeg2dc5:
- normbeg rcontloop5,5
-
-normalbeg2dc4:
- normbeg rcontloop4,4
-
-normalbeg2dc3:
- normbeg rcontloop3,3
-
-normalbeg2dc2:
- normbeg rcontloop2,2
-
-normalbeg2dc1:
- normbeg rcontloop1,1
-
-normalbeg2dc0:
- normbeg rcontloop0,0
-
-
-; we go in normalbeg2 because *(ushf*)(match+best_len-1) == scan_end
-
-normalbeg2:
- mov edi,window
-
- cmp bp,word ptr[edi+eax]
- jne contloop3 ; if *(ushf*)match != scan_start, continue
-
-iseq:
-; if we are here, we know that *(match+best_len-1) == scan_end
-; and (match == scan_start)
-
- mov edi,edx
- mov esi,scan ; esi = scan
- add edi,eax ; edi = window + cur_match = match
-
- mov edx,[esi+3] ; compare manually dword at match+3
- xor edx,[edi+3] ; and scan +3
-
- jz begincompare ; if equal, go to long compare
-
-; we will determine the unmatch byte and calculate len (in esi)
- or dl,dl
- je eq1rr
- mov esi,3
- jmp trfinval
-eq1rr:
- or dx,dx
- je eq1
-
- mov esi,4
- jmp trfinval
-eq1:
- and edx,0ffffffh
- jz eq11
- mov esi,5
- jmp trfinval
-eq11:
- mov esi,6
- jmp trfinval
-
-begincompare:
- ; here we now scan and match begin same
- add edi,6
- add esi,6
- mov ecx,(MAX_MATCH-(2+4))/4 ; scan for at most MAX_MATCH bytes
- repe cmpsd ; loop until mismatch
-
- je trfin ; go to trfin if not unmatch
-; we determine the unmatch byte
- sub esi,4
- mov edx,[edi-4]
- xor edx,[esi]
-
- or dl,dl
- jnz trfin
- inc esi
-
- or dx,dx
- jnz trfin
- inc esi
-
- and edx,0ffffffh
- jnz trfin
- inc esi
-
-trfin:
- sub esi,scan ; esi = len
-trfinval:
-; here we have finised compare, and esi contain len of equal string
- cmp esi,best_len ; if len > best_len, go newbestlen
- ja short newbestlen
-; now we restore edx, ecx and esi, for the big loop
- mov esi,prev
- mov ecx,limit
- mov edx,window
- jmp contloop3
-
-newbestlen:
- mov best_len,esi ; len become best_len
-
- mov match_start,eax ; save new position as match_start
- cmp esi,nice_match ; if best_len >= nice_match, exit
- jae exitloop
- mov ecx,scan
- mov edx,window ; restore edx=window
- add ecx,esi
- add esi,edx
-
- dec esi
- mov windowlen,esi ; windowlen = window + best_len-1
- mov bx,[ecx-1] ; bx = *(scan+best_len-1) = scan_end
-
-; now we restore ecx and esi, for the big loop :
- mov esi,prev
- mov ecx,limit
- jmp contloop3
-
-exitloop:
-; exit : s->match_start=match_start
- mov ebx,match_start
- mov ebp,str_s
- mov ecx,best_len
- mov dword ptr [ebp+dep_match_start],ebx
- mov eax,dword ptr [ebp+dep_lookahead]
- cmp ecx,eax
- ja minexlo
- mov eax,ecx
-minexlo:
-; return min(best_len,s->lookahead)
-
-; restore stack and register ebx,esi,edi,ebp
- add esp,NbStackAdd
-
- pop ebx
- pop esi
- pop edi
- pop ebp
- ret
-InfoAuthor:
-; please don't remove this string !
-; Your are free use gvmat32 in any fre or commercial apps if you don't remove the string in the binary!
- db 0dh,0ah,"GVMat32 optimised assembly code written 1996-98 by Gilles Vollant",0dh,0ah
-
-
-
-IFDEF NOUNDERLINE
-longest_match_7fff endp
-ELSE
-_longest_match_7fff endp
-ENDIF
-
-
-IFDEF NOUNDERLINE
-cpudetect32 proc near
-ELSE
-_cpudetect32 proc near
-ENDIF
-
- push ebx
-
- pushfd ; push original EFLAGS
- pop eax ; get original EFLAGS
- mov ecx, eax ; save original EFLAGS
- xor eax, 40000h ; flip AC bit in EFLAGS
- push eax ; save new EFLAGS value on stack
- popfd ; replace current EFLAGS value
- pushfd ; get new EFLAGS
- pop eax ; store new EFLAGS in EAX
- xor eax, ecx ; can’t toggle AC bit, processor=80386
- jz end_cpu_is_386 ; jump if 80386 processor
- push ecx
- popfd ; restore AC bit in EFLAGS first
-
- pushfd
- pushfd
- pop ecx
-
- mov eax, ecx ; get original EFLAGS
- xor eax, 200000h ; flip ID bit in EFLAGS
- push eax ; save new EFLAGS value on stack
- popfd ; replace current EFLAGS value
- pushfd ; get new EFLAGS
- pop eax ; store new EFLAGS in EAX
- popfd ; restore original EFLAGS
- xor eax, ecx ; can’t toggle ID bit,
- je is_old_486 ; processor=old
-
- mov eax,1
- db 0fh,0a2h ;CPUID
-
-exitcpudetect:
- pop ebx
- ret
-
-end_cpu_is_386:
- mov eax,0300h
- jmp exitcpudetect
-
-is_old_486:
- mov eax,0400h
- jmp exitcpudetect
-
-IFDEF NOUNDERLINE
-cpudetect32 endp
-ELSE
-_cpudetect32 endp
-ENDIF
-ENDIF
-
-MAX_MATCH equ 258
-MIN_MATCH equ 3
-MIN_LOOKAHEAD equ (MAX_MATCH + MIN_MATCH + 1)
-MAX_MATCH_8_ equ ((MAX_MATCH + 7) AND 0FFF0h)
-
-
-;;; stack frame offsets
-
-chainlenwmask equ esp + 0 ; high word: current chain len
- ; low word: s->wmask
-window equ esp + 4 ; local copy of s->window
-windowbestlen equ esp + 8 ; s->window + bestlen
-scanstart equ esp + 16 ; first two bytes of string
-scanend equ esp + 12 ; last two bytes of string
-scanalign equ esp + 20 ; dword-misalignment of string
-nicematch equ esp + 24 ; a good enough match size
-bestlen equ esp + 28 ; size of best match so far
-scan equ esp + 32 ; ptr to string wanting match
-
-LocalVarsSize equ 36
-; saved ebx byte esp + 36
-; saved edi byte esp + 40
-; saved esi byte esp + 44
-; saved ebp byte esp + 48
-; return address byte esp + 52
-deflatestate equ esp + 56 ; the function arguments
-curmatch equ esp + 60
-
-;;; Offsets for fields in the deflate_state structure. These numbers
-;;; are calculated from the definition of deflate_state, with the
-;;; assumption that the compiler will dword-align the fields. (Thus,
-;;; changing the definition of deflate_state could easily cause this
-;;; program to crash horribly, without so much as a warning at
-;;; compile time. Sigh.)
-
-dsWSize equ 36+zlib1222add
-dsWMask equ 44+zlib1222add
-dsWindow equ 48+zlib1222add
-dsPrev equ 56+zlib1222add
-dsMatchLen equ 88+zlib1222add
-dsPrevMatch equ 92+zlib1222add
-dsStrStart equ 100+zlib1222add
-dsMatchStart equ 104+zlib1222add
-dsLookahead equ 108+zlib1222add
-dsPrevLen equ 112+zlib1222add
-dsMaxChainLen equ 116+zlib1222add
-dsGoodMatch equ 132+zlib1222add
-dsNiceMatch equ 136+zlib1222add
-
-
-;;; match.asm -- Pentium-Pro-optimized version of longest_match()
-;;; Written for zlib 1.1.2
-;;; Copyright (C) 1998 Brian Raiter <breadbox@muppetlabs.com>
-;;; You can look at http://www.muppetlabs.com/~breadbox/software/assembly.html
-;;;
-;;; This is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License.
-
-;GLOBAL _longest_match, _match_init
-
-
-;SECTION .text
-
-;;; uInt longest_match(deflate_state *deflatestate, IPos curmatch)
-
-;_longest_match:
-IFDEF NOOLDPENTIUMCODE
- IFDEF NOUNDERLINE
- longest_match proc near
- ELSE
- _longest_match proc near
- ENDIF
-ELSE
- IFDEF NOUNDERLINE
- longest_match_686 proc near
- ELSE
- _longest_match_686 proc near
- ENDIF
-ENDIF
-
-;;; Save registers that the compiler may be using, and adjust esp to
-;;; make room for our stack frame.
-
- push ebp
- push edi
- push esi
- push ebx
- sub esp, LocalVarsSize
-
-;;; Retrieve the function arguments. ecx will hold cur_match
-;;; throughout the entire function. edx will hold the pointer to the
-;;; deflate_state structure during the function's setup (before
-;;; entering the main loop.
-
- mov edx, [deflatestate]
- mov ecx, [curmatch]
-
-;;; uInt wmask = s->w_mask;
-;;; unsigned chain_length = s->max_chain_length;
-;;; if (s->prev_length >= s->good_match) {
-;;; chain_length >>= 2;
-;;; }
-
- mov eax, [edx + dsPrevLen]
- mov ebx, [edx + dsGoodMatch]
- cmp eax, ebx
- mov eax, [edx + dsWMask]
- mov ebx, [edx + dsMaxChainLen]
- jl LastMatchGood
- shr ebx, 2
-LastMatchGood:
-
-;;; chainlen is decremented once beforehand so that the function can
-;;; use the sign flag instead of the zero flag for the exit test.
-;;; It is then shifted into the high word, to make room for the wmask
-;;; value, which it will always accompany.
-
- dec ebx
- shl ebx, 16
- or ebx, eax
- mov [chainlenwmask], ebx
-
-;;; if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;
-
- mov eax, [edx + dsNiceMatch]
- mov ebx, [edx + dsLookahead]
- cmp ebx, eax
- jl LookaheadLess
- mov ebx, eax
-LookaheadLess: mov [nicematch], ebx
-
-;;; register Bytef *scan = s->window + s->strstart;
-
- mov esi, [edx + dsWindow]
- mov [window], esi
- mov ebp, [edx + dsStrStart]
- lea edi, [esi + ebp]
- mov [scan], edi
-
-;;; Determine how many bytes the scan ptr is off from being
-;;; dword-aligned.
-
- mov eax, edi
- neg eax
- and eax, 3
- mov [scanalign], eax
-
-;;; IPos limit = s->strstart > (IPos)MAX_DIST(s) ?
-;;; s->strstart - (IPos)MAX_DIST(s) : NIL;
-
- mov eax, [edx + dsWSize]
- sub eax, MIN_LOOKAHEAD
- sub ebp, eax
- jg LimitPositive
- xor ebp, ebp
-LimitPositive:
-
-;;; int best_len = s->prev_length;
-
- mov eax, [edx + dsPrevLen]
- mov [bestlen], eax
-
-;;; Store the sum of s->window + best_len in esi locally, and in esi.
-
- add esi, eax
- mov [windowbestlen], esi
-
-;;; register ush scan_start = *(ushf*)scan;
-;;; register ush scan_end = *(ushf*)(scan+best_len-1);
-;;; Posf *prev = s->prev;
-
- movzx ebx, word ptr [edi]
- mov [scanstart], ebx
- movzx ebx, word ptr [edi + eax - 1]
- mov [scanend], ebx
- mov edi, [edx + dsPrev]
-
-;;; Jump into the main loop.
-
- mov edx, [chainlenwmask]
- jmp short LoopEntry
-
-align 4
-
-;;; do {
-;;; match = s->window + cur_match;
-;;; if (*(ushf*)(match+best_len-1) != scan_end ||
-;;; *(ushf*)match != scan_start) continue;
-;;; [...]
-;;; } while ((cur_match = prev[cur_match & wmask]) > limit
-;;; && --chain_length != 0);
-;;;
-;;; Here is the inner loop of the function. The function will spend the
-;;; majority of its time in this loop, and majority of that time will
-;;; be spent in the first ten instructions.
-;;;
-;;; Within this loop:
-;;; ebx = scanend
-;;; ecx = curmatch
-;;; edx = chainlenwmask - i.e., ((chainlen << 16) | wmask)
-;;; esi = windowbestlen - i.e., (window + bestlen)
-;;; edi = prev
-;;; ebp = limit
-
-LookupLoop:
- and ecx, edx
- movzx ecx, word ptr [edi + ecx*2]
- cmp ecx, ebp
- jbe LeaveNow
- sub edx, 00010000h
- js LeaveNow
-LoopEntry: movzx eax, word ptr [esi + ecx - 1]
- cmp eax, ebx
- jnz LookupLoop
- mov eax, [window]
- movzx eax, word ptr [eax + ecx]
- cmp eax, [scanstart]
- jnz LookupLoop
-
-;;; Store the current value of chainlen.
-
- mov [chainlenwmask], edx
-
-;;; Point edi to the string under scrutiny, and esi to the string we
-;;; are hoping to match it up with. In actuality, esi and edi are
-;;; both pointed (MAX_MATCH_8 - scanalign) bytes ahead, and edx is
-;;; initialized to -(MAX_MATCH_8 - scanalign).
-
- mov esi, [window]
- mov edi, [scan]
- add esi, ecx
- mov eax, [scanalign]
- mov edx, 0fffffef8h; -(MAX_MATCH_8)
- lea edi, [edi + eax + 0108h] ;MAX_MATCH_8]
- lea esi, [esi + eax + 0108h] ;MAX_MATCH_8]
-
-;;; Test the strings for equality, 8 bytes at a time. At the end,
-;;; adjust edx so that it is offset to the exact byte that mismatched.
-;;;
-;;; We already know at this point that the first three bytes of the
-;;; strings match each other, and they can be safely passed over before
-;;; starting the compare loop. So what this code does is skip over 0-3
-;;; bytes, as much as necessary in order to dword-align the edi
-;;; pointer. (esi will still be misaligned three times out of four.)
-;;;
-;;; It should be confessed that this loop usually does not represent
-;;; much of the total running time. Replacing it with a more
-;;; straightforward "rep cmpsb" would not drastically degrade
-;;; performance.
-
-LoopCmps:
- mov eax, [esi + edx]
- xor eax, [edi + edx]
- jnz LeaveLoopCmps
- mov eax, [esi + edx + 4]
- xor eax, [edi + edx + 4]
- jnz LeaveLoopCmps4
- add edx, 8
- jnz LoopCmps
- jmp short LenMaximum
-LeaveLoopCmps4: add edx, 4
-LeaveLoopCmps: test eax, 0000FFFFh
- jnz LenLower
- add edx, 2
- shr eax, 16
-LenLower: sub al, 1
- adc edx, 0
-
-;;; Calculate the length of the match. If it is longer than MAX_MATCH,
-;;; then automatically accept it as the best possible match and leave.
-
- lea eax, [edi + edx]
- mov edi, [scan]
- sub eax, edi
- cmp eax, MAX_MATCH
- jge LenMaximum
-
-;;; If the length of the match is not longer than the best match we
-;;; have so far, then forget it and return to the lookup loop.
-
- mov edx, [deflatestate]
- mov ebx, [bestlen]
- cmp eax, ebx
- jg LongerMatch
- mov esi, [windowbestlen]
- mov edi, [edx + dsPrev]
- mov ebx, [scanend]
- mov edx, [chainlenwmask]
- jmp LookupLoop
-
-;;; s->match_start = cur_match;
-;;; best_len = len;
-;;; if (len >= nice_match) break;
-;;; scan_end = *(ushf*)(scan+best_len-1);
-
-LongerMatch: mov ebx, [nicematch]
- mov [bestlen], eax
- mov [edx + dsMatchStart], ecx
- cmp eax, ebx
- jge LeaveNow
- mov esi, [window]
- add esi, eax
- mov [windowbestlen], esi
- movzx ebx, word ptr [edi + eax - 1]
- mov edi, [edx + dsPrev]
- mov [scanend], ebx
- mov edx, [chainlenwmask]
- jmp LookupLoop
-
-;;; Accept the current string, with the maximum possible length.
-
-LenMaximum: mov edx, [deflatestate]
- mov dword ptr [bestlen], MAX_MATCH
- mov [edx + dsMatchStart], ecx
-
-;;; if ((uInt)best_len <= s->lookahead) return (uInt)best_len;
-;;; return s->lookahead;
-
-LeaveNow:
- mov edx, [deflatestate]
- mov ebx, [bestlen]
- mov eax, [edx + dsLookahead]
- cmp ebx, eax
- jg LookaheadRet
- mov eax, ebx
-LookaheadRet:
-
-;;; Restore the stack and return from whence we came.
-
- add esp, LocalVarsSize
- pop ebx
- pop esi
- pop edi
- pop ebp
-
- ret
-; please don't remove this string !
-; Your can freely use gvmat32 in any free or commercial app if you don't remove the string in the binary!
- db 0dh,0ah,"asm686 with masm, optimised assembly code from Brian Raiter, written 1998",0dh,0ah
-
-
-IFDEF NOOLDPENTIUMCODE
- IFDEF NOUNDERLINE
- longest_match endp
- ELSE
- _longest_match endp
- ENDIF
-
- IFDEF NOUNDERLINE
- match_init proc near
- ret
- match_init endp
- ELSE
- _match_init proc near
- ret
- _match_init endp
- ENDIF
-ELSE
- IFDEF NOUNDERLINE
- longest_match_686 endp
- ELSE
- _longest_match_686 endp
- ENDIF
-ENDIF
-
-_TEXT ends
-end
diff --git a/compat/zlib/contrib/masmx86/gvmat32.obj b/compat/zlib/contrib/masmx86/gvmat32.obj
deleted file mode 100644
index ebb3262..0000000
--- a/compat/zlib/contrib/masmx86/gvmat32.obj
+++ /dev/null
Binary files differ
diff --git a/compat/zlib/contrib/masmx86/gvmat32c.c b/compat/zlib/contrib/masmx86/gvmat32c.c
deleted file mode 100644
index 7ad2b27..0000000
--- a/compat/zlib/contrib/masmx86/gvmat32c.c
+++ /dev/null
@@ -1,62 +0,0 @@
-/* gvmat32.c -- C portion of the optimized longest_match for 32 bits x86
- * Copyright (C) 1995-1996 Jean-loup Gailly and Gilles Vollant.
- * File written by Gilles Vollant, by modifiying the longest_match
- * from Jean-loup Gailly in deflate.c
- * it prepare all parameters and call the assembly longest_match_gvasm
- * longest_match execute standard C code is wmask != 0x7fff
- * (assembly code is faster with a fixed wmask)
- *
- * Read comment at beginning of gvmat32.asm for more information
- */
-
-#if defined(ASMV) && (!defined(NOOLDPENTIUMCODE))
-#include "deflate.h"
-
-/* if your C compiler don't add underline before function name,
- define ADD_UNDERLINE_ASMFUNC */
-#ifdef ADD_UNDERLINE_ASMFUNC
-#define longest_match_7fff _longest_match_7fff
-#define longest_match_686 _longest_match_686
-#define cpudetect32 _cpudetect32
-#endif
-
-
-unsigned long cpudetect32();
-
-uInt longest_match_c(
- deflate_state *s,
- IPos cur_match); /* current match */
-
-
-uInt longest_match_7fff(
- deflate_state *s,
- IPos cur_match); /* current match */
-
-uInt longest_match_686(
- deflate_state *s,
- IPos cur_match); /* current match */
-
-
-static uInt iIsPPro=2;
-
-void match_init ()
-{
- iIsPPro = (((cpudetect32()/0x100)&0xf)>=6) ? 1 : 0;
-}
-
-uInt longest_match(
- deflate_state *s,
- IPos cur_match) /* current match */
-{
- if (iIsPPro!=0)
- return longest_match_686(s,cur_match);
-
- if (s->w_mask != 0x7fff)
- return longest_match_686(s,cur_match);
-
- /* now ((s->w_mask == 0x7fff) && (iIsPPro==0)) */
- return longest_match_7fff(s,cur_match);
-}
-
-
-#endif /* defined(ASMV) && (!defined(NOOLDPENTIUMCODE)) */
diff --git a/compat/zlib/contrib/masmx86/inffas32.asm b/compat/zlib/contrib/masmx86/inffas32.asm
index 92ac22a..03d20f8 100644
--- a/compat/zlib/contrib/masmx86/inffas32.asm
+++ b/compat/zlib/contrib/masmx86/inffas32.asm
@@ -73,11 +73,6 @@ inflate_fast_use_mmx:
_TEXT segment
-PUBLIC _inflate_fast
-
-ALIGN 4
-_inflate_fast:
- jmp inflate_fast_entry
@@ -163,7 +158,8 @@ distbits_state equ (76+4+zlib1222sup) ;/* state->distbits */
;SECTION .text
ALIGN 4
-inflate_fast_entry:
+_inflate_fast proc near
+.FPO (16, 4, 0, 0, 1, 0)
push edi
push esi
push ebp
@@ -1078,6 +1074,7 @@ L_done:
pop esi
pop edi
ret
+_inflate_fast endp
_TEXT ends
end
diff --git a/compat/zlib/contrib/masmx86/inffas32.obj b/compat/zlib/contrib/masmx86/inffas32.obj
deleted file mode 100644
index bd6664d..0000000
--- a/compat/zlib/contrib/masmx86/inffas32.obj
+++ /dev/null
Binary files differ
diff --git a/compat/zlib/contrib/masmx86/match686.asm b/compat/zlib/contrib/masmx86/match686.asm
index 1eaf555..3b09212 100644
--- a/compat/zlib/contrib/masmx86/match686.asm
+++ b/compat/zlib/contrib/masmx86/match686.asm
@@ -195,6 +195,7 @@ dsNiceMatch equ 136+zlib1222add
ELSE
_longest_match proc near
ENDIF
+.FPO (9, 4, 0, 0, 1, 0)
;;; Save registers that the compiler may be using, and adjust esp to
;;; make room for our stack frame.
diff --git a/compat/zlib/contrib/masmx86/mkasm.bat b/compat/zlib/contrib/masmx86/mkasm.bat
deleted file mode 100755
index 70a51f8..0000000
--- a/compat/zlib/contrib/masmx86/mkasm.bat
+++ /dev/null
@@ -1,3 +0,0 @@
-cl /DASMV /I..\.. /O2 /c gvmat32c.c
-ml /coff /Zi /c /Flgvmat32.lst gvmat32.asm
-ml /coff /Zi /c /Flinffas32.lst inffas32.asm
diff --git a/compat/zlib/contrib/minizip/ChangeLogUnzip b/compat/zlib/contrib/minizip/ChangeLogUnzip
deleted file mode 100644
index 50ca6a9..0000000
--- a/compat/zlib/contrib/minizip/ChangeLogUnzip
+++ /dev/null
@@ -1,67 +0,0 @@
-Change in 1.01e (12 feb 05)
-- Fix in zipOpen2 for globalcomment (Rolf Kalbermatter)
-- Fix possible memory leak in unzip.c (Zoran Stevanovic)
-
-Change in 1.01b (20 may 04)
-- Integrate patch from Debian package (submited by Mark Brown)
-- Add tools mztools from Xavier Roche
-
-Change in 1.01 (8 may 04)
-- fix buffer overrun risk in unzip.c (Xavier Roche)
-- fix a minor buffer insecurity in minizip.c (Mike Whittaker)
-
-Change in 1.00: (10 sept 03)
-- rename to 1.00
-- cosmetic code change
-
-Change in 0.22: (19 May 03)
-- crypting support (unless you define NOCRYPT)
-- append file in existing zipfile
-
-Change in 0.21: (10 Mar 03)
-- bug fixes
-
-Change in 0.17: (27 Jan 02)
-- bug fixes
-
-Change in 0.16: (19 Jan 02)
-- Support of ioapi for virtualize zip file access
-
-Change in 0.15: (19 Mar 98)
-- fix memory leak in minizip.c
-
-Change in 0.14: (10 Mar 98)
-- fix bugs in minizip.c sample for zipping big file
-- fix problem in month in date handling
-- fix bug in unzlocal_GetCurrentFileInfoInternal in unzip.c for
- comment handling
-
-Change in 0.13: (6 Mar 98)
-- fix bugs in zip.c
-- add real minizip sample
-
-Change in 0.12: (4 Mar 98)
-- add zip.c and zip.h for creates .zip file
-- fix change_file_date in miniunz.c for Unix (Jean-loup Gailly)
-- fix miniunz.c for file without specific record for directory
-
-Change in 0.11: (3 Mar 98)
-- fix bug in unzGetCurrentFileInfo for get extra field and comment
-- enhance miniunz sample, remove the bad unztst.c sample
-
-Change in 0.10: (2 Mar 98)
-- fix bug in unzReadCurrentFile
-- rename unzip* to unz* function and structure
-- remove Windows-like hungary notation variable name
-- modify some structure in unzip.h
-- add somes comment in source
-- remove unzipGetcCurrentFile function
-- replace ZUNZEXPORT by ZEXPORT
-- add unzGetLocalExtrafield for get the local extrafield info
-- add a new sample, miniunz.c
-
-Change in 0.4: (25 Feb 98)
-- suppress the type unzipFileInZip.
- Only on file in the zipfile can be open at the same time
-- fix somes typo in code
-- added tm_unz structure in unzip_file_info (date/time in readable format)
diff --git a/compat/zlib/contrib/minizip/Makefile.am b/compat/zlib/contrib/minizip/Makefile.am
new file mode 100644
index 0000000..d343011
--- /dev/null
+++ b/compat/zlib/contrib/minizip/Makefile.am
@@ -0,0 +1,45 @@
+lib_LTLIBRARIES = libminizip.la
+
+if COND_DEMOS
+bin_PROGRAMS = miniunzip minizip
+endif
+
+zlib_top_srcdir = $(top_srcdir)/../..
+zlib_top_builddir = $(top_builddir)/../..
+
+AM_CPPFLAGS = -I$(zlib_top_srcdir)
+AM_LDFLAGS = -L$(zlib_top_builddir)
+
+if WIN32
+iowin32_src = iowin32.c
+iowin32_h = iowin32.h
+endif
+
+libminizip_la_SOURCES = \
+ ioapi.c \
+ mztools.c \
+ unzip.c \
+ zip.c \
+ ${iowin32_src}
+
+libminizip_la_LDFLAGS = $(AM_LDFLAGS) -version-info 1:0:0 -lz
+
+minizip_includedir = $(includedir)/minizip
+minizip_include_HEADERS = \
+ crypt.h \
+ ioapi.h \
+ mztools.h \
+ unzip.h \
+ zip.h \
+ ${iowin32_h}
+
+pkgconfigdir = $(libdir)/pkgconfig
+pkgconfig_DATA = minizip.pc
+
+EXTRA_PROGRAMS = miniunzip minizip
+
+miniunzip_SOURCES = miniunz.c
+miniunzip_LDADD = libminizip.la
+
+minizip_SOURCES = minizip.c
+minizip_LDADD = libminizip.la -lz
diff --git a/compat/zlib/contrib/minizip/configure.ac b/compat/zlib/contrib/minizip/configure.ac
new file mode 100644
index 0000000..6a9af21
--- /dev/null
+++ b/compat/zlib/contrib/minizip/configure.ac
@@ -0,0 +1,32 @@
+# -*- Autoconf -*-
+# Process this file with autoconf to produce a configure script.
+
+AC_INIT([minizip], [1.2.7], [bugzilla.redhat.com])
+AC_CONFIG_SRCDIR([minizip.c])
+AM_INIT_AUTOMAKE([foreign])
+LT_INIT
+
+AC_MSG_CHECKING([whether to build example programs])
+AC_ARG_ENABLE([demos], AC_HELP_STRING([--enable-demos], [build example programs]))
+AM_CONDITIONAL([COND_DEMOS], [test "$enable_demos" = yes])
+if test "$enable_demos" = yes
+then
+ AC_MSG_RESULT([yes])
+else
+ AC_MSG_RESULT([no])
+fi
+
+case "${host}" in
+ *-mingw* | mingw*)
+ WIN32="yes"
+ ;;
+ *)
+ ;;
+esac
+AM_CONDITIONAL([WIN32], [test "${WIN32}" = "yes"])
+
+
+AC_SUBST([HAVE_UNISTD_H], [0])
+AC_CHECK_HEADER([unistd.h], [HAVE_UNISTD_H=1], [])
+AC_CONFIG_FILES([Makefile minizip.pc])
+AC_OUTPUT
diff --git a/compat/zlib/contrib/minizip/ioapi.c b/compat/zlib/contrib/minizip/ioapi.c
index 49958f6..7f5c191 100644
--- a/compat/zlib/contrib/minizip/ioapi.c
+++ b/compat/zlib/contrib/minizip/ioapi.c
@@ -10,10 +10,22 @@
*/
-#if (defined(_WIN32))
+#if defined(_WIN32) && (!(defined(_CRT_SECURE_NO_WARNINGS)))
#define _CRT_SECURE_NO_WARNINGS
#endif
+#if defined(__APPLE__) || defined(IOAPI_NO_64)
+// In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions
+#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
+#define FTELLO_FUNC(stream) ftello(stream)
+#define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin)
+#else
+#define FOPEN_FUNC(filename, mode) fopen64(filename, mode)
+#define FTELLO_FUNC(stream) ftello64(stream)
+#define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin)
+#endif
+
+
#include "ioapi.h"
voidpf call_zopen64 (const zlib_filefunc64_32_def* pfilefunc,const void*filename,int mode)
@@ -47,7 +59,7 @@ ZPOS64_T call_ztell64 (const zlib_filefunc64_32_def* pfilefunc,voidpf filestream
else
{
uLong tell_uLong = (*(pfilefunc->ztell32_file))(pfilefunc->zfile_func64.opaque,filestream);
- if ((tell_uLong) == ((uLong)-1))
+ if ((tell_uLong) == MAXU32)
return (ZPOS64_T)-1;
else
return tell_uLong;
@@ -112,7 +124,7 @@ static voidpf ZCALLBACK fopen64_file_func (voidpf opaque, const void* filename,
mode_fopen = "wb";
if ((filename!=NULL) && (mode_fopen != NULL))
- file = fopen64((const char*)filename, mode_fopen);
+ file = FOPEN_FUNC((const char*)filename, mode_fopen);
return file;
}
@@ -142,7 +154,7 @@ static long ZCALLBACK ftell_file_func (voidpf opaque, voidpf stream)
static ZPOS64_T ZCALLBACK ftell64_file_func (voidpf opaque, voidpf stream)
{
ZPOS64_T ret;
- ret = ftello64((FILE *)stream);
+ ret = FTELLO_FUNC((FILE *)stream);
return ret;
}
@@ -188,7 +200,7 @@ static long ZCALLBACK fseek64_file_func (voidpf opaque, voidpf stream, ZPOS64_T
}
ret = 0;
- if(fseeko64((FILE *)stream, offset, fseek_origin) != 0)
+ if(FSEEKO_FUNC((FILE *)stream, offset, fseek_origin) != 0)
ret = -1;
return ret;
diff --git a/compat/zlib/contrib/minizip/ioapi.h b/compat/zlib/contrib/minizip/ioapi.h
index 8309c4c..8dcbdb0 100644
--- a/compat/zlib/contrib/minizip/ioapi.h
+++ b/compat/zlib/contrib/minizip/ioapi.h
@@ -21,7 +21,7 @@
#ifndef _ZLIBIOAPI64_H
#define _ZLIBIOAPI64_H
-#if (!defined(_WIN32)) && (!defined(WIN32))
+#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
// Linux needs this to support file operation on files larger then 4+GB
// But might need better if/def to select just the platforms that needs them.
@@ -38,6 +38,7 @@
#ifndef _FILE_OFFSET_BIT
#define _FILE_OFFSET_BIT 64
#endif
+
#endif
#include <stdio.h>
@@ -49,6 +50,11 @@
#define ftello64 ftell
#define fseeko64 fseek
#else
+#ifdef __FreeBSD__
+#define fopen64 fopen
+#define ftello64 ftello
+#define fseeko64 fseeko
+#endif
#ifdef _MSC_VER
#define fopen64 fopen
#if (_MSC_VER >= 1400) && (!(defined(NO_MSCVER_FILE64_FUNC)))
@@ -85,6 +91,8 @@ typedef 64BIT_INT_CUSTOM_TYPE ZPOS64_T;
typedef uint64_t ZPOS64_T;
#else
+/* Maximum unsigned 32-bit value used as placeholder for zip64 */
+#define MAXU32 0xffffffff
#if defined(_MSC_VER) || defined(__BORLANDC__)
typedef unsigned __int64 ZPOS64_T;
diff --git a/compat/zlib/contrib/minizip/miniunz.c b/compat/zlib/contrib/minizip/miniunz.c
index 9ed009f..3d65401 100644
--- a/compat/zlib/contrib/minizip/miniunz.c
+++ b/compat/zlib/contrib/minizip/miniunz.c
@@ -12,7 +12,7 @@
Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
*/
-#ifndef _WIN32
+#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
#ifndef __USE_FILE_OFFSET64
#define __USE_FILE_OFFSET64
#endif
@@ -27,6 +27,18 @@
#endif
#endif
+#ifdef __APPLE__
+// In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions
+#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
+#define FTELLO_FUNC(stream) ftello(stream)
+#define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin)
+#else
+#define FOPEN_FUNC(filename, mode) fopen64(filename, mode)
+#define FTELLO_FUNC(stream) ftello64(stream)
+#define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin)
+#endif
+
+
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
@@ -34,14 +46,15 @@
#include <errno.h>
#include <fcntl.h>
-#ifdef unix
-# include <unistd.h>
-# include <utime.h>
-#else
+#ifdef _WIN32
# include <direct.h>
# include <io.h>
+#else
+# include <unistd.h>
+# include <utime.h>
#endif
+
#include "unzip.h"
#define CASESENSITIVITY (0)
@@ -84,7 +97,7 @@ void change_file_date(filename,dosdate,tmu_date)
SetFileTime(hFile,&ftm,&ftLastAcc,&ftm);
CloseHandle(hFile);
#else
-#ifdef unix
+#ifdef unix || __APPLE__
struct utimbuf ut;
struct tm newdate;
newdate.tm_sec = tmu_date.tm_sec;
@@ -114,10 +127,10 @@ int mymkdir(dirname)
int ret=0;
#ifdef _WIN32
ret = _mkdir(dirname);
-#else
-#ifdef unix
+#elif unix
+ ret = mkdir (dirname,0775);
+#elif __APPLE__
ret = mkdir (dirname,0775);
-#endif
#endif
return ret;
}
@@ -364,7 +377,7 @@ int do_extract_currentfile(uf,popt_extract_without_path,popt_overwrite,password)
{
char rep=0;
FILE* ftestexist;
- ftestexist = fopen64(write_filename,"rb");
+ ftestexist = FOPEN_FUNC(write_filename,"rb");
if (ftestexist!=NULL)
{
fclose(ftestexist);
@@ -395,8 +408,7 @@ int do_extract_currentfile(uf,popt_extract_without_path,popt_overwrite,password)
if ((skip==0) && (err==UNZ_OK))
{
- fout=fopen64(write_filename,"wb");
-
+ fout=FOPEN_FUNC(write_filename,"wb");
/* some zipfile don't contain directory alone before file */
if ((fout==NULL) && ((*popt_extract_without_path)==0) &&
(filename_withoutpath!=(char*)filename_inzip))
@@ -405,7 +417,7 @@ int do_extract_currentfile(uf,popt_extract_without_path,popt_overwrite,password)
*(filename_withoutpath-1)='\0';
makedir(write_filename);
*(filename_withoutpath-1)=c;
- fout=fopen64(write_filename,"wb");
+ fout=FOPEN_FUNC(write_filename,"wb");
}
if (fout==NULL)
diff --git a/compat/zlib/contrib/minizip/minizip.c b/compat/zlib/contrib/minizip/minizip.c
index 7a4fa5a..4288962 100644
--- a/compat/zlib/contrib/minizip/minizip.c
+++ b/compat/zlib/contrib/minizip/minizip.c
@@ -13,7 +13,7 @@
*/
-#ifndef _WIN32
+#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
#ifndef __USE_FILE_OFFSET64
#define __USE_FILE_OFFSET64
#endif
@@ -28,6 +28,19 @@
#endif
#endif
+#ifdef __APPLE__
+// In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions
+#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
+#define FTELLO_FUNC(stream) ftello(stream)
+#define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin)
+#else
+#define FOPEN_FUNC(filename, mode) fopen64(filename, mode)
+#define FTELLO_FUNC(stream) ftello64(stream)
+#define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin)
+#endif
+
+
+
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
@@ -35,14 +48,14 @@
#include <errno.h>
#include <fcntl.h>
-#ifdef unix
+#ifdef _WIN32
+# include <direct.h>
+# include <io.h>
+#else
# include <unistd.h>
# include <utime.h>
# include <sys/types.h>
# include <sys/stat.h>
-#else
-# include <direct.h>
-# include <io.h>
#endif
#include "zip.h"
@@ -81,7 +94,7 @@ uLong filetime(f, tmzip, dt)
return ret;
}
#else
-#ifdef unix
+#ifdef unix || __APPLE__
uLong filetime(f, tmzip, dt)
char *f; /* name of file to get info on */
tm_zip *tmzip; /* return value: access, modific. and creation times */
@@ -142,7 +155,7 @@ int check_exist_file(filename)
{
FILE* ftestexist;
int ret = 1;
- ftestexist = fopen64(filename,"rb");
+ ftestexist = FOPEN_FUNC(filename,"rb");
if (ftestexist==NULL)
ret = 0;
else
@@ -173,7 +186,8 @@ int getFileCrc(const char* filenameinzip,void*buf,unsigned long size_buf,unsigne
{
unsigned long calculate_crc=0;
int err=ZIP_OK;
- FILE * fin = fopen64(filenameinzip,"rb");
+ FILE * fin = FOPEN_FUNC(filenameinzip,"rb");
+
unsigned long size_read = 0;
unsigned long total_read = 0;
if (fin==NULL)
@@ -211,13 +225,12 @@ int isLargeFile(const char* filename)
{
int largeFile = 0;
ZPOS64_T pos = 0;
- FILE* pFile = fopen64(filename, "rb");
+ FILE* pFile = FOPEN_FUNC(filename, "rb");
if(pFile != NULL)
{
- int n = fseeko64(pFile, 0, SEEK_END);
-
- pos = ftello64(pFile);
+ int n = FSEEKO_FUNC(pFile, 0, SEEK_END);
+ pos = FTELLO_FUNC(pFile);
printf("File : %s is %lld bytes\n", filename, pos);
@@ -447,7 +460,7 @@ int main(argc,argv)
printf("error in opening %s in zipfile\n",filenameinzip);
else
{
- fin = fopen64(filenameinzip,"rb");
+ fin = FOPEN_FUNC(filenameinzip,"rb");
if (fin==NULL)
{
err=ZIP_ERRNO;
diff --git a/compat/zlib/contrib/minizip/minizip.pc.in b/compat/zlib/contrib/minizip/minizip.pc.in
new file mode 100644
index 0000000..69b5b7f
--- /dev/null
+++ b/compat/zlib/contrib/minizip/minizip.pc.in
@@ -0,0 +1,12 @@
+prefix=@prefix@
+exec_prefix=@exec_prefix@
+libdir=@libdir@
+includedir=@includedir@/minizip
+
+Name: minizip
+Description: Minizip zip file manipulation library
+Requires:
+Version: @PACKAGE_VERSION@
+Libs: -L${libdir} -lminizip
+Libs.private: -lz
+Cflags: -I${includedir}
diff --git a/compat/zlib/contrib/minizip/mztools.c b/compat/zlib/contrib/minizip/mztools.c
index f9092e6..96891c2 100644
--- a/compat/zlib/contrib/minizip/mztools.c
+++ b/compat/zlib/contrib/minizip/mztools.c
@@ -42,7 +42,7 @@ uLong* bytesRecovered;
int entries = 0;
uLong totalBytes = 0;
char header[30];
- char filename[256];
+ char filename[1024];
char extra[1024];
int offset = 0;
int offsetCD = 0;
@@ -73,9 +73,14 @@ uLong* bytesRecovered;
/* Filename */
if (fnsize > 0) {
- if (fread(filename, 1, fnsize, fpZip) == fnsize) {
- if (fwrite(filename, 1, fnsize, fpOut) == fnsize) {
- offset += fnsize;
+ if (fnsize < sizeof(filename)) {
+ if (fread(filename, 1, fnsize, fpZip) == fnsize) {
+ if (fwrite(filename, 1, fnsize, fpOut) == fnsize) {
+ offset += fnsize;
+ } else {
+ err = Z_ERRNO;
+ break;
+ }
} else {
err = Z_ERRNO;
break;
@@ -91,9 +96,14 @@ uLong* bytesRecovered;
/* Extra field */
if (extsize > 0) {
- if (fread(extra, 1, extsize, fpZip) == extsize) {
- if (fwrite(extra, 1, extsize, fpOut) == extsize) {
- offset += extsize;
+ if (extsize < sizeof(extra)) {
+ if (fread(extra, 1, extsize, fpZip) == extsize) {
+ if (fwrite(extra, 1, extsize, fpOut) == extsize) {
+ offset += extsize;
+ } else {
+ err = Z_ERRNO;
+ break;
+ }
} else {
err = Z_ERRNO;
break;
diff --git a/compat/zlib/contrib/minizip/mztools.h b/compat/zlib/contrib/minizip/mztools.h
index 88b3459..a49a426 100644
--- a/compat/zlib/contrib/minizip/mztools.h
+++ b/compat/zlib/contrib/minizip/mztools.h
@@ -28,4 +28,10 @@ extern int ZEXPORT unzRepair(const char* file,
uLong* nRecovered,
uLong* bytesRecovered);
+
+#ifdef __cplusplus
+}
+#endif
+
+
#endif
diff --git a/compat/zlib/contrib/minizip/unzip.c b/compat/zlib/contrib/minizip/unzip.c
index 7617f41..affad4b 100644
--- a/compat/zlib/contrib/minizip/unzip.c
+++ b/compat/zlib/contrib/minizip/unzip.c
@@ -1040,26 +1040,26 @@ local int unz64local_GetCurrentFileInfoInternal (unzFile file,
{
uLong uL;
- if(file_info.uncompressed_size == (ZPOS64_T)(unsigned long)-1)
+ if(file_info.uncompressed_size == MAXU32)
{
if (unz64local_getLong64(&s->z_filefunc, s->filestream,&file_info.uncompressed_size) != UNZ_OK)
err=UNZ_ERRNO;
}
- if(file_info.compressed_size == (ZPOS64_T)(unsigned long)-1)
+ if(file_info.compressed_size == MAXU32)
{
if (unz64local_getLong64(&s->z_filefunc, s->filestream,&file_info.compressed_size) != UNZ_OK)
err=UNZ_ERRNO;
}
- if(file_info_internal.offset_curfile == (ZPOS64_T)(unsigned long)-1)
+ if(file_info_internal.offset_curfile == MAXU32)
{
/* Relative Header offset */
if (unz64local_getLong64(&s->z_filefunc, s->filestream,&file_info_internal.offset_curfile) != UNZ_OK)
err=UNZ_ERRNO;
}
- if(file_info.disk_num_start == (unsigned long)-1)
+ if(file_info.disk_num_start == MAXU32)
{
/* Disk Start Number */
if (unz64local_getLong(&s->z_filefunc, s->filestream,&uL) != UNZ_OK)
@@ -1145,7 +1145,7 @@ extern int ZEXPORT unzGetCurrentFileInfo (unzFile file,
szFileName,fileNameBufferSize,
extraField,extraFieldBufferSize,
szComment,commentBufferSize);
- if (err==UNZ_OK)
+ if ((err==UNZ_OK) && (pfile_info != NULL))
{
pfile_info->version = file_info64.version;
pfile_info->version_needed = file_info64.version_needed;
@@ -1696,7 +1696,7 @@ extern int ZEXPORT unzReadCurrentFile (unzFile file, voidp buf, unsigned len)
return UNZ_PARAMERROR;
- if ((pfile_in_zip_read_info->read_buffer == NULL))
+ if (pfile_in_zip_read_info->read_buffer == NULL)
return UNZ_END_OF_LIST_OF_FILE;
if (len==0)
return 0;
diff --git a/compat/zlib/contrib/minizip/zip.c b/compat/zlib/contrib/minizip/zip.c
index 3c34fc8..147934c 100644
--- a/compat/zlib/contrib/minizip/zip.c
+++ b/compat/zlib/contrib/minizip/zip.c
@@ -1067,6 +1067,7 @@ extern int ZEXPORT zipOpenNewFileInZip4_64 (zipFile file, const char* filename,
int err = ZIP_OK;
# ifdef NOCRYPT
+ (crcForCrypting);
if (password != NULL)
return ZIP_PARAMERROR;
# endif
@@ -1114,9 +1115,9 @@ extern int ZEXPORT zipOpenNewFileInZip4_64 (zipFile file, const char* filename,
zi->ci.flag = flagBase;
if ((level==8) || (level==9))
zi->ci.flag |= 2;
- if ((level==2))
+ if (level==2)
zi->ci.flag |= 4;
- if ((level==1))
+ if (level==1)
zi->ci.flag |= 6;
if (password != NULL)
zi->ci.flag |= 1;
@@ -1710,7 +1711,7 @@ extern int ZEXPORT zipCloseFileInZipRaw64 (zipFile file, ZPOS64_T uncompressed_s
if (err==ZIP_OK)
err = zip64local_putValue(&zi->z_filefunc,zi->filestream,crc32,4); /* crc 32, unknown */
- if(uncompressed_size >= 0xffffffff)
+ if(uncompressed_size >= 0xffffffff || compressed_size >= 0xffffffff )
{
if(zi->ci.pos_zip64extrainfo > 0)
{
@@ -1724,6 +1725,8 @@ extern int ZEXPORT zipCloseFileInZipRaw64 (zipFile file, ZPOS64_T uncompressed_s
if (err==ZIP_OK) /* uncompressed size, unknown */
err = zip64local_putValue(&zi->z_filefunc, zi->filestream, compressed_size, 8);
}
+ else
+ err = ZIP_BADZIPFILE; // Caller passed zip64 = 0, so no room for zip64 info -> fatal
}
else
{
@@ -1852,7 +1855,7 @@ int Write_EndOfCentralDirectoryRecord(zip64_internal* zi, uLong size_centraldir,
err = zip64local_putValue(&zi->z_filefunc,zi->filestream, (uLong)0xffffffff,4);
}
else
- err = zip64local_putValue(&zi->z_filefunc,zi->filestream, (uLong)(centraldir_pos_inzip - zi->add_position_when_writting_offset),4);
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream, (uLong)(centraldir_pos_inzip - zi->add_position_when_writting_offset),4);
}
return err;
@@ -1919,7 +1922,7 @@ extern int ZEXPORT zipClose (zipFile file, const char* global_comment)
free_linkedlist(&(zi->central_dir));
pos = centraldir_pos_inzip - zi->add_position_when_writting_offset;
- if(pos >= 0xffffffff)
+ if(pos >= 0xffffffff || zi->number_entry > 0xFFFF)
{
ZPOS64_T Zip64EOCDpos = ZTELL64(zi->z_filefunc,zi->filestream);
Write_Zip64EndOfCentralDirectoryRecord(zi, size_centraldir, centraldir_pos_inzip);
diff --git a/compat/zlib/contrib/pascal/zlibd32.mak b/compat/zlib/contrib/pascal/zlibd32.mak
index 0d0699a..9bb00b7 100644
--- a/compat/zlib/contrib/pascal/zlibd32.mak
+++ b/compat/zlib/contrib/pascal/zlibd32.mak
@@ -63,9 +63,9 @@ uncompr.obj: uncompr.c zlib.h zconf.h
zutil.obj: zutil.c zutil.h zlib.h zconf.h
-example.obj: example.c zlib.h zconf.h
+example.obj: test/example.c zlib.h zconf.h
-minigzip.obj: minigzip.c zlib.h zconf.h
+minigzip.obj: test/minigzip.c zlib.h zconf.h
# For the sake of the old Borland make,
diff --git a/compat/zlib/contrib/pascal/zlibpas.pas b/compat/zlib/contrib/pascal/zlibpas.pas
index 637ae3a..7abd862 100644
--- a/compat/zlib/contrib/pascal/zlibpas.pas
+++ b/compat/zlib/contrib/pascal/zlibpas.pas
@@ -10,7 +10,8 @@ unit zlibpas;
interface
const
- ZLIB_VERSION = '1.2.5';
+ ZLIB_VERSION = '1.2.7';
+ ZLIB_VERNUM = $1270;
type
alloc_func = function(opaque: Pointer; items, size: Integer): Pointer;
@@ -45,6 +46,23 @@ type
reserved: LongInt; (* reserved for future use *)
end;
+ gz_headerp = ^gz_header;
+ gz_header = packed record
+ text: Integer; (* true if compressed data believed to be text *)
+ time: LongInt; (* modification time *)
+ xflags: Integer; (* extra flags (not used when writing a gzip file) *)
+ os: Integer; (* operating system *)
+ extra: PChar; (* pointer to extra field or Z_NULL if none *)
+ extra_len: Integer; (* extra field length (valid if extra != Z_NULL) *)
+ extra_max: Integer; (* space at extra (only when reading header) *)
+ name: PChar; (* pointer to zero-terminated file name or Z_NULL *)
+ name_max: Integer; (* space at name (only when reading header) *)
+ comment: PChar; (* pointer to zero-terminated comment or Z_NULL *)
+ comm_max: Integer; (* space at comment (only when reading header) *)
+ hcrc: Integer; (* true if there was or will be a header crc *)
+ done: Integer; (* true when done reading gzip header *)
+ end;
+
(* constants *)
const
Z_NO_FLUSH = 0;
@@ -52,6 +70,8 @@ const
Z_SYNC_FLUSH = 2;
Z_FULL_FLUSH = 3;
Z_FINISH = 4;
+ Z_BLOCK = 5;
+ Z_TREES = 6;
Z_OK = 0;
Z_STREAM_END = 1;
@@ -71,9 +91,11 @@ const
Z_FILTERED = 1;
Z_HUFFMAN_ONLY = 2;
Z_RLE = 3;
+ Z_FIXED = 4;
Z_DEFAULT_STRATEGY = 0;
Z_BINARY = 0;
+ Z_TEXT = 1;
Z_ASCII = 1;
Z_UNKNOWN = 2;
@@ -96,14 +118,21 @@ function deflateSetDictionary(var strm: z_stream; const dictionary: PChar;
function deflateCopy(var dest, source: z_stream): Integer;
function deflateReset(var strm: z_stream): Integer;
function deflateParams(var strm: z_stream; level, strategy: Integer): Integer;
+function deflateTune(var strm: z_stream; good_length, max_lazy, nice_length, max_chain: Integer): Integer;
function deflateBound(var strm: z_stream; sourceLen: LongInt): LongInt;
+function deflatePending(var strm: z_stream; var pending: Integer; var bits: Integer): Integer;
function deflatePrime(var strm: z_stream; bits, value: Integer): Integer;
+function deflateSetHeader(var strm: z_stream; head: gz_header): Integer;
function inflateInit2(var strm: z_stream; windowBits: Integer): Integer;
function inflateSetDictionary(var strm: z_stream; const dictionary: PChar;
dictLength: Integer): Integer;
function inflateSync(var strm: z_stream): Integer;
function inflateCopy(var dest, source: z_stream): Integer;
function inflateReset(var strm: z_stream): Integer;
+function inflateReset2(var strm: z_stream; windowBits: Integer): Integer;
+function inflatePrime(var strm: z_stream; bits, value: Integer): Integer;
+function inflateMark(var strm: z_stream): LongInt;
+function inflateGetHeader(var strm: z_stream; var head: gz_header): Integer;
function inflateBackInit(var strm: z_stream;
windowBits: Integer; window: PChar): Integer;
function inflateBack(var strm: z_stream; in_fn: in_func; in_desc: Pointer;
@@ -123,7 +152,9 @@ function uncompress(dest: PChar; var destLen: LongInt;
(* checksum functions *)
function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt;
+function adler32_combine(adler1, adler2, len2: LongInt): LongInt;
function crc32(crc: LongInt; const buf: PChar; len: Integer): LongInt;
+function crc32_combine(crc1, crc2, len2: LongInt): LongInt;
(* various hacks, don't look :) *)
function deflateInit_(var strm: z_stream; level: Integer;
@@ -155,10 +186,12 @@ implementation
{$L zutil.obj}
function adler32; external;
+function adler32_combine; external;
function compress; external;
function compress2; external;
function compressBound; external;
function crc32; external;
+function crc32_combine; external;
function deflate; external;
function deflateBound; external;
function deflateCopy; external;
@@ -166,18 +199,25 @@ function deflateEnd; external;
function deflateInit_; external;
function deflateInit2_; external;
function deflateParams; external;
+function deflatePending; external;
function deflatePrime; external;
function deflateReset; external;
function deflateSetDictionary; external;
+function deflateSetHeader; external;
+function deflateTune; external;
function inflate; external;
function inflateBack; external;
function inflateBackEnd; external;
function inflateBackInit_; external;
function inflateCopy; external;
function inflateEnd; external;
+function inflateGetHeader; external;
function inflateInit_; external;
function inflateInit2_; external;
+function inflateMark; external;
+function inflatePrime; external;
function inflateReset; external;
+function inflateReset2; external;
function inflateSetDictionary; external;
function inflateSync; external;
function uncompress; external;
diff --git a/compat/zlib/contrib/puff/Makefile b/compat/zlib/contrib/puff/Makefile
index b6b6940..0e2594c 100644
--- a/compat/zlib/contrib/puff/Makefile
+++ b/compat/zlib/contrib/puff/Makefile
@@ -1,8 +1,42 @@
-puff: puff.c puff.h
- cc -DTEST -o puff puff.c
+CFLAGS=-O
+
+puff: puff.o pufftest.o
+
+puff.o: puff.h
+
+pufftest.o: puff.h
test: puff
puff zeros.raw
+puft: puff.c puff.h pufftest.o
+ cc -fprofile-arcs -ftest-coverage -o puft puff.c pufftest.o
+
+# puff full coverage test (should say 100%)
+cov: puft
+ @rm -f *.gcov *.gcda
+ @puft -w zeros.raw 2>&1 | cat > /dev/null
+ @echo '04' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2
+ @echo '00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2
+ @echo '00 00 00 00 00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 254
+ @echo '00 01 00 fe ff' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2
+ @echo '01 01 00 fe ff 0a' | xxd -r -p | puft -f 2>&1 | cat > /dev/null
+ @echo '02 7e ff ff' | xxd -r -p | puft 2> /dev/null || test $$? -eq 246
+ @echo '02' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2
+ @echo '04 80 49 92 24 49 92 24 0f b4 ff ff c3 04' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2
+ @echo '04 80 49 92 24 49 92 24 71 ff ff 93 11 00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 249
+ @echo '04 c0 81 08 00 00 00 00 20 7f eb 0b 00 00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 246
+ @echo '0b 00 00' | xxd -r -p | puft -f 2>&1 | cat > /dev/null
+ @echo '1a 07' | xxd -r -p | puft 2> /dev/null || test $$? -eq 246
+ @echo '0c c0 81 00 00 00 00 00 90 ff 6b 04' | xxd -r -p | puft 2> /dev/null || test $$? -eq 245
+ @puft -f zeros.raw 2>&1 | cat > /dev/null
+ @echo 'fc 00 00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 253
+ @echo '04 00 fe ff' | xxd -r -p | puft 2> /dev/null || test $$? -eq 252
+ @echo '04 00 24 49' | xxd -r -p | puft 2> /dev/null || test $$? -eq 251
+ @echo '04 80 49 92 24 49 92 24 0f b4 ff ff c3 84' | xxd -r -p | puft 2> /dev/null || test $$? -eq 248
+ @echo '04 00 24 e9 ff ff' | xxd -r -p | puft 2> /dev/null || test $$? -eq 250
+ @echo '04 00 24 e9 ff 6d' | xxd -r -p | puft 2> /dev/null || test $$? -eq 247
+ @gcov -n puff.c
+
clean:
- rm -f puff puff.o
+ rm -f puff puft *.o *.gc*
diff --git a/compat/zlib/contrib/puff/puff.c b/compat/zlib/contrib/puff/puff.c
index 650694e..df8470c 100644
--- a/compat/zlib/contrib/puff/puff.c
+++ b/compat/zlib/contrib/puff/puff.c
@@ -2,7 +2,7 @@
* puff.c
* Copyright (C) 2002-2010 Mark Adler
* For conditions of distribution and use, see copyright notice in puff.h
- * version 2.1, 4 Apr 2010
+ * version 2.2, 25 Apr 2010
*
* puff.c is a simple inflate written to be an unambiguous way to specify the
* deflate format. It is not written for speed but rather simplicity. As a
@@ -49,9 +49,9 @@
* - Fix fixed codes table error
* - Provide a scanning mode for determining size of
* uncompressed data
- * 1.3 20 Mar 2002 - Go back to lengths for puff() parameters [Jean-loup]
+ * 1.3 20 Mar 2002 - Go back to lengths for puff() parameters [Gailly]
* - Add a puff.h file for the interface
- * - Add braces in puff() for else do [Jean-loup]
+ * - Add braces in puff() for else do [Gailly]
* - Use indexes instead of pointers for readability
* 1.4 31 Mar 2002 - Simplify construct() code set check
* - Fix some comments
@@ -69,13 +69,19 @@
* - Allow TEST code to read from piped stdin
* 2.1 4 Apr 2010 - Avoid variable initialization for happier compilers
* - Avoid unsigned comparisons for even happier compilers
+ * 2.2 25 Apr 2010 - Fix bug in variable initializations [Oberhumer]
+ * - Add const where appropriate [Oberhumer]
+ * - Split if's and ?'s for coverage testing
+ * - Break out test code to separate file
+ * - Move NIL to puff.h
+ * - Allow incomplete code only if single code length is 1
+ * - Add full code coverage test to Makefile
*/
#include <setjmp.h> /* for setjmp(), longjmp(), and jmp_buf */
#include "puff.h" /* prototype for puff() */
#define local static /* for local function definitions */
-#define NIL ((unsigned char *)0) /* for no output option */
/*
* Maximums for allocations and loops. It is not useful to change these --
@@ -95,7 +101,7 @@ struct state {
unsigned long outcnt; /* bytes written to out so far */
/* input state */
- unsigned char *in; /* input buffer */
+ const unsigned char *in; /* input buffer */
unsigned long inlen; /* available input at in */
unsigned long incnt; /* bytes read so far */
int bitbuf; /* bit buffer */
@@ -123,7 +129,8 @@ local int bits(struct state *s, int need)
/* load at least need bits into val */
val = s->bitbuf;
while (s->bitcnt < need) {
- if (s->incnt == s->inlen) longjmp(s->env, 1); /* out of input */
+ if (s->incnt == s->inlen)
+ longjmp(s->env, 1); /* out of input */
val |= (long)(s->in[s->incnt++]) << s->bitcnt; /* load eight bits */
s->bitcnt += 8;
}
@@ -162,7 +169,8 @@ local int stored(struct state *s)
s->bitcnt = 0;
/* get length and check against its one's complement */
- if (s->incnt + 4 > s->inlen) return 2; /* not enough input */
+ if (s->incnt + 4 > s->inlen)
+ return 2; /* not enough input */
len = s->in[s->incnt++];
len |= s->in[s->incnt++] << 8;
if (s->in[s->incnt++] != (~len & 0xff) ||
@@ -170,7 +178,8 @@ local int stored(struct state *s)
return -2; /* didn't match complement! */
/* copy len bytes from in to out */
- if (s->incnt + len > s->inlen) return 2; /* not enough input */
+ if (s->incnt + len > s->inlen)
+ return 2; /* not enough input */
if (s->out != NIL) {
if (s->outcnt + len > s->outlen)
return 1; /* not enough output space */
@@ -222,7 +231,7 @@ struct huffman {
* in the deflate format. See the format notes for fixed() and dynamic().
*/
#ifdef SLOW
-local int decode(struct state *s, struct huffman *h)
+local int decode(struct state *s, const struct huffman *h)
{
int len; /* current number of bits in code */
int code; /* len bits being decoded */
@@ -250,7 +259,7 @@ local int decode(struct state *s, struct huffman *h)
* a few percent larger.
*/
#else /* !SLOW */
-local int decode(struct state *s, struct huffman *h)
+local int decode(struct state *s, const struct huffman *h)
{
int len; /* current number of bits in code */
int code; /* len bits being decoded */
@@ -283,10 +292,13 @@ local int decode(struct state *s, struct huffman *h)
len++;
}
left = (MAXBITS+1) - len;
- if (left == 0) break;
- if (s->incnt == s->inlen) longjmp(s->env, 1); /* out of input */
+ if (left == 0)
+ break;
+ if (s->incnt == s->inlen)
+ longjmp(s->env, 1); /* out of input */
bitbuf = s->in[s->incnt++];
- if (left > 8) left = 8;
+ if (left > 8)
+ left = 8;
}
return -10; /* ran out of codes */
}
@@ -324,7 +336,7 @@ local int decode(struct state *s, struct huffman *h)
* - Within a given code length, the symbols are kept in ascending order for
* the code bits definition.
*/
-local int construct(struct huffman *h, short *length, int n)
+local int construct(struct huffman *h, const short *length, int n)
{
int symbol; /* current symbol when stepping through length[] */
int len; /* current length when stepping through h->count[] */
@@ -344,7 +356,8 @@ local int construct(struct huffman *h, short *length, int n)
for (len = 1; len <= MAXBITS; len++) {
left <<= 1; /* one more bit, double codes left */
left -= h->count[len]; /* deduct count from possible codes */
- if (left < 0) return left; /* over-subscribed--return negative */
+ if (left < 0)
+ return left; /* over-subscribed--return negative */
} /* left > 0 means incomplete */
/* generate offsets into symbol table for each length for sorting */
@@ -420,8 +433,8 @@ local int construct(struct huffman *h, short *length, int n)
* defined to do the wrong thing in this case.
*/
local int codes(struct state *s,
- struct huffman *lencode,
- struct huffman *distcode)
+ const struct huffman *lencode,
+ const struct huffman *distcode)
{
int symbol; /* decoded symbol */
int len; /* length for copy */
@@ -444,11 +457,13 @@ local int codes(struct state *s,
/* decode literals and length/distance pairs */
do {
symbol = decode(s, lencode);
- if (symbol < 0) return symbol; /* invalid symbol */
+ if (symbol < 0)
+ return symbol; /* invalid symbol */
if (symbol < 256) { /* literal: symbol is the byte */
/* write out the literal */
if (s->out != NIL) {
- if (s->outcnt == s->outlen) return 1;
+ if (s->outcnt == s->outlen)
+ return 1;
s->out[s->outcnt] = symbol;
}
s->outcnt++;
@@ -456,12 +471,14 @@ local int codes(struct state *s,
else if (symbol > 256) { /* length */
/* get and compute length */
symbol -= 257;
- if (symbol >= 29) return -10; /* invalid fixed code */
+ if (symbol >= 29)
+ return -10; /* invalid fixed code */
len = lens[symbol] + bits(s, lext[symbol]);
/* get and check distance */
symbol = decode(s, distcode);
- if (symbol < 0) return symbol; /* invalid symbol */
+ if (symbol < 0)
+ return symbol; /* invalid symbol */
dist = dists[symbol] + bits(s, dext[symbol]);
#ifndef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
if (dist > s->outcnt)
@@ -470,13 +487,15 @@ local int codes(struct state *s,
/* copy length bytes from distance bytes back */
if (s->out != NIL) {
- if (s->outcnt + len > s->outlen) return 1;
+ if (s->outcnt + len > s->outlen)
+ return 1;
while (len--) {
s->out[s->outcnt] =
#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
- dist > s->outcnt ? 0 :
+ dist > s->outcnt ?
+ 0 :
#endif
- s->out[s->outcnt - dist];
+ s->out[s->outcnt - dist];
s->outcnt++;
}
}
@@ -525,6 +544,12 @@ local int fixed(struct state *s)
int symbol;
short lengths[FIXLCODES];
+ /* construct lencode and distcode */
+ lencode.count = lencnt;
+ lencode.symbol = lensym;
+ distcode.count = distcnt;
+ distcode.symbol = distsym;
+
/* literal/length table */
for (symbol = 0; symbol < 144; symbol++)
lengths[symbol] = 8;
@@ -541,12 +566,6 @@ local int fixed(struct state *s)
lengths[symbol] = 5;
construct(&distcode, lengths, MAXDCODES);
- /* construct lencode and distcode */
- lencode.count = lencnt;
- lencode.symbol = lensym;
- distcode.count = distcnt;
- distcode.symbol = distsym;
-
/* do this just once */
virgin = 0;
}
@@ -675,7 +694,8 @@ local int dynamic(struct state *s)
/* build huffman table for code lengths codes (use lencode temporarily) */
err = construct(&lencode, lengths, 19);
- if (err != 0) return -4; /* require complete code set here */
+ if (err != 0) /* require complete code set here */
+ return -4;
/* read length/literal and distance code length tables */
index = 0;
@@ -689,7 +709,8 @@ local int dynamic(struct state *s)
else { /* repeat instruction */
len = 0; /* assume repeating zeros */
if (symbol == 16) { /* repeat last length 3..6 times */
- if (index == 0) return -5; /* no last length! */
+ if (index == 0)
+ return -5; /* no last length! */
len = lengths[index - 1]; /* last length */
symbol = 3 + bits(s, 2);
}
@@ -710,13 +731,13 @@ local int dynamic(struct state *s)
/* build huffman table for literal/length codes */
err = construct(&lencode, lengths, nlen);
- if (err < 0 || (err > 0 && nlen - lencode.count[0] != 1))
- return -7; /* only allow incomplete codes if just one code */
+ if (err && (err < 0 || nlen != lencode.count[0] + lencode.count[1]))
+ return -7; /* incomplete code ok only for single length 1 code */
/* build huffman table for distance codes */
err = construct(&distcode, lengths + nlen, ndist);
- if (err < 0 || (err > 0 && ndist - distcode.count[0] != 1))
- return -8; /* only allow incomplete codes if just one code */
+ if (err && (err < 0 || ndist != distcode.count[0] + distcode.count[1]))
+ return -8; /* incomplete code ok only for single length 1 code */
/* decode data until end-of-block code */
return codes(s, &lencode, &distcode);
@@ -768,7 +789,7 @@ local int dynamic(struct state *s)
*/
int puff(unsigned char *dest, /* pointer to destination pointer */
unsigned long *destlen, /* amount of output space */
- unsigned char *source, /* pointer to source data pointer */
+ const unsigned char *source, /* pointer to source data pointer */
unsigned long *sourcelen) /* amount of input available */
{
struct state s; /* input/output state */
@@ -795,11 +816,15 @@ int puff(unsigned char *dest, /* pointer to destination pointer */
do {
last = bits(&s, 1); /* one if last block */
type = bits(&s, 2); /* block type 0..3 */
- err = type == 0 ? stored(&s) :
- (type == 1 ? fixed(&s) :
- (type == 2 ? dynamic(&s) :
- -1)); /* type == 3, invalid */
- if (err != 0) break; /* return with error */
+ err = type == 0 ?
+ stored(&s) :
+ (type == 1 ?
+ fixed(&s) :
+ (type == 2 ?
+ dynamic(&s) :
+ -1)); /* type == 3, invalid */
+ if (err != 0)
+ break; /* return with error */
} while (!last);
}
@@ -810,146 +835,3 @@ int puff(unsigned char *dest, /* pointer to destination pointer */
}
return err;
}
-
-#ifdef TEST
-/* Examples of how to use puff().
-
- Usage: puff [-w] [-nnn] file
- ... | puff [-w] [-nnn]
-
- where file is the input file with deflate data, nnn is the number of bytes
- of input to skip before inflating (e.g. to skip a zlib or gzip header), and
- -w is used to write the decompressed data to stdout */
-
-#include <stdio.h>
-#include <stdlib.h>
-
-/* Return size times approximately the cube root of 2, keeping the result as 1,
- 3, or 5 times a power of 2 -- the result is always > size, until the result
- is the maximum value of an unsigned long, where it remains. This is useful
- to keep reallocations less than ~33% over the actual data. */
-local size_t bythirds(size_t size)
-{
- int n;
- size_t m;
-
- m = size;
- for (n = 0; m; n++)
- m >>= 1;
- if (n < 3)
- return size + 1;
- n -= 3;
- m = size >> n;
- m += m == 6 ? 2 : 1;
- m <<= n;
- return m > size ? m : (size_t)(-1);
-}
-
-/* Read the input file *name, or stdin if name is NULL, into allocated memory.
- Reallocate to larger buffers until the entire file is read in. Return a
- pointer to the allocated data, or NULL if there was a memory allocation
- failure. *len is the number of bytes of data read from the input file (even
- if load() returns NULL). If the input file was empty or could not be opened
- or read, *len is zero. */
-local void *load(char *name, size_t *len)
-{
- size_t size;
- void *buf, *swap;
- FILE *in;
-
- *len = 0;
- buf = malloc(size = 4096);
- if (buf == NULL)
- return NULL;
- in = name == NULL ? stdin : fopen(name, "rb");
- if (in != NULL) {
- for (;;) {
- *len += fread((char *)buf + *len, 1, size - *len, in);
- if (*len < size) break;
- size = bythirds(size);
- if (size == *len || (swap = realloc(buf, size)) == NULL) {
- free(buf);
- buf = NULL;
- break;
- }
- buf = swap;
- }
- fclose(in);
- }
- return buf;
-}
-
-int main(int argc, char **argv)
-{
- int ret, put = 0;
- unsigned skip = 0;
- char *arg, *name = NULL;
- unsigned char *source = NULL, *dest;
- size_t len = 0;
- unsigned long sourcelen, destlen;
-
- /* process arguments */
- while (arg = *++argv, --argc)
- if (arg[0] == '-') {
- if (arg[1] == 'w' && arg[2] == 0)
- put = 1;
- else if (arg[1] >= '0' && arg[1] <= '9')
- skip = (unsigned)atoi(arg + 1);
- else {
- fprintf(stderr, "invalid option %s\n", arg);
- return 3;
- }
- }
- else if (name != NULL) {
- fprintf(stderr, "only one file name allowed\n");
- return 3;
- }
- else
- name = arg;
- source = load(name, &len);
- if (source == NULL) {
- fprintf(stderr, "memory allocation failure\n");
- return 4;
- }
- if (len == 0) {
- fprintf(stderr, "could not read %s, or it was empty\n",
- name == NULL ? "<stdin>" : name);
- free(source);
- return 3;
- }
- if (skip >= len) {
- fprintf(stderr, "skip request of %d leaves no input\n", skip);
- free(source);
- return 3;
- }
-
- /* test inflate data with offset skip */
- len -= skip;
- sourcelen = (unsigned long)len;
- ret = puff(NIL, &destlen, source + skip, &sourcelen);
- if (ret)
- fprintf(stderr, "puff() failed with return code %d\n", ret);
- else {
- fprintf(stderr, "puff() succeeded uncompressing %lu bytes\n", destlen);
- if (sourcelen < len) fprintf(stderr, "%lu compressed bytes unused\n",
- len - sourcelen);
- }
-
- /* if requested, inflate again and write decompressd data to stdout */
- if (put) {
- dest = malloc(destlen);
- if (dest == NULL) {
- fprintf(stderr, "memory allocation failure\n");
- free(source);
- return 4;
- }
- puff(dest, &destlen, source + skip, &sourcelen);
- fwrite(dest, 1, destlen, stdout);
- free(dest);
- }
-
- /* clean up */
- free(source);
- return ret;
-}
-#endif
diff --git a/compat/zlib/contrib/puff/puff.h b/compat/zlib/contrib/puff/puff.h
index 88d1b38..6a0080a 100644
--- a/compat/zlib/contrib/puff/puff.h
+++ b/compat/zlib/contrib/puff/puff.h
@@ -1,6 +1,6 @@
/* puff.h
Copyright (C) 2002-2010 Mark Adler, all rights reserved
- version 2.1, 4 Apr 2010
+ version 2.2, 25 Apr 2010
This software is provided 'as-is', without any express or implied
warranty. In no event will the author be held liable for any damages
@@ -25,7 +25,11 @@
/*
* See puff.c for purpose and usage.
*/
+#ifndef NIL
+# define NIL ((unsigned char *)0) /* for no output option */
+#endif
+
int puff(unsigned char *dest, /* pointer to destination pointer */
unsigned long *destlen, /* amount of output space */
- unsigned char *source, /* pointer to source data pointer */
+ const unsigned char *source, /* pointer to source data pointer */
unsigned long *sourcelen); /* amount of input available */
diff --git a/compat/zlib/contrib/puff/pufftest.c b/compat/zlib/contrib/puff/pufftest.c
new file mode 100644
index 0000000..76e35f6
--- /dev/null
+++ b/compat/zlib/contrib/puff/pufftest.c
@@ -0,0 +1,165 @@
+/*
+ * pufftest.c
+ * Copyright (C) 2002-2010 Mark Adler
+ * For conditions of distribution and use, see copyright notice in puff.h
+ * version 2.2, 25 Apr 2010
+ */
+
+/* Example of how to use puff().
+
+ Usage: puff [-w] [-f] [-nnn] file
+ ... | puff [-w] [-f] [-nnn]
+
+ where file is the input file with deflate data, nnn is the number of bytes
+ of input to skip before inflating (e.g. to skip a zlib or gzip header), and
+ -w is used to write the decompressed data to stdout. -f is for coverage
+ testing, and causes pufftest to fail with not enough output space (-f does
+ a write like -w, so -w is not required). */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "puff.h"
+
+#if defined(MSDOS) || defined(OS2) || defined(WIN32) || defined(__CYGWIN__)
+# include <fcntl.h>
+# include <io.h>
+# define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY)
+#else
+# define SET_BINARY_MODE(file)
+#endif
+
+#define local static
+
+/* Return size times approximately the cube root of 2, keeping the result as 1,
+ 3, or 5 times a power of 2 -- the result is always > size, until the result
+ is the maximum value of an unsigned long, where it remains. This is useful
+ to keep reallocations less than ~33% over the actual data. */
+local size_t bythirds(size_t size)
+{
+ int n;
+ size_t m;
+
+ m = size;
+ for (n = 0; m; n++)
+ m >>= 1;
+ if (n < 3)
+ return size + 1;
+ n -= 3;
+ m = size >> n;
+ m += m == 6 ? 2 : 1;
+ m <<= n;
+ return m > size ? m : (size_t)(-1);
+}
+
+/* Read the input file *name, or stdin if name is NULL, into allocated memory.
+ Reallocate to larger buffers until the entire file is read in. Return a
+ pointer to the allocated data, or NULL if there was a memory allocation
+ failure. *len is the number of bytes of data read from the input file (even
+ if load() returns NULL). If the input file was empty or could not be opened
+ or read, *len is zero. */
+local void *load(const char *name, size_t *len)
+{
+ size_t size;
+ void *buf, *swap;
+ FILE *in;
+
+ *len = 0;
+ buf = malloc(size = 4096);
+ if (buf == NULL)
+ return NULL;
+ in = name == NULL ? stdin : fopen(name, "rb");
+ if (in != NULL) {
+ for (;;) {
+ *len += fread((char *)buf + *len, 1, size - *len, in);
+ if (*len < size) break;
+ size = bythirds(size);
+ if (size == *len || (swap = realloc(buf, size)) == NULL) {
+ free(buf);
+ buf = NULL;
+ break;
+ }
+ buf = swap;
+ }
+ fclose(in);
+ }
+ return buf;
+}
+
+int main(int argc, char **argv)
+{
+ int ret, put = 0, fail = 0;
+ unsigned skip = 0;
+ char *arg, *name = NULL;
+ unsigned char *source = NULL, *dest;
+ size_t len = 0;
+ unsigned long sourcelen, destlen;
+
+ /* process arguments */
+ while (arg = *++argv, --argc)
+ if (arg[0] == '-') {
+ if (arg[1] == 'w' && arg[2] == 0)
+ put = 1;
+ else if (arg[1] == 'f' && arg[2] == 0)
+ fail = 1, put = 1;
+ else if (arg[1] >= '0' && arg[1] <= '9')
+ skip = (unsigned)atoi(arg + 1);
+ else {
+ fprintf(stderr, "invalid option %s\n", arg);
+ return 3;
+ }
+ }
+ else if (name != NULL) {
+ fprintf(stderr, "only one file name allowed\n");
+ return 3;
+ }
+ else
+ name = arg;
+ source = load(name, &len);
+ if (source == NULL) {
+ fprintf(stderr, "memory allocation failure\n");
+ return 4;
+ }
+ if (len == 0) {
+ fprintf(stderr, "could not read %s, or it was empty\n",
+ name == NULL ? "<stdin>" : name);
+ free(source);
+ return 3;
+ }
+ if (skip >= len) {
+ fprintf(stderr, "skip request of %d leaves no input\n", skip);
+ free(source);
+ return 3;
+ }
+
+ /* test inflate data with offset skip */
+ len -= skip;
+ sourcelen = (unsigned long)len;
+ ret = puff(NIL, &destlen, source + skip, &sourcelen);
+ if (ret)
+ fprintf(stderr, "puff() failed with return code %d\n", ret);
+ else {
+ fprintf(stderr, "puff() succeeded uncompressing %lu bytes\n", destlen);
+ if (sourcelen < len) fprintf(stderr, "%lu compressed bytes unused\n",
+ len - sourcelen);
+ }
+
+ /* if requested, inflate again and write decompressd data to stdout */
+ if (put && ret == 0) {
+ if (fail)
+ destlen >>= 1;
+ dest = malloc(destlen);
+ if (dest == NULL) {
+ fprintf(stderr, "memory allocation failure\n");
+ free(source);
+ return 4;
+ }
+ puff(dest, &destlen, source + skip, &sourcelen);
+ SET_BINARY_MODE(stdout);
+ fwrite(dest, 1, destlen, stdout);
+ free(dest);
+ }
+
+ /* clean up */
+ free(source);
+ return ret;
+}
diff --git a/compat/zlib/contrib/puff/zeros.raw b/compat/zlib/contrib/puff/zeros.raw
index 637b7be..0a90e76 100644
--- a/compat/zlib/contrib/puff/zeros.raw
+++ b/compat/zlib/contrib/puff/zeros.raw
Binary files differ
diff --git a/compat/zlib/contrib/vstudio/readme.txt b/compat/zlib/contrib/vstudio/readme.txt
index 904888b..59c8b8b 100644
--- a/compat/zlib/contrib/vstudio/readme.txt
+++ b/compat/zlib/contrib/vstudio/readme.txt
@@ -1,8 +1,8 @@
-Building instructions for the DLL versions of Zlib 1.2.4
+Building instructions for the DLL versions of Zlib 1.2.7
========================================================
This directory contains projects that build zlib and minizip using
-Microsoft Visual C++ 9.0/10.0, and Visual C++ .
+Microsoft Visual C++ 9.0/10.0.
You don't need to build these projects yourself. You can download the
binaries from:
@@ -10,9 +10,6 @@ binaries from:
More information can be found at this site.
-first compile assembly code by running
-bld_ml64.bat in contrib\masmx64
-bld_ml32.bat in contrib\masmx86
@@ -20,13 +17,16 @@ bld_ml32.bat in contrib\masmx86
Build instructions for Visual Studio 2008 (32 bits or 64 bits)
--------------------------------------------------------------
- Uncompress current zlib, including all contrib/* files
-- Open contrib\vstudio\vc9\zlibvc.sln with Microsoft Visual C++ 2008.0
+- Compile assembly code (with Visual Studio Command Prompt) by running:
+ bld_ml64.bat (in contrib\masmx64)
+ bld_ml32.bat (in contrib\masmx86)
+- Open contrib\vstudio\vc9\zlibvc.sln with Microsoft Visual C++ 2008
- Or run: vcbuild /rebuild contrib\vstudio\vc9\zlibvc.sln "Release|Win32"
Build instructions for Visual Studio 2010 (32 bits or 64 bits)
--------------------------------------------------------------
- Uncompress current zlib, including all contrib/* files
-- Open contrib\vstudio\vc10\zlibvc.sln with Microsoft Visual C++ 2010.0
+- Open contrib\vstudio\vc10\zlibvc.sln with Microsoft Visual C++ 2010
Important
diff --git a/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj b/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj
index 2d62815..bcb08ff 100644
--- a/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj
+++ b/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj
@@ -139,7 +139,7 @@
</ClCompile>
<Link>
<AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
- <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
<GenerateDebugInformation>true</GenerateDebugInformation>
<ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
<SubSystem>Console</SubSystem>
@@ -169,7 +169,7 @@
</ClCompile>
<Link>
<AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
- <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
<GenerateDebugInformation>true</GenerateDebugInformation>
<SubSystem>Console</SubSystem>
<OptimizeReferences>true</OptimizeReferences>
@@ -200,7 +200,7 @@
</ClCompile>
<Link>
<AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
- <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
<GenerateDebugInformation>true</GenerateDebugInformation>
<ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
<SubSystem>Console</SubSystem>
@@ -227,7 +227,7 @@
</ClCompile>
<Link>
<AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
- <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
<GenerateDebugInformation>true</GenerateDebugInformation>
<ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
<SubSystem>Console</SubSystem>
@@ -257,7 +257,7 @@
</ClCompile>
<Link>
<AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
- <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
<GenerateDebugInformation>true</GenerateDebugInformation>
<SubSystem>Console</SubSystem>
<OptimizeReferences>true</OptimizeReferences>
@@ -288,7 +288,7 @@
</ClCompile>
<Link>
<AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
- <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
<GenerateDebugInformation>true</GenerateDebugInformation>
<SubSystem>Console</SubSystem>
<OptimizeReferences>true</OptimizeReferences>
diff --git a/compat/zlib/contrib/vstudio/vc10/zlib.rc b/compat/zlib/contrib/vstudio/vc10/zlib.rc
index f822450..8eca4db 100644
--- a/compat/zlib/contrib/vstudio/vc10/zlib.rc
+++ b/compat/zlib/contrib/vstudio/vc10/zlib.rc
@@ -2,8 +2,8 @@
#define IDR_VERSION1 1
IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE
- FILEVERSION 1,2,5,0
- PRODUCTVERSION 1,2,5,0
+ FILEVERSION 1.2.7,0
+ PRODUCTVERSION 1.2.7,0
FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
FILEFLAGS 0
FILEOS VOS_DOS_WINDOWS32
@@ -17,12 +17,12 @@ BEGIN
BEGIN
VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0"
- VALUE "FileVersion", "1.2.5\0"
+ VALUE "FileVersion", "1.2.7\0"
VALUE "InternalName", "zlib\0"
VALUE "OriginalFilename", "zlib.dll\0"
VALUE "ProductName", "ZLib.DLL\0"
VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
- VALUE "LegalCopyright", "(C) 1995-2010 Jean-loup Gailly & Mark Adler\0"
+ VALUE "LegalCopyright", "(C) 1995-2012 Jean-loup Gailly & Mark Adler\0"
END
END
BLOCK "VarFileInfo"
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibvc.def b/compat/zlib/contrib/vstudio/vc10/zlibvc.def
index 0269ef7..18ddf50 100644
--- a/compat/zlib/contrib/vstudio/vc10/zlibvc.def
+++ b/compat/zlib/contrib/vstudio/vc10/zlibvc.def
@@ -1,7 +1,7 @@
LIBRARY
; zlib data compression and ZIP file I/O library
-VERSION 1.24
+VERSION 1.2.7
EXPORTS
adler32 @1
@@ -55,6 +55,7 @@ EXPORTS
gzungetc @49
zlibCompileFlags @50
deflatePrime @51
+ deflatePending @52
unzOpen @61
unzClose @62
@@ -128,3 +129,11 @@ EXPORTS
inflatePrime @158
inflateReset2 @159
inflateUndermine @160
+
+; zlib1 v1.2.6 added:
+ gzgetc_ @161
+ inflateResetKeep @163
+ deflateResetKeep @164
+
+; zlib1 v1.2.7 added:
+ gzopen_w @165
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj b/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj
index 9862398..9218fdc 100644
--- a/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj
+++ b/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj
@@ -180,6 +180,12 @@
<CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
<CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
<CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|x64'">zlibwapi</TargetName>
</PropertyGroup>
<ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
<Midl>
@@ -227,6 +233,10 @@
</DataExecutionPrevention>
<ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
</Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx86
+bld_ml32.bat</Command>
+ </PreBuildEvent>
</ItemDefinitionGroup>
<ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
<Midl>
@@ -324,6 +334,10 @@
</DataExecutionPrevention>
<ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
</Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx86
+bld_ml32.bat</Command>
+ </PreBuildEvent>
</ItemDefinitionGroup>
<ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
<Midl>
@@ -368,6 +382,10 @@
<ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
<TargetMachine>MachineX64</TargetMachine>
</Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\contrib\masmx64
+bld_ml64.bat</Command>
+ </PreBuildEvent>
</ItemDefinitionGroup>
<ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
<Midl>
@@ -547,6 +565,10 @@
<ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
<TargetMachine>MachineX64</TargetMachine>
</Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx64
+bld_ml64.bat</Command>
+ </PreBuildEvent>
</ItemDefinitionGroup>
<ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
<Midl>
diff --git a/compat/zlib/contrib/vstudio/vc7/miniunz.vcproj b/compat/zlib/contrib/vstudio/vc7/miniunz.vcproj
deleted file mode 100644
index ad5117c..0000000
--- a/compat/zlib/contrib/vstudio/vc7/miniunz.vcproj
+++ /dev/null
@@ -1,126 +0,0 @@
-<?xml version="1.0" encoding = "Windows-1252"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="7.00"
- Name="miniunz"
- ProjectGUID="{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
- Keyword="Win32Proj">
- <Platforms>
- <Platform
- Name="Win32"/>
- </Platforms>
- <Configurations>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory="Debug"
- IntermediateDirectory="Debug"
- ConfigurationType="1"
- CharacterSet="2">
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE"
- MinimalRebuild="TRUE"
- BasicRuntimeChecks="3"
- RuntimeLibrary="5"
- UsePrecompiledHeader="0"
- WarningLevel="3"
- Detect64BitPortabilityProblems="TRUE"
- DebugInformationFormat="4"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)/miniunz.exe"
- LinkIncremental="2"
- GenerateDebugInformation="TRUE"
- ProgramDatabaseFile="$(OutDir)/miniunz.pdb"
- SubSystem="1"
- TargetMachine="1"/>
- <Tool
- Name="VCMIDLTool"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- </Configuration>
- <Configuration
- Name="Release|Win32"
- OutputDirectory="Release"
- IntermediateDirectory="Release"
- ConfigurationType="1"
- CharacterSet="2">
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="TRUE"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE"
- StringPooling="TRUE"
- RuntimeLibrary="4"
- EnableFunctionLevelLinking="TRUE"
- UsePrecompiledHeader="0"
- WarningLevel="3"
- Detect64BitPortabilityProblems="TRUE"
- DebugInformationFormat="3"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)/miniunz.exe"
- LinkIncremental="1"
- GenerateDebugInformation="TRUE"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="1"/>
- <Tool
- Name="VCMIDLTool"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- </Configuration>
- </Configurations>
- <Files>
- <Filter
- Name="Source Files"
- Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm">
- <File
- RelativePath="..\..\minizip\miniunz.c">
- </File>
- </Filter>
- <Filter
- Name="Header Files"
- Filter="h;hpp;hxx;hm;inl;inc">
- </Filter>
- <Filter
- Name="Resource Files"
- Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe">
- </Filter>
- <File
- RelativePath="ReleaseDll\zlibwapi.lib">
- </File>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
diff --git a/compat/zlib/contrib/vstudio/vc7/minizip.vcproj b/compat/zlib/contrib/vstudio/vc7/minizip.vcproj
deleted file mode 100644
index fb5b632..0000000
--- a/compat/zlib/contrib/vstudio/vc7/minizip.vcproj
+++ /dev/null
@@ -1,126 +0,0 @@
-<?xml version="1.0" encoding = "Windows-1252"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="7.00"
- Name="minizip"
- ProjectGUID="{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
- Keyword="Win32Proj">
- <Platforms>
- <Platform
- Name="Win32"/>
- </Platforms>
- <Configurations>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory="Debug"
- IntermediateDirectory="Debug"
- ConfigurationType="1"
- CharacterSet="2">
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE"
- MinimalRebuild="TRUE"
- BasicRuntimeChecks="3"
- RuntimeLibrary="5"
- UsePrecompiledHeader="0"
- WarningLevel="3"
- Detect64BitPortabilityProblems="TRUE"
- DebugInformationFormat="4"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)/minizip.exe"
- LinkIncremental="2"
- GenerateDebugInformation="TRUE"
- ProgramDatabaseFile="$(OutDir)/minizip.pdb"
- SubSystem="1"
- TargetMachine="1"/>
- <Tool
- Name="VCMIDLTool"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- </Configuration>
- <Configuration
- Name="Release|Win32"
- OutputDirectory="Release"
- IntermediateDirectory="Release"
- ConfigurationType="1"
- CharacterSet="2">
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="TRUE"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE"
- StringPooling="TRUE"
- RuntimeLibrary="4"
- EnableFunctionLevelLinking="TRUE"
- UsePrecompiledHeader="0"
- WarningLevel="3"
- Detect64BitPortabilityProblems="TRUE"
- DebugInformationFormat="3"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)/minizip.exe"
- LinkIncremental="1"
- GenerateDebugInformation="TRUE"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="1"/>
- <Tool
- Name="VCMIDLTool"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- </Configuration>
- </Configurations>
- <Files>
- <Filter
- Name="Source Files"
- Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm">
- <File
- RelativePath="..\..\minizip\minizip.c">
- </File>
- </Filter>
- <Filter
- Name="Header Files"
- Filter="h;hpp;hxx;hm;inl;inc">
- </Filter>
- <Filter
- Name="Resource Files"
- Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe">
- </Filter>
- <File
- RelativePath="ReleaseDll\zlibwapi.lib">
- </File>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
diff --git a/compat/zlib/contrib/vstudio/vc7/testzlib.vcproj b/compat/zlib/contrib/vstudio/vc7/testzlib.vcproj
deleted file mode 100644
index 97bc3e8..0000000
--- a/compat/zlib/contrib/vstudio/vc7/testzlib.vcproj
+++ /dev/null
@@ -1,126 +0,0 @@
-<?xml version="1.0" encoding = "Windows-1252"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="7.00"
- Name="testZlibDll"
- ProjectGUID="{AA6666AA-E09F-4135-9C0C-4FE50C3C654C}"
- Keyword="Win32Proj">
- <Platforms>
- <Platform
- Name="Win32"/>
- </Platforms>
- <Configurations>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory="Debug"
- IntermediateDirectory="Debug"
- ConfigurationType="1"
- CharacterSet="2">
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\.."
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE"
- MinimalRebuild="TRUE"
- BasicRuntimeChecks="3"
- RuntimeLibrary="5"
- UsePrecompiledHeader="0"
- WarningLevel="3"
- Detect64BitPortabilityProblems="TRUE"
- DebugInformationFormat="4"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="2"
- GenerateDebugInformation="TRUE"
- ProgramDatabaseFile="$(OutDir)/testzlib.pdb"
- SubSystem="1"
- TargetMachine="1"/>
- <Tool
- Name="VCMIDLTool"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- </Configuration>
- <Configuration
- Name="Release|Win32"
- OutputDirectory="Release"
- IntermediateDirectory="Release"
- ConfigurationType="1"
- CharacterSet="2">
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="TRUE"
- AdditionalIncludeDirectories="..\..\.."
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE"
- StringPooling="TRUE"
- RuntimeLibrary="4"
- EnableFunctionLevelLinking="TRUE"
- UsePrecompiledHeader="0"
- WarningLevel="3"
- Detect64BitPortabilityProblems="TRUE"
- DebugInformationFormat="3"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="1"
- GenerateDebugInformation="TRUE"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="1"/>
- <Tool
- Name="VCMIDLTool"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- </Configuration>
- </Configurations>
- <Files>
- <Filter
- Name="Source Files"
- Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm">
- <File
- RelativePath="..\..\testzlib\testzlib.c">
- </File>
- </Filter>
- <Filter
- Name="Header Files"
- Filter="h;hpp;hxx;hm;inl;inc">
- </Filter>
- <Filter
- Name="Resource Files"
- Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe">
- </Filter>
- <File
- RelativePath="ReleaseDll\zlibwapi.lib">
- </File>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
diff --git a/compat/zlib/contrib/vstudio/vc7/zlib.rc b/compat/zlib/contrib/vstudio/vc7/zlib.rc
deleted file mode 100644
index 72cb8b4..0000000
--- a/compat/zlib/contrib/vstudio/vc7/zlib.rc
+++ /dev/null
@@ -1,32 +0,0 @@
-#include <windows.h>
-
-#define IDR_VERSION1 1
-IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE
- FILEVERSION 1,2,3,0
- PRODUCTVERSION 1,2,3,0
- FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
- FILEFLAGS 0
- FILEOS VOS_DOS_WINDOWS32
- FILETYPE VFT_DLL
- FILESUBTYPE 0 // not used
-BEGIN
- BLOCK "StringFileInfo"
- BEGIN
- BLOCK "040904E4"
- //language ID = U.S. English, char set = Windows, Multilingual
-
- BEGIN
- VALUE "FileDescription", "zlib data compression library\0"
- VALUE "FileVersion", "1.2.3.0\0"
- VALUE "InternalName", "zlib\0"
- VALUE "OriginalFilename", "zlib.dll\0"
- VALUE "ProductName", "ZLib.DLL\0"
- VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
- VALUE "LegalCopyright", "(C) 1995-2003 Jean-loup Gailly & Mark Adler\0"
- END
- END
- BLOCK "VarFileInfo"
- BEGIN
- VALUE "Translation", 0x0409, 1252
- END
-END
diff --git a/compat/zlib/contrib/vstudio/vc7/zlibstat.vcproj b/compat/zlib/contrib/vstudio/vc7/zlibstat.vcproj
deleted file mode 100644
index 766d7a4..0000000
--- a/compat/zlib/contrib/vstudio/vc7/zlibstat.vcproj
+++ /dev/null
@@ -1,246 +0,0 @@
-<?xml version="1.0" encoding = "Windows-1252"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="7.00"
- Name="zlibstat"
- SccProjectName=""
- SccLocalPath="">
- <Platforms>
- <Platform
- Name="Win32"/>
- </Platforms>
- <Configurations>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory=".\zlibstatDebug"
- IntermediateDirectory=".\zlibstatDebug"
- ConfigurationType="4"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE">
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI"
- ExceptionHandling="FALSE"
- RuntimeLibrary="5"
- PrecompiledHeaderFile=".\zlibstatDebug/zlibstat.pch"
- AssemblerListingLocation=".\zlibstatDebug/"
- ObjectFile=".\zlibstatDebug/"
- ProgramDataBaseFileName=".\zlibstatDebug/"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"
- DebugInformationFormat="1"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions="/NODEFAULTLIB "
- OutputFile=".\zlibstatDebug\zlibstat.lib"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCMIDLTool"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"
- Culture="1036"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- </Configuration>
- <Configuration
- Name="ReleaseAxp|Win32"
- OutputDirectory=".\zlibsta0"
- IntermediateDirectory=".\zlibsta0"
- ConfigurationType="4"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE">
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI"
- StringPooling="TRUE"
- ExceptionHandling="FALSE"
- RuntimeLibrary="4"
- EnableFunctionLevelLinking="TRUE"
- PrecompiledHeaderFile=".\zlibsta0/zlibstat.pch"
- AssemblerListingLocation=".\zlibsta0/"
- ObjectFile=".\zlibsta0/"
- ProgramDataBaseFileName=".\zlibsta0/"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions="/NODEFAULTLIB "
- OutputFile=".\zlibsta0\zlibstat.lib"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCMIDLTool"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- </Configuration>
- <Configuration
- Name="Release|Win32"
- OutputDirectory=".\zlibstat"
- IntermediateDirectory=".\zlibstat"
- ConfigurationType="4"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE">
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI;ASMV;ASMINF"
- StringPooling="TRUE"
- ExceptionHandling="FALSE"
- RuntimeLibrary="4"
- EnableFunctionLevelLinking="TRUE"
- PrecompiledHeaderFile=".\zlibstat/zlibstat.pch"
- AssemblerListingLocation=".\zlibstat/"
- ObjectFile=".\zlibstat/"
- ProgramDataBaseFileName=".\zlibstat/"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions="..\..\masmx86\gvmat32.obj ..\..\masmx86\inffas32.obj /NODEFAULTLIB "
- OutputFile=".\zlibstat\zlibstat.lib"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCMIDLTool"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"
- Culture="1036"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- </Configuration>
- <Configuration
- Name="ReleaseWithoutAsm|Win32"
- OutputDirectory="zlibstatWithoutAsm"
- IntermediateDirectory="zlibstatWithoutAsm"
- ConfigurationType="4"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE">
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI"
- StringPooling="TRUE"
- ExceptionHandling="FALSE"
- RuntimeLibrary="4"
- EnableFunctionLevelLinking="TRUE"
- PrecompiledHeaderFile=".\zlibstat/zlibstat.pch"
- AssemblerListingLocation=".\zlibstatWithoutAsm/"
- ObjectFile=".\zlibstatWithoutAsm/"
- ProgramDataBaseFileName=".\zlibstatWithoutAsm/"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions=" /NODEFAULTLIB "
- OutputFile=".\zlibstatWithoutAsm\zlibstat.lib"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCMIDLTool"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"
- Culture="1036"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- </Configuration>
- </Configurations>
- <Files>
- <Filter
- Name="Source Files"
- Filter="">
- <File
- RelativePath="..\..\..\adler32.c">
- </File>
- <File
- RelativePath="..\..\..\compress.c">
- </File>
- <File
- RelativePath="..\..\..\crc32.c">
- </File>
- <File
- RelativePath="..\..\..\deflate.c">
- </File>
- <File
- RelativePath="..\..\masmx86\gvmat32c.c">
- </File>
- <File
- RelativePath="..\..\..\gzio.c">
- </File>
- <File
- RelativePath="..\..\..\infback.c">
- </File>
- <File
- RelativePath="..\..\..\inffast.c">
- </File>
- <File
- RelativePath="..\..\..\inflate.c">
- </File>
- <File
- RelativePath="..\..\..\inftrees.c">
- </File>
- <File
- RelativePath="..\..\minizip\ioapi.c">
- </File>
- <File
- RelativePath="..\..\..\trees.c">
- </File>
- <File
- RelativePath="..\..\..\uncompr.c">
- </File>
- <File
- RelativePath="..\..\minizip\unzip.c">
- </File>
- <File
- RelativePath="..\..\minizip\zip.c">
- </File>
- <File
- RelativePath=".\zlib.rc">
- </File>
- <File
- RelativePath=".\zlibvc.def">
- </File>
- <File
- RelativePath="..\..\..\zutil.c">
- </File>
- </Filter>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
diff --git a/compat/zlib/contrib/vstudio/vc7/zlibvc.def b/compat/zlib/contrib/vstudio/vc7/zlibvc.def
deleted file mode 100644
index a40e715..0000000
--- a/compat/zlib/contrib/vstudio/vc7/zlibvc.def
+++ /dev/null
@@ -1,92 +0,0 @@
-
-VERSION 1.23
-
-HEAPSIZE 1048576,8192
-
-EXPORTS
- adler32 @1
- compress @2
- crc32 @3
- deflate @4
- deflateCopy @5
- deflateEnd @6
- deflateInit2_ @7
- deflateInit_ @8
- deflateParams @9
- deflateReset @10
- deflateSetDictionary @11
- gzclose @12
- gzdopen @13
- gzerror @14
- gzflush @15
- gzopen @16
- gzread @17
- gzwrite @18
- inflate @19
- inflateEnd @20
- inflateInit2_ @21
- inflateInit_ @22
- inflateReset @23
- inflateSetDictionary @24
- inflateSync @25
- uncompress @26
- zlibVersion @27
- gzprintf @28
- gzputc @29
- gzgetc @30
- gzseek @31
- gzrewind @32
- gztell @33
- gzeof @34
- gzsetparams @35
- zError @36
- inflateSyncPoint @37
- get_crc_table @38
- compress2 @39
- gzputs @40
- gzgets @41
- inflateCopy @42
- inflateBackInit_ @43
- inflateBack @44
- inflateBackEnd @45
- compressBound @46
- deflateBound @47
- gzclearerr @48
- gzungetc @49
- zlibCompileFlags @50
- deflatePrime @51
-
- unzOpen @61
- unzClose @62
- unzGetGlobalInfo @63
- unzGetCurrentFileInfo @64
- unzGoToFirstFile @65
- unzGoToNextFile @66
- unzOpenCurrentFile @67
- unzReadCurrentFile @68
- unzOpenCurrentFile3 @69
- unztell @70
- unzeof @71
- unzCloseCurrentFile @72
- unzGetGlobalComment @73
- unzStringFileNameCompare @74
- unzLocateFile @75
- unzGetLocalExtrafield @76
- unzOpen2 @77
- unzOpenCurrentFile2 @78
- unzOpenCurrentFilePassword @79
-
- zipOpen @80
- zipOpenNewFileInZip @81
- zipWriteInFileInZip @82
- zipCloseFileInZip @83
- zipClose @84
- zipOpenNewFileInZip2 @86
- zipCloseFileInZipRaw @87
- zipOpen2 @88
- zipOpenNewFileInZip3 @89
-
- unzGetFilePos @100
- unzGoToFilePos @101
-
- fill_win32_filefunc @110
diff --git a/compat/zlib/contrib/vstudio/vc7/zlibvc.sln b/compat/zlib/contrib/vstudio/vc7/zlibvc.sln
deleted file mode 100644
index 927b42b..0000000
--- a/compat/zlib/contrib/vstudio/vc7/zlibvc.sln
+++ /dev/null
@@ -1,78 +0,0 @@
-Microsoft Visual Studio Solution File, Format Version 7.00
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testZlibDll", "testzlib.vcproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654C}"
-EndProject
-Global
- GlobalSection(SolutionConfiguration) = preSolution
- ConfigName.0 = Debug
- ConfigName.1 = Release
- ConfigName.2 = ReleaseAxp
- ConfigName.3 = ReleaseWithoutAsm
- ConfigName.4 = ReleaseWithoutCrtdll
- EndGlobalSection
- GlobalSection(ProjectDependencies) = postSolution
- EndGlobalSection
- GlobalSection(ProjectConfiguration) = postSolution
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug.ActiveCfg = Debug|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug.Build.0 = Debug|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release.ActiveCfg = Release|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release.Build.0 = Release|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseAxp.ActiveCfg = ReleaseAxp|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseAxp.Build.0 = ReleaseAxp|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm.ActiveCfg = ReleaseWithoutAsm|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm.Build.0 = ReleaseWithoutAsm|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutCrtdll.ActiveCfg = ReleaseAxp|Win32
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutCrtdll.Build.0 = ReleaseAxp|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug.ActiveCfg = Debug|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug.Build.0 = Debug|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release.ActiveCfg = Release|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release.Build.0 = Release|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseAxp.ActiveCfg = ReleaseAxp|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseAxp.Build.0 = ReleaseAxp|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm.ActiveCfg = ReleaseWithoutAsm|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm.Build.0 = ReleaseWithoutAsm|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutCrtdll.ActiveCfg = ReleaseWithoutCrtdll|Win32
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutCrtdll.Build.0 = ReleaseWithoutCrtdll|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug.ActiveCfg = Debug|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug.Build.0 = Debug|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release.ActiveCfg = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release.Build.0 = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseAxp.ActiveCfg = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseAxp.Build.0 = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm.ActiveCfg = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm.Build.0 = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutCrtdll.ActiveCfg = Release|Win32
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutCrtdll.Build.0 = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug.ActiveCfg = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug.Build.0 = Debug|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release.Build.0 = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseAxp.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseAxp.Build.0 = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm.Build.0 = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutCrtdll.ActiveCfg = Release|Win32
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutCrtdll.Build.0 = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654C}.Debug.ActiveCfg = Debug|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654C}.Debug.Build.0 = Debug|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654C}.Release.ActiveCfg = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654C}.Release.Build.0 = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654C}.ReleaseAxp.ActiveCfg = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654C}.ReleaseAxp.Build.0 = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654C}.ReleaseWithoutAsm.ActiveCfg = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654C}.ReleaseWithoutAsm.Build.0 = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654C}.ReleaseWithoutCrtdll.ActiveCfg = Release|Win32
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654C}.ReleaseWithoutCrtdll.Build.0 = Release|Win32
- EndGlobalSection
- GlobalSection(ExtensibilityGlobals) = postSolution
- EndGlobalSection
- GlobalSection(ExtensibilityAddIns) = postSolution
- EndGlobalSection
-EndGlobal
diff --git a/compat/zlib/contrib/vstudio/vc7/zlibvc.vcproj b/compat/zlib/contrib/vstudio/vc7/zlibvc.vcproj
deleted file mode 100644
index 8533b49..0000000
--- a/compat/zlib/contrib/vstudio/vc7/zlibvc.vcproj
+++ /dev/null
@@ -1,445 +0,0 @@
-<?xml version="1.0" encoding = "Windows-1252"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="7.00"
- Name="zlibvc"
- SccProjectName=""
- SccLocalPath="">
- <Platforms>
- <Platform
- Name="Win32"/>
- </Platforms>
- <Configurations>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory=".\DebugDll"
- IntermediateDirectory=".\DebugDll"
- ConfigurationType="2"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE">
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32,ZLIB_WINAPI,ASMV,ASMINF"
- ExceptionHandling="FALSE"
- RuntimeLibrary="1"
- PrecompiledHeaderFile=".\DebugDll/zlibvc.pch"
- AssemblerListingLocation=".\DebugDll/"
- ObjectFile=".\DebugDll/"
- ProgramDataBaseFileName=".\DebugDll/"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"
- DebugInformationFormat="4"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- AdditionalOptions="/MACHINE:I386"
- AdditionalDependencies="..\..\masmx86\gvmat32.obj ..\..\masmx86\inffas32.obj"
- OutputFile=".\DebugDll\zlibwapi.dll"
- LinkIncremental="2"
- SuppressStartupBanner="TRUE"
- ModuleDefinitionFile=".\zlibvc.def"
- GenerateDebugInformation="TRUE"
- ProgramDatabaseFile=".\DebugDll/zlibwapi.pdb"
- SubSystem="2"
- ImportLibrary=".\DebugDll/zlibwapi.lib"/>
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="_DEBUG"
- MkTypLibCompatible="TRUE"
- SuppressStartupBanner="TRUE"
- TargetEnvironment="1"
- TypeLibraryName=".\DebugDll/zlibvc.tlb"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="_DEBUG"
- Culture="1036"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- </Configuration>
- <Configuration
- Name="ReleaseWithoutAsm|Win32"
- OutputDirectory=".\zlibDllWithoutAsm"
- IntermediateDirectory=".\zlibDllWithoutAsm"
- ConfigurationType="2"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE"
- WholeProgramOptimization="TRUE">
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32,ZLIB_WINAPI"
- StringPooling="TRUE"
- ExceptionHandling="FALSE"
- RuntimeLibrary="0"
- EnableFunctionLevelLinking="TRUE"
- PrecompiledHeaderFile=".\zlibDllWithoutAsm/zlibvc.pch"
- AssemblerOutput="2"
- AssemblerListingLocation=".\zlibDllWithoutAsm/"
- ObjectFile=".\zlibDllWithoutAsm/"
- ProgramDataBaseFileName=".\zlibDllWithoutAsm/"
- BrowseInformation="1"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- AdditionalOptions="/MACHINE:I386"
- AdditionalDependencies="crtdll.lib"
- OutputFile=".\zlibDllWithoutAsm\zlibwapi.dll"
- LinkIncremental="1"
- SuppressStartupBanner="TRUE"
- IgnoreAllDefaultLibraries="TRUE"
- ModuleDefinitionFile=".\zlibvc.def"
- ProgramDatabaseFile=".\zlibDllWithoutAsm/zlibwapi.pdb"
- GenerateMapFile="TRUE"
- MapFileName=".\zlibDllWithoutAsm/zlibwapi.map"
- SubSystem="2"
- OptimizeForWindows98="1"
- ImportLibrary=".\zlibDllWithoutAsm/zlibwapi.lib"/>
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="NDEBUG"
- MkTypLibCompatible="TRUE"
- SuppressStartupBanner="TRUE"
- TargetEnvironment="1"
- TypeLibraryName=".\zlibDllWithoutAsm/zlibvc.tlb"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="NDEBUG"
- Culture="1036"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- </Configuration>
- <Configuration
- Name="ReleaseWithoutCrtdll|Win32"
- OutputDirectory=".\zlibDllWithoutCrtDll"
- IntermediateDirectory=".\zlibDllWithoutCrtDll"
- ConfigurationType="2"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE"
- WholeProgramOptimization="TRUE">
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32,ZLIB_WINAPI,ASMV,ASMINF"
- StringPooling="TRUE"
- ExceptionHandling="FALSE"
- RuntimeLibrary="0"
- EnableFunctionLevelLinking="TRUE"
- PrecompiledHeaderFile=".\zlibDllWithoutCrtDll/zlibvc.pch"
- AssemblerOutput="2"
- AssemblerListingLocation=".\zlibDllWithoutCrtDll/"
- ObjectFile=".\zlibDllWithoutCrtDll/"
- ProgramDataBaseFileName=".\zlibDllWithoutCrtDll/"
- BrowseInformation="1"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- AdditionalOptions="/MACHINE:I386"
- AdditionalDependencies="..\..\masmx86\gvmat32.obj ..\..\masmx86\inffas32.obj "
- OutputFile=".\zlibDllWithoutCrtDll\zlibwapi.dll"
- LinkIncremental="1"
- SuppressStartupBanner="TRUE"
- IgnoreAllDefaultLibraries="FALSE"
- ModuleDefinitionFile=".\zlibvc.def"
- ProgramDatabaseFile=".\zlibDllWithoutCrtDll/zlibwapi.pdb"
- GenerateMapFile="TRUE"
- MapFileName=".\zlibDllWithoutCrtDll/zlibwapi.map"
- SubSystem="2"
- OptimizeForWindows98="1"
- ImportLibrary=".\zlibDllWithoutCrtDll/zlibwapi.lib"/>
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="NDEBUG"
- MkTypLibCompatible="TRUE"
- SuppressStartupBanner="TRUE"
- TargetEnvironment="1"
- TypeLibraryName=".\zlibDllWithoutCrtDll/zlibvc.tlb"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="NDEBUG"
- Culture="1036"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- </Configuration>
- <Configuration
- Name="ReleaseAxp|Win32"
- OutputDirectory=".\zlibvc__"
- IntermediateDirectory=".\zlibvc__"
- ConfigurationType="2"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE"
- WholeProgramOptimization="TRUE">
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32,ZLIB_WINAPI"
- StringPooling="TRUE"
- ExceptionHandling="FALSE"
- RuntimeLibrary="0"
- EnableFunctionLevelLinking="TRUE"
- PrecompiledHeaderFile=".\zlibvc__/zlibvc.pch"
- AssemblerOutput="2"
- AssemblerListingLocation=".\zlibvc__/"
- ObjectFile=".\zlibvc__/"
- ProgramDataBaseFileName=".\zlibvc__/"
- BrowseInformation="1"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="crtdll.lib"
- OutputFile="zlibvc__\zlibwapi.dll"
- LinkIncremental="1"
- SuppressStartupBanner="TRUE"
- IgnoreAllDefaultLibraries="TRUE"
- ModuleDefinitionFile=".\zlibvc.def"
- ProgramDatabaseFile=".\zlibvc__/zlibwapi.pdb"
- GenerateMapFile="TRUE"
- MapFileName=".\zlibvc__/zlibwapi.map"
- SubSystem="2"
- ImportLibrary=".\zlibvc__/zlibwapi.lib"/>
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="NDEBUG"
- MkTypLibCompatible="TRUE"
- SuppressStartupBanner="TRUE"
- TargetEnvironment="1"
- TypeLibraryName=".\zlibvc__/zlibvc.tlb"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="NDEBUG"
- Culture="1036"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- </Configuration>
- <Configuration
- Name="Release|Win32"
- OutputDirectory=".\ReleaseDll"
- IntermediateDirectory=".\ReleaseDll"
- ConfigurationType="2"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE"
- WholeProgramOptimization="TRUE">
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32,ZLIB_WINAPI,ASMV,ASMINF"
- StringPooling="TRUE"
- ExceptionHandling="FALSE"
- RuntimeLibrary="0"
- EnableFunctionLevelLinking="TRUE"
- PrecompiledHeaderFile=".\ReleaseDll/zlibvc.pch"
- AssemblerOutput="2"
- AssemblerListingLocation=".\ReleaseDll/"
- ObjectFile=".\ReleaseDll/"
- ProgramDataBaseFileName=".\ReleaseDll/"
- BrowseInformation="1"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- AdditionalOptions="/MACHINE:I386"
- AdditionalDependencies="..\..\masmx86\gvmat32.obj ..\..\masmx86\inffas32.obj crtdll.lib"
- OutputFile=".\ReleaseDll\zlibwapi.dll"
- LinkIncremental="1"
- SuppressStartupBanner="TRUE"
- IgnoreAllDefaultLibraries="TRUE"
- ModuleDefinitionFile=".\zlibvc.def"
- ProgramDatabaseFile=".\ReleaseDll/zlibwapi.pdb"
- GenerateMapFile="TRUE"
- MapFileName=".\ReleaseDll/zlibwapi.map"
- SubSystem="2"
- OptimizeForWindows98="1"
- ImportLibrary=".\ReleaseDll/zlibwapi.lib"/>
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="NDEBUG"
- MkTypLibCompatible="TRUE"
- SuppressStartupBanner="TRUE"
- TargetEnvironment="1"
- TypeLibraryName=".\Release/zlibvc.tlb"/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="NDEBUG"
- Culture="1036"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- </Configuration>
- </Configurations>
- <Files>
- <Filter
- Name="Source Files"
- Filter="cpp;c;cxx;rc;def;r;odl;hpj;bat;for;f90">
- <File
- RelativePath="..\..\..\adler32.c">
- </File>
- <File
- RelativePath="..\..\..\compress.c">
- </File>
- <File
- RelativePath="..\..\..\crc32.c">
- </File>
- <File
- RelativePath="..\..\..\deflate.c">
- </File>
- <File
- RelativePath="..\..\masmx86\gvmat32c.c">
- <FileConfiguration
- Name="ReleaseWithoutAsm|Win32"
- ExcludedFromBuild="TRUE">
- <Tool
- Name="VCCLCompilerTool"/>
- </FileConfiguration>
- </File>
- <File
- RelativePath="..\..\..\gzio.c">
- </File>
- <File
- RelativePath="..\..\..\infback.c">
- </File>
- <File
- RelativePath="..\..\..\inffast.c">
- </File>
- <File
- RelativePath="..\..\..\inflate.c">
- </File>
- <File
- RelativePath="..\..\..\inftrees.c">
- </File>
- <File
- RelativePath="..\..\minizip\ioapi.c">
- </File>
- <File
- RelativePath="..\..\minizip\iowin32.c">
- </File>
- <File
- RelativePath="..\..\..\trees.c">
- </File>
- <File
- RelativePath="..\..\..\uncompr.c">
- </File>
- <File
- RelativePath="..\..\minizip\unzip.c">
- <FileConfiguration
- Name="Release|Win32">
- <Tool
- Name="VCCLCompilerTool"
- AdditionalIncludeDirectories=""
- PreprocessorDefinitions="ZLIB_INTERNAL"/>
- </FileConfiguration>
- </File>
- <File
- RelativePath="..\..\minizip\zip.c">
- <FileConfiguration
- Name="Release|Win32">
- <Tool
- Name="VCCLCompilerTool"
- AdditionalIncludeDirectories=""
- PreprocessorDefinitions="ZLIB_INTERNAL"/>
- </FileConfiguration>
- </File>
- <File
- RelativePath=".\zlib.rc">
- </File>
- <File
- RelativePath=".\zlibvc.def">
- </File>
- <File
- RelativePath="..\..\..\zutil.c">
- </File>
- </Filter>
- <Filter
- Name="Header Files"
- Filter="h;hpp;hxx;hm;inl;fi;fd">
- <File
- RelativePath="..\..\..\deflate.h">
- </File>
- <File
- RelativePath="..\..\..\infblock.h">
- </File>
- <File
- RelativePath="..\..\..\infcodes.h">
- </File>
- <File
- RelativePath="..\..\..\inffast.h">
- </File>
- <File
- RelativePath="..\..\..\inftrees.h">
- </File>
- <File
- RelativePath="..\..\..\infutil.h">
- </File>
- <File
- RelativePath="..\..\..\zconf.h">
- </File>
- <File
- RelativePath="..\..\..\zlib.h">
- </File>
- <File
- RelativePath="..\..\..\zutil.h">
- </File>
- </Filter>
- <Filter
- Name="Resource Files"
- Filter="ico;cur;bmp;dlg;rc2;rct;bin;cnt;rtf;gif;jpg;jpeg;jpe">
- </Filter>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
diff --git a/compat/zlib/contrib/vstudio/vc8/miniunz.vcproj b/compat/zlib/contrib/vstudio/vc8/miniunz.vcproj
deleted file mode 100644
index 4af53e8..0000000
--- a/compat/zlib/contrib/vstudio/vc8/miniunz.vcproj
+++ /dev/null
@@ -1,566 +0,0 @@
-<?xml version="1.0" encoding="Windows-1252"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="8,00"
- Name="miniunz"
- ProjectGUID="{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
- Keyword="Win32Proj"
- >
- <Platforms>
- <Platform
- Name="Win32"
- />
- <Platform
- Name="x64"
- />
- <Platform
- Name="Itanium"
- />
- </Platforms>
- <ToolFiles>
- </ToolFiles>
- <Configurations>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory="x86\MiniUnzip$(ConfigurationName)"
- IntermediateDirectory="x86\MiniUnzip$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE"
- MinimalRebuild="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="1"
- BufferSecurityCheck="false"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="4"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="x86\ZlibDllDebug\zlibwapi.lib"
- OutputFile="$(OutDir)/miniunz.exe"
- LinkIncremental="2"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/miniunz.pdb"
- SubSystem="1"
- TargetMachine="1"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Debug|x64"
- OutputDirectory="x64\MiniUnzip$(ConfigurationName)"
- IntermediateDirectory="x64\MiniUnzip$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="3"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64"
- MinimalRebuild="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="3"
- BufferSecurityCheck="false"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="x64\ZlibDllDebug\zlibwapi.lib"
- OutputFile="$(OutDir)/miniunz.exe"
- LinkIncremental="2"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/miniunz.pdb"
- SubSystem="1"
- TargetMachine="17"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Debug|Itanium"
- OutputDirectory="ia64\MiniUnzip$(ConfigurationName)"
- IntermediateDirectory="ia64\MiniUnzip$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="2"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64"
- MinimalRebuild="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="3"
- BufferSecurityCheck="false"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="ia64\ZlibDllDebug\zlibwapi.lib"
- OutputFile="$(OutDir)/miniunz.exe"
- LinkIncremental="2"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/miniunz.pdb"
- SubSystem="1"
- TargetMachine="5"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|Win32"
- OutputDirectory="x86\MiniUnzip$(ConfigurationName)"
- IntermediateDirectory="x86\MiniUnzip$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="0"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="x86\ZlibDllRelease\zlibwapi.lib"
- OutputFile="$(OutDir)/miniunz.exe"
- LinkIncremental="1"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="1"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|x64"
- OutputDirectory="x64\MiniUnzip$(ConfigurationName)"
- IntermediateDirectory="x64\MiniUnzip$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="3"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="x64\ZlibDllRelease\zlibwapi.lib"
- OutputFile="$(OutDir)/miniunz.exe"
- LinkIncremental="1"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="17"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|Itanium"
- OutputDirectory="ia64\MiniUnzip$(ConfigurationName)"
- IntermediateDirectory="ia64\MiniUnzip$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="2"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="ia64\ZlibDllRelease\zlibwapi.lib"
- OutputFile="$(OutDir)/miniunz.exe"
- LinkIncremental="1"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="5"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- </Configurations>
- <References>
- </References>
- <Files>
- <Filter
- Name="Source Files"
- Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm"
- >
- <File
- RelativePath="..\..\minizip\miniunz.c"
- >
- </File>
- </Filter>
- <Filter
- Name="Header Files"
- Filter="h;hpp;hxx;hm;inl;inc"
- >
- </Filter>
- <Filter
- Name="Resource Files"
- Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
- >
- </Filter>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
diff --git a/compat/zlib/contrib/vstudio/vc8/minizip.vcproj b/compat/zlib/contrib/vstudio/vc8/minizip.vcproj
deleted file mode 100644
index 85f64c4..0000000
--- a/compat/zlib/contrib/vstudio/vc8/minizip.vcproj
+++ /dev/null
@@ -1,563 +0,0 @@
-<?xml version="1.0" encoding="Windows-1252"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="8,00"
- Name="minizip"
- ProjectGUID="{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
- Keyword="Win32Proj"
- >
- <Platforms>
- <Platform
- Name="Win32"
- />
- <Platform
- Name="x64"
- />
- <Platform
- Name="Itanium"
- />
- </Platforms>
- <ToolFiles>
- </ToolFiles>
- <Configurations>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory="x86\MiniZip$(ConfigurationName)"
- IntermediateDirectory="x86\MiniZip$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE"
- MinimalRebuild="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="1"
- BufferSecurityCheck="false"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="4"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="x86\ZlibDllDebug\zlibwapi.lib"
- OutputFile="$(OutDir)/minizip.exe"
- LinkIncremental="2"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/minizip.pdb"
- SubSystem="1"
- TargetMachine="1"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Debug|x64"
- OutputDirectory="x64\$(ConfigurationName)"
- IntermediateDirectory="x64\$(ConfigurationName)"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="3"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64"
- MinimalRebuild="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="3"
- BufferSecurityCheck="false"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="x64\ZlibDllDebug\zlibwapi.lib"
- OutputFile="$(OutDir)/minizip.exe"
- LinkIncremental="2"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/minizip.pdb"
- SubSystem="1"
- TargetMachine="17"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Debug|Itanium"
- OutputDirectory="ia64\$(ConfigurationName)"
- IntermediateDirectory="ia64\$(ConfigurationName)"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="2"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64"
- MinimalRebuild="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="3"
- BufferSecurityCheck="false"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="ia64\ZlibDllDebug\zlibwapi.lib"
- OutputFile="$(OutDir)/minizip.exe"
- LinkIncremental="2"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/minizip.pdb"
- SubSystem="1"
- TargetMachine="5"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|Win32"
- OutputDirectory="x86\MiniZip$(ConfigurationName)"
- IntermediateDirectory="x86\MiniZip$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="0"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="x86\ZlibDllRelease\zlibwapi.lib"
- OutputFile="$(OutDir)/minizip.exe"
- LinkIncremental="1"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="1"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|x64"
- OutputDirectory="x64\$(ConfigurationName)"
- IntermediateDirectory="x64\$(ConfigurationName)"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="3"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="x64\ZlibDllRelease\zlibwapi.lib"
- OutputFile="$(OutDir)/minizip.exe"
- LinkIncremental="1"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="17"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|Itanium"
- OutputDirectory="ia64\$(ConfigurationName)"
- IntermediateDirectory="ia64\$(ConfigurationName)"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="2"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="ia64\ZlibDllRelease\zlibwapi.lib"
- OutputFile="$(OutDir)/minizip.exe"
- LinkIncremental="1"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="5"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- </Configurations>
- <References>
- </References>
- <Files>
- <Filter
- Name="Source Files"
- Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm"
- >
- <File
- RelativePath="..\..\minizip\minizip.c"
- >
- </File>
- </Filter>
- <Filter
- Name="Header Files"
- Filter="h;hpp;hxx;hm;inl;inc"
- >
- </Filter>
- <Filter
- Name="Resource Files"
- Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
- >
- </Filter>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
diff --git a/compat/zlib/contrib/vstudio/vc8/testzlib.vcproj b/compat/zlib/contrib/vstudio/vc8/testzlib.vcproj
deleted file mode 100644
index 68c3539..0000000
--- a/compat/zlib/contrib/vstudio/vc8/testzlib.vcproj
+++ /dev/null
@@ -1,948 +0,0 @@
-<?xml version="1.0" encoding="Windows-1252"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="8,00"
- Name="testzlib"
- ProjectGUID="{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
- RootNamespace="testzlib"
- Keyword="Win32Proj"
- >
- <Platforms>
- <Platform
- Name="Win32"
- />
- <Platform
- Name="x64"
- />
- <Platform
- Name="Itanium"
- />
- </Platforms>
- <ToolFiles>
- </ToolFiles>
- <Configurations>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory="x86\TestZlib$(ConfigurationName)"
- IntermediateDirectory="x86\TestZlib$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\.."
- PreprocessorDefinitions="ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE"
- MinimalRebuild="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="1"
- BufferSecurityCheck="false"
- UsePrecompiledHeader="0"
- AssemblerOutput="4"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="4"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="..\..\masmx86\gvmat32.obj ..\..\masmx86\inffas32.obj"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="2"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/testzlib.pdb"
- SubSystem="1"
- TargetMachine="1"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Debug|x64"
- OutputDirectory="x64\TestZlib$(ConfigurationName)"
- IntermediateDirectory="x64\TestZlib$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- AdditionalIncludeDirectories="..\..\.."
- PreprocessorDefinitions="ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE"
- BasicRuntimeChecks="0"
- RuntimeLibrary="3"
- BufferSecurityCheck="false"
- AssemblerListingLocation="$(IntDir)\"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="..\..\masmx64\gvmat64.obj ..\..\masmx64\inffasx64.obj"
- GenerateManifest="false"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Debug|Itanium"
- OutputDirectory="ia64\TestZlib$(ConfigurationName)"
- IntermediateDirectory="ia64\TestZlib$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="2"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\.."
- PreprocessorDefinitions="ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;WIN64"
- MinimalRebuild="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="3"
- BufferSecurityCheck="false"
- UsePrecompiledHeader="0"
- AssemblerOutput="4"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="2"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/testzlib.pdb"
- SubSystem="1"
- TargetMachine="5"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="ReleaseWithoutAsm|Win32"
- OutputDirectory="x86\TestZlib$(ConfigurationName)"
- IntermediateDirectory="x86\TestZlib$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- CharacterSet="2"
- WholeProgramOptimization="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\.."
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="0"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="1"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="1"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="ReleaseWithoutAsm|x64"
- OutputDirectory="x64\TestZlib$(ConfigurationName)"
- IntermediateDirectory="x64\TestZlib$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- WholeProgramOptimization="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- AdditionalIncludeDirectories="..\..\.."
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE"
- BasicRuntimeChecks="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- AssemblerListingLocation="$(IntDir)\"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies=""
- GenerateManifest="false"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="ReleaseWithoutAsm|Itanium"
- OutputDirectory="ia64\TestZlib$(ConfigurationName)"
- IntermediateDirectory="ia64\TestZlib$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- CharacterSet="2"
- WholeProgramOptimization="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="2"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\.."
- PreprocessorDefinitions="ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;WIN64"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="1"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="5"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|Win32"
- OutputDirectory="x86\TestZlib$(ConfigurationName)"
- IntermediateDirectory="x86\TestZlib$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- CharacterSet="2"
- WholeProgramOptimization="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\.."
- PreprocessorDefinitions="ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="0"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="..\..\masmx86\gvmat32.obj ..\..\masmx86\inffas32.obj"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="1"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="1"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|x64"
- OutputDirectory="x64\TestZlib$(ConfigurationName)"
- IntermediateDirectory="x64\TestZlib$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- WholeProgramOptimization="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- AdditionalIncludeDirectories="..\..\.."
- PreprocessorDefinitions="ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE"
- BasicRuntimeChecks="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- AssemblerListingLocation="$(IntDir)\"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="..\..\masmx64\gvmat64.obj ..\..\masmx64\inffasx64.obj"
- GenerateManifest="false"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|Itanium"
- OutputDirectory="ia64\TestZlib$(ConfigurationName)"
- IntermediateDirectory="ia64\TestZlib$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- CharacterSet="2"
- WholeProgramOptimization="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="2"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\.."
- PreprocessorDefinitions="ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;WIN64"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="1"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="5"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- </Configurations>
- <References>
- </References>
- <Files>
- <Filter
- Name="Source Files"
- Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm"
- >
- <File
- RelativePath="..\..\..\adler32.c"
- >
- </File>
- <File
- RelativePath="..\..\..\compress.c"
- >
- </File>
- <File
- RelativePath="..\..\..\crc32.c"
- >
- </File>
- <File
- RelativePath="..\..\..\deflate.c"
- >
- </File>
- <File
- RelativePath="..\..\masmx86\gvmat32c.c"
- >
- <FileConfiguration
- Name="Debug|x64"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Debug|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|x64"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|x64"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Debug|Win64 (AMD64)"
- ExcludedFromBuild="TRUE"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|Win64 (AMD64)"
- ExcludedFromBuild="TRUE"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseAsm|Win64 (AMD64)"
- ExcludedFromBuild="TRUE"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- </File>
- <File
- RelativePath="..\..\..\infback.c"
- >
- </File>
- <File
- RelativePath="..\..\masmx64\inffas8664.c"
- >
- <FileConfiguration
- Name="Debug|Win32"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Debug|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|Win32"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|Win32"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- </File>
- <File
- RelativePath="..\..\..\inffast.c"
- >
- </File>
- <File
- RelativePath="..\..\..\inflate.c"
- >
- </File>
- <File
- RelativePath="..\..\..\inftrees.c"
- >
- </File>
- <File
- RelativePath="..\..\testzlib\testzlib.c"
- >
- </File>
- <File
- RelativePath="..\..\..\trees.c"
- >
- </File>
- <File
- RelativePath="..\..\..\uncompr.c"
- >
- </File>
- <File
- RelativePath="..\..\..\zutil.c"
- >
- </File>
- </Filter>
- <Filter
- Name="Header Files"
- Filter="h;hpp;hxx;hm;inl;inc"
- >
- </Filter>
- <Filter
- Name="Resource Files"
- Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
- >
- </Filter>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
diff --git a/compat/zlib/contrib/vstudio/vc8/testzlibdll.vcproj b/compat/zlib/contrib/vstudio/vc8/testzlibdll.vcproj
deleted file mode 100644
index f38ab5e..0000000
--- a/compat/zlib/contrib/vstudio/vc8/testzlibdll.vcproj
+++ /dev/null
@@ -1,567 +0,0 @@
-<?xml version="1.0" encoding="Windows-1252"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="8,00"
- Name="TestZlibDll"
- ProjectGUID="{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
- Keyword="Win32Proj"
- SignManifests="true"
- >
- <Platforms>
- <Platform
- Name="Win32"
- />
- <Platform
- Name="x64"
- />
- <Platform
- Name="Itanium"
- />
- </Platforms>
- <ToolFiles>
- </ToolFiles>
- <Configurations>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory="x86\TestZlibDll$(ConfigurationName)"
- IntermediateDirectory="x86\TestZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE"
- MinimalRebuild="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="1"
- BufferSecurityCheck="false"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="4"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="x86\ZlibDllDebug\zlibwapi.lib"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="2"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/testzlib.pdb"
- SubSystem="1"
- TargetMachine="1"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Debug|x64"
- OutputDirectory="x64\TestZlibDll$(ConfigurationName)"
- IntermediateDirectory="x64\TestZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="3"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64"
- MinimalRebuild="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="3"
- BufferSecurityCheck="false"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="x64\ZlibDllDebug\zlibwapi.lib"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="2"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/testzlib.pdb"
- SubSystem="1"
- TargetMachine="17"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Debug|Itanium"
- OutputDirectory="ia64\TestZlibDll$(ConfigurationName)"
- IntermediateDirectory="ia64\TestZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="2"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64"
- MinimalRebuild="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="3"
- BufferSecurityCheck="false"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="ia64\ZlibDllDebug\zlibwapi.lib"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="2"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/testzlib.pdb"
- SubSystem="1"
- TargetMachine="5"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|Win32"
- OutputDirectory="x86\TestZlibDll$(ConfigurationName)"
- IntermediateDirectory="x86\TestZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="0"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="x86\ZlibDllRelease\zlibwapi.lib"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="1"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="1"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|x64"
- OutputDirectory="x64\TestZlibDll$(ConfigurationName)"
- IntermediateDirectory="x64\TestZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="3"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="x64\ZlibDllRelease\zlibwapi.lib"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="1"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="17"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|Itanium"
- OutputDirectory="ia64\TestZlibDll$(ConfigurationName)"
- IntermediateDirectory="ia64\TestZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="1"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- CharacterSet="2"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="2"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="2"
- InlineFunctionExpansion="1"
- OmitFramePointers="true"
- AdditionalIncludeDirectories="..\..\..;..\..\minizip"
- PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64"
- StringPooling="true"
- BasicRuntimeChecks="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- UsePrecompiledHeader="0"
- AssemblerListingLocation="$(IntDir)\"
- WarningLevel="3"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="ia64\ZlibDllRelease\zlibwapi.lib"
- OutputFile="$(OutDir)/testzlib.exe"
- LinkIncremental="1"
- GenerateManifest="false"
- GenerateDebugInformation="true"
- SubSystem="1"
- OptimizeReferences="2"
- EnableCOMDATFolding="2"
- OptimizeForWindows98="1"
- TargetMachine="5"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- </Configurations>
- <References>
- </References>
- <Files>
- <Filter
- Name="Source Files"
- Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm"
- >
- <File
- RelativePath="..\..\testzlib\testzlib.c"
- >
- </File>
- </Filter>
- <Filter
- Name="Header Files"
- Filter="h;hpp;hxx;hm;inl;inc"
- >
- </Filter>
- <Filter
- Name="Resource Files"
- Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
- >
- </Filter>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
diff --git a/compat/zlib/contrib/vstudio/vc8/zlib.rc b/compat/zlib/contrib/vstudio/vc8/zlib.rc
deleted file mode 100644
index 72cb8b4..0000000
--- a/compat/zlib/contrib/vstudio/vc8/zlib.rc
+++ /dev/null
@@ -1,32 +0,0 @@
-#include <windows.h>
-
-#define IDR_VERSION1 1
-IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE
- FILEVERSION 1,2,3,0
- PRODUCTVERSION 1,2,3,0
- FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
- FILEFLAGS 0
- FILEOS VOS_DOS_WINDOWS32
- FILETYPE VFT_DLL
- FILESUBTYPE 0 // not used
-BEGIN
- BLOCK "StringFileInfo"
- BEGIN
- BLOCK "040904E4"
- //language ID = U.S. English, char set = Windows, Multilingual
-
- BEGIN
- VALUE "FileDescription", "zlib data compression library\0"
- VALUE "FileVersion", "1.2.3.0\0"
- VALUE "InternalName", "zlib\0"
- VALUE "OriginalFilename", "zlib.dll\0"
- VALUE "ProductName", "ZLib.DLL\0"
- VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
- VALUE "LegalCopyright", "(C) 1995-2003 Jean-loup Gailly & Mark Adler\0"
- END
- END
- BLOCK "VarFileInfo"
- BEGIN
- VALUE "Translation", 0x0409, 1252
- END
-END
diff --git a/compat/zlib/contrib/vstudio/vc8/zlibstat.vcproj b/compat/zlib/contrib/vstudio/vc8/zlibstat.vcproj
deleted file mode 100644
index fb97037..0000000
--- a/compat/zlib/contrib/vstudio/vc8/zlibstat.vcproj
+++ /dev/null
@@ -1,870 +0,0 @@
-<?xml version="1.0" encoding="Windows-1252"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="8,00"
- Name="zlibstat"
- ProjectGUID="{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
- >
- <Platforms>
- <Platform
- Name="Win32"
- />
- <Platform
- Name="x64"
- />
- <Platform
- Name="Itanium"
- />
- </Platforms>
- <ToolFiles>
- </ToolFiles>
- <Configurations>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory="x86\ZlibStat$(ConfigurationName)"
- IntermediateDirectory="x86\ZlibStat$(ConfigurationName)\Tmp"
- ConfigurationType="4"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE"
- ExceptionHandling="0"
- RuntimeLibrary="1"
- BufferSecurityCheck="false"
- PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- WarningLevel="3"
- SuppressStartupBanner="true"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="1"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions="/MACHINE:X86 /NODEFAULTLIB"
- OutputFile="$(OutDir)\zlibstat.lib"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Debug|x64"
- OutputDirectory="x64\ZlibStat$(ConfigurationName)"
- IntermediateDirectory="x64\ZlibStat$(ConfigurationName)\Tmp"
- ConfigurationType="4"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="3"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;WIN64"
- ExceptionHandling="0"
- RuntimeLibrary="3"
- BufferSecurityCheck="false"
- PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- WarningLevel="3"
- SuppressStartupBanner="true"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="1"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions="/MACHINE:AMD64 /NODEFAULTLIB"
- OutputFile="$(OutDir)\zlibstat.lib"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Debug|Itanium"
- OutputDirectory="ia64\ZlibStat$(ConfigurationName)"
- IntermediateDirectory="ia64\ZlibStat$(ConfigurationName)\Tmp"
- ConfigurationType="4"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="2"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;WIN64"
- ExceptionHandling="0"
- RuntimeLibrary="3"
- BufferSecurityCheck="false"
- PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- WarningLevel="3"
- SuppressStartupBanner="true"
- Detect64BitPortabilityProblems="true"
- DebugInformationFormat="1"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions="/MACHINE:IA64 /NODEFAULTLIB"
- OutputFile="$(OutDir)\zlibstat.lib"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|Win32"
- OutputDirectory="x86\ZlibStat$(ConfigurationName)"
- IntermediateDirectory="x86\ZlibStat$(ConfigurationName)\Tmp"
- ConfigurationType="4"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ASMV;ASMINF"
- StringPooling="true"
- ExceptionHandling="0"
- RuntimeLibrary="0"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- WarningLevel="3"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions="/MACHINE:X86 /NODEFAULTLIB"
- AdditionalDependencies="..\..\masmx86\gvmat32.obj ..\..\masmx86\inffas32.obj "
- OutputFile="$(OutDir)\zlibstat.lib"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|x64"
- OutputDirectory="x64\ZlibStat$(ConfigurationName)"
- IntermediateDirectory="x64\ZlibStat$(ConfigurationName)\Tmp"
- ConfigurationType="4"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="3"
- />
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ASMV;ASMINF;WIN64"
- StringPooling="true"
- ExceptionHandling="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- WarningLevel="3"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions="/MACHINE:AMD64 /NODEFAULTLIB"
- AdditionalDependencies="..\..\masmx64\gvmat64.obj ..\..\masmx64\inffasx64.obj "
- OutputFile="$(OutDir)\zlibstat.lib"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|Itanium"
- OutputDirectory="ia64\ZlibStat$(ConfigurationName)"
- IntermediateDirectory="ia64\ZlibStat$(ConfigurationName)\Tmp"
- ConfigurationType="4"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="2"
- />
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;WIN64"
- StringPooling="true"
- ExceptionHandling="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- WarningLevel="3"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions="/MACHINE:IA64 /NODEFAULTLIB"
- OutputFile="$(OutDir)\zlibstat.lib"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="ReleaseWithoutAsm|Win32"
- OutputDirectory="x86\ZlibStat$(ConfigurationName)"
- IntermediateDirectory="x86\ZlibStat$(ConfigurationName)\Tmp"
- ConfigurationType="4"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- />
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE"
- StringPooling="true"
- ExceptionHandling="0"
- RuntimeLibrary="0"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- WarningLevel="3"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions="/MACHINE:X86 /NODEFAULTLIB"
- OutputFile="$(OutDir)\zlibstat.lib"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="ReleaseWithoutAsm|x64"
- OutputDirectory="x64\ZlibStat$(ConfigurationName)"
- IntermediateDirectory="x64\ZlibStat$(ConfigurationName)\Tmp"
- ConfigurationType="4"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="3"
- />
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;WIN64"
- StringPooling="true"
- ExceptionHandling="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- WarningLevel="3"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions="/MACHINE:AMD64 /NODEFAULTLIB"
- OutputFile="$(OutDir)\zlibstat.lib"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="ReleaseWithoutAsm|Itanium"
- OutputDirectory="ia64\ZlibStat$(ConfigurationName)"
- IntermediateDirectory="ia64\ZlibStat$(ConfigurationName)\Tmp"
- ConfigurationType="4"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- TargetEnvironment="2"
- />
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;WIN64"
- StringPooling="true"
- ExceptionHandling="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- WarningLevel="3"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLibrarianTool"
- AdditionalOptions="/MACHINE:IA64 /NODEFAULTLIB"
- OutputFile="$(OutDir)\zlibstat.lib"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- </Configurations>
- <References>
- </References>
- <Files>
- <Filter
- Name="Source Files"
- >
- <File
- RelativePath="..\..\..\adler32.c"
- >
- </File>
- <File
- RelativePath="..\..\..\compress.c"
- >
- </File>
- <File
- RelativePath="..\..\..\crc32.c"
- >
- </File>
- <File
- RelativePath="..\..\..\deflate.c"
- >
- </File>
- <File
- RelativePath="..\..\masmx86\gvmat32c.c"
- >
- <FileConfiguration
- Name="Debug|x64"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Debug|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|x64"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|x64"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- </File>
- <File
- RelativePath="..\..\..\gzio.c"
- >
- </File>
- <File
- RelativePath="..\..\..\infback.c"
- >
- </File>
- <File
- RelativePath="..\..\masmx64\inffas8664.c"
- >
- <FileConfiguration
- Name="Debug|Win32"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Debug|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|Win32"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|Win32"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- </File>
- <File
- RelativePath="..\..\..\inffast.c"
- >
- </File>
- <File
- RelativePath="..\..\..\inflate.c"
- >
- </File>
- <File
- RelativePath="..\..\..\inftrees.c"
- >
- </File>
- <File
- RelativePath="..\..\minizip\ioapi.c"
- >
- </File>
- <File
- RelativePath="..\..\..\trees.c"
- >
- </File>
- <File
- RelativePath="..\..\..\uncompr.c"
- >
- </File>
- <File
- RelativePath="..\..\minizip\unzip.c"
- >
- </File>
- <File
- RelativePath="..\..\minizip\zip.c"
- >
- </File>
- <File
- RelativePath=".\zlib.rc"
- >
- </File>
- <File
- RelativePath=".\zlibvc.def"
- >
- </File>
- <File
- RelativePath="..\..\..\zutil.c"
- >
- </File>
- </Filter>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
diff --git a/compat/zlib/contrib/vstudio/vc8/zlibvc.def b/compat/zlib/contrib/vstudio/vc8/zlibvc.def
deleted file mode 100644
index a40e715..0000000
--- a/compat/zlib/contrib/vstudio/vc8/zlibvc.def
+++ /dev/null
@@ -1,92 +0,0 @@
-
-VERSION 1.23
-
-HEAPSIZE 1048576,8192
-
-EXPORTS
- adler32 @1
- compress @2
- crc32 @3
- deflate @4
- deflateCopy @5
- deflateEnd @6
- deflateInit2_ @7
- deflateInit_ @8
- deflateParams @9
- deflateReset @10
- deflateSetDictionary @11
- gzclose @12
- gzdopen @13
- gzerror @14
- gzflush @15
- gzopen @16
- gzread @17
- gzwrite @18
- inflate @19
- inflateEnd @20
- inflateInit2_ @21
- inflateInit_ @22
- inflateReset @23
- inflateSetDictionary @24
- inflateSync @25
- uncompress @26
- zlibVersion @27
- gzprintf @28
- gzputc @29
- gzgetc @30
- gzseek @31
- gzrewind @32
- gztell @33
- gzeof @34
- gzsetparams @35
- zError @36
- inflateSyncPoint @37
- get_crc_table @38
- compress2 @39
- gzputs @40
- gzgets @41
- inflateCopy @42
- inflateBackInit_ @43
- inflateBack @44
- inflateBackEnd @45
- compressBound @46
- deflateBound @47
- gzclearerr @48
- gzungetc @49
- zlibCompileFlags @50
- deflatePrime @51
-
- unzOpen @61
- unzClose @62
- unzGetGlobalInfo @63
- unzGetCurrentFileInfo @64
- unzGoToFirstFile @65
- unzGoToNextFile @66
- unzOpenCurrentFile @67
- unzReadCurrentFile @68
- unzOpenCurrentFile3 @69
- unztell @70
- unzeof @71
- unzCloseCurrentFile @72
- unzGetGlobalComment @73
- unzStringFileNameCompare @74
- unzLocateFile @75
- unzGetLocalExtrafield @76
- unzOpen2 @77
- unzOpenCurrentFile2 @78
- unzOpenCurrentFilePassword @79
-
- zipOpen @80
- zipOpenNewFileInZip @81
- zipWriteInFileInZip @82
- zipCloseFileInZip @83
- zipClose @84
- zipOpenNewFileInZip2 @86
- zipCloseFileInZipRaw @87
- zipOpen2 @88
- zipOpenNewFileInZip3 @89
-
- unzGetFilePos @100
- unzGoToFilePos @101
-
- fill_win32_filefunc @110
diff --git a/compat/zlib/contrib/vstudio/vc8/zlibvc.sln b/compat/zlib/contrib/vstudio/vc8/zlibvc.sln
deleted file mode 100644
index a815a55..0000000
--- a/compat/zlib/contrib/vstudio/vc8/zlibvc.sln
+++ /dev/null
@@ -1,144 +0,0 @@
-
-Microsoft Visual Studio Solution File, Format Version 9.00
-# Visual Studio 2005
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "TestZlibDll", "testzlibdll.vcproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
- ProjectSection(ProjectDependencies) = postProject
- {8FD826F8-3739-44E6-8CC8-997122E53B8D} = {8FD826F8-3739-44E6-8CC8-997122E53B8D}
- EndProjectSection
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
- ProjectSection(ProjectDependencies) = postProject
- {8FD826F8-3739-44E6-8CC8-997122E53B8D} = {8FD826F8-3739-44E6-8CC8-997122E53B8D}
- EndProjectSection
-EndProject
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
- ProjectSection(ProjectDependencies) = postProject
- {8FD826F8-3739-44E6-8CC8-997122E53B8D} = {8FD826F8-3739-44E6-8CC8-997122E53B8D}
- EndProjectSection
-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|Itanium
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.Build.0 = Debug|Itanium
- {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|Itanium
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.Build.0 = Release|Itanium
- {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 = ReleaseWithoutAsm|x64
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = ReleaseWithoutAsm|x64
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium
- {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium
- {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|Itanium
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.Build.0 = Debug|Itanium
- {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|Itanium
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.Build.0 = Release|Itanium
- {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|Itanium
- {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium
- {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|Itanium
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.Build.0 = Debug|Itanium
- {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|Itanium
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.Build.0 = Release|Itanium
- {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|Itanium
- {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium
- {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|Itanium
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.Build.0 = Debug|Itanium
- {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|Itanium
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.Build.0 = Release|Itanium
- {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|Itanium
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Itanium
- {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|Itanium
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Itanium
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.Build.0 = Debug|Itanium
- {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|Itanium
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.Build.0 = Release|Itanium
- {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|Itanium
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Itanium
- {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|Itanium
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Itanium
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.Build.0 = Debug|Itanium
- {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|Itanium
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.Build.0 = Release|Itanium
- {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|Itanium
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Itanium
- {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|Itanium
- EndGlobalSection
- GlobalSection(SolutionProperties) = preSolution
- HideSolutionNode = FALSE
- EndGlobalSection
-EndGlobal
diff --git a/compat/zlib/contrib/vstudio/vc8/zlibvc.vcproj b/compat/zlib/contrib/vstudio/vc8/zlibvc.vcproj
deleted file mode 100644
index e717011..0000000
--- a/compat/zlib/contrib/vstudio/vc8/zlibvc.vcproj
+++ /dev/null
@@ -1,1219 +0,0 @@
-<?xml version="1.0" encoding="Windows-1252"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="8,00"
- Name="zlibvc"
- ProjectGUID="{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
- >
- <Platforms>
- <Platform
- Name="Win32"
- />
- <Platform
- Name="x64"
- />
- <Platform
- Name="Itanium"
- />
- </Platforms>
- <ToolFiles>
- </ToolFiles>
- <Configurations>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory="x86\ZlibDll$(ConfigurationName)"
- IntermediateDirectory="x86\ZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="2"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="_DEBUG"
- MkTypLibCompatible="true"
- SuppressStartupBanner="true"
- TargetEnvironment="1"
- TypeLibraryName="$(OutDir)/zlibvc.tlb"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32,_CRT_SECURE_NO_DEPRECATE,ZLIB_WINAPI,ASMV,ASMINF"
- ExceptionHandling="0"
- RuntimeLibrary="1"
- BufferSecurityCheck="false"
- PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- BrowseInformation="0"
- WarningLevel="3"
- SuppressStartupBanner="true"
- DebugInformationFormat="4"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="_DEBUG"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalOptions="/MACHINE:I386"
- AdditionalDependencies="..\..\masmx86\gvmat32.obj ..\..\masmx86\inffas32.obj"
- OutputFile="$(OutDir)\zlibwapi.dll"
- LinkIncremental="2"
- SuppressStartupBanner="true"
- GenerateManifest="false"
- ModuleDefinitionFile=".\zlibvc.def"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
- GenerateMapFile="true"
- MapFileName="$(OutDir)/zlibwapi.map"
- SubSystem="2"
- ImportLibrary="$(OutDir)/zlibwapi.lib"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Debug|x64"
- OutputDirectory="x64\ZlibDll$(ConfigurationName)"
- IntermediateDirectory="x64\ZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="2"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="_DEBUG"
- MkTypLibCompatible="true"
- SuppressStartupBanner="true"
- TargetEnvironment="3"
- TypeLibraryName="$(OutDir)/zlibvc.tlb"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32,_CRT_SECURE_NO_DEPRECATE,ZLIB_WINAPI,ASMV,ASMINF;WIN64"
- ExceptionHandling="0"
- RuntimeLibrary="3"
- BufferSecurityCheck="false"
- PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- BrowseInformation="0"
- WarningLevel="3"
- SuppressStartupBanner="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="_DEBUG"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="..\..\masmx64\gvmat64.obj ..\..\masmx64\inffasx64.obj "
- OutputFile="$(OutDir)\zlibwapi.dll"
- LinkIncremental="2"
- SuppressStartupBanner="true"
- GenerateManifest="false"
- ModuleDefinitionFile=".\zlibvc.def"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
- GenerateMapFile="true"
- MapFileName="$(OutDir)/zlibwapi.map"
- SubSystem="2"
- ImportLibrary="$(OutDir)/zlibwapi.lib"
- TargetMachine="17"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Debug|Itanium"
- OutputDirectory="ia64\ZlibDll$(ConfigurationName)"
- IntermediateDirectory="ia64\ZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="2"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="_DEBUG"
- MkTypLibCompatible="true"
- SuppressStartupBanner="true"
- TargetEnvironment="2"
- TypeLibraryName="$(OutDir)/zlibvc.tlb"
- />
- <Tool
- Name="VCCLCompilerTool"
- Optimization="0"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;WIN64"
- ExceptionHandling="0"
- RuntimeLibrary="3"
- BufferSecurityCheck="false"
- PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- BrowseInformation="0"
- WarningLevel="3"
- SuppressStartupBanner="true"
- DebugInformationFormat="3"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="_DEBUG"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)\zlibwapi.dll"
- LinkIncremental="2"
- SuppressStartupBanner="true"
- GenerateManifest="false"
- ModuleDefinitionFile=".\zlibvc.def"
- GenerateDebugInformation="true"
- ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
- GenerateMapFile="true"
- MapFileName="$(OutDir)/zlibwapi.map"
- SubSystem="2"
- ImportLibrary="$(OutDir)/zlibwapi.lib"
- TargetMachine="5"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="ReleaseWithoutAsm|Win32"
- OutputDirectory="x86\ZlibDll$(ConfigurationName)"
- IntermediateDirectory="x86\ZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="2"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- WholeProgramOptimization="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="NDEBUG"
- MkTypLibCompatible="true"
- SuppressStartupBanner="true"
- TargetEnvironment="1"
- TypeLibraryName="$(OutDir)/zlibvc.tlb"
- />
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32,_CRT_SECURE_NO_DEPRECATE,ZLIB_WINAPI"
- StringPooling="true"
- ExceptionHandling="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
- AssemblerOutput="2"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- BrowseInformation="0"
- WarningLevel="3"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="NDEBUG"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalOptions="/MACHINE:I386"
- OutputFile="$(OutDir)\zlibwapi.dll"
- LinkIncremental="1"
- SuppressStartupBanner="true"
- GenerateManifest="false"
- IgnoreAllDefaultLibraries="false"
- ModuleDefinitionFile=".\zlibvc.def"
- ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
- GenerateMapFile="true"
- MapFileName="$(OutDir)/zlibwapi.map"
- SubSystem="2"
- OptimizeForWindows98="1"
- ImportLibrary="$(OutDir)/zlibwapi.lib"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="ReleaseWithoutAsm|x64"
- OutputDirectory="x64\ZlibDll$(ConfigurationName)"
- IntermediateDirectory="x64\ZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="2"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- WholeProgramOptimization="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="NDEBUG"
- MkTypLibCompatible="true"
- SuppressStartupBanner="true"
- TargetEnvironment="3"
- TypeLibraryName="$(OutDir)/zlibvc.tlb"
- />
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32,_CRT_SECURE_NO_DEPRECATE,ZLIB_WINAPI;WIN64"
- StringPooling="true"
- ExceptionHandling="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
- AssemblerOutput="2"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- BrowseInformation="0"
- WarningLevel="3"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="NDEBUG"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)\zlibwapi.dll"
- LinkIncremental="1"
- SuppressStartupBanner="true"
- GenerateManifest="false"
- IgnoreAllDefaultLibraries="false"
- ModuleDefinitionFile=".\zlibvc.def"
- ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
- GenerateMapFile="true"
- MapFileName="$(OutDir)/zlibwapi.map"
- SubSystem="2"
- OptimizeForWindows98="1"
- ImportLibrary="$(OutDir)/zlibwapi.lib"
- TargetMachine="17"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="ReleaseWithoutAsm|Itanium"
- OutputDirectory="ia64\ZlibDll$(ConfigurationName)"
- IntermediateDirectory="ia64\ZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="2"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- WholeProgramOptimization="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="NDEBUG"
- MkTypLibCompatible="true"
- SuppressStartupBanner="true"
- TargetEnvironment="2"
- TypeLibraryName="$(OutDir)/zlibvc.tlb"
- />
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32,_CRT_SECURE_NO_DEPRECATE,ZLIB_WINAPI;WIN64"
- StringPooling="true"
- ExceptionHandling="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
- AssemblerOutput="2"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- BrowseInformation="0"
- WarningLevel="3"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="NDEBUG"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)\zlibwapi.dll"
- LinkIncremental="1"
- SuppressStartupBanner="true"
- GenerateManifest="false"
- IgnoreAllDefaultLibraries="false"
- ModuleDefinitionFile=".\zlibvc.def"
- ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
- GenerateMapFile="true"
- MapFileName="$(OutDir)/zlibwapi.map"
- SubSystem="2"
- OptimizeForWindows98="1"
- ImportLibrary="$(OutDir)/zlibwapi.lib"
- TargetMachine="5"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|Win32"
- OutputDirectory="x86\ZlibDll$(ConfigurationName)"
- IntermediateDirectory="x86\ZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="2"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- WholeProgramOptimization="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="NDEBUG"
- MkTypLibCompatible="true"
- SuppressStartupBanner="true"
- TargetEnvironment="1"
- TypeLibraryName="$(OutDir)/zlibvc.tlb"
- />
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="WIN32;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;ASMV;ASMINF"
- StringPooling="true"
- ExceptionHandling="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
- AssemblerOutput="2"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- BrowseInformation="0"
- WarningLevel="3"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="NDEBUG"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalOptions="/MACHINE:I386"
- AdditionalDependencies="..\..\masmx86\gvmat32.obj ..\..\masmx86\inffas32.obj "
- OutputFile="$(OutDir)\zlibwapi.dll"
- LinkIncremental="1"
- SuppressStartupBanner="true"
- GenerateManifest="false"
- IgnoreAllDefaultLibraries="false"
- ModuleDefinitionFile=".\zlibvc.def"
- ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
- GenerateMapFile="true"
- MapFileName="$(OutDir)/zlibwapi.map"
- SubSystem="2"
- OptimizeForWindows98="1"
- ImportLibrary="$(OutDir)/zlibwapi.lib"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|x64"
- OutputDirectory="x64\ZlibDll$(ConfigurationName)"
- IntermediateDirectory="x64\ZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="2"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- WholeProgramOptimization="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="NDEBUG"
- MkTypLibCompatible="true"
- SuppressStartupBanner="true"
- TargetEnvironment="3"
- TypeLibraryName="$(OutDir)/zlibvc.tlb"
- />
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;ASMV;ASMINF;WIN64"
- StringPooling="true"
- ExceptionHandling="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
- AssemblerOutput="2"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- BrowseInformation="0"
- WarningLevel="3"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="NDEBUG"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="..\..\masmx64\gvmat64.obj ..\..\masmx64\inffasx64.obj "
- OutputFile="$(OutDir)\zlibwapi.dll"
- LinkIncremental="1"
- SuppressStartupBanner="true"
- GenerateManifest="false"
- IgnoreAllDefaultLibraries="false"
- ModuleDefinitionFile=".\zlibvc.def"
- ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
- GenerateMapFile="true"
- MapFileName="$(OutDir)/zlibwapi.map"
- SubSystem="2"
- OptimizeForWindows98="1"
- ImportLibrary="$(OutDir)/zlibwapi.lib"
- TargetMachine="17"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- <Configuration
- Name="Release|Itanium"
- OutputDirectory="ia64\ZlibDll$(ConfigurationName)"
- IntermediateDirectory="ia64\ZlibDll$(ConfigurationName)\Tmp"
- ConfigurationType="2"
- InheritedPropertySheets="UpgradeFromVC70.vsprops"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="false"
- WholeProgramOptimization="1"
- >
- <Tool
- Name="VCPreBuildEventTool"
- />
- <Tool
- Name="VCCustomBuildTool"
- />
- <Tool
- Name="VCXMLDataGeneratorTool"
- />
- <Tool
- Name="VCWebServiceProxyGeneratorTool"
- />
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="NDEBUG"
- MkTypLibCompatible="true"
- SuppressStartupBanner="true"
- TargetEnvironment="2"
- TypeLibraryName="$(OutDir)/zlibvc.tlb"
- />
- <Tool
- Name="VCCLCompilerTool"
- InlineFunctionExpansion="1"
- AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
- PreprocessorDefinitions="_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;WIN64"
- StringPooling="true"
- ExceptionHandling="0"
- RuntimeLibrary="2"
- BufferSecurityCheck="false"
- EnableFunctionLevelLinking="true"
- PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
- AssemblerOutput="2"
- AssemblerListingLocation="$(IntDir)\"
- ObjectFile="$(IntDir)\"
- ProgramDataBaseFileName="$(OutDir)\"
- BrowseInformation="0"
- WarningLevel="3"
- SuppressStartupBanner="true"
- />
- <Tool
- Name="VCManagedResourceCompilerTool"
- />
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="NDEBUG"
- Culture="1036"
- />
- <Tool
- Name="VCPreLinkEventTool"
- />
- <Tool
- Name="VCLinkerTool"
- OutputFile="$(OutDir)\zlibwapi.dll"
- LinkIncremental="1"
- SuppressStartupBanner="true"
- GenerateManifest="false"
- IgnoreAllDefaultLibraries="false"
- ModuleDefinitionFile=".\zlibvc.def"
- ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
- GenerateMapFile="true"
- MapFileName="$(OutDir)/zlibwapi.map"
- SubSystem="2"
- OptimizeForWindows98="1"
- ImportLibrary="$(OutDir)/zlibwapi.lib"
- TargetMachine="5"
- />
- <Tool
- Name="VCALinkTool"
- />
- <Tool
- Name="VCManifestTool"
- />
- <Tool
- Name="VCXDCMakeTool"
- />
- <Tool
- Name="VCBscMakeTool"
- />
- <Tool
- Name="VCFxCopTool"
- />
- <Tool
- Name="VCAppVerifierTool"
- />
- <Tool
- Name="VCWebDeploymentTool"
- />
- <Tool
- Name="VCPostBuildEventTool"
- />
- </Configuration>
- </Configurations>
- <References>
- </References>
- <Files>
- <Filter
- Name="Source Files"
- Filter="cpp;c;cxx;rc;def;r;odl;hpj;bat;for;f90"
- >
- <File
- RelativePath="..\..\..\adler32.c"
- >
- </File>
- <File
- RelativePath="..\..\..\compress.c"
- >
- </File>
- <File
- RelativePath="..\..\..\crc32.c"
- >
- </File>
- <File
- RelativePath="..\..\..\deflate.c"
- >
- </File>
- <File
- RelativePath="..\..\masmx86\gvmat32c.c"
- >
- <FileConfiguration
- Name="Debug|x64"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Debug|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|Win32"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|x64"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|x64"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- </File>
- <File
- RelativePath="..\..\..\gzio.c"
- >
- </File>
- <File
- RelativePath="..\..\..\infback.c"
- >
- </File>
- <File
- RelativePath="..\..\masmx64\inffas8664.c"
- >
- <FileConfiguration
- Name="Debug|Win32"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Debug|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|Win32"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="ReleaseWithoutAsm|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|Win32"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|Itanium"
- ExcludedFromBuild="true"
- >
- <Tool
- Name="VCCLCompilerTool"
- />
- </FileConfiguration>
- </File>
- <File
- RelativePath="..\..\..\inffast.c"
- >
- </File>
- <File
- RelativePath="..\..\..\inflate.c"
- >
- </File>
- <File
- RelativePath="..\..\..\inftrees.c"
- >
- </File>
- <File
- RelativePath="..\..\minizip\ioapi.c"
- >
- </File>
- <File
- RelativePath="..\..\minizip\iowin32.c"
- >
- </File>
- <File
- RelativePath="..\..\..\trees.c"
- >
- </File>
- <File
- RelativePath="..\..\..\uncompr.c"
- >
- </File>
- <File
- RelativePath="..\..\minizip\unzip.c"
- >
- <FileConfiguration
- Name="Release|Win32"
- >
- <Tool
- Name="VCCLCompilerTool"
- AdditionalIncludeDirectories=""
- PreprocessorDefinitions="ZLIB_INTERNAL"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|x64"
- >
- <Tool
- Name="VCCLCompilerTool"
- AdditionalIncludeDirectories=""
- PreprocessorDefinitions="ZLIB_INTERNAL"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|Itanium"
- >
- <Tool
- Name="VCCLCompilerTool"
- AdditionalIncludeDirectories=""
- PreprocessorDefinitions="ZLIB_INTERNAL"
- />
- </FileConfiguration>
- </File>
- <File
- RelativePath="..\..\minizip\zip.c"
- >
- <FileConfiguration
- Name="Release|Win32"
- >
- <Tool
- Name="VCCLCompilerTool"
- AdditionalIncludeDirectories=""
- PreprocessorDefinitions="ZLIB_INTERNAL"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|x64"
- >
- <Tool
- Name="VCCLCompilerTool"
- AdditionalIncludeDirectories=""
- PreprocessorDefinitions="ZLIB_INTERNAL"
- />
- </FileConfiguration>
- <FileConfiguration
- Name="Release|Itanium"
- >
- <Tool
- Name="VCCLCompilerTool"
- AdditionalIncludeDirectories=""
- PreprocessorDefinitions="ZLIB_INTERNAL"
- />
- </FileConfiguration>
- </File>
- <File
- RelativePath=".\zlib.rc"
- >
- </File>
- <File
- RelativePath=".\zlibvc.def"
- >
- </File>
- <File
- RelativePath="..\..\..\zutil.c"
- >
- </File>
- </Filter>
- <Filter
- Name="Header Files"
- Filter="h;hpp;hxx;hm;inl;fi;fd"
- >
- <File
- RelativePath="..\..\..\deflate.h"
- >
- </File>
- <File
- RelativePath="..\..\..\infblock.h"
- >
- </File>
- <File
- RelativePath="..\..\..\infcodes.h"
- >
- </File>
- <File
- RelativePath="..\..\..\inffast.h"
- >
- </File>
- <File
- RelativePath="..\..\..\inftrees.h"
- >
- </File>
- <File
- RelativePath="..\..\..\infutil.h"
- >
- </File>
- <File
- RelativePath="..\..\..\zconf.h"
- >
- </File>
- <File
- RelativePath="..\..\..\zlib.h"
- >
- </File>
- <File
- RelativePath="..\..\..\zutil.h"
- >
- </File>
- </Filter>
- <Filter
- Name="Resource Files"
- Filter="ico;cur;bmp;dlg;rc2;rct;bin;cnt;rtf;gif;jpg;jpeg;jpe"
- >
- </Filter>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
diff --git a/compat/zlib/contrib/vstudio/vc9/zlib.rc b/compat/zlib/contrib/vstudio/vc9/zlib.rc
index f822450..8eca4db 100644
--- a/compat/zlib/contrib/vstudio/vc9/zlib.rc
+++ b/compat/zlib/contrib/vstudio/vc9/zlib.rc
@@ -2,8 +2,8 @@
#define IDR_VERSION1 1
IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE
- FILEVERSION 1,2,5,0
- PRODUCTVERSION 1,2,5,0
+ FILEVERSION 1.2.7,0
+ PRODUCTVERSION 1.2.7,0
FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
FILEFLAGS 0
FILEOS VOS_DOS_WINDOWS32
@@ -17,12 +17,12 @@ BEGIN
BEGIN
VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0"
- VALUE "FileVersion", "1.2.5\0"
+ VALUE "FileVersion", "1.2.7\0"
VALUE "InternalName", "zlib\0"
VALUE "OriginalFilename", "zlib.dll\0"
VALUE "ProductName", "ZLib.DLL\0"
VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
- VALUE "LegalCopyright", "(C) 1995-2010 Jean-loup Gailly & Mark Adler\0"
+ VALUE "LegalCopyright", "(C) 1995-2012 Jean-loup Gailly & Mark Adler\0"
END
END
BLOCK "VarFileInfo"
diff --git a/compat/zlib/contrib/vstudio/vc9/zlibvc.def b/compat/zlib/contrib/vstudio/vc9/zlibvc.def
index 0269ef7..2df8bb3 100644
--- a/compat/zlib/contrib/vstudio/vc9/zlibvc.def
+++ b/compat/zlib/contrib/vstudio/vc9/zlibvc.def
@@ -1,7 +1,7 @@
LIBRARY
; zlib data compression and ZIP file I/O library
-VERSION 1.24
+VERSION 1.2.7
EXPORTS
adler32 @1
@@ -55,6 +55,7 @@ EXPORTS
gzungetc @49
zlibCompileFlags @50
deflatePrime @51
+ deflatePending @52
unzOpen @61
unzClose @62
@@ -128,3 +129,11 @@ EXPORTS
inflatePrime @158
inflateReset2 @159
inflateUndermine @160
+
+; zlib1 v1.2.6 added:
+ gzgetc_ @161
+ inflateResetKeep @163
+ deflateResetKeep @164
+
+; zlib1 v1.2.7 added:
+ gzopen_w @165
diff --git a/compat/zlib/crc32.c b/compat/zlib/crc32.c
index 5511cd5..979a719 100644
--- a/compat/zlib/crc32.c
+++ b/compat/zlib/crc32.c
@@ -1,5 +1,5 @@
/* crc32.c -- compute the CRC-32 of a data stream
- * Copyright (C) 1995-2006, 2010 Mark Adler
+ * Copyright (C) 1995-2006, 2010, 2011, 2012 Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*
* Thanks to Rodney Brown <rbrown64@csc.com.au> for his contribution of faster
@@ -9,7 +9,7 @@
* factor of two increase in speed on a Power PC G4 (PPC7455) using gcc -O3.
*/
-/* @(#) $Id: crc32.c,v 1.3 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
/*
Note on the use of DYNAMIC_CRC_TABLE: there is no mutex or semaphore
@@ -17,6 +17,8 @@
of the crc tables. Therefore, if you #define DYNAMIC_CRC_TABLE, you should
first call get_crc_table() to initialize the tables before allowing more than
one thread to use crc32().
+
+ DYNAMIC_CRC_TABLE and MAKECRCH can be #defined to write out crc32.h.
*/
#ifdef MAKECRCH
@@ -30,31 +32,11 @@
#define local static
-/* Find a four-byte integer type for crc32_little() and crc32_big(). */
-#ifndef NOBYFOUR
-# ifdef STDC /* need ANSI C limits.h to determine sizes */
-# include <limits.h>
-# define BYFOUR
-# if (UINT_MAX == 0xffffffffUL)
- typedef unsigned int u4;
-# else
-# if (ULONG_MAX == 0xffffffffUL)
- typedef unsigned long u4;
-# else
-# if (USHRT_MAX == 0xffffffffUL)
- typedef unsigned short u4;
-# else
-# undef BYFOUR /* can't find a four-byte integer type! */
-# endif
-# endif
-# endif
-# endif /* STDC */
-#endif /* !NOBYFOUR */
-
/* Definitions for doing the crc four data bytes at a time. */
+#if !defined(NOBYFOUR) && defined(Z_U4)
+# define BYFOUR
+#endif
#ifdef BYFOUR
-# define REV(w) ((((w)>>24)&0xff)+(((w)>>8)&0xff00)+ \
- (((w)&0xff00)<<8)+(((w)&0xff)<<24))
local unsigned long crc32_little OF((unsigned long,
const unsigned char FAR *, unsigned));
local unsigned long crc32_big OF((unsigned long,
@@ -68,16 +50,16 @@
local unsigned long gf2_matrix_times OF((unsigned long *mat,
unsigned long vec));
local void gf2_matrix_square OF((unsigned long *square, unsigned long *mat));
-local uLong crc32_combine_(uLong crc1, uLong crc2, z_off64_t len2);
+local uLong crc32_combine_ OF((uLong crc1, uLong crc2, z_off64_t len2));
#ifdef DYNAMIC_CRC_TABLE
local volatile int crc_table_empty = 1;
-local unsigned long FAR crc_table[TBLS][256];
+local z_crc_t FAR crc_table[TBLS][256];
local void make_crc_table OF((void));
#ifdef MAKECRCH
- local void write_table OF((FILE *, const unsigned long FAR *));
+ local void write_table OF((FILE *, const z_crc_t FAR *));
#endif /* MAKECRCH */
/*
Generate tables for a byte-wise 32-bit CRC calculation on the polynomial:
@@ -107,9 +89,9 @@ local void make_crc_table OF((void));
*/
local void make_crc_table()
{
- unsigned long c;
+ z_crc_t c;
int n, k;
- unsigned long poly; /* polynomial exclusive-or pattern */
+ z_crc_t poly; /* polynomial exclusive-or pattern */
/* terms of polynomial defining this crc (except x^32): */
static volatile int first = 1; /* flag to limit concurrent making */
static const unsigned char p[] = {0,1,2,4,5,7,8,10,11,12,16,22,23,26};
@@ -121,13 +103,13 @@ local void make_crc_table()
first = 0;
/* make exclusive-or pattern from polynomial (0xedb88320UL) */
- poly = 0UL;
- for (n = 0; n < sizeof(p)/sizeof(unsigned char); n++)
- poly |= 1UL << (31 - p[n]);
+ poly = 0;
+ for (n = 0; n < (int)(sizeof(p)/sizeof(unsigned char)); n++)
+ poly |= (z_crc_t)1 << (31 - p[n]);
/* generate a crc for every 8-bit value */
for (n = 0; n < 256; n++) {
- c = (unsigned long)n;
+ c = (z_crc_t)n;
for (k = 0; k < 8; k++)
c = c & 1 ? poly ^ (c >> 1) : c >> 1;
crc_table[0][n] = c;
@@ -138,11 +120,11 @@ local void make_crc_table()
and then the byte reversal of those as well as the first table */
for (n = 0; n < 256; n++) {
c = crc_table[0][n];
- crc_table[4][n] = REV(c);
+ crc_table[4][n] = ZSWAP32(c);
for (k = 1; k < 4; k++) {
c = crc_table[0][c & 0xff] ^ (c >> 8);
crc_table[k][n] = c;
- crc_table[k + 4][n] = REV(c);
+ crc_table[k + 4][n] = ZSWAP32(c);
}
}
#endif /* BYFOUR */
@@ -164,7 +146,7 @@ local void make_crc_table()
if (out == NULL) return;
fprintf(out, "/* crc32.h -- tables for rapid CRC calculation\n");
fprintf(out, " * Generated automatically by crc32.c\n */\n\n");
- fprintf(out, "local const unsigned long FAR ");
+ fprintf(out, "local const z_crc_t FAR ");
fprintf(out, "crc_table[TBLS][256] =\n{\n {\n");
write_table(out, crc_table[0]);
# ifdef BYFOUR
@@ -184,12 +166,13 @@ local void make_crc_table()
#ifdef MAKECRCH
local void write_table(out, table)
FILE *out;
- const unsigned long FAR *table;
+ const z_crc_t FAR *table;
{
int n;
for (n = 0; n < 256; n++)
- fprintf(out, "%s0x%08lxUL%s", n % 5 ? "" : " ", table[n],
+ fprintf(out, "%s0x%08lxUL%s", n % 5 ? "" : " ",
+ (unsigned long)(table[n]),
n == 255 ? "\n" : (n % 5 == 4 ? ",\n" : ", "));
}
#endif /* MAKECRCH */
@@ -204,13 +187,13 @@ local void write_table(out, table)
/* =========================================================================
* This function can be used by asm versions of crc32()
*/
-const unsigned long FAR * ZEXPORT get_crc_table()
+const z_crc_t FAR * ZEXPORT get_crc_table()
{
#ifdef DYNAMIC_CRC_TABLE
if (crc_table_empty)
make_crc_table();
#endif /* DYNAMIC_CRC_TABLE */
- return (const unsigned long FAR *)crc_table;
+ return (const z_crc_t FAR *)crc_table;
}
/* ========================================================================= */
@@ -232,7 +215,7 @@ unsigned long ZEXPORT crc32(crc, buf, len)
#ifdef BYFOUR
if (sizeof(void *) == sizeof(ptrdiff_t)) {
- u4 endian;
+ z_crc_t endian;
endian = 1;
if (*((unsigned char *)(&endian)))
@@ -266,17 +249,17 @@ local unsigned long crc32_little(crc, buf, len)
const unsigned char FAR *buf;
unsigned len;
{
- register u4 c;
- register const u4 FAR *buf4;
+ register z_crc_t c;
+ register const z_crc_t FAR *buf4;
- c = (u4)crc;
+ c = (z_crc_t)crc;
c = ~c;
while (len && ((ptrdiff_t)buf & 3)) {
c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8);
len--;
}
- buf4 = (const u4 FAR *)(const void FAR *)buf;
+ buf4 = (const z_crc_t FAR *)(const void FAR *)buf;
while (len >= 32) {
DOLIT32;
len -= 32;
@@ -306,17 +289,17 @@ local unsigned long crc32_big(crc, buf, len)
const unsigned char FAR *buf;
unsigned len;
{
- register u4 c;
- register const u4 FAR *buf4;
+ register z_crc_t c;
+ register const z_crc_t FAR *buf4;
- c = REV((u4)crc);
+ c = ZSWAP32((z_crc_t)crc);
c = ~c;
while (len && ((ptrdiff_t)buf & 3)) {
c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8);
len--;
}
- buf4 = (const u4 FAR *)(const void FAR *)buf;
+ buf4 = (const z_crc_t FAR *)(const void FAR *)buf;
buf4--;
while (len >= 32) {
DOBIG32;
@@ -333,7 +316,7 @@ local unsigned long crc32_big(crc, buf, len)
c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8);
} while (--len);
c = ~c;
- return (unsigned long)(REV(c));
+ return (unsigned long)(ZSWAP32(c));
}
#endif /* BYFOUR */
diff --git a/compat/zlib/crc32.h b/compat/zlib/crc32.h
index 8053b61..9e0c778 100644
--- a/compat/zlib/crc32.h
+++ b/compat/zlib/crc32.h
@@ -2,7 +2,7 @@
* Generated automatically by crc32.c
*/
-local const unsigned long FAR crc_table[TBLS][256] =
+local const z_crc_t FAR crc_table[TBLS][256] =
{
{
0x00000000UL, 0x77073096UL, 0xee0e612cUL, 0x990951baUL, 0x076dc419UL,
diff --git a/compat/zlib/deflate.c b/compat/zlib/deflate.c
index fa892ad..9e4c2cb 100644
--- a/compat/zlib/deflate.c
+++ b/compat/zlib/deflate.c
@@ -1,5 +1,5 @@
/* deflate.c -- compress data using the deflation algorithm
- * Copyright (C) 1995-2010 Jean-loup Gailly and Mark Adler
+ * Copyright (C) 1995-2012 Jean-loup Gailly and Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*/
@@ -37,7 +37,7 @@
* REFERENCES
*
* Deutsch, L.P.,"DEFLATE Compressed Data Format Specification".
- * Available in http://www.ietf.org/rfc/rfc1951.txt
+ * Available in http://tools.ietf.org/html/rfc1951
*
* A description of the Rabin and Karp algorithm is given in the book
* "Algorithms" by R. Sedgewick, Addison-Wesley, p252.
@@ -47,12 +47,12 @@
*
*/
-/* @(#) $Id: deflate.c,v 1.3 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
#include "deflate.h"
const char deflate_copyright[] =
- " deflate 1.2.5 Copyright 1995-2010 Jean-loup Gailly and Mark Adler ";
+ " deflate 1.2.7 Copyright 1995-2012 Jean-loup Gailly and Mark Adler ";
/*
If you use the zlib library in a product, an acknowledgment is welcome
in the documentation of your product. If for some reason you cannot
@@ -155,6 +155,9 @@ local const config configuration_table[10] = {
struct static_tree_desc_s {int dummy;}; /* for buggy compilers */
#endif
+/* rank Z_BLOCK between Z_NO_FLUSH and Z_PARTIAL_FLUSH */
+#define RANK(f) (((f) << 1) - ((f) > 4 ? 9 : 0))
+
/* ===========================================================================
* Update a hash value with the given input byte
* IN assertion: all calls to to UPDATE_HASH are made with consecutive
@@ -235,10 +238,19 @@ int ZEXPORT deflateInit2_(strm, level, method, windowBits, memLevel, strategy,
strm->msg = Z_NULL;
if (strm->zalloc == (alloc_func)0) {
+#ifdef Z_SOLO
+ return Z_STREAM_ERROR;
+#else
strm->zalloc = zcalloc;
strm->opaque = (voidpf)0;
+#endif
}
- if (strm->zfree == (free_func)0) strm->zfree = zcfree;
+ if (strm->zfree == (free_func)0)
+#ifdef Z_SOLO
+ return Z_STREAM_ERROR;
+#else
+ strm->zfree = zcfree;
+#endif
#ifdef FASTEST
if (level != 0) level = 1;
@@ -314,43 +326,70 @@ int ZEXPORT deflateSetDictionary (strm, dictionary, dictLength)
uInt dictLength;
{
deflate_state *s;
- uInt length = dictLength;
- uInt n;
- IPos hash_head = 0;
+ uInt str, n;
+ int wrap;
+ unsigned avail;
+ unsigned char *next;
- if (strm == Z_NULL || strm->state == Z_NULL || dictionary == Z_NULL ||
- strm->state->wrap == 2 ||
- (strm->state->wrap == 1 && strm->state->status != INIT_STATE))
+ if (strm == Z_NULL || strm->state == Z_NULL || dictionary == Z_NULL)
return Z_STREAM_ERROR;
-
s = strm->state;
- if (s->wrap)
- strm->adler = adler32(strm->adler, dictionary, dictLength);
+ wrap = s->wrap;
+ if (wrap == 2 || (wrap == 1 && s->status != INIT_STATE) || s->lookahead)
+ return Z_STREAM_ERROR;
- if (length < MIN_MATCH) return Z_OK;
- if (length > s->w_size) {
- length = s->w_size;
- dictionary += dictLength - length; /* use the tail of the dictionary */
+ /* when using zlib wrappers, compute Adler-32 for provided dictionary */
+ if (wrap == 1)
+ strm->adler = adler32(strm->adler, dictionary, dictLength);
+ s->wrap = 0; /* avoid computing Adler-32 in read_buf */
+
+ /* if dictionary would fill window, just replace the history */
+ if (dictLength >= s->w_size) {
+ if (wrap == 0) { /* already empty otherwise */
+ CLEAR_HASH(s);
+ s->strstart = 0;
+ s->block_start = 0L;
+ s->insert = 0;
+ }
+ dictionary += dictLength - s->w_size; /* use the tail */
+ dictLength = s->w_size;
}
- zmemcpy(s->window, dictionary, length);
- s->strstart = length;
- s->block_start = (long)length;
- /* Insert all strings in the hash table (except for the last two bytes).
- * s->lookahead stays null, so s->ins_h will be recomputed at the next
- * call of fill_window.
- */
- s->ins_h = s->window[0];
- UPDATE_HASH(s, s->ins_h, s->window[1]);
- for (n = 0; n <= length - MIN_MATCH; n++) {
- INSERT_STRING(s, n, hash_head);
+ /* insert dictionary into window and hash */
+ avail = strm->avail_in;
+ next = strm->next_in;
+ strm->avail_in = dictLength;
+ strm->next_in = (Bytef *)dictionary;
+ fill_window(s);
+ while (s->lookahead >= MIN_MATCH) {
+ str = s->strstart;
+ n = s->lookahead - (MIN_MATCH-1);
+ do {
+ UPDATE_HASH(s, s->ins_h, s->window[str + MIN_MATCH-1]);
+#ifndef FASTEST
+ s->prev[str & s->w_mask] = s->head[s->ins_h];
+#endif
+ s->head[s->ins_h] = (Pos)str;
+ str++;
+ } while (--n);
+ s->strstart = str;
+ s->lookahead = MIN_MATCH-1;
+ fill_window(s);
}
- if (hash_head) hash_head = 0; /* to make compiler happy */
+ s->strstart += s->lookahead;
+ s->block_start = (long)s->strstart;
+ s->insert = s->lookahead;
+ s->lookahead = 0;
+ s->match_length = s->prev_length = MIN_MATCH-1;
+ s->match_available = 0;
+ strm->next_in = next;
+ strm->avail_in = avail;
+ s->wrap = wrap;
return Z_OK;
}
/* ========================================================================= */
-int ZEXPORT deflateReset (strm)
+int ZEXPORT deflateResetKeep (strm)
z_streamp strm;
{
deflate_state *s;
@@ -380,12 +419,23 @@ int ZEXPORT deflateReset (strm)
s->last_flush = Z_NO_FLUSH;
_tr_init(s);
- lm_init(s);
return Z_OK;
}
/* ========================================================================= */
+int ZEXPORT deflateReset (strm)
+ z_streamp strm;
+{
+ int ret;
+
+ ret = deflateResetKeep(strm);
+ if (ret == Z_OK)
+ lm_init(strm->state);
+ return ret;
+}
+
+/* ========================================================================= */
int ZEXPORT deflateSetHeader (strm, head)
z_streamp strm;
gz_headerp head;
@@ -397,14 +447,42 @@ int ZEXPORT deflateSetHeader (strm, head)
}
/* ========================================================================= */
+int ZEXPORT deflatePending (strm, pending, bits)
+ unsigned *pending;
+ int *bits;
+ z_streamp strm;
+{
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ if (pending != Z_NULL)
+ *pending = strm->state->pending;
+ if (bits != Z_NULL)
+ *bits = strm->state->bi_valid;
+ return Z_OK;
+}
+
+/* ========================================================================= */
int ZEXPORT deflatePrime (strm, bits, value)
z_streamp strm;
int bits;
int value;
{
+ deflate_state *s;
+ int put;
+
if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
- strm->state->bi_valid = bits;
- strm->state->bi_buf = (ush)(value & ((1 << bits) - 1));
+ s = strm->state;
+ if ((Bytef *)(s->d_buf) < s->pending_out + ((Buf_size + 7) >> 3))
+ return Z_BUF_ERROR;
+ do {
+ put = Buf_size - s->bi_valid;
+ if (put > bits)
+ put = bits;
+ s->bi_buf |= (ush)((value & ((1 << put) - 1)) << s->bi_valid);
+ s->bi_valid += put;
+ _tr_flush_bits(s);
+ value >>= put;
+ bits -= put;
+ } while (bits);
return Z_OK;
}
@@ -562,19 +640,22 @@ local void putShortMSB (s, b)
local void flush_pending(strm)
z_streamp strm;
{
- unsigned len = strm->state->pending;
+ unsigned len;
+ deflate_state *s = strm->state;
+ _tr_flush_bits(s);
+ len = s->pending;
if (len > strm->avail_out) len = strm->avail_out;
if (len == 0) return;
- zmemcpy(strm->next_out, strm->state->pending_out, len);
+ zmemcpy(strm->next_out, s->pending_out, len);
strm->next_out += len;
- strm->state->pending_out += len;
+ s->pending_out += len;
strm->total_out += len;
strm->avail_out -= len;
- strm->state->pending -= len;
- if (strm->state->pending == 0) {
- strm->state->pending_out = strm->state->pending_buf;
+ s->pending -= len;
+ if (s->pending == 0) {
+ s->pending_out = s->pending_buf;
}
}
@@ -801,7 +882,7 @@ int ZEXPORT deflate (strm, flush)
* flushes. For repeated and useless calls with Z_FINISH, we keep
* returning Z_STREAM_END instead of Z_BUF_ERROR.
*/
- } else if (strm->avail_in == 0 && flush <= old_flush &&
+ } else if (strm->avail_in == 0 && RANK(flush) <= RANK(old_flush) &&
flush != Z_FINISH) {
ERR_RETURN(strm, Z_BUF_ERROR);
}
@@ -850,6 +931,7 @@ int ZEXPORT deflate (strm, flush)
if (s->lookahead == 0) {
s->strstart = 0;
s->block_start = 0L;
+ s->insert = 0;
}
}
}
@@ -945,12 +1027,12 @@ int ZEXPORT deflateCopy (dest, source)
ss = source->state;
- zmemcpy(dest, source, sizeof(z_stream));
+ zmemcpy((voidpf)dest, (voidpf)source, sizeof(z_stream));
ds = (deflate_state *) ZALLOC(dest, 1, sizeof(deflate_state));
if (ds == Z_NULL) return Z_MEM_ERROR;
dest->state = (struct internal_state FAR *) ds;
- zmemcpy(ds, ss, sizeof(deflate_state));
+ zmemcpy((voidpf)ds, (voidpf)ss, sizeof(deflate_state));
ds->strm = dest;
ds->window = (Bytef *) ZALLOC(dest, ds->w_size, 2*sizeof(Byte));
@@ -966,8 +1048,8 @@ int ZEXPORT deflateCopy (dest, source)
}
/* following zmemcpy do not work for 16-bit MSDOS */
zmemcpy(ds->window, ss->window, ds->w_size * 2 * sizeof(Byte));
- zmemcpy(ds->prev, ss->prev, ds->w_size * sizeof(Pos));
- zmemcpy(ds->head, ss->head, ds->hash_size * sizeof(Pos));
+ zmemcpy((voidpf)ds->prev, (voidpf)ss->prev, ds->w_size * sizeof(Pos));
+ zmemcpy((voidpf)ds->head, (voidpf)ss->head, ds->hash_size * sizeof(Pos));
zmemcpy(ds->pending_buf, ss->pending_buf, (uInt)ds->pending_buf_size);
ds->pending_out = ds->pending_buf + (ss->pending_out - ss->pending_buf);
@@ -1001,15 +1083,15 @@ local int read_buf(strm, buf, size)
strm->avail_in -= len;
+ zmemcpy(buf, strm->next_in, len);
if (strm->state->wrap == 1) {
- strm->adler = adler32(strm->adler, strm->next_in, len);
+ strm->adler = adler32(strm->adler, buf, len);
}
#ifdef GZIP
else if (strm->state->wrap == 2) {
- strm->adler = crc32(strm->adler, strm->next_in, len);
+ strm->adler = crc32(strm->adler, buf, len);
}
#endif
- zmemcpy(buf, strm->next_in, len);
strm->next_in += len;
strm->total_in += len;
@@ -1036,6 +1118,7 @@ local void lm_init (s)
s->strstart = 0;
s->block_start = 0L;
s->lookahead = 0;
+ s->insert = 0;
s->match_length = s->prev_length = MIN_MATCH-1;
s->match_available = 0;
s->ins_h = 0;
@@ -1310,6 +1393,8 @@ local void fill_window(s)
unsigned more; /* Amount of free space at the end of the window. */
uInt wsize = s->w_size;
+ Assert(s->lookahead < MIN_LOOKAHEAD, "already enough lookahead");
+
do {
more = (unsigned)(s->window_size -(ulg)s->lookahead -(ulg)s->strstart);
@@ -1362,7 +1447,7 @@ local void fill_window(s)
#endif
more += wsize;
}
- if (s->strm->avail_in == 0) return;
+ if (s->strm->avail_in == 0) break;
/* If there was no sliding:
* strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 &&
@@ -1381,12 +1466,24 @@ local void fill_window(s)
s->lookahead += n;
/* Initialize the hash value now that we have some input: */
- if (s->lookahead >= MIN_MATCH) {
- s->ins_h = s->window[s->strstart];
- UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]);
+ if (s->lookahead + s->insert >= MIN_MATCH) {
+ uInt str = s->strstart - s->insert;
+ s->ins_h = s->window[str];
+ UPDATE_HASH(s, s->ins_h, s->window[str + 1]);
#if MIN_MATCH != 3
Call UPDATE_HASH() MIN_MATCH-3 more times
#endif
+ while (s->insert) {
+ UPDATE_HASH(s, s->ins_h, s->window[str + MIN_MATCH-1]);
+#ifndef FASTEST
+ s->prev[str & s->w_mask] = s->head[s->ins_h];
+#endif
+ s->head[s->ins_h] = (Pos)str;
+ str++;
+ s->insert--;
+ if (s->lookahead + s->insert < MIN_MATCH)
+ break;
+ }
}
/* If the whole input has less than MIN_MATCH bytes, ins_h is garbage,
* but this is not important since only literal bytes will be emitted.
@@ -1427,6 +1524,9 @@ local void fill_window(s)
s->high_water += init;
}
}
+
+ Assert((ulg)s->strstart <= s->window_size - MIN_LOOKAHEAD,
+ "not enough room for search");
}
/* ===========================================================================
@@ -1506,8 +1606,14 @@ local block_state deflate_stored(s, flush)
FLUSH_BLOCK(s, 0);
}
}
- FLUSH_BLOCK(s, flush == Z_FINISH);
- return flush == Z_FINISH ? finish_done : block_done;
+ s->insert = 0;
+ if (flush == Z_FINISH) {
+ FLUSH_BLOCK(s, 1);
+ return finish_done;
+ }
+ if ((long)s->strstart > s->block_start)
+ FLUSH_BLOCK(s, 0);
+ return block_done;
}
/* ===========================================================================
@@ -1603,8 +1709,14 @@ local block_state deflate_fast(s, flush)
}
if (bflush) FLUSH_BLOCK(s, 0);
}
- FLUSH_BLOCK(s, flush == Z_FINISH);
- return flush == Z_FINISH ? finish_done : block_done;
+ s->insert = s->strstart < MIN_MATCH-1 ? s->strstart : MIN_MATCH-1;
+ if (flush == Z_FINISH) {
+ FLUSH_BLOCK(s, 1);
+ return finish_done;
+ }
+ if (s->last_lit)
+ FLUSH_BLOCK(s, 0);
+ return block_done;
}
#ifndef FASTEST
@@ -1728,8 +1840,14 @@ local block_state deflate_slow(s, flush)
_tr_tally_lit(s, s->window[s->strstart-1], bflush);
s->match_available = 0;
}
- FLUSH_BLOCK(s, flush == Z_FINISH);
- return flush == Z_FINISH ? finish_done : block_done;
+ s->insert = s->strstart < MIN_MATCH-1 ? s->strstart : MIN_MATCH-1;
+ if (flush == Z_FINISH) {
+ FLUSH_BLOCK(s, 1);
+ return finish_done;
+ }
+ if (s->last_lit)
+ FLUSH_BLOCK(s, 0);
+ return block_done;
}
#endif /* FASTEST */
@@ -1749,11 +1867,11 @@ local block_state deflate_rle(s, flush)
for (;;) {
/* Make sure that we always have enough lookahead, except
* at the end of the input file. We need MAX_MATCH bytes
- * for the longest encodable run.
+ * for the longest run, plus one for the unrolled loop.
*/
- if (s->lookahead < MAX_MATCH) {
+ if (s->lookahead <= MAX_MATCH) {
fill_window(s);
- if (s->lookahead < MAX_MATCH && flush == Z_NO_FLUSH) {
+ if (s->lookahead <= MAX_MATCH && flush == Z_NO_FLUSH) {
return need_more;
}
if (s->lookahead == 0) break; /* flush the current block */
@@ -1776,6 +1894,7 @@ local block_state deflate_rle(s, flush)
if (s->match_length > s->lookahead)
s->match_length = s->lookahead;
}
+ Assert(scan <= s->window+(uInt)(s->window_size-1), "wild scan");
}
/* Emit match if have run of MIN_MATCH or longer, else emit literal */
@@ -1796,8 +1915,14 @@ local block_state deflate_rle(s, flush)
}
if (bflush) FLUSH_BLOCK(s, 0);
}
- FLUSH_BLOCK(s, flush == Z_FINISH);
- return flush == Z_FINISH ? finish_done : block_done;
+ s->insert = 0;
+ if (flush == Z_FINISH) {
+ FLUSH_BLOCK(s, 1);
+ return finish_done;
+ }
+ if (s->last_lit)
+ FLUSH_BLOCK(s, 0);
+ return block_done;
}
/* ===========================================================================
@@ -1829,6 +1954,12 @@ local block_state deflate_huff(s, flush)
s->strstart++;
if (bflush) FLUSH_BLOCK(s, 0);
}
- FLUSH_BLOCK(s, flush == Z_FINISH);
- return flush == Z_FINISH ? finish_done : block_done;
+ s->insert = 0;
+ if (flush == Z_FINISH) {
+ FLUSH_BLOCK(s, 1);
+ return finish_done;
+ }
+ if (s->last_lit)
+ FLUSH_BLOCK(s, 0);
+ return block_done;
}
diff --git a/compat/zlib/deflate.h b/compat/zlib/deflate.h
index 9199d88..fbac44d 100644
--- a/compat/zlib/deflate.h
+++ b/compat/zlib/deflate.h
@@ -1,5 +1,5 @@
/* deflate.h -- internal compression state
- * Copyright (C) 1995-2010 Jean-loup Gailly
+ * Copyright (C) 1995-2012 Jean-loup Gailly
* For conditions of distribution and use, see copyright notice in zlib.h
*/
@@ -8,7 +8,7 @@
subject to change. Applications should only use zlib.h.
*/
-/* @(#) $Id: deflate.h,v 1.3 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
#ifndef DEFLATE_H
#define DEFLATE_H
@@ -48,6 +48,9 @@
#define MAX_BITS 15
/* All codes must not exceed MAX_BITS bits */
+#define Buf_size 16
+/* size of bit buffer in bi_buf */
+
#define INIT_STATE 42
#define EXTRA_STATE 69
#define NAME_STATE 73
@@ -188,7 +191,7 @@ typedef struct internal_state {
int nice_match; /* Stop searching when current match exceeds this */
/* used by trees.c: */
- /* Didn't use ct_data typedef below to supress compiler warning */
+ /* Didn't use ct_data typedef below to suppress compiler warning */
struct ct_data_s dyn_ltree[HEAP_SIZE]; /* literal and length tree */
struct ct_data_s dyn_dtree[2*D_CODES+1]; /* distance tree */
struct ct_data_s bl_tree[2*BL_CODES+1]; /* Huffman tree for bit lengths */
@@ -244,7 +247,7 @@ typedef struct internal_state {
ulg opt_len; /* bit length of current block with optimal trees */
ulg static_len; /* bit length of current block with static trees */
uInt matches; /* number of string matches in current block */
- int last_eob_len; /* bit length of EOB code for last block */
+ uInt insert; /* bytes at end of window left to insert */
#ifdef DEBUG
ulg compressed_len; /* total bit length of compressed file mod 2^32 */
@@ -294,6 +297,7 @@ void ZLIB_INTERNAL _tr_init OF((deflate_state *s));
int ZLIB_INTERNAL _tr_tally OF((deflate_state *s, unsigned dist, unsigned lc));
void ZLIB_INTERNAL _tr_flush_block OF((deflate_state *s, charf *buf,
ulg stored_len, int last));
+void ZLIB_INTERNAL _tr_flush_bits OF((deflate_state *s));
void ZLIB_INTERNAL _tr_align OF((deflate_state *s));
void ZLIB_INTERNAL _tr_stored_block OF((deflate_state *s, charf *buf,
ulg stored_len, int last));
diff --git a/compat/zlib/doc/algorithm.txt b/compat/zlib/doc/algorithm.txt
index 34960bd..c97f495 100644
--- a/compat/zlib/doc/algorithm.txt
+++ b/compat/zlib/doc/algorithm.txt
@@ -206,4 +206,4 @@ Compression,'' IEEE Transactions on Information Theory, Vol. 23, No. 3,
pp. 337-343.
``DEFLATE Compressed Data Format Specification'' available in
-http://www.ietf.org/rfc/rfc1951.txt
+http://tools.ietf.org/html/rfc1951
diff --git a/compat/zlib/gzguts.h b/compat/zlib/gzguts.h
index 0f8fb79..ee3f281 100644
--- a/compat/zlib/gzguts.h
+++ b/compat/zlib/gzguts.h
@@ -1,5 +1,5 @@
/* gzguts.h -- zlib internal header definitions for gz* operations
- * Copyright (C) 2004, 2005, 2010 Mark Adler
+ * Copyright (C) 2004, 2005, 2010, 2011, 2012 Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*/
@@ -12,7 +12,7 @@
# endif
#endif
-#if ((__GNUC__-0) * 10 + __GNUC_MINOR__-0 >= 33) && !defined(NO_VIZ)
+#ifdef HAVE_HIDDEN
# define ZLIB_INTERNAL __attribute__((visibility ("hidden")))
#else
# define ZLIB_INTERNAL
@@ -27,13 +27,65 @@
#endif
#include <fcntl.h>
+#ifdef _WIN32
+# include <stddef.h>
+#endif
+
+#if defined(__TURBOC__) || defined(_MSC_VER) || defined(_WIN32)
+# include <io.h>
+#endif
+
#ifdef NO_DEFLATE /* for compatibility with old definition */
# define NO_GZCOMPRESS
#endif
-#ifdef _MSC_VER
-# include <io.h>
-# define vsnprintf _vsnprintf
+#if defined(STDC99) || (defined(__TURBOC__) && __TURBOC__ >= 0x550)
+# ifndef HAVE_VSNPRINTF
+# define HAVE_VSNPRINTF
+# endif
+#endif
+
+#if defined(__CYGWIN__)
+# ifndef HAVE_VSNPRINTF
+# define HAVE_VSNPRINTF
+# endif
+#endif
+
+#if defined(MSDOS) && defined(__BORLANDC__) && (BORLANDC > 0x410)
+# ifndef HAVE_VSNPRINTF
+# define HAVE_VSNPRINTF
+# endif
+#endif
+
+#ifndef HAVE_VSNPRINTF
+# ifdef MSDOS
+/* vsnprintf may exist on some MS-DOS compilers (DJGPP?),
+ but for now we just assume it doesn't. */
+# define NO_vsnprintf
+# endif
+# ifdef __TURBOC__
+# define NO_vsnprintf
+# endif
+# ifdef WIN32
+/* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */
+# if !defined(vsnprintf) && !defined(NO_vsnprintf)
+# if !defined(_MSC_VER) || ( defined(_MSC_VER) && _MSC_VER < 1500 )
+# define vsnprintf _vsnprintf
+# endif
+# endif
+# endif
+# ifdef __SASC
+# define NO_vsnprintf
+# endif
+# ifdef VMS
+# define NO_vsnprintf
+# endif
+# ifdef __OS400__
+# define NO_vsnprintf
+# endif
+# ifdef __MVS__
+# define NO_vsnprintf
+# endif
#endif
#ifndef local
@@ -52,7 +104,7 @@
# include <windows.h>
# define zstrerror() gz_strwinerror((DWORD)GetLastError())
#else
-# ifdef STDC
+# ifndef NO_STRERROR
# include <errno.h>
# define zstrerror() strerror(errno)
# else
@@ -68,6 +120,13 @@
ZEXTERN z_off64_t ZEXPORT gzoffset64 OF((gzFile));
#endif
+/* default memLevel */
+#if MAX_MEM_LEVEL >= 8
+# define DEF_MEM_LEVEL 8
+#else
+# define DEF_MEM_LEVEL MAX_MEM_LEVEL
+#endif
+
/* default i/o buffer size -- double this for output when reading */
#define GZBUFSIZE 8192
@@ -84,23 +143,25 @@
/* internal gzip file state data structure */
typedef struct {
+ /* exposed contents for gzgetc() macro */
+ struct gzFile_s x; /* "x" for exposed */
+ /* x.have: number of bytes available at x.next */
+ /* x.next: next output data to deliver or write */
+ /* x.pos: current position in uncompressed data */
/* used for both reading and writing */
int mode; /* see gzip modes above */
int fd; /* file descriptor */
char *path; /* path or fd for error messages */
- z_off64_t pos; /* current position in uncompressed data */
unsigned size; /* buffer size, zero if not allocated yet */
unsigned want; /* requested buffer size, default is GZBUFSIZE */
unsigned char *in; /* input buffer */
unsigned char *out; /* output buffer (double-sized when reading) */
- unsigned char *next; /* next output data to deliver or write */
+ int direct; /* 0 if processing gzip, 1 if transparent */
/* just for reading */
- unsigned have; /* amount of output data unused at next */
- int eof; /* true if end of input file reached */
- z_off64_t start; /* where the gzip data started, for rewinding */
- z_off64_t raw; /* where the raw data started, for seeking */
int how; /* 0: get header, 1: copy, 2: decompress */
- int direct; /* true if last read direct, false if gzip */
+ z_off64_t start; /* where the gzip data started, for rewinding */
+ int eof; /* true if end of input file reached */
+ int past; /* true if read requested past end */
/* just for writing */
int level; /* compression level */
int strategy; /* compression strategy */
diff --git a/compat/zlib/gzlib.c b/compat/zlib/gzlib.c
index 603e60e..ca55c6e 100644
--- a/compat/zlib/gzlib.c
+++ b/compat/zlib/gzlib.c
@@ -1,19 +1,23 @@
/* gzlib.c -- zlib functions common to reading and writing gzip files
- * Copyright (C) 2004, 2010 Mark Adler
+ * Copyright (C) 2004, 2010, 2011, 2012 Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*/
#include "gzguts.h"
+#if defined(_WIN32) && !defined(__BORLANDC__)
+# define LSEEK _lseeki64
+#else
#if defined(_LARGEFILE64_SOURCE) && _LFS64_LARGEFILE-0
# define LSEEK lseek64
#else
# define LSEEK lseek
#endif
+#endif
/* Local functions */
local void gz_reset OF((gz_statep));
-local gzFile gz_open OF((const char *, int, const char *));
+local gzFile gz_open OF((const void *, int, const char *));
#if defined UNDER_CE
@@ -71,25 +75,37 @@ char ZLIB_INTERNAL *gz_strwinerror (error)
local void gz_reset(state)
gz_statep state;
{
+ state->x.have = 0; /* no output data available */
if (state->mode == GZ_READ) { /* for reading ... */
- state->have = 0; /* no output data available */
state->eof = 0; /* not at end of file */
+ state->past = 0; /* have not read past end yet */
state->how = LOOK; /* look for gzip header */
- state->direct = 1; /* default for empty file */
}
state->seek = 0; /* no seek request pending */
gz_error(state, Z_OK, NULL); /* clear error */
- state->pos = 0; /* no uncompressed data yet */
+ state->x.pos = 0; /* no uncompressed data yet */
state->strm.avail_in = 0; /* no input data yet */
}
/* Open a gzip file either by name or file descriptor. */
local gzFile gz_open(path, fd, mode)
- const char *path;
+ const void *path;
int fd;
const char *mode;
{
gz_statep state;
+ size_t len;
+ int oflag;
+#ifdef O_CLOEXEC
+ int cloexec = 0;
+#endif
+#ifdef O_EXCL
+ int exclusive = 0;
+#endif
+
+ /* check input */
+ if (path == NULL)
+ return NULL;
/* allocate gzFile structure to return */
state = malloc(sizeof(gz_state));
@@ -103,6 +119,7 @@ local gzFile gz_open(path, fd, mode)
state->mode = GZ_NONE;
state->level = Z_DEFAULT_COMPRESSION;
state->strategy = Z_DEFAULT_STRATEGY;
+ state->direct = 0;
while (*mode) {
if (*mode >= '0' && *mode <= '9')
state->level = *mode - '0';
@@ -124,6 +141,16 @@ local gzFile gz_open(path, fd, mode)
return NULL;
case 'b': /* ignore -- will request binary anyway */
break;
+#ifdef O_CLOEXEC
+ case 'e':
+ cloexec = 1;
+ break;
+#endif
+#ifdef O_EXCL
+ case 'x':
+ exclusive = 1;
+ break;
+#endif
case 'f':
state->strategy = Z_FILTERED;
break;
@@ -135,6 +162,8 @@ local gzFile gz_open(path, fd, mode)
break;
case 'F':
state->strategy = Z_FIXED;
+ case 'T':
+ state->direct = 1;
default: /* could consider as an error, but just ignore */
;
}
@@ -147,30 +176,67 @@ local gzFile gz_open(path, fd, mode)
return NULL;
}
+ /* can't force transparent read */
+ if (state->mode == GZ_READ) {
+ if (state->direct) {
+ free(state);
+ return NULL;
+ }
+ state->direct = 1; /* for empty file */
+ }
+
/* save the path name for error messages */
- state->path = malloc(strlen(path) + 1);
+#ifdef _WIN32
+ if (fd == -2) {
+ len = wcstombs(NULL, path, 0);
+ if (len == (size_t)-1)
+ len = 0;
+ }
+ else
+#endif
+ len = strlen(path);
+ state->path = malloc(len + 1);
if (state->path == NULL) {
free(state);
return NULL;
}
- strcpy(state->path, path);
+#ifdef _WIN32
+ if (fd == -2)
+ if (len)
+ wcstombs(state->path, path, len + 1);
+ else
+ *(state->path) = 0;
+ else
+#endif
+ strcpy(state->path, path);
- /* open the file with the appropriate mode (or just use fd) */
- state->fd = fd != -1 ? fd :
- open(path,
+ /* compute the flags for open() */
+ oflag =
#ifdef O_LARGEFILE
- O_LARGEFILE |
+ O_LARGEFILE |
#endif
#ifdef O_BINARY
- O_BINARY |
+ O_BINARY |
+#endif
+#ifdef O_CLOEXEC
+ (cloexec ? O_CLOEXEC : 0) |
#endif
- (state->mode == GZ_READ ?
- O_RDONLY :
- (O_WRONLY | O_CREAT | (
- state->mode == GZ_WRITE ?
- O_TRUNC :
- O_APPEND))),
- 0666);
+ (state->mode == GZ_READ ?
+ O_RDONLY :
+ (O_WRONLY | O_CREAT |
+#ifdef O_EXCL
+ (exclusive ? O_EXCL : 0) |
+#endif
+ (state->mode == GZ_WRITE ?
+ O_TRUNC :
+ O_APPEND)));
+
+ /* open the file with the appropriate flags (or just use fd) */
+ state->fd = fd > -1 ? fd : (
+#ifdef _WIN32
+ fd == -2 ? _wopen(path, oflag, 0666) :
+#endif
+ open(path, oflag, 0666));
if (state->fd == -1) {
free(state->path);
free(state);
@@ -225,6 +291,16 @@ gzFile ZEXPORT gzdopen(fd, mode)
}
/* -- see zlib.h -- */
+#ifdef _WIN32
+gzFile ZEXPORT gzopen_w(path, mode)
+ const wchar_t *path;
+ const char *mode;
+{
+ return gz_open(path, -2, mode);
+}
+#endif
+
+/* -- see zlib.h -- */
int ZEXPORT gzbuffer(file, size)
gzFile file;
unsigned size;
@@ -243,8 +319,8 @@ int ZEXPORT gzbuffer(file, size)
return -1;
/* check and set requested size */
- if (size == 0)
- return -1;
+ if (size < 2)
+ size = 2; /* need two bytes to check magic header */
state->want = size;
return 0;
}
@@ -261,7 +337,8 @@ int ZEXPORT gzrewind(file)
state = (gz_statep)file;
/* check that we're reading and that there's no error */
- if (state->mode != GZ_READ || state->err != Z_OK)
+ if (state->mode != GZ_READ ||
+ (state->err != Z_OK && state->err != Z_BUF_ERROR))
return -1;
/* back up and start over */
@@ -289,7 +366,7 @@ z_off64_t ZEXPORT gzseek64(file, offset, whence)
return -1;
/* check that there's no error */
- if (state->err != Z_OK)
+ if (state->err != Z_OK && state->err != Z_BUF_ERROR)
return -1;
/* can only seek from start or relative to current position */
@@ -298,31 +375,32 @@ z_off64_t ZEXPORT gzseek64(file, offset, whence)
/* normalize offset to a SEEK_CUR specification */
if (whence == SEEK_SET)
- offset -= state->pos;
+ offset -= state->x.pos;
else if (state->seek)
offset += state->skip;
state->seek = 0;
/* if within raw area while reading, just go there */
if (state->mode == GZ_READ && state->how == COPY &&
- state->pos + offset >= state->raw) {
- ret = LSEEK(state->fd, offset - state->have, SEEK_CUR);
+ state->x.pos + offset >= 0) {
+ ret = LSEEK(state->fd, offset - state->x.have, SEEK_CUR);
if (ret == -1)
return -1;
- state->have = 0;
+ state->x.have = 0;
state->eof = 0;
+ state->past = 0;
state->seek = 0;
gz_error(state, Z_OK, NULL);
state->strm.avail_in = 0;
- state->pos += offset;
- return state->pos;
+ state->x.pos += offset;
+ return state->x.pos;
}
/* calculate skip amount, rewinding if needed for back seek when reading */
if (offset < 0) {
if (state->mode != GZ_READ) /* writing -- can't go backwards */
return -1;
- offset += state->pos;
+ offset += state->x.pos;
if (offset < 0) /* before start of file! */
return -1;
if (gzrewind(file) == -1) /* rewind, then skip to offset */
@@ -331,11 +409,11 @@ z_off64_t ZEXPORT gzseek64(file, offset, whence)
/* if reading, skip what's in output buffer (one less gzgetc() check) */
if (state->mode == GZ_READ) {
- n = GT_OFF(state->have) || (z_off64_t)state->have > offset ?
- (unsigned)offset : state->have;
- state->have -= n;
- state->next += n;
- state->pos += n;
+ n = GT_OFF(state->x.have) || (z_off64_t)state->x.have > offset ?
+ (unsigned)offset : state->x.have;
+ state->x.have -= n;
+ state->x.next += n;
+ state->x.pos += n;
offset -= n;
}
@@ -344,7 +422,7 @@ z_off64_t ZEXPORT gzseek64(file, offset, whence)
state->seek = 1;
state->skip = offset;
}
- return state->pos + offset;
+ return state->x.pos + offset;
}
/* -- see zlib.h -- */
@@ -373,7 +451,7 @@ z_off64_t ZEXPORT gztell64(file)
return -1;
/* return position */
- return state->pos + (state->seek ? state->skip : 0);
+ return state->x.pos + (state->seek ? state->skip : 0);
}
/* -- see zlib.h -- */
@@ -433,8 +511,7 @@ int ZEXPORT gzeof(file)
return 0;
/* return end-of-file state */
- return state->mode == GZ_READ ?
- (state->eof && state->strm.avail_in == 0 && state->have == 0) : 0;
+ return state->mode == GZ_READ ? state->past : 0;
}
/* -- see zlib.h -- */
@@ -471,8 +548,10 @@ void ZEXPORT gzclearerr(file)
return;
/* clear error and end-of-file */
- if (state->mode == GZ_READ)
+ if (state->mode == GZ_READ) {
state->eof = 0;
+ state->past = 0;
+ }
gz_error(state, Z_OK, NULL);
}
@@ -494,6 +573,10 @@ void ZLIB_INTERNAL gz_error(state, err, msg)
state->msg = NULL;
}
+ /* if fatal, set state->x.have to 0 so that the gzgetc() macro fails */
+ if (err != Z_OK && err != Z_BUF_ERROR)
+ state->x.have = 0;
+
/* set error code, and if no message, then done */
state->err = err;
if (msg == NULL)
diff --git a/compat/zlib/gzread.c b/compat/zlib/gzread.c
index 548201a..3493d34 100644
--- a/compat/zlib/gzread.c
+++ b/compat/zlib/gzread.c
@@ -1,5 +1,5 @@
/* gzread.c -- zlib functions for reading gzip files
- * Copyright (C) 2004, 2005, 2010 Mark Adler
+ * Copyright (C) 2004, 2005, 2010, 2011, 2012 Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*/
@@ -8,10 +8,9 @@
/* Local functions */
local int gz_load OF((gz_statep, unsigned char *, unsigned, unsigned *));
local int gz_avail OF((gz_statep));
-local int gz_next4 OF((gz_statep, unsigned long *));
-local int gz_head OF((gz_statep));
+local int gz_look OF((gz_statep));
local int gz_decomp OF((gz_statep));
-local int gz_make OF((gz_statep));
+local int gz_fetch OF((gz_statep));
local int gz_skip OF((gz_statep, z_off64_t));
/* Use read() to load a buffer -- return -1 on error, otherwise 0. Read from
@@ -46,67 +45,47 @@ local int gz_load(state, buf, len, have)
error, 0 otherwise. Note that the eof flag is set when the end of the input
file is reached, even though there may be unused data in the buffer. Once
that data has been used, no more attempts will be made to read the file.
- gz_avail() assumes that strm->avail_in == 0. */
+ If strm->avail_in != 0, then the current data is moved to the beginning of
+ the input buffer, and then the remainder of the buffer is loaded with the
+ available data from the input file. */
local int gz_avail(state)
gz_statep state;
{
+ unsigned got;
z_streamp strm = &(state->strm);
- if (state->err != Z_OK)
+ if (state->err != Z_OK && state->err != Z_BUF_ERROR)
return -1;
if (state->eof == 0) {
- if (gz_load(state, state->in, state->size,
- (unsigned *)&(strm->avail_in)) == -1)
+ if (strm->avail_in) { /* copy what's there to the start */
+ unsigned char *p = state->in, *q = strm->next_in;
+ unsigned n = strm->avail_in;
+ do {
+ *p++ = *q++;
+ } while (--n);
+ }
+ if (gz_load(state, state->in + strm->avail_in,
+ state->size - strm->avail_in, &got) == -1)
return -1;
+ strm->avail_in += got;
strm->next_in = state->in;
}
return 0;
}
-/* Get next byte from input, or -1 if end or error. */
-#define NEXT() ((strm->avail_in == 0 && gz_avail(state) == -1) ? -1 : \
- (strm->avail_in == 0 ? -1 : \
- (strm->avail_in--, *(strm->next_in)++)))
-
-/* Get a four-byte little-endian integer and return 0 on success and the value
- in *ret. Otherwise -1 is returned and *ret is not modified. */
-local int gz_next4(state, ret)
- gz_statep state;
- unsigned long *ret;
-{
- int ch;
- unsigned long val;
- z_streamp strm = &(state->strm);
-
- val = NEXT();
- val += (unsigned)NEXT() << 8;
- val += (unsigned long)NEXT() << 16;
- ch = NEXT();
- if (ch == -1)
- return -1;
- val += (unsigned long)ch << 24;
- *ret = val;
- return 0;
-}
-
-/* Look for gzip header, set up for inflate or copy. state->have must be zero.
+/* Look for gzip header, set up for inflate or copy. state->x.have must be 0.
If this is the first time in, allocate required memory. state->how will be
left unchanged if there is no more input data available, will be set to COPY
if there is no gzip header and direct copying will be performed, or it will
- be set to GZIP for decompression, and the gzip header will be skipped so
- that the next available input data is the raw deflate stream. If direct
- copying, then leftover input data from the input buffer will be copied to
- the output buffer. In that case, all further file reads will be directly to
- either the output buffer or a user buffer. If decompressing, the inflate
- state and the check value will be initialized. gz_head() will return 0 on
- success or -1 on failure. Failures may include read errors or gzip header
- errors. */
-local int gz_head(state)
+ be set to GZIP for decompression. If direct copying, then leftover input
+ data from the input buffer will be copied to the output buffer. In that
+ case, all further file reads will be directly to either the output buffer or
+ a user buffer. If decompressing, the inflate state will be initialized.
+ gz_look() will return 0 on success or -1 on failure. */
+local int gz_look(state)
gz_statep state;
{
z_streamp strm = &(state->strm);
- int flags;
- unsigned len;
/* allocate read buffers and inflate memory */
if (state->size == 0) {
@@ -129,7 +108,7 @@ local int gz_head(state)
state->strm.opaque = Z_NULL;
state->strm.avail_in = 0;
state->strm.next_in = Z_NULL;
- if (inflateInit2(&(state->strm), -15) != Z_OK) { /* raw inflate */
+ if (inflateInit2(&(state->strm), 15 + 16) != Z_OK) { /* gunzip */
free(state->out);
free(state->in);
state->size = 0;
@@ -138,83 +117,45 @@ local int gz_head(state)
}
}
- /* get some data in the input buffer */
- if (strm->avail_in == 0) {
+ /* get at least the magic bytes in the input buffer */
+ if (strm->avail_in < 2) {
if (gz_avail(state) == -1)
return -1;
if (strm->avail_in == 0)
return 0;
}
- /* look for the gzip magic header bytes 31 and 139 */
- if (strm->next_in[0] == 31) {
- strm->avail_in--;
- strm->next_in++;
- if (strm->avail_in == 0 && gz_avail(state) == -1)
- return -1;
- if (strm->avail_in && strm->next_in[0] == 139) {
- /* we have a gzip header, woo hoo! */
- strm->avail_in--;
- strm->next_in++;
-
- /* skip rest of header */
- if (NEXT() != 8) { /* compression method */
- gz_error(state, Z_DATA_ERROR, "unknown compression method");
- return -1;
- }
- flags = NEXT();
- if (flags & 0xe0) { /* reserved flag bits */
- gz_error(state, Z_DATA_ERROR, "unknown header flags set");
- return -1;
- }
- NEXT(); /* modification time */
- NEXT();
- NEXT();
- NEXT();
- NEXT(); /* extra flags */
- NEXT(); /* operating system */
- if (flags & 4) { /* extra field */
- len = (unsigned)NEXT();
- len += (unsigned)NEXT() << 8;
- while (len--)
- if (NEXT() < 0)
- break;
- }
- if (flags & 8) /* file name */
- while (NEXT() > 0)
- ;
- if (flags & 16) /* comment */
- while (NEXT() > 0)
- ;
- if (flags & 2) { /* header crc */
- NEXT();
- NEXT();
- }
- /* an unexpected end of file is not checked for here -- it will be
- noticed on the first request for uncompressed data */
-
- /* set up for decompression */
- inflateReset(strm);
- strm->adler = crc32(0L, Z_NULL, 0);
- state->how = GZIP;
- state->direct = 0;
- return 0;
- }
- else {
- /* not a gzip file -- save first byte (31) and fall to raw i/o */
- state->out[0] = 31;
- state->have = 1;
- }
+ /* look for gzip magic bytes -- if there, do gzip decoding (note: there is
+ a logical dilemma here when considering the case of a partially written
+ gzip file, to wit, if a single 31 byte is written, then we cannot tell
+ whether this is a single-byte file, or just a partially written gzip
+ file -- for here we assume that if a gzip file is being written, then
+ the header will be written in a single operation, so that reading a
+ single byte is sufficient indication that it is not a gzip file) */
+ if (strm->avail_in > 1 &&
+ strm->next_in[0] == 31 && strm->next_in[1] == 139) {
+ inflateReset(strm);
+ state->how = GZIP;
+ state->direct = 0;
+ return 0;
+ }
+
+ /* no gzip header -- if we were decoding gzip before, then this is trailing
+ garbage. Ignore the trailing garbage and finish. */
+ if (state->direct == 0) {
+ strm->avail_in = 0;
+ state->eof = 1;
+ state->x.have = 0;
+ return 0;
}
- /* doing raw i/o, save start of raw data for seeking, copy any leftover
- input to output -- this assumes that the output buffer is larger than
- the input buffer, which also assures space for gzungetc() */
- state->raw = state->pos;
- state->next = state->out;
+ /* doing raw i/o, copy any leftover input to output -- this assumes that
+ the output buffer is larger than the input buffer, which also assures
+ space for gzungetc() */
+ state->x.next = state->out;
if (strm->avail_in) {
- memcpy(state->next + state->have, strm->next_in, strm->avail_in);
- state->have += strm->avail_in;
+ memcpy(state->x.next, strm->next_in, strm->avail_in);
+ state->x.have = strm->avail_in;
strm->avail_in = 0;
}
state->how = COPY;
@@ -223,19 +164,15 @@ local int gz_head(state)
}
/* Decompress from input to the provided next_out and avail_out in the state.
- If the end of the compressed data is reached, then verify the gzip trailer
- check value and length (modulo 2^32). state->have and state->next are set
- to point to the just decompressed data, and the crc is updated. If the
- trailer is verified, state->how is reset to LOOK to look for the next gzip
- stream or raw data, once state->have is depleted. Returns 0 on success, -1
- on failure. Failures may include invalid compressed data or a failed gzip
- trailer verification. */
+ On return, state->x.have and state->x.next point to the just decompressed
+ data. If the gzip stream completes, state->how is reset to LOOK to look for
+ the next gzip stream or raw data, once state->x.have is depleted. Returns 0
+ on success, -1 on failure. */
local int gz_decomp(state)
gz_statep state;
{
- int ret;
+ int ret = Z_OK;
unsigned had;
- unsigned long crc, len;
z_streamp strm = &(state->strm);
/* fill output buffer up to end of deflate stream */
@@ -245,15 +182,15 @@ local int gz_decomp(state)
if (strm->avail_in == 0 && gz_avail(state) == -1)
return -1;
if (strm->avail_in == 0) {
- gz_error(state, Z_DATA_ERROR, "unexpected end of file");
- return -1;
+ gz_error(state, Z_BUF_ERROR, "unexpected end of file");
+ break;
}
/* decompress and handle errors */
ret = inflate(strm, Z_NO_FLUSH);
if (ret == Z_STREAM_ERROR || ret == Z_NEED_DICT) {
gz_error(state, Z_STREAM_ERROR,
- "internal error: inflate stream corrupt");
+ "internal error: inflate stream corrupt");
return -1;
}
if (ret == Z_MEM_ERROR) {
@@ -262,67 +199,55 @@ local int gz_decomp(state)
}
if (ret == Z_DATA_ERROR) { /* deflate stream invalid */
gz_error(state, Z_DATA_ERROR,
- strm->msg == NULL ? "compressed data error" : strm->msg);
+ strm->msg == NULL ? "compressed data error" : strm->msg);
return -1;
}
} while (strm->avail_out && ret != Z_STREAM_END);
- /* update available output and crc check value */
- state->have = had - strm->avail_out;
- state->next = strm->next_out - state->have;
- strm->adler = crc32(strm->adler, state->next, state->have);
+ /* update available output */
+ state->x.have = had - strm->avail_out;
+ state->x.next = strm->next_out - state->x.have;
- /* check gzip trailer if at end of deflate stream */
- if (ret == Z_STREAM_END) {
- if (gz_next4(state, &crc) == -1 || gz_next4(state, &len) == -1) {
- gz_error(state, Z_DATA_ERROR, "unexpected end of file");
- return -1;
- }
- if (crc != strm->adler) {
- gz_error(state, Z_DATA_ERROR, "incorrect data check");
- return -1;
- }
- if (len != (strm->total_out & 0xffffffffL)) {
- gz_error(state, Z_DATA_ERROR, "incorrect length check");
- return -1;
- }
- state->how = LOOK; /* ready for next stream, once have is 0 (leave
- state->direct unchanged to remember how) */
- }
+ /* if the gzip stream completed successfully, look for another */
+ if (ret == Z_STREAM_END)
+ state->how = LOOK;
/* good decompression */
return 0;
}
-/* Make data and put in the output buffer. Assumes that state->have == 0.
+/* Fetch data and put it in the output buffer. Assumes state->x.have is 0.
Data is either copied from the input file or decompressed from the input
file depending on state->how. If state->how is LOOK, then a gzip header is
- looked for (and skipped if found) to determine wither to copy or decompress.
- Returns -1 on error, otherwise 0. gz_make() will leave state->have as COPY
- or GZIP unless the end of the input file has been reached and all data has
- been processed. */
-local int gz_make(state)
+ looked for to determine whether to copy or decompress. Returns -1 on error,
+ otherwise 0. gz_fetch() will leave state->how as COPY or GZIP unless the
+ end of the input file has been reached and all data has been processed. */
+local int gz_fetch(state)
gz_statep state;
{
z_streamp strm = &(state->strm);
- if (state->how == LOOK) { /* look for gzip header */
- if (gz_head(state) == -1)
- return -1;
- if (state->have) /* got some data from gz_head() */
+ do {
+ switch(state->how) {
+ case LOOK: /* -> LOOK, COPY (only if never GZIP), or GZIP */
+ if (gz_look(state) == -1)
+ return -1;
+ if (state->how == LOOK)
+ return 0;
+ break;
+ case COPY: /* -> COPY */
+ if (gz_load(state, state->out, state->size << 1, &(state->x.have))
+ == -1)
+ return -1;
+ state->x.next = state->out;
return 0;
- }
- if (state->how == COPY) { /* straight copy */
- if (gz_load(state, state->out, state->size << 1, &(state->have)) == -1)
- return -1;
- state->next = state->out;
- }
- else if (state->how == GZIP) { /* decompress */
- strm->avail_out = state->size << 1;
- strm->next_out = state->out;
- if (gz_decomp(state) == -1)
- return -1;
- }
+ case GZIP: /* -> GZIP or LOOK (if end of gzip stream) */
+ strm->avail_out = state->size << 1;
+ strm->next_out = state->out;
+ if (gz_decomp(state) == -1)
+ return -1;
+ }
+ } while (state->x.have == 0 && (!state->eof || strm->avail_in));
return 0;
}
@@ -336,12 +261,12 @@ local int gz_skip(state, len)
/* skip over len bytes or reach end-of-file, whichever comes first */
while (len)
/* skip over whatever is in output buffer */
- if (state->have) {
- n = GT_OFF(state->have) || (z_off64_t)state->have > len ?
- (unsigned)len : state->have;
- state->have -= n;
- state->next += n;
- state->pos += n;
+ if (state->x.have) {
+ n = GT_OFF(state->x.have) || (z_off64_t)state->x.have > len ?
+ (unsigned)len : state->x.have;
+ state->x.have -= n;
+ state->x.next += n;
+ state->x.pos += n;
len -= n;
}
@@ -352,7 +277,7 @@ local int gz_skip(state, len)
/* need more data to skip -- load up output buffer */
else {
/* get more output, looking for header if required */
- if (gz_make(state) == -1)
+ if (gz_fetch(state) == -1)
return -1;
}
return 0;
@@ -374,14 +299,15 @@ int ZEXPORT gzread(file, buf, len)
state = (gz_statep)file;
strm = &(state->strm);
- /* check that we're reading and that there's no error */
- if (state->mode != GZ_READ || state->err != Z_OK)
+ /* check that we're reading and that there's no (serious) error */
+ if (state->mode != GZ_READ ||
+ (state->err != Z_OK && state->err != Z_BUF_ERROR))
return -1;
/* since an int is returned, make sure len fits in one, otherwise return
with an error (this avoids the flaw in the interface) */
if ((int)len < 0) {
- gz_error(state, Z_BUF_ERROR, "requested length does not fit in int");
+ gz_error(state, Z_DATA_ERROR, "requested length does not fit in int");
return -1;
}
@@ -400,24 +326,26 @@ int ZEXPORT gzread(file, buf, len)
got = 0;
do {
/* first just try copying data from the output buffer */
- if (state->have) {
- n = state->have > len ? len : state->have;
- memcpy(buf, state->next, n);
- state->next += n;
- state->have -= n;
+ if (state->x.have) {
+ n = state->x.have > len ? len : state->x.have;
+ memcpy(buf, state->x.next, n);
+ state->x.next += n;
+ state->x.have -= n;
}
/* output buffer empty -- return if we're at the end of the input */
- else if (state->eof && strm->avail_in == 0)
+ else if (state->eof && strm->avail_in == 0) {
+ state->past = 1; /* tried to read past end */
break;
+ }
/* need output data -- for small len or new stream load up our output
buffer */
else if (state->how == LOOK || len < (state->size << 1)) {
/* get more output, looking for header if required */
- if (gz_make(state) == -1)
+ if (gz_fetch(state) == -1)
return -1;
- continue; /* no progress yet -- go back to memcpy() above */
+ continue; /* no progress yet -- go back to copy above */
/* the copy above assures that we will leave with space in the
output buffer, allowing at least one gzungetc() to succeed */
}
@@ -434,15 +362,15 @@ int ZEXPORT gzread(file, buf, len)
strm->next_out = buf;
if (gz_decomp(state) == -1)
return -1;
- n = state->have;
- state->have = 0;
+ n = state->x.have;
+ state->x.have = 0;
}
/* update progress */
len -= n;
buf = (char *)buf + n;
got += n;
- state->pos += n;
+ state->x.pos += n;
} while (len);
/* return number of bytes read into user buffer (will fit in int) */
@@ -450,6 +378,7 @@ int ZEXPORT gzread(file, buf, len)
}
/* -- see zlib.h -- */
+#undef gzgetc
int ZEXPORT gzgetc(file)
gzFile file;
{
@@ -462,15 +391,16 @@ int ZEXPORT gzgetc(file)
return -1;
state = (gz_statep)file;
- /* check that we're reading and that there's no error */
- if (state->mode != GZ_READ || state->err != Z_OK)
+ /* check that we're reading and that there's no (serious) error */
+ if (state->mode != GZ_READ ||
+ (state->err != Z_OK && state->err != Z_BUF_ERROR))
return -1;
/* try output buffer (no need to check for skip request) */
- if (state->have) {
- state->have--;
- state->pos++;
- return *(state->next)++;
+ if (state->x.have) {
+ state->x.have--;
+ state->x.pos++;
+ return *(state->x.next)++;
}
/* nothing there -- try gzread() */
@@ -478,6 +408,12 @@ int ZEXPORT gzgetc(file)
return ret < 1 ? -1 : buf[0];
}
+int ZEXPORT gzgetc_(file)
+gzFile file;
+{
+ return gzgetc(file);
+}
+
/* -- see zlib.h -- */
int ZEXPORT gzungetc(c, file)
int c;
@@ -490,8 +426,9 @@ int ZEXPORT gzungetc(c, file)
return -1;
state = (gz_statep)file;
- /* check that we're reading and that there's no error */
- if (state->mode != GZ_READ || state->err != Z_OK)
+ /* check that we're reading and that there's no (serious) error */
+ if (state->mode != GZ_READ ||
+ (state->err != Z_OK && state->err != Z_BUF_ERROR))
return -1;
/* process a skip request */
@@ -506,32 +443,34 @@ int ZEXPORT gzungetc(c, file)
return -1;
/* if output buffer empty, put byte at end (allows more pushing) */
- if (state->have == 0) {
- state->have = 1;
- state->next = state->out + (state->size << 1) - 1;
- state->next[0] = c;
- state->pos--;
+ if (state->x.have == 0) {
+ state->x.have = 1;
+ state->x.next = state->out + (state->size << 1) - 1;
+ state->x.next[0] = c;
+ state->x.pos--;
+ state->past = 0;
return c;
}
/* if no room, give up (must have already done a gzungetc()) */
- if (state->have == (state->size << 1)) {
- gz_error(state, Z_BUF_ERROR, "out of room to push characters");
+ if (state->x.have == (state->size << 1)) {
+ gz_error(state, Z_DATA_ERROR, "out of room to push characters");
return -1;
}
/* slide output data if needed and insert byte before existing data */
- if (state->next == state->out) {
- unsigned char *src = state->out + state->have;
+ if (state->x.next == state->out) {
+ unsigned char *src = state->out + state->x.have;
unsigned char *dest = state->out + (state->size << 1);
while (src > state->out)
*--dest = *--src;
- state->next = dest;
+ state->x.next = dest;
}
- state->have++;
- state->next--;
- state->next[0] = c;
- state->pos--;
+ state->x.have++;
+ state->x.next--;
+ state->x.next[0] = c;
+ state->x.pos--;
+ state->past = 0;
return c;
}
@@ -551,8 +490,9 @@ char * ZEXPORT gzgets(file, buf, len)
return NULL;
state = (gz_statep)file;
- /* check that we're reading and that there's no error */
- if (state->mode != GZ_READ || state->err != Z_OK)
+ /* check that we're reading and that there's no (serious) error */
+ if (state->mode != GZ_READ ||
+ (state->err != Z_OK && state->err != Z_BUF_ERROR))
return NULL;
/* process a skip request */
@@ -569,32 +509,31 @@ char * ZEXPORT gzgets(file, buf, len)
left = (unsigned)len - 1;
if (left) do {
/* assure that something is in the output buffer */
- if (state->have == 0) {
- if (gz_make(state) == -1)
- return NULL; /* error */
- if (state->have == 0) { /* end of file */
- if (buf == str) /* got bupkus */
- return NULL;
- break; /* got something -- return it */
- }
+ if (state->x.have == 0 && gz_fetch(state) == -1)
+ return NULL; /* error */
+ if (state->x.have == 0) { /* end of file */
+ state->past = 1; /* read past end */
+ break; /* return what we have */
}
/* look for end-of-line in current output buffer */
- n = state->have > left ? left : state->have;
- eol = memchr(state->next, '\n', n);
+ n = state->x.have > left ? left : state->x.have;
+ eol = memchr(state->x.next, '\n', n);
if (eol != NULL)
- n = (unsigned)(eol - state->next) + 1;
+ n = (unsigned)(eol - state->x.next) + 1;
/* copy through end-of-line, or remainder if not found */
- memcpy(buf, state->next, n);
- state->have -= n;
- state->next += n;
- state->pos += n;
+ memcpy(buf, state->x.next, n);
+ state->x.have -= n;
+ state->x.next += n;
+ state->x.pos += n;
left -= n;
buf += n;
} while (left && eol == NULL);
- /* found end-of-line or out of space -- terminate string and return it */
+ /* return terminated string, or if nothing, end of file */
+ if (buf == str)
+ return NULL;
buf[0] = 0;
return str;
}
@@ -610,16 +549,12 @@ int ZEXPORT gzdirect(file)
return 0;
state = (gz_statep)file;
- /* check that we're reading */
- if (state->mode != GZ_READ)
- return 0;
-
/* if the state is not known, but we can find out, then do so (this is
mainly for right after a gzopen() or gzdopen()) */
- if (state->how == LOOK && state->have == 0)
- (void)gz_head(state);
+ if (state->mode == GZ_READ && state->how == LOOK && state->x.have == 0)
+ (void)gz_look(state);
- /* return 1 if reading direct, 0 if decompressing a gzip stream */
+ /* return 1 if transparent, 0 if processing a gzip stream */
return state->direct;
}
@@ -627,7 +562,7 @@ int ZEXPORT gzdirect(file)
int ZEXPORT gzclose_r(file)
gzFile file;
{
- int ret;
+ int ret, err;
gz_statep state;
/* get internal structure */
@@ -645,9 +580,10 @@ int ZEXPORT gzclose_r(file)
free(state->out);
free(state->in);
}
+ err = state->err == Z_BUF_ERROR ? Z_BUF_ERROR : Z_OK;
gz_error(state, Z_OK, NULL);
free(state->path);
ret = close(state->fd);
free(state);
- return ret ? Z_ERRNO : Z_OK;
+ return ret ? Z_ERRNO : err;
}
diff --git a/compat/zlib/gzwrite.c b/compat/zlib/gzwrite.c
index e8defc6..27cb342 100644
--- a/compat/zlib/gzwrite.c
+++ b/compat/zlib/gzwrite.c
@@ -1,5 +1,5 @@
/* gzwrite.c -- zlib functions for writing gzip files
- * Copyright (C) 2004, 2005, 2010 Mark Adler
+ * Copyright (C) 2004, 2005, 2010, 2011, 2012 Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*/
@@ -18,44 +18,55 @@ local int gz_init(state)
int ret;
z_streamp strm = &(state->strm);
- /* allocate input and output buffers */
+ /* allocate input buffer */
state->in = malloc(state->want);
- state->out = malloc(state->want);
- if (state->in == NULL || state->out == NULL) {
- if (state->out != NULL)
- free(state->out);
- if (state->in != NULL)
- free(state->in);
+ if (state->in == NULL) {
gz_error(state, Z_MEM_ERROR, "out of memory");
return -1;
}
- /* allocate deflate memory, set up for gzip compression */
- strm->zalloc = Z_NULL;
- strm->zfree = Z_NULL;
- strm->opaque = Z_NULL;
- ret = deflateInit2(strm, state->level, Z_DEFLATED,
- 15 + 16, 8, state->strategy);
- if (ret != Z_OK) {
- free(state->in);
- gz_error(state, Z_MEM_ERROR, "out of memory");
- return -1;
+ /* only need output buffer and deflate state if compressing */
+ if (!state->direct) {
+ /* allocate output buffer */
+ state->out = malloc(state->want);
+ if (state->out == NULL) {
+ free(state->in);
+ gz_error(state, Z_MEM_ERROR, "out of memory");
+ return -1;
+ }
+
+ /* allocate deflate memory, set up for gzip compression */
+ strm->zalloc = Z_NULL;
+ strm->zfree = Z_NULL;
+ strm->opaque = Z_NULL;
+ ret = deflateInit2(strm, state->level, Z_DEFLATED,
+ MAX_WBITS + 16, DEF_MEM_LEVEL, state->strategy);
+ if (ret != Z_OK) {
+ free(state->out);
+ free(state->in);
+ gz_error(state, Z_MEM_ERROR, "out of memory");
+ return -1;
+ }
}
/* mark state as initialized */
state->size = state->want;
- /* initialize write buffer */
- strm->avail_out = state->size;
- strm->next_out = state->out;
- state->next = strm->next_out;
+ /* initialize write buffer if compressing */
+ if (!state->direct) {
+ strm->avail_out = state->size;
+ strm->next_out = state->out;
+ state->x.next = strm->next_out;
+ }
return 0;
}
/* Compress whatever is at avail_in and next_in and write to the output file.
Return -1 if there is an error writing to the output file, otherwise 0.
flush is assumed to be a valid deflate() flush value. If flush is Z_FINISH,
- then the deflate() state is reset to start a new gzip stream. */
+ then the deflate() state is reset to start a new gzip stream. If gz->direct
+ is true, then simply write to the output file without compressing, and
+ ignore flush. */
local int gz_comp(state, flush)
gz_statep state;
int flush;
@@ -68,6 +79,17 @@ local int gz_comp(state, flush)
if (state->size == 0 && gz_init(state) == -1)
return -1;
+ /* write directly if requested */
+ if (state->direct) {
+ got = write(state->fd, strm->next_in, strm->avail_in);
+ if (got < 0 || (unsigned)got != strm->avail_in) {
+ gz_error(state, Z_ERRNO, zstrerror());
+ return -1;
+ }
+ strm->avail_in = 0;
+ return 0;
+ }
+
/* run deflate() on provided input until it produces no more output */
ret = Z_OK;
do {
@@ -75,8 +97,8 @@ local int gz_comp(state, flush)
doing Z_FINISH then don't write until we get to Z_STREAM_END */
if (strm->avail_out == 0 || (flush != Z_NO_FLUSH &&
(flush != Z_FINISH || ret == Z_STREAM_END))) {
- have = (unsigned)(strm->next_out - state->next);
- if (have && ((got = write(state->fd, state->next, have)) < 0 ||
+ have = (unsigned)(strm->next_out - state->x.next);
+ if (have && ((got = write(state->fd, state->x.next, have)) < 0 ||
(unsigned)got != have)) {
gz_error(state, Z_ERRNO, zstrerror());
return -1;
@@ -85,7 +107,7 @@ local int gz_comp(state, flush)
strm->avail_out = state->size;
strm->next_out = state->out;
}
- state->next = strm->next_out;
+ state->x.next = strm->next_out;
}
/* compress */
@@ -131,7 +153,7 @@ local int gz_zero(state, len)
}
strm->avail_in = n;
strm->next_in = state->in;
- state->pos += n;
+ state->x.pos += n;
if (gz_comp(state, Z_NO_FLUSH) == -1)
return -1;
len -= n;
@@ -163,7 +185,7 @@ int ZEXPORT gzwrite(file, buf, len)
/* since an int is returned, make sure len fits in one, otherwise return
with an error (this avoids the flaw in the interface) */
if ((int)len < 0) {
- gz_error(state, Z_BUF_ERROR, "requested length does not fit in int");
+ gz_error(state, Z_DATA_ERROR, "requested length does not fit in int");
return 0;
}
@@ -193,7 +215,7 @@ int ZEXPORT gzwrite(file, buf, len)
n = len;
memcpy(strm->next_in + strm->avail_in, buf, n);
strm->avail_in += n;
- state->pos += n;
+ state->x.pos += n;
buf = (char *)buf + n;
len -= n;
if (len && gz_comp(state, Z_NO_FLUSH) == -1)
@@ -208,7 +230,7 @@ int ZEXPORT gzwrite(file, buf, len)
/* directly compress user buffer to file */
strm->avail_in = len;
strm->next_in = (voidp)buf;
- state->pos += len;
+ state->x.pos += len;
if (gz_comp(state, Z_NO_FLUSH) == -1)
return 0;
}
@@ -249,15 +271,15 @@ int ZEXPORT gzputc(file, c)
if (strm->avail_in == 0)
strm->next_in = state->in;
strm->next_in[strm->avail_in++] = c;
- state->pos++;
- return c;
+ state->x.pos++;
+ return c & 0xff;
}
/* no room in buffer or not initialized, use gz_write() */
buf[0] = c;
if (gzwrite(file, buf, 1) != 1)
return -1;
- return c;
+ return c & 0xff;
}
/* -- see zlib.h -- */
@@ -274,7 +296,7 @@ int ZEXPORT gzputs(file, str)
return ret == 0 && len != 0 ? -1 : ret;
}
-#ifdef STDC
+#if defined(STDC) || defined(Z_HAVE_STDARG_H)
#include <stdarg.h>
/* -- see zlib.h -- */
@@ -316,19 +338,19 @@ int ZEXPORTVA gzprintf (gzFile file, const char *format, ...)
va_start(va, format);
#ifdef NO_vsnprintf
# ifdef HAS_vsprintf_void
- (void)vsprintf(state->in, format, va);
+ (void)vsprintf((char *)(state->in), format, va);
va_end(va);
for (len = 0; len < size; len++)
if (state->in[len] == 0) break;
# else
- len = vsprintf(state->in, format, va);
+ len = vsprintf((char *)(state->in), format, va);
va_end(va);
# endif
#else
# ifdef HAS_vsnprintf_void
- (void)vsnprintf(state->in, size, format, va);
+ (void)vsnprintf((char *)(state->in), size, format, va);
va_end(va);
- len = strlen(state->in);
+ len = strlen((char *)(state->in));
# else
len = vsnprintf((char *)(state->in), size, format, va);
va_end(va);
@@ -342,11 +364,11 @@ int ZEXPORTVA gzprintf (gzFile file, const char *format, ...)
/* update buffer and position, defer compression until needed */
strm->avail_in = (unsigned)len;
strm->next_in = state->in;
- state->pos += len;
+ state->x.pos += len;
return len;
}
-#else /* !STDC */
+#else /* !STDC && !Z_HAVE_STDARG_H */
/* -- see zlib.h -- */
int ZEXPORTVA gzprintf (file, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10,
@@ -366,6 +388,10 @@ int ZEXPORTVA gzprintf (file, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10,
state = (gz_statep)file;
strm = &(state->strm);
+ /* check that can really pass pointer in ints */
+ if (sizeof(int) != sizeof(void *))
+ return 0;
+
/* check that we're writing and that there's no error */
if (state->mode != GZ_WRITE || state->err != Z_OK)
return 0;
@@ -390,22 +416,23 @@ int ZEXPORTVA gzprintf (file, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10,
state->in[size - 1] = 0;
#ifdef NO_snprintf
# ifdef HAS_sprintf_void
- sprintf(state->in, format, a1, a2, a3, a4, a5, a6, a7, a8,
+ sprintf((char *)(state->in), format, a1, a2, a3, a4, a5, a6, a7, a8,
a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
for (len = 0; len < size; len++)
if (state->in[len] == 0) break;
# else
- len = sprintf(state->in, format, a1, a2, a3, a4, a5, a6, a7, a8,
- a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
+ len = sprintf((char *)(state->in), format, a1, a2, a3, a4, a5, a6, a7, a8,
+ a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
# endif
#else
# ifdef HAS_snprintf_void
- snprintf(state->in, size, format, a1, a2, a3, a4, a5, a6, a7, a8,
+ snprintf((char *)(state->in), size, format, a1, a2, a3, a4, a5, a6, a7, a8,
a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
- len = strlen(state->in);
+ len = strlen((char *)(state->in));
# else
- len = snprintf(state->in, size, format, a1, a2, a3, a4, a5, a6, a7, a8,
- a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
+ len = snprintf((char *)(state->in), size, format, a1, a2, a3, a4, a5, a6,
+ a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18,
+ a19, a20);
# endif
#endif
@@ -416,7 +443,7 @@ int ZEXPORTVA gzprintf (file, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10,
/* update buffer and position, defer compression until needed */
strm->avail_in = (unsigned)len;
strm->next_in = state->in;
- state->pos += len;
+ state->x.pos += len;
return len;
}
@@ -500,7 +527,7 @@ int ZEXPORT gzsetparams(file, level, strategy)
int ZEXPORT gzclose_w(file)
gzFile file;
{
- int ret = 0;
+ int ret = Z_OK;
gz_statep state;
/* get internal structure */
@@ -515,17 +542,24 @@ int ZEXPORT gzclose_w(file)
/* check for seek request */
if (state->seek) {
state->seek = 0;
- ret += gz_zero(state, state->skip);
+ if (gz_zero(state, state->skip) == -1)
+ ret = state->err;
}
/* flush, free memory, and close file */
- ret += gz_comp(state, Z_FINISH);
- (void)deflateEnd(&(state->strm));
- free(state->out);
- free(state->in);
+ if (state->size) {
+ if (gz_comp(state, Z_FINISH) == -1)
+ ret = state->err;
+ if (!state->direct) {
+ (void)deflateEnd(&(state->strm));
+ free(state->out);
+ }
+ free(state->in);
+ }
gz_error(state, Z_OK, NULL);
free(state->path);
- ret += close(state->fd);
+ if (close(state->fd) == -1)
+ ret = Z_ERRNO;
free(state);
- return ret ? Z_ERRNO : Z_OK;
+ return ret;
}
diff --git a/compat/zlib/infback.c b/compat/zlib/infback.c
index af3a8c9..981aff1 100644
--- a/compat/zlib/infback.c
+++ b/compat/zlib/infback.c
@@ -1,5 +1,5 @@
/* infback.c -- inflate using a call-back interface
- * Copyright (C) 1995-2009 Mark Adler
+ * Copyright (C) 1995-2011 Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*/
@@ -42,10 +42,19 @@ int stream_size;
return Z_STREAM_ERROR;
strm->msg = Z_NULL; /* in case we return an error */
if (strm->zalloc == (alloc_func)0) {
+#ifdef Z_SOLO
+ return Z_STREAM_ERROR;
+#else
strm->zalloc = zcalloc;
strm->opaque = (voidpf)0;
+#endif
}
- if (strm->zfree == (free_func)0) strm->zfree = zcfree;
+ if (strm->zfree == (free_func)0)
+#ifdef Z_SOLO
+ return Z_STREAM_ERROR;
+#else
+ strm->zfree = zcfree;
+#endif
state = (struct inflate_state FAR *)ZALLOC(strm, 1,
sizeof(struct inflate_state));
if (state == Z_NULL) return Z_MEM_ERROR;
@@ -394,7 +403,6 @@ void FAR *out_desc;
PULLBYTE();
}
if (here.val < 16) {
- NEEDBITS(here.bits);
DROPBITS(here.bits);
state->lens[state->have++] = here.val;
}
diff --git a/compat/zlib/inffixed.h b/compat/zlib/inffixed.h
index 75ed4b5..d628327 100644
--- a/compat/zlib/inffixed.h
+++ b/compat/zlib/inffixed.h
@@ -2,9 +2,9 @@
* Generated automatically by makefixed().
*/
- /* WARNING: this file should *not* be used by applications. It
- is part of the implementation of the compression library and
- is subject to change. Applications should only use zlib.h.
+ /* WARNING: this file should *not* be used by applications.
+ It is part of the implementation of this library and is
+ subject to change. Applications should only use zlib.h.
*/
static const code lenfix[512] = {
diff --git a/compat/zlib/inflate.c b/compat/zlib/inflate.c
index a8431ab..47418a1 100644
--- a/compat/zlib/inflate.c
+++ b/compat/zlib/inflate.c
@@ -1,5 +1,5 @@
/* inflate.c -- zlib decompression
- * Copyright (C) 1995-2010 Mark Adler
+ * Copyright (C) 1995-2012 Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*/
@@ -100,7 +100,7 @@ local int updatewindow OF((z_streamp strm, unsigned out));
local unsigned syncsearch OF((unsigned FAR *have, unsigned char FAR *buf,
unsigned len));
-int ZEXPORT inflateReset(strm)
+int ZEXPORT inflateResetKeep(strm)
z_streamp strm;
{
struct inflate_state FAR *state;
@@ -109,15 +109,13 @@ z_streamp strm;
state = (struct inflate_state FAR *)strm->state;
strm->total_in = strm->total_out = state->total = 0;
strm->msg = Z_NULL;
- strm->adler = 1; /* to support ill-conceived Java test suite */
+ if (state->wrap) /* to support ill-conceived Java test suite */
+ strm->adler = state->wrap & 1;
state->mode = HEAD;
state->last = 0;
state->havedict = 0;
state->dmax = 32768U;
state->head = Z_NULL;
- state->wsize = 0;
- state->whave = 0;
- state->wnext = 0;
state->hold = 0;
state->bits = 0;
state->lencode = state->distcode = state->next = state->codes;
@@ -127,6 +125,19 @@ z_streamp strm;
return Z_OK;
}
+int ZEXPORT inflateReset(strm)
+z_streamp strm;
+{
+ struct inflate_state FAR *state;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ state->wsize = 0;
+ state->whave = 0;
+ state->wnext = 0;
+ return inflateResetKeep(strm);
+}
+
int ZEXPORT inflateReset2(strm, windowBits)
z_streamp strm;
int windowBits;
@@ -180,10 +191,19 @@ int stream_size;
if (strm == Z_NULL) return Z_STREAM_ERROR;
strm->msg = Z_NULL; /* in case we return an error */
if (strm->zalloc == (alloc_func)0) {
+#ifdef Z_SOLO
+ return Z_STREAM_ERROR;
+#else
strm->zalloc = zcalloc;
strm->opaque = (voidpf)0;
+#endif
}
- if (strm->zfree == (free_func)0) strm->zfree = zcfree;
+ if (strm->zfree == (free_func)0)
+#ifdef Z_SOLO
+ return Z_STREAM_ERROR;
+#else
+ strm->zfree = zcfree;
+#endif
state = (struct inflate_state FAR *)
ZALLOC(strm, 1, sizeof(struct inflate_state));
if (state == Z_NULL) return Z_MEM_ERROR;
@@ -321,8 +341,8 @@ void makefixed()
low = 0;
for (;;) {
if ((low % 7) == 0) printf("\n ");
- printf("{%u,%u,%d}", state.lencode[low].op, state.lencode[low].bits,
- state.lencode[low].val);
+ printf("{%u,%u,%d}", (low & 127) == 99 ? 64 : state.lencode[low].op,
+ state.lencode[low].bits, state.lencode[low].val);
if (++low == size) break;
putchar(',');
}
@@ -499,11 +519,6 @@ unsigned out;
bits -= bits & 7; \
} while (0)
-/* Reverse the bytes in a 32-bit value */
-#define REVERSE(q) \
- ((((q) >> 24) & 0xff) + (((q) >> 8) & 0xff00) + \
- (((q) & 0xff00) << 8) + (((q) & 0xff) << 24))
-
/*
inflate() uses a state machine to process as much input data and generate as
much output data as possible before returning. The state machine is
@@ -797,7 +812,7 @@ int flush;
#endif
case DICTID:
NEEDBITS(32);
- strm->adler = state->check = REVERSE(hold);
+ strm->adler = state->check = ZSWAP32(hold);
INITBITS();
state->mode = DICT;
case DICT:
@@ -925,7 +940,6 @@ int flush;
PULLBYTE();
}
if (here.val < 16) {
- NEEDBITS(here.bits);
DROPBITS(here.bits);
state->lens[state->have++] = here.val;
}
@@ -1170,7 +1184,7 @@ int flush;
#ifdef GUNZIP
state->flags ? hold :
#endif
- REVERSE(hold)) != state->check) {
+ ZSWAP32(hold)) != state->check) {
strm->msg = (char *)"incorrect data check";
state->mode = BAD;
break;
@@ -1214,7 +1228,8 @@ int flush;
*/
inf_leave:
RESTORE();
- if (state->wsize || (state->mode < CHECK && out != strm->avail_out))
+ if (state->wsize || (out != strm->avail_out && state->mode < BAD &&
+ (state->mode < CHECK || flush != Z_FINISH)))
if (updatewindow(strm, out)) {
state->mode = MEM;
return Z_MEM_ERROR;
@@ -1255,7 +1270,10 @@ const Bytef *dictionary;
uInt dictLength;
{
struct inflate_state FAR *state;
- unsigned long id;
+ unsigned long dictid;
+ unsigned char *next;
+ unsigned avail;
+ int ret;
/* check state */
if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
@@ -1263,29 +1281,27 @@ uInt dictLength;
if (state->wrap != 0 && state->mode != DICT)
return Z_STREAM_ERROR;
- /* check for correct dictionary id */
+ /* check for correct dictionary identifier */
if (state->mode == DICT) {
- id = adler32(0L, Z_NULL, 0);
- id = adler32(id, dictionary, dictLength);
- if (id != state->check)
+ dictid = adler32(0L, Z_NULL, 0);
+ dictid = adler32(dictid, dictionary, dictLength);
+ if (dictid != state->check)
return Z_DATA_ERROR;
}
- /* copy dictionary to window */
- if (updatewindow(strm, strm->avail_out)) {
+ /* copy dictionary to window using updatewindow(), which will amend the
+ existing dictionary if appropriate */
+ next = strm->next_out;
+ avail = strm->avail_out;
+ strm->next_out = (Bytef *)dictionary + dictLength;
+ strm->avail_out = 0;
+ ret = updatewindow(strm, dictLength);
+ strm->avail_out = avail;
+ strm->next_out = next;
+ if (ret) {
state->mode = MEM;
return Z_MEM_ERROR;
}
- if (dictLength > state->wsize) {
- zmemcpy(state->window, dictionary + dictLength - state->wsize,
- state->wsize);
- state->whave = state->wsize;
- }
- else {
- zmemcpy(state->window + state->wsize - dictLength, dictionary,
- dictLength);
- state->whave = dictLength;
- }
state->havedict = 1;
Tracev((stderr, "inflate: dictionary set\n"));
return Z_OK;
@@ -1433,8 +1449,8 @@ z_streamp source;
}
/* copy state */
- zmemcpy(dest, source, sizeof(z_stream));
- zmemcpy(copy, state, sizeof(struct inflate_state));
+ zmemcpy((voidpf)dest, (voidpf)source, sizeof(z_stream));
+ zmemcpy((voidpf)copy, (voidpf)state, sizeof(struct inflate_state));
if (state->lencode >= state->codes &&
state->lencode <= state->codes + ENOUGH - 1) {
copy->lencode = copy->codes + (state->lencode - state->codes);
diff --git a/compat/zlib/inftrees.c b/compat/zlib/inftrees.c
index 11e9c52..abcd7c4 100644
--- a/compat/zlib/inftrees.c
+++ b/compat/zlib/inftrees.c
@@ -1,5 +1,5 @@
/* inftrees.c -- generate Huffman trees for efficient decoding
- * Copyright (C) 1995-2010 Mark Adler
+ * Copyright (C) 1995-2012 Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*/
@@ -9,7 +9,7 @@
#define MAXBITS 15
const char inflate_copyright[] =
- " inflate 1.2.5 Copyright 1995-2010 Mark Adler ";
+ " inflate 1.2.7 Copyright 1995-2012 Mark Adler ";
/*
If you use the zlib library in a product, an acknowledgment is welcome
in the documentation of your product. If for some reason you cannot
@@ -62,7 +62,7 @@ unsigned short FAR *work;
35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0};
static const unsigned short lext[31] = { /* Length codes 257..285 extra */
16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18,
- 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 73, 195};
+ 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 78, 68};
static const unsigned short dbase[32] = { /* Distance codes 0..29 base */
1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193,
257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145,
@@ -289,38 +289,14 @@ unsigned short FAR *work;
}
}
- /*
- Fill in rest of table for incomplete codes. This loop is similar to the
- loop above in incrementing huff for table indices. It is assumed that
- len is equal to curr + drop, so there is no loop needed to increment
- through high index bits. When the current sub-table is filled, the loop
- drops back to the root table to fill in any remaining entries there.
- */
- here.op = (unsigned char)64; /* invalid code marker */
- here.bits = (unsigned char)(len - drop);
- here.val = (unsigned short)0;
- while (huff != 0) {
- /* when done with sub-table, drop back to root table */
- if (drop != 0 && (huff & mask) != low) {
- drop = 0;
- len = root;
- next = *table;
- here.bits = (unsigned char)len;
- }
-
- /* put invalid code marker in table */
- next[huff >> drop] = here;
-
- /* backwards increment the len-bit code huff */
- incr = 1U << (len - 1);
- while (huff & incr)
- incr >>= 1;
- if (incr != 0) {
- huff &= incr - 1;
- huff += incr;
- }
- else
- huff = 0;
+ /* fill in remaining table entry if code is incomplete (guaranteed to have
+ at most one remaining entry, since if the code is incomplete, the
+ maximum code length that was allowed to get this far is one bit) */
+ if (huff != 0) {
+ here.op = (unsigned char)64; /* invalid code marker */
+ here.bits = (unsigned char)(len - drop);
+ here.val = (unsigned short)0;
+ next[huff] = here;
}
/* set return parameters */
diff --git a/compat/zlib/make_vms.com b/compat/zlib/make_vms.com
index 6576490..65e9d0c 100644
--- a/compat/zlib/make_vms.com
+++ b/compat/zlib/make_vms.com
@@ -3,7 +3,7 @@ $! Martin P.J. Zinser
$!
$! In case of problems with the install you might contact me at
$! zinser@zinser.no-ip.info(preferred) or
-$! zinser@sysdev.deutsche-boerse.com (work)
+$! martin.zinser@eurexchange.com (work)
$!
$! Make procedure history for Zlib
$!
@@ -14,9 +14,16 @@ $! 0.02 20061008 Adapt to new Makefile.in
$! 0.03 20091224 Add support for large file check
$! 0.04 20100110 Add new gzclose, gzlib, gzread, gzwrite
$! 0.05 20100221 Exchange zlibdefs.h by zconf.h.in
+$! 0.06 20120111 Fix missing amiss_err, update zconf_h.in, fix new exmples
+$! subdir path, update module search in makefile.in
+$! 0.07 20120115 Triggered by work done by Alexey Chupahin completly redesigned
+$! shared image creation
+$! 0.08 20120219 Make it work on VAX again, pre-load missing symbols to shared
+$! image
+$! 0.09 20120305 SMS. P1 sets builder ("MMK", "MMS", " " (built-in)).
+$! "" -> automatic, preference: MMK, MMS, built-in.
$!
$ on error then goto err_exit
-$ set proc/parse=ext
$!
$ true = 1
$ false = 0
@@ -32,31 +39,43 @@ $ s_case = False
$!
$! Setup variables holding "config" information
$!
-$ Make = ""
+$ Make = "''p1'"
$ name = "Zlib"
$ version = "?.?.?"
$ v_string = "ZLIB_VERSION"
$ v_file = "zlib.h"
-$ ccopt = ""
+$ ccopt = "/include = []"
$ lopts = ""
$ dnsrl = ""
-$ aconf_in_file = "zconf.h.in#zconf.h_in"
+$ aconf_in_file = "zconf.h.in#zconf.h_in#zconf_h.in"
$ conf_check_string = ""
$ linkonly = false
$ optfile = name + ".opt"
+$ mapfile = name + ".map"
$ libdefs = ""
+$ vax = f$getsyi("HW_MODEL").lt.1024
$ axp = f$getsyi("HW_MODEL").ge.1024 .and. f$getsyi("HW_MODEL").lt.4096
+$ ia64 = f$getsyi("HW_MODEL").ge.4096
$!
-$ whoami = f$parse(f$enviornment("Procedure"),,,,"NO_CONCEAL")
+$! 2012-03-05 SMS.
+$! Why is this needed? And if it is needed, why not simply ".not. vax"?
+$!
+$!!! if axp .or. ia64 then set proc/parse=extended
+$!
+$ whoami = f$parse(f$environment("Procedure"),,,,"NO_CONCEAL")
$ mydef = F$parse(whoami,,,"DEVICE")
$ mydir = f$parse(whoami,,,"DIRECTORY") - "]["
$ myproc = f$parse(whoami,,,"Name") + f$parse(whoami,,,"type")
$!
$! Check for MMK/MMS
$!
-$ If F$Search ("Sys$System:MMS.EXE") .nes. "" Then Make = "MMS"
-$ If F$Type (MMK) .eqs. "STRING" Then Make = "MMK"
-$!
+$ if (Make .eqs. "")
+$ then
+$ If F$Search ("Sys$System:MMS.EXE") .nes. "" Then Make = "MMS"
+$ If F$Type (MMK) .eqs. "STRING" Then Make = "MMK"
+$ else
+$ Make = f$edit( Make, "trim")
+$ endif
$!
$ gosub find_version
$!
@@ -69,6 +88,7 @@ $! Look for the compiler used
$!
$ gosub check_compiler
$ close topt
+$ close optf
$!
$ if its_decc
$ then
@@ -83,6 +103,15 @@ $ ccopt = "/decc" + ccopt
$ define sys decc$library_include:
$ endif
$ endif
+$!
+$! 2012-03-05 SMS.
+$! Why /NAMES = AS_IS? Why not simply ".not. vax"? And why not on VAX?
+$!
+$ if axp .or. ia64
+$ then
+$ ccopt = ccopt + "/name=as_is/opt=(inline=speed)"
+$ s_case = true
+$ endif
$ endif
$ if its_vaxc .or. its_gnuc
$ then
@@ -122,15 +151,20 @@ $ gosub check_config
$ endif
$ goto aconf_loop
$ACONF_EXIT:
+$ write aconf ""
+$ write aconf "/* VMS specifics added by make_vms.com: */"
$ write aconf "#define VMS 1"
$ write aconf "#include <unistd.h>"
$ write aconf "#include <unixio.h>"
$ write aconf "#ifdef _LARGEFILE"
-$ write aconf "#define off64_t __off64_t"
-$ write aconf "#define fopen64 fopen"
-$ write aconf "#define fseeko64 fseeko"
-$ write aconf "#define lseek64 lseek"
-$ write aconf "#define ftello64 ftell"
+$ write aconf "# define off64_t __off64_t"
+$ write aconf "# define fopen64 fopen"
+$ write aconf "# define fseeko64 fseeko"
+$ write aconf "# define lseek64 lseek"
+$ write aconf "# define ftello64 ftell"
+$ write aconf "#endif"
+$ write aconf "#if !defined( __VAX) && (__CRTL_VER >= 70312000)"
+$ write aconf "# define HAVE_VSNPRINTF"
$ write aconf "#endif"
$ close aconf_in
$ close aconf
@@ -139,8 +173,9 @@ $! Build the thing plain or with mms
$!
$ write sys$output "Compiling Zlib sources ..."
$ if make.eqs.""
-$ then
-$ dele example.obj;*,minigzip.obj;*
+$ then
+$ if (f$search( "example.obj;*") .nes. "") then delete example.obj;*
+$ if (f$search( "minigzip.obj;*") .nes. "") then delete minigzip.obj;*
$ CALL MAKE adler32.OBJ "CC ''CCOPT' adler32" -
adler32.c zlib.h zconf.h
$ CALL MAKE compress.OBJ "CC ''CCOPT' compress" -
@@ -174,41 +209,34 @@ $ CALL MAKE zutil.OBJ "CC ''CCOPT' zutil" -
$ write sys$output "Building Zlib ..."
$ CALL MAKE libz.OLB "lib/crea libz.olb *.obj" *.OBJ
$ write sys$output "Building example..."
-$ CALL MAKE example.OBJ "CC ''CCOPT' example" -
- example.c zlib.h zconf.h
+$ CALL MAKE example.OBJ "CC ''CCOPT' [.test]example" -
+ [.test]example.c zlib.h zconf.h
$ call make example.exe "LINK example,libz.olb/lib" example.obj libz.olb
-$ if f$search("x11vms:xvmsutils.olb") .nes. ""
-$ then
-$ write sys$output "Building minigzip..."
-$ CALL MAKE minigzip.OBJ "CC ''CCOPT' minigzip" -
- minigzip.c zlib.h zconf.h
-$ call make minigzip.exe -
- "LINK minigzip,libz.olb/lib,x11vms:xvmsutils.olb/lib" -
- minigzip.obj libz.olb
-$ endif
-$ else
+$ write sys$output "Building minigzip..."
+$ CALL MAKE minigzip.OBJ "CC ''CCOPT' [.test]minigzip" -
+ [.test]minigzip.c zlib.h zconf.h
+$ call make minigzip.exe -
+ "LINK minigzip,libz.olb/lib" -
+ minigzip.obj libz.olb
+$ else
$ gosub crea_mms
$ write sys$output "Make ''name' ''version' with ''Make' "
$ 'make'
-$ endif
+$ endif
$!
-$! Alpha gets a shareable image
+$! Create shareable image
$!
-$ If axp
-$ Then
-$ gosub crea_olist
-$ write sys$output "Creating libzshr.exe"
-$ call anal_obj_axp modules.opt _link.opt
-$ if s_case
-$ then
-$ open/append optf modules.opt
-$ write optf "case_sensitive=YES"
-$ close optf
-$ endif
-$ LINK_'lopts'/SHARE=libzshr.exe modules.opt/opt,_link.opt/opt
-$ endif
+$ gosub crea_olist
+$ write sys$output "Creating libzshr.exe"
+$ call map_2_shopt 'mapfile' 'optfile'
+$ LINK_'lopts'/SHARE=libzshr.exe modules.opt/opt,'optfile'/opt
$ write sys$output "Zlib build completed"
+$ delete/nolog tmp.opt;*
$ exit
+$AMISS_ERR:
+$ write sys$output "No source for config.hin found."
+$ write sys$output "Tried any of ''aconf_in_file'"
+$ goto err_exit
$CC_ERR:
$ write sys$output "C compiler required to build ''name'"
$ goto err_exit
@@ -216,7 +244,6 @@ $ERR_EXIT:
$ set message/facil/ident/sever/text
$ close/nolog optf
$ close/nolog topt
-$ close/nolog conf_hin
$ close/nolog aconf_in
$ close/nolog aconf
$ close/nolog out
@@ -397,7 +424,7 @@ $ copy sys$input: out
$ deck
# descrip.mms: MMS description file for building zlib on VMS
# written by Martin P.J. Zinser
-# <zinser@zinser.no-ip.info or zinser@sysdev.deutsche-boerse.com>
+# <zinser@zinser.no-ip.info or martin.zinser@eurexchange.com>
OBJS = adler32.obj, compress.obj, crc32.obj, gzclose.obj, gzlib.obj\
gzread.obj, gzwrite.obj, uncompr.obj, infback.obj\
@@ -407,10 +434,9 @@ OBJS = adler32.obj, compress.obj, crc32.obj, gzclose.obj, gzlib.obj\
$ eod
$ write out "CFLAGS=", ccopt
$ write out "LOPTS=", lopts
+$ write out "all : example.exe minigzip.exe libz.olb"
$ copy sys$input: out
$ deck
-
-all : example.exe minigzip.exe libz.olb
@ write sys$output " Example applications available"
libz.olb : libz.olb($(OBJS))
@@ -420,7 +446,7 @@ example.exe : example.obj libz.olb
link $(LOPTS) example,libz.olb/lib
minigzip.exe : minigzip.obj libz.olb
- link $(LOPTS) minigzip,libz.olb/lib,x11vms:xvmsutils.olb/lib
+ link $(LOPTS) minigzip,libz.olb/lib
clean :
delete *.obj;*,libz.olb;*,*.opt;*,*.exe;*
@@ -431,7 +457,7 @@ adler32.obj : adler32.c zutil.h zlib.h zconf.h
compress.obj : compress.c zlib.h zconf.h
crc32.obj : crc32.c zutil.h zlib.h zconf.h
deflate.obj : deflate.c deflate.h zutil.h zlib.h zconf.h
-example.obj : example.c zlib.h zconf.h
+example.obj : [.test]example.c zlib.h zconf.h
gzclose.obj : gzclose.c zutil.h zlib.h zconf.h
gzlib.obj : gzlib.c zutil.h zlib.h zconf.h
gzread.obj : gzread.c zutil.h zlib.h zconf.h
@@ -439,7 +465,7 @@ gzwrite.obj : gzwrite.c zutil.h zlib.h zconf.h
inffast.obj : inffast.c zutil.h zlib.h zconf.h inftrees.h inffast.h
inflate.obj : inflate.c zutil.h zlib.h zconf.h
inftrees.obj : inftrees.c zutil.h zlib.h zconf.h inftrees.h
-minigzip.obj : minigzip.c zlib.h zconf.h
+minigzip.obj : [.test]minigzip.c zlib.h zconf.h
trees.obj : trees.c deflate.h zutil.h zlib.h zconf.h
uncompr.obj : uncompr.c zlib.h zconf.h
zutil.obj : zutil.c zutil.h zlib.h zconf.h
@@ -455,13 +481,18 @@ $!
$CREA_OLIST:
$ open/read min makefile.in
$ open/write mod modules.opt
-$ src_check = "OBJC ="
+$ src_check_list = "OBJZ =#OBJG ="
$MRLOOP:
$ read/end=mrdone min rec
-$ if (f$extract(0,6,rec) .nes. src_check) then goto mrloop
+$ i = 0
+$SRC_CHECK_LOOP:
+$ src_check = f$element(i, "#", src_check_list)
+$ i = i+1
+$ if src_check .eqs. "#" then goto mrloop
+$ if (f$extract(0,6,rec) .nes. src_check) then goto src_check_loop
$ rec = rec - src_check
$ gosub extra_filnam
-$ if (f$element(1,"\",rec) .eqs. "\") then goto mrdone
+$ if (f$element(1,"\",rec) .eqs. "\") then goto mrloop
$MRSLOOP:
$ read/end=mrdone min rec
$ gosub extra_filnam
@@ -672,133 +703,165 @@ $ endif
$ return
$!------------------------------------------------------------------------------
$!
-$! Analyze Object files for OpenVMS AXP to extract Procedure and Data
-$! information to build a symbol vector for a shareable image
-$! All the "brains" of this logic was suggested by Hartmut Becker
-$! (Hartmut.Becker@compaq.com). All the bugs were introduced by me
-$! (zinser@zinser.no-ip.info), so if you do have problem reports please do not
-$! bother Hartmut/HP, but get in touch with me
+$! Write configuration to both permanent and temporary config file
$!
$! Version history
-$! 0.01 20040406 Skip over shareable images in option file
-$! 0.02 20041109 Fix option file for shareable images with case_sensitive=YES
-$! 0.03 20050107 Skip over Identification labels in option file
-$! 0.04 20060117 Add uppercase alias to code compiled with /name=as_is
+$! 0.01 20031029 First version to receive a number
+$!
+$WRITE_CONFIG: SUBROUTINE
+$ write aconf 'p1'
+$ open/append confh 'th'
+$ write confh 'p1'
+$ close confh
+$ENDSUBROUTINE
+$!------------------------------------------------------------------------------
+$!
+$! Analyze the project map file and create the symbol vector for a shareable
+$! image from it
+$!
+$! Version history
+$! 0.01 20120128 First version
+$! 0.02 20120226 Add pre-load logic
+$!
+$ MAP_2_SHOPT: Subroutine
$!
-$ ANAL_OBJ_AXP: Subroutine
-$ V = 'F$Verify(0)
$ SAY := "WRITE_ SYS$OUTPUT"
-$
+$!
$ IF F$SEARCH("''P1'") .EQS. ""
$ THEN
-$ SAY "ANAL_OBJ_AXP-E-NOSUCHFILE: Error, inputfile ''p1' not available"
-$ goto exit_aa
+$ SAY "MAP_2_SHOPT-E-NOSUCHFILE: Error, inputfile ''p1' not available"
+$ goto exit_m2s
$ ENDIF
$ IF "''P2'" .EQS. ""
$ THEN
-$ SAY "ANAL_OBJ_AXP: Error, no output file provided"
-$ goto exit_aa
+$ SAY "MAP_2_SHOPT: Error, no output file provided"
+$ goto exit_m2s
$ ENDIF
-$
-$ open/read in 'p1
-$ create a.tmp
-$ open/append atmp a.tmp
-$ loop:
-$ read/end=end_loop in line
-$ if f$locate("/SHARE",f$edit(line,"upcase")) .lt. f$length(line)
-$ then
-$ write sys$output "ANAL_SKP_SHR-i-skipshare, ''line'"
-$ goto loop
-$ endif
-$ if f$locate("IDENTIFICATION=",f$edit(line,"upcase")) .lt. f$length(line)
-$ then
-$ write sys$output "ANAL_OBJ_AXP-i-ident: Identification ", -
- f$element(1,"=",line)
-$ goto loop
-$ endif
-$ f= f$search(line)
-$ if f .eqs. ""
-$ then
-$ write sys$output "ANAL_OBJ_AXP-w-nosuchfile, ''line'"
-$ goto loop
-$ endif
-$ define/user sys$output nl:
-$ define/user sys$error nl:
-$ anal/obj/gsd 'f /out=x.tmp
-$ open/read xtmp x.tmp
-$ XLOOP:
-$ read/end=end_xloop xtmp xline
-$ xline = f$edit(xline,"compress")
-$ write atmp xline
-$ goto xloop
-$ END_XLOOP:
-$ close xtmp
-$ goto loop
-$ end_loop:
-$ close in
-$ close atmp
-$ if f$search("a.tmp") .eqs. "" -
- then $ exit
-$ ! all global definitions
-$ search a.tmp "symbol:","EGSY$V_DEF 1","EGSY$V_NORM 1"/out=b.tmp
-$ ! all procedures
-$ search b.tmp "EGSY$V_NORM 1"/wind=(0,1) /out=c.tmp
-$ search c.tmp "symbol:"/out=d.tmp
-$ define/user sys$output nl:
-$ edito/edt/command=sys$input d.tmp
-sub/symbol: "/symbol_vector=(/whole
-sub/"/=PROCEDURE)/whole
-exit
-$ ! all data
-$ search b.tmp "EGSY$V_DEF 1"/wind=(0,1) /out=e.tmp
-$ search e.tmp "symbol:"/out=f.tmp
-$ define/user sys$output nl:
-$ edito/edt/command=sys$input f.tmp
-sub/symbol: "/symbol_vector=(/whole
-sub/"/=DATA)/whole
-exit
-$ sort/nodupl d.tmp,f.tmp g.tmp
-$ open/read raw_vector g.tmp
-$ open/write case_vector 'p2'
-$ RAWLOOP:
-$ read/end=end_rawloop raw_vector raw_element
-$ write case_vector raw_element
-$ if f$locate("=PROCEDURE)",raw_element) .lt. f$length(raw_element)
-$ then
-$ name = f$element(1,"=",raw_element) - "("
-$ if f$edit(name,"UPCASE") .nes. name then -
- write case_vector f$fao(" symbol_vector=(!AS/!AS=PROCEDURE)", -
- f$edit(name,"UPCASE"), name)
-$ endif
-$ if f$locate("=DATA)",raw_element) .lt. f$length(raw_element)
+$!
+$ module1 = "deflate#deflateEnd#deflateInit_#deflateParams#deflateSetDictionary"
+$ module2 = "gzclose#gzerror#gzgetc#gzgets#gzopen#gzprintf#gzputc#gzputs#gzread"
+$ module3 = "gzseek#gztell#inflate#inflateEnd#inflateInit_#inflateSetDictionary"
+$ module4 = "inflateSync#uncompress#zlibVersion#compress"
+$ open/read map 'p1
+$ if axp .or. ia64
$ then
-$ name = f$element(1,"=",raw_element) - "("
-$ if f$edit(name,"UPCASE") .nes. name then -
- write case_vector f$fao(" symbol_vector=(!AS/!AS=DATA)", -
- f$edit(name,"UPCASE"), name)
+$ open/write aopt a.opt
+$ open/write bopt b.opt
+$ write aopt " CASE_SENSITIVE=YES"
+$ write bopt "SYMBOL_VECTOR= (-"
+$ mod_sym_num = 1
+$ MOD_SYM_LOOP:
+$ if f$type(module'mod_sym_num') .nes. ""
+$ then
+$ mod_in = 0
+$ MOD_SYM_IN:
+$ shared_proc = f$element(mod_in, "#", module'mod_sym_num')
+$ if shared_proc .nes. "#"
+$ then
+$ write aopt f$fao(" symbol_vector=(!AS/!AS=PROCEDURE)",-
+ f$edit(shared_proc,"upcase"),shared_proc)
+$ write bopt f$fao("!AS=PROCEDURE,-",shared_proc)
+$ mod_in = mod_in + 1
+$ goto mod_sym_in
+$ endif
+$ mod_sym_num = mod_sym_num + 1
+$ goto mod_sym_loop
+$ endif
+$MAP_LOOP:
+$ read/end=map_end map line
+$ if (f$locate("{",line).lt. f$length(line)) .or. -
+ (f$locate("global:", line) .lt. f$length(line))
+$ then
+$ proc = true
+$ goto map_loop
+$ endif
+$ if f$locate("}",line).lt. f$length(line) then proc = false
+$ if f$locate("local:", line) .lt. f$length(line) then proc = false
+$ if proc
+$ then
+$ shared_proc = f$edit(line,"collapse")
+$ chop_semi = f$locate(";", shared_proc)
+$ if chop_semi .lt. f$length(shared_proc) then -
+ shared_proc = f$extract(0, chop_semi, shared_proc)
+$ write aopt f$fao(" symbol_vector=(!AS/!AS=PROCEDURE)",-
+ f$edit(shared_proc,"upcase"),shared_proc)
+$ write bopt f$fao("!AS=PROCEDURE,-",shared_proc)
+$ endif
+$ goto map_loop
+$MAP_END:
+$ close/nolog aopt
+$ close/nolog bopt
+$ open/append libopt 'p2'
+$ open/read aopt a.opt
+$ open/read bopt b.opt
+$ALOOP:
+$ read/end=aloop_end aopt line
+$ write libopt line
+$ goto aloop
+$ALOOP_END:
+$ close/nolog aopt
+$ sv = ""
+$BLOOP:
+$ read/end=bloop_end bopt svn
+$ if (svn.nes."")
+$ then
+$ if (sv.nes."") then write libopt sv
+$ sv = svn
+$ endif
+$ goto bloop
+$BLOOP_END:
+$ write libopt f$extract(0,f$length(sv)-2,sv), "-"
+$ write libopt ")"
+$ close/nolog bopt
+$ delete/nolog/noconf a.opt;*,b.opt;*
+$ else
+$ if vax
+$ then
+$ open/append libopt 'p2'
+$ mod_sym_num = 1
+$ VMOD_SYM_LOOP:
+$ if f$type(module'mod_sym_num') .nes. ""
+$ then
+$ mod_in = 0
+$ VMOD_SYM_IN:
+$ shared_proc = f$element(mod_in, "#", module'mod_sym_num')
+$ if shared_proc .nes. "#"
+$ then
+$ write libopt f$fao("UNIVERSAL=!AS",-
+ f$edit(shared_proc,"upcase"))
+$ mod_in = mod_in + 1
+$ goto vmod_sym_in
+$ endif
+$ mod_sym_num = mod_sym_num + 1
+$ goto vmod_sym_loop
+$ endif
+$VMAP_LOOP:
+$ read/end=vmap_end map line
+$ if (f$locate("{",line).lt. f$length(line)) .or. -
+ (f$locate("global:", line) .lt. f$length(line))
+$ then
+$ proc = true
+$ goto vmap_loop
+$ endif
+$ if f$locate("}",line).lt. f$length(line) then proc = false
+$ if f$locate("local:", line) .lt. f$length(line) then proc = false
+$ if proc
+$ then
+$ shared_proc = f$edit(line,"collapse")
+$ chop_semi = f$locate(";", shared_proc)
+$ if chop_semi .lt. f$length(shared_proc) then -
+ shared_proc = f$extract(0, chop_semi, shared_proc)
+$ write libopt f$fao("UNIVERSAL=!AS",-
+ f$edit(shared_proc,"upcase"))
+$ endif
+$ goto vmap_loop
+$VMAP_END:
+$ else
+$ write sys$output "Unknown Architecture (Not VAX, AXP, or IA64)"
+$ write sys$output "No options file created"
+$ endif
$ endif
-$ goto rawloop
-$ END_RAWLOOP:
-$ close raw_vector
-$ close case_vector
-$ delete a.tmp;*,b.tmp;*,c.tmp;*,d.tmp;*,e.tmp;*,f.tmp;*,g.tmp;*
-$ if f$search("x.tmp") .nes. "" -
- then $ delete x.tmp;*
-$!
-$ EXIT_AA:
-$ if V then set verify
+$ EXIT_M2S:
+$ close/nolog map
+$ close/nolog libopt
$ endsubroutine
-$!------------------------------------------------------------------------------
-$!
-$! Write configuration to both permanent and temporary config file
-$!
-$! Version history
-$! 0.01 20031029 First version to receive a number
-$!
-$WRITE_CONFIG: SUBROUTINE
-$ write aconf 'p1'
-$ open/append confh 'th'
-$ write confh 'p1'
-$ close confh
-$ENDSUBROUTINE
-$!------------------------------------------------------------------------------
diff --git a/compat/zlib/msdos/Makefile.bor b/compat/zlib/msdos/Makefile.bor
index 0c1b99c..3d12a2c 100644
--- a/compat/zlib/msdos/Makefile.bor
+++ b/compat/zlib/msdos/Makefile.bor
@@ -86,9 +86,9 @@ uncompr.obj: uncompr.c zlib.h zconf.h
zutil.obj: zutil.c zutil.h zlib.h zconf.h
-example.obj: example.c zlib.h zconf.h
+example.obj: test/example.c zlib.h zconf.h
-minigzip.obj: minigzip.c zlib.h zconf.h
+minigzip.obj: test/minigzip.c zlib.h zconf.h
# the command line is cut to fit in the MS-DOS 128 byte limit:
diff --git a/compat/zlib/msdos/Makefile.msc b/compat/zlib/msdos/Makefile.msc
index cd2816f..ae83786 100644
--- a/compat/zlib/msdos/Makefile.msc
+++ b/compat/zlib/msdos/Makefile.msc
@@ -80,10 +80,10 @@ uncompr.obj: uncompr.c zlib.h zconf.h
zutil.obj: zutil.c zutil.h zlib.h zconf.h
-example.obj: example.c zlib.h zconf.h
+example.obj: test/example.c zlib.h zconf.h
$(CC) -c $(CFLAGS) $*.c
-minigzip.obj: minigzip.c zlib.h zconf.h
+minigzip.obj: test/minigzip.c zlib.h zconf.h
$(CC) -c $(CFLAGS) $*.c
diff --git a/compat/zlib/msdos/Makefile.tc b/compat/zlib/msdos/Makefile.tc
index bcd0d18..5aec82a 100644
--- a/compat/zlib/msdos/Makefile.tc
+++ b/compat/zlib/msdos/Makefile.tc
@@ -71,9 +71,9 @@ uncompr.obj: uncompr.c zlib.h zconf.h
zutil.obj: zutil.c zutil.h zlib.h zconf.h
-example.obj: example.c zlib.h zconf.h
+example.obj: test/example.c zlib.h zconf.h
-minigzip.obj: minigzip.c zlib.h zconf.h
+minigzip.obj: test/minigzip.c zlib.h zconf.h
# the command line is cut to fit in the MS-DOS 128 byte limit:
diff --git a/compat/zlib/win32/Makefile.emx b/compat/zlib/old/Makefile.emx
index 4d6ab0e..4d6ab0e 100644
--- a/compat/zlib/win32/Makefile.emx
+++ b/compat/zlib/old/Makefile.emx
diff --git a/compat/zlib/old/as400/compile.clp b/compat/zlib/old/as400/compile.clp
deleted file mode 100644
index 8554951..0000000
--- a/compat/zlib/old/as400/compile.clp
+++ /dev/null
@@ -1,123 +0,0 @@
-/******************************************************************************/
-/* */
-/* ZLIB */
-/* */
-/* Compile sources into modules and link them into a service program. */
-/* */
-/******************************************************************************/
-
- PGM
-
-/* Configuration adjustable parameters. */
-
- DCL VAR(&SRCLIB) TYPE(*CHAR) LEN(10) +
- VALUE('ZLIB') /* Source library. */
- DCL VAR(&SRCFILE) TYPE(*CHAR) LEN(10) +
- VALUE('SOURCES') /* Source member file. */
- DCL VAR(&CTLFILE) TYPE(*CHAR) LEN(10) +
- VALUE('TOOLS') /* Control member file. */
-
- DCL VAR(&MODLIB) TYPE(*CHAR) LEN(10) +
- VALUE('ZLIB') /* Module library. */
-
- DCL VAR(&SRVLIB) TYPE(*CHAR) LEN(10) +
- VALUE('LGPL') /* Service program library. */
-
- DCL VAR(&CFLAGS) TYPE(*CHAR) +
- VALUE('OPTIMIZE(40)') /* Compile options. */
-
-
-/* Working storage. */
-
- DCL VAR(&CMDLEN) TYPE(*DEC) LEN(15 5) VALUE(300) /* Command length. */
- DCL VAR(&CMD) TYPE(*CHAR) LEN(512)
-
-
-/* Compile sources into modules. */
-
- CHGVAR VAR(&CMD) VALUE('CRTCMOD MODULE(' *TCAT &MODLIB *TCAT +
- '/ADLER32) SRCFILE(' *TCAT +
- &SRCLIB *TCAT '/' *TCAT &SRCFILE *TCAT +
- ') SYSIFCOPT(*IFSIO)' *BCAT &CFLAGS)
- CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
-
- CHGVAR VAR(&CMD) VALUE('CRTCMOD MODULE(' *TCAT &MODLIB *TCAT +
- '/COMPRESS) SRCFILE(' *TCAT +
- &SRCLIB *TCAT '/' *TCAT &SRCFILE *TCAT +
- ') SYSIFCOPT(*IFSIO)' *BCAT &CFLAGS)
- CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
-
- CHGVAR VAR(&CMD) VALUE('CRTCMOD MODULE(' *TCAT &MODLIB *TCAT +
- '/CRC32) SRCFILE(' *TCAT +
- &SRCLIB *TCAT '/' *TCAT &SRCFILE *TCAT +
- ') SYSIFCOPT(*IFSIO)' *BCAT &CFLAGS)
- CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
-
- CHGVAR VAR(&CMD) VALUE('CRTCMOD MODULE(' *TCAT &MODLIB *TCAT +
- '/DEFLATE) SRCFILE(' *TCAT +
- &SRCLIB *TCAT '/' *TCAT &SRCFILE *TCAT +
- ') SYSIFCOPT(*IFSIO)' *BCAT &CFLAGS)
- CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
-
- CHGVAR VAR(&CMD) VALUE('CRTCMOD MODULE(' *TCAT &MODLIB *TCAT +
- '/GZIO) SRCFILE(' *TCAT +
- &SRCLIB *TCAT '/' *TCAT &SRCFILE *TCAT +
- ') SYSIFCOPT(*IFSIO)' *BCAT &CFLAGS)
- CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
-
- CHGVAR VAR(&CMD) VALUE('CRTCMOD MODULE(' *TCAT &MODLIB *TCAT +
- '/INFBACK) SRCFILE(' *TCAT +
- &SRCLIB *TCAT '/' *TCAT &SRCFILE *TCAT +
- ') SYSIFCOPT(*IFSIO)' *BCAT &CFLAGS)
- CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
-
- CHGVAR VAR(&CMD) VALUE('CRTCMOD MODULE(' *TCAT &MODLIB *TCAT +
- '/INFFAST) SRCFILE(' *TCAT +
- &SRCLIB *TCAT '/' *TCAT &SRCFILE *TCAT +
- ') SYSIFCOPT(*IFSIO)' *BCAT &CFLAGS)
- CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
-
- CHGVAR VAR(&CMD) VALUE('CRTCMOD MODULE(' *TCAT &MODLIB *TCAT +
- '/INFLATE) SRCFILE(' *TCAT +
- &SRCLIB *TCAT '/' *TCAT &SRCFILE *TCAT +
- ') SYSIFCOPT(*IFSIO)' *BCAT &CFLAGS)
- CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
-
- CHGVAR VAR(&CMD) VALUE('CRTCMOD MODULE(' *TCAT &MODLIB *TCAT +
- '/INFTREES) SRCFILE(' *TCAT +
- &SRCLIB *TCAT '/' *TCAT &SRCFILE *TCAT +
- ') SYSIFCOPT(*IFSIO)' *BCAT &CFLAGS)
- CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
-
- CHGVAR VAR(&CMD) VALUE('CRTCMOD MODULE(' *TCAT &MODLIB *TCAT +
- '/TREES) SRCFILE(' *TCAT +
- &SRCLIB *TCAT '/' *TCAT &SRCFILE *TCAT +
- ') SYSIFCOPT(*IFSIO)' *BCAT &CFLAGS)
- CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
-
- CHGVAR VAR(&CMD) VALUE('CRTCMOD MODULE(' *TCAT &MODLIB *TCAT +
- '/UNCOMPR) SRCFILE(' *TCAT +
- &SRCLIB *TCAT '/' *TCAT &SRCFILE *TCAT +
- ') SYSIFCOPT(*IFSIO)' *BCAT &CFLAGS)
- CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
-
- CHGVAR VAR(&CMD) VALUE('CRTCMOD MODULE(' *TCAT &MODLIB *TCAT +
- '/ZUTIL) SRCFILE(' *TCAT +
- &SRCLIB *TCAT '/' *TCAT &SRCFILE *TCAT +
- ') SYSIFCOPT(*IFSIO)' *BCAT &CFLAGS)
- CALL PGM(QCMDEXC) PARM(&CMD &CMDLEN)
-
-
-/* Link modules into a service program. */
-
- CRTSRVPGM SRVPGM(&SRVLIB/ZLIB) +
- MODULE(&MODLIB/ADLER32 &MODLIB/COMPRESS +
- &MODLIB/CRC32 &MODLIB/DEFLATE +
- &MODLIB/GZIO &MODLIB/INFBACK +
- &MODLIB/INFFAST &MODLIB/INFLATE +
- &MODLIB/INFTREES &MODLIB/TREES +
- &MODLIB/UNCOMPR &MODLIB/ZUTIL) +
- SRCFILE(&SRCLIB/&CTLFILE) SRCMBR(BNDSRC) +
- TEXT('ZLIB 1.2.3') TGTRLS(V4R4M0)
-
- ENDPGM
diff --git a/compat/zlib/old/visualc6/README.txt b/compat/zlib/old/visualc6/README.txt
deleted file mode 100644
index d0296c2..0000000
--- a/compat/zlib/old/visualc6/README.txt
+++ /dev/null
@@ -1,73 +0,0 @@
-Microsoft Developer Studio Project Files, Format Version 6.00 for zlib.
-
-Copyright (C) 2000-2004 Simon-Pierre Cadieux.
-Copyright (C) 2004 Cosmin Truta.
-For conditions of distribution and use, see copyright notice in zlib.h.
-
-
-This project builds the zlib binaries as follows:
-
-* Win32_DLL_Release\zlib1.dll DLL build
-* Win32_DLL_Debug\zlib1d.dll DLL build (debug version)
-* Win32_DLL_ASM_Release\zlib1.dll DLL build using ASM code
-* Win32_DLL_ASM_Debug\zlib1d.dll DLL build using ASM code (debug version)
-* Win32_LIB_Release\zlib.lib static build
-* Win32_LIB_Debug\zlibd.lib static build (debug version)
-* Win32_LIB_ASM_Release\zlib.lib static build using ASM code
-* Win32_LIB_ASM_Debug\zlibd.lib static build using ASM code (debug version)
-
-
-For more information regarding the DLL builds, please see the DLL FAQ
-in ..\..\win32\DLL_FAQ.txt.
-
-
-To build and test:
-
-1) On the main menu, select "File | Open Workspace".
- Open "zlib.dsw".
-
-2) Select "Build | Set Active Configuration".
- Choose the configuration you wish to build.
-
-3) Select "Build | Clean".
-
-4) Select "Build | Build ... (F7)". Ignore warning messages about
- not being able to find certain include files (e.g. alloc.h).
-
-5) If you built one of the sample programs (example or minigzip),
- select "Build | Execute ... (Ctrl+F5)".
-
-
-To use:
-
-1) Select "Project | Settings (Alt+F7)".
- Make note of the configuration names used in your project.
- Usually, these names are "Win32 Release" and "Win32 Debug".
-
-2) In the Workspace window, select the "FileView" tab.
- Right-click on the root item "Workspace '...'".
- Select "Insert Project into Workspace".
- Switch on the checkbox "Dependency of:", and select the name
- of your project. Open "zlib.dsp".
-
-3) Select "Build | Configurations".
- For each configuration of your project:
- 3.1) Choose the zlib configuration you wish to use.
- 3.2) Click on "Add".
- 3.3) Set the new zlib configuration name to the name used by
- the configuration from the current iteration.
-
-4) Select "Build | Set Active Configuration".
- Choose the configuration you wish to build.
-
-5) Select "Build | Build ... (F7)".
-
-6) If you built an executable program, select
- "Build | Execute ... (Ctrl+F5)".
-
-
-Note:
-
-To build the ASM-enabled code, you need Microsoft Assembler
-(ML.EXE). You can get it by downloading and installing the
-latest Processor Pack for Visual C++ 6.0.
diff --git a/compat/zlib/old/visualc6/example.dsp b/compat/zlib/old/visualc6/example.dsp
deleted file mode 100644
index d358052..0000000
--- a/compat/zlib/old/visualc6/example.dsp
+++ /dev/null
@@ -1,278 +0,0 @@
-# Microsoft Developer Studio Project File - Name="example" - Package Owner=<4>
-# Microsoft Developer Studio Generated Build File, Format Version 6.00
-# ** DO NOT EDIT **
-
-# TARGTYPE "Win32 (x86) Console Application" 0x0103
-
-CFG=example - Win32 LIB Debug
-!MESSAGE This is not a valid makefile. To build this project using NMAKE,
-!MESSAGE use the Export Makefile command and run
-!MESSAGE
-!MESSAGE NMAKE /f "example.mak".
-!MESSAGE
-!MESSAGE You can specify a configuration when running NMAKE
-!MESSAGE by defining the macro CFG on the command line. For example:
-!MESSAGE
-!MESSAGE NMAKE /f "example.mak" CFG="example - Win32 LIB Debug"
-!MESSAGE
-!MESSAGE Possible choices for configuration are:
-!MESSAGE
-!MESSAGE "example - Win32 DLL ASM Release" (based on "Win32 (x86) Console Application")
-!MESSAGE "example - Win32 DLL ASM Debug" (based on "Win32 (x86) Console Application")
-!MESSAGE "example - Win32 DLL Release" (based on "Win32 (x86) Console Application")
-!MESSAGE "example - Win32 DLL Debug" (based on "Win32 (x86) Console Application")
-!MESSAGE "example - Win32 LIB ASM Release" (based on "Win32 (x86) Console Application")
-!MESSAGE "example - Win32 LIB ASM Debug" (based on "Win32 (x86) Console Application")
-!MESSAGE "example - Win32 LIB Release" (based on "Win32 (x86) Console Application")
-!MESSAGE "example - Win32 LIB Debug" (based on "Win32 (x86) Console Application")
-!MESSAGE
-
-# Begin Project
-# PROP AllowPerConfigDependencies 0
-# PROP Scc_ProjName ""
-# PROP Scc_LocalPath ""
-CPP=cl.exe
-RSC=rc.exe
-
-!IF "$(CFG)" == "example - Win32 DLL ASM Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "example___Win32_DLL_ASM_Release"
-# PROP BASE Intermediate_Dir "example___Win32_DLL_ASM_Release"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir "Win32_DLL_ASM_Release"
-# PROP Intermediate_Dir "Win32_DLL_ASM_Release"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /FD /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "NDEBUG" /FD /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "NDEBUG"
-# ADD RSC /l 0x409 /d "NDEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
-# ADD LINK32 /nologo /subsystem:console /machine:I386
-
-!ELSEIF "$(CFG)" == "example - Win32 DLL ASM Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "example___Win32_DLL_ASM_Debug"
-# PROP BASE Intermediate_Dir "example___Win32_DLL_ASM_Debug"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 1
-# PROP Output_Dir "Win32_DLL_ASM_Debug"
-# PROP Intermediate_Dir "Win32_DLL_ASM_Debug"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /FD /GZ /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "_DEBUG" /FR /FD /GZ /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "_DEBUG"
-# ADD RSC /l 0x409 /d "_DEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-# ADD LINK32 /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-
-!ELSEIF "$(CFG)" == "example - Win32 DLL Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "example___Win32_DLL_Release"
-# PROP BASE Intermediate_Dir "example___Win32_DLL_Release"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir "Win32_DLL_Release"
-# PROP Intermediate_Dir "Win32_DLL_Release"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /FD /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "NDEBUG" /FD /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "NDEBUG"
-# ADD RSC /l 0x409 /d "NDEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
-# ADD LINK32 /nologo /subsystem:console /machine:I386
-
-!ELSEIF "$(CFG)" == "example - Win32 DLL Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "example___Win32_DLL_Debug"
-# PROP BASE Intermediate_Dir "example___Win32_DLL_Debug"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 1
-# PROP Output_Dir "Win32_DLL_Debug"
-# PROP Intermediate_Dir "Win32_DLL_Debug"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /FD /GZ /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "_DEBUG" /FR /FD /GZ /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "_DEBUG"
-# ADD RSC /l 0x409 /d "_DEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-# ADD LINK32 /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-
-!ELSEIF "$(CFG)" == "example - Win32 LIB ASM Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "example___Win32_LIB_ASM_Release"
-# PROP BASE Intermediate_Dir "example___Win32_LIB_ASM_Release"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir "Win32_LIB_ASM_Release"
-# PROP Intermediate_Dir "Win32_LIB_ASM_Release"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /FD /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "NDEBUG" /FD /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "NDEBUG"
-# ADD RSC /l 0x409 /d "NDEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
-# ADD LINK32 /nologo /subsystem:console /machine:I386
-
-!ELSEIF "$(CFG)" == "example - Win32 LIB ASM Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "example___Win32_LIB_ASM_Debug"
-# PROP BASE Intermediate_Dir "example___Win32_LIB_ASM_Debug"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 1
-# PROP Output_Dir "Win32_LIB_ASM_Debug"
-# PROP Intermediate_Dir "Win32_LIB_ASM_Debug"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /FD /GZ /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "_DEBUG" /FR /FD /GZ /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "_DEBUG"
-# ADD RSC /l 0x409 /d "_DEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-# ADD LINK32 /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-
-!ELSEIF "$(CFG)" == "example - Win32 LIB Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "example___Win32_LIB_Release"
-# PROP BASE Intermediate_Dir "example___Win32_LIB_Release"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir "Win32_LIB_Release"
-# PROP Intermediate_Dir "Win32_LIB_Release"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /FD /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "NDEBUG" /FD /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "NDEBUG"
-# ADD RSC /l 0x409 /d "NDEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
-# ADD LINK32 /nologo /subsystem:console /machine:I386
-
-!ELSEIF "$(CFG)" == "example - Win32 LIB Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "example___Win32_LIB_Debug"
-# PROP BASE Intermediate_Dir "example___Win32_LIB_Debug"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 1
-# PROP Output_Dir "Win32_LIB_Debug"
-# PROP Intermediate_Dir "Win32_LIB_Debug"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /FD /GZ /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "_DEBUG" /FR /FD /GZ /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "_DEBUG"
-# ADD RSC /l 0x409 /d "_DEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-# ADD LINK32 /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-
-!ENDIF
-
-# Begin Target
-
-# Name "example - Win32 DLL ASM Release"
-# Name "example - Win32 DLL ASM Debug"
-# Name "example - Win32 DLL Release"
-# Name "example - Win32 DLL Debug"
-# Name "example - Win32 LIB ASM Release"
-# Name "example - Win32 LIB ASM Debug"
-# Name "example - Win32 LIB Release"
-# Name "example - Win32 LIB Debug"
-# Begin Group "Source Files"
-
-# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat"
-# Begin Source File
-
-SOURCE=..\..\example.c
-# End Source File
-# End Group
-# Begin Group "Header Files"
-
-# PROP Default_Filter "h;hpp;hxx;hm;inl"
-# Begin Source File
-
-SOURCE=..\..\zconf.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\zlib.h
-# End Source File
-# End Group
-# End Target
-# End Project
diff --git a/compat/zlib/old/visualc6/minigzip.dsp b/compat/zlib/old/visualc6/minigzip.dsp
deleted file mode 100644
index 7103468..0000000
--- a/compat/zlib/old/visualc6/minigzip.dsp
+++ /dev/null
@@ -1,278 +0,0 @@
-# Microsoft Developer Studio Project File - Name="minigzip" - Package Owner=<4>
-# Microsoft Developer Studio Generated Build File, Format Version 6.00
-# ** DO NOT EDIT **
-
-# TARGTYPE "Win32 (x86) Console Application" 0x0103
-
-CFG=minigzip - Win32 LIB Debug
-!MESSAGE This is not a valid makefile. To build this project using NMAKE,
-!MESSAGE use the Export Makefile command and run
-!MESSAGE
-!MESSAGE NMAKE /f "minigzip.mak".
-!MESSAGE
-!MESSAGE You can specify a configuration when running NMAKE
-!MESSAGE by defining the macro CFG on the command line. For example:
-!MESSAGE
-!MESSAGE NMAKE /f "minigzip.mak" CFG="minigzip - Win32 LIB Debug"
-!MESSAGE
-!MESSAGE Possible choices for configuration are:
-!MESSAGE
-!MESSAGE "minigzip - Win32 DLL ASM Release" (based on "Win32 (x86) Console Application")
-!MESSAGE "minigzip - Win32 DLL ASM Debug" (based on "Win32 (x86) Console Application")
-!MESSAGE "minigzip - Win32 DLL Release" (based on "Win32 (x86) Console Application")
-!MESSAGE "minigzip - Win32 DLL Debug" (based on "Win32 (x86) Console Application")
-!MESSAGE "minigzip - Win32 LIB ASM Release" (based on "Win32 (x86) Console Application")
-!MESSAGE "minigzip - Win32 LIB ASM Debug" (based on "Win32 (x86) Console Application")
-!MESSAGE "minigzip - Win32 LIB Release" (based on "Win32 (x86) Console Application")
-!MESSAGE "minigzip - Win32 LIB Debug" (based on "Win32 (x86) Console Application")
-!MESSAGE
-
-# Begin Project
-# PROP AllowPerConfigDependencies 0
-# PROP Scc_ProjName ""
-# PROP Scc_LocalPath ""
-CPP=cl.exe
-RSC=rc.exe
-
-!IF "$(CFG)" == "minigzip - Win32 DLL ASM Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "minigzip___Win32_DLL_ASM_Release"
-# PROP BASE Intermediate_Dir "minigzip___Win32_DLL_ASM_Release"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir "Win32_DLL_ASM_Release"
-# PROP Intermediate_Dir "Win32_DLL_ASM_Release"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /FD /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "NDEBUG" /FD /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "NDEBUG"
-# ADD RSC /l 0x409 /d "NDEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
-# ADD LINK32 /nologo /subsystem:console /machine:I386
-
-!ELSEIF "$(CFG)" == "minigzip - Win32 DLL ASM Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "minigzip___Win32_DLL_ASM_Debug"
-# PROP BASE Intermediate_Dir "minigzip___Win32_DLL_ASM_Debug"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 1
-# PROP Output_Dir "Win32_DLL_ASM_Debug"
-# PROP Intermediate_Dir "Win32_DLL_ASM_Debug"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /FD /GZ /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "_DEBUG" /FR /FD /GZ /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "_DEBUG"
-# ADD RSC /l 0x409 /d "_DEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-# ADD LINK32 /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-
-!ELSEIF "$(CFG)" == "minigzip - Win32 DLL Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "minigzip___Win32_DLL_Release"
-# PROP BASE Intermediate_Dir "minigzip___Win32_DLL_Release"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir "Win32_DLL_Release"
-# PROP Intermediate_Dir "Win32_DLL_Release"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /FD /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "NDEBUG" /FD /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "NDEBUG"
-# ADD RSC /l 0x409 /d "NDEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
-# ADD LINK32 /nologo /subsystem:console /machine:I386
-
-!ELSEIF "$(CFG)" == "minigzip - Win32 DLL Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "minigzip___Win32_DLL_Debug"
-# PROP BASE Intermediate_Dir "minigzip___Win32_DLL_Debug"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 1
-# PROP Output_Dir "Win32_DLL_Debug"
-# PROP Intermediate_Dir "Win32_DLL_Debug"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /FD /GZ /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "_DEBUG" /FR /FD /GZ /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "_DEBUG"
-# ADD RSC /l 0x409 /d "_DEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-# ADD LINK32 /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-
-!ELSEIF "$(CFG)" == "minigzip - Win32 LIB ASM Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "minigzip___Win32_LIB_ASM_Release"
-# PROP BASE Intermediate_Dir "minigzip___Win32_LIB_ASM_Release"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir "Win32_LIB_ASM_Release"
-# PROP Intermediate_Dir "Win32_LIB_ASM_Release"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /FD /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "NDEBUG" /FD /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "NDEBUG"
-# ADD RSC /l 0x409 /d "NDEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
-# ADD LINK32 /nologo /subsystem:console /machine:I386
-
-!ELSEIF "$(CFG)" == "minigzip - Win32 LIB ASM Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "minigzip___Win32_LIB_ASM_Debug"
-# PROP BASE Intermediate_Dir "minigzip___Win32_LIB_ASM_Debug"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 1
-# PROP Output_Dir "Win32_LIB_ASM_Debug"
-# PROP Intermediate_Dir "Win32_LIB_ASM_Debug"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /FD /GZ /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "_DEBUG" /FR /FD /GZ /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "_DEBUG"
-# ADD RSC /l 0x409 /d "_DEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-# ADD LINK32 /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-
-!ELSEIF "$(CFG)" == "minigzip - Win32 LIB Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "minigzip___Win32_LIB_Release"
-# PROP BASE Intermediate_Dir "minigzip___Win32_LIB_Release"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir "Win32_LIB_Release"
-# PROP Intermediate_Dir "Win32_LIB_Release"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /FD /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "NDEBUG" /FD /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "NDEBUG"
-# ADD RSC /l 0x409 /d "NDEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
-# ADD LINK32 /nologo /subsystem:console /machine:I386
-
-!ELSEIF "$(CFG)" == "minigzip - Win32 LIB Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "minigzip___Win32_LIB_Debug"
-# PROP BASE Intermediate_Dir "minigzip___Win32_LIB_Debug"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 1
-# PROP Output_Dir "Win32_LIB_Debug"
-# PROP Intermediate_Dir "Win32_LIB_Debug"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-# ADD BASE CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /FD /GZ /c
-# SUBTRACT BASE CPP /YX
-# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "_DEBUG" /FR /FD /GZ /c
-# SUBTRACT CPP /YX
-# ADD BASE RSC /l 0x409 /d "_DEBUG"
-# ADD RSC /l 0x409 /d "_DEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-# ADD LINK32 /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
-
-!ENDIF
-
-# Begin Target
-
-# Name "minigzip - Win32 DLL ASM Release"
-# Name "minigzip - Win32 DLL ASM Debug"
-# Name "minigzip - Win32 DLL Release"
-# Name "minigzip - Win32 DLL Debug"
-# Name "minigzip - Win32 LIB ASM Release"
-# Name "minigzip - Win32 LIB ASM Debug"
-# Name "minigzip - Win32 LIB Release"
-# Name "minigzip - Win32 LIB Debug"
-# Begin Group "Source Files"
-
-# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat"
-# Begin Source File
-
-SOURCE=..\..\minigzip.c
-# End Source File
-# End Group
-# Begin Group "Header Files"
-
-# PROP Default_Filter "h;hpp;hxx;hm;inl"
-# Begin Source File
-
-SOURCE=..\..\zconf.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\zlib.h
-# End Source File
-# End Group
-# End Target
-# End Project
diff --git a/compat/zlib/old/visualc6/zlib.dsp b/compat/zlib/old/visualc6/zlib.dsp
deleted file mode 100644
index 00f54ea..0000000
--- a/compat/zlib/old/visualc6/zlib.dsp
+++ /dev/null
@@ -1,621 +0,0 @@
-# Microsoft Developer Studio Project File - Name="zlib" - Package Owner=<4>
-# Microsoft Developer Studio Generated Build File, Format Version 6.00
-# ** DO NOT EDIT **
-
-# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102
-# TARGTYPE "Win32 (x86) Static Library" 0x0104
-
-CFG=zlib - Win32 LIB Debug
-!MESSAGE This is not a valid makefile. To build this project using NMAKE,
-!MESSAGE use the Export Makefile command and run
-!MESSAGE
-!MESSAGE NMAKE /f "zlib.mak".
-!MESSAGE
-!MESSAGE You can specify a configuration when running NMAKE
-!MESSAGE by defining the macro CFG on the command line. For example:
-!MESSAGE
-!MESSAGE NMAKE /f "zlib.mak" CFG="zlib - Win32 LIB Debug"
-!MESSAGE
-!MESSAGE Possible choices for configuration are:
-!MESSAGE
-!MESSAGE "zlib - Win32 DLL ASM Release" (based on "Win32 (x86) Dynamic-Link Library")
-!MESSAGE "zlib - Win32 DLL ASM Debug" (based on "Win32 (x86) Dynamic-Link Library")
-!MESSAGE "zlib - Win32 DLL Release" (based on "Win32 (x86) Dynamic-Link Library")
-!MESSAGE "zlib - Win32 DLL Debug" (based on "Win32 (x86) Dynamic-Link Library")
-!MESSAGE "zlib - Win32 LIB ASM Release" (based on "Win32 (x86) Static Library")
-!MESSAGE "zlib - Win32 LIB ASM Debug" (based on "Win32 (x86) Static Library")
-!MESSAGE "zlib - Win32 LIB Release" (based on "Win32 (x86) Static Library")
-!MESSAGE "zlib - Win32 LIB Debug" (based on "Win32 (x86) Static Library")
-!MESSAGE
-
-# Begin Project
-# PROP AllowPerConfigDependencies 0
-# PROP Scc_ProjName ""
-# PROP Scc_LocalPath ""
-
-!IF "$(CFG)" == "zlib - Win32 DLL ASM Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "zlib___Win32_DLL_ASM_Release"
-# PROP BASE Intermediate_Dir "zlib___Win32_DLL_ASM_Release"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir "Win32_DLL_ASM_Release"
-# PROP Intermediate_Dir "Win32_DLL_ASM_Release"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-CPP=cl.exe
-# ADD BASE CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /FD /c
-# SUBTRACT BASE CPP /YX /Yc /Yu
-# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "NDEBUG" /D "ASMV" /D "ASMINF" /FD /c
-# SUBTRACT CPP /YX /Yc /Yu
-MTL=midl.exe
-# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
-# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
-RSC=rc.exe
-# ADD BASE RSC /l 0x409 /d "NDEBUG"
-# ADD RSC /l 0x409 /d "NDEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
-# ADD LINK32 /nologo /dll /machine:I386 /out:"Win32_DLL_ASM_Release\zlib1.dll"
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL ASM Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "zlib___Win32_DLL_ASM_Debug"
-# PROP BASE Intermediate_Dir "zlib___Win32_DLL_ASM_Debug"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 1
-# PROP Output_Dir "Win32_DLL_ASM_Debug"
-# PROP Intermediate_Dir "Win32_DLL_ASM_Debug"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-CPP=cl.exe
-# ADD BASE CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /FD /GZ /c
-# SUBTRACT BASE CPP /YX /Yc /Yu
-# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "_DEBUG" /D "ASMV" /D "ASMINF" /FR /FD /GZ /c
-# SUBTRACT CPP /YX /Yc /Yu
-MTL=midl.exe
-# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
-# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
-RSC=rc.exe
-# ADD BASE RSC /l 0x409 /d "_DEBUG"
-# ADD RSC /l 0x409 /d "_DEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept
-# ADD LINK32 /nologo /dll /debug /machine:I386 /out:"Win32_DLL_ASM_Debug\zlib1d.dll" /pdbtype:sept
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "zlib___Win32_DLL_Release"
-# PROP BASE Intermediate_Dir "zlib___Win32_DLL_Release"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir "Win32_DLL_Release"
-# PROP Intermediate_Dir "Win32_DLL_Release"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-CPP=cl.exe
-# ADD BASE CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /FD /c
-# SUBTRACT BASE CPP /YX /Yc /Yu
-# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "NDEBUG" /FD /c
-# SUBTRACT CPP /YX /Yc /Yu
-MTL=midl.exe
-# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
-# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
-RSC=rc.exe
-# ADD BASE RSC /l 0x409 /d "NDEBUG"
-# ADD RSC /l 0x409 /d "NDEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
-# ADD LINK32 /nologo /dll /machine:I386 /out:"Win32_DLL_Release\zlib1.dll"
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "zlib___Win32_DLL_Debug"
-# PROP BASE Intermediate_Dir "zlib___Win32_DLL_Debug"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 1
-# PROP Output_Dir "Win32_DLL_Debug"
-# PROP Intermediate_Dir "Win32_DLL_Debug"
-# PROP Ignore_Export_Lib 0
-# PROP Target_Dir ""
-CPP=cl.exe
-# ADD BASE CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /FD /GZ /c
-# SUBTRACT BASE CPP /YX /Yc /Yu
-# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "_DEBUG" /FR /FD /GZ /c
-# SUBTRACT CPP /YX /Yc /Yu
-MTL=midl.exe
-# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
-# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
-RSC=rc.exe
-# ADD BASE RSC /l 0x409 /d "_DEBUG"
-# ADD RSC /l 0x409 /d "_DEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LINK32=link.exe
-# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept
-# ADD LINK32 /nologo /dll /debug /machine:I386 /out:"Win32_DLL_Debug\zlib1d.dll" /pdbtype:sept
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB ASM Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "zlib___Win32_LIB_ASM_Release"
-# PROP BASE Intermediate_Dir "zlib___Win32_LIB_ASM_Release"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir "Win32_LIB_ASM_Release"
-# PROP Intermediate_Dir "Win32_LIB_ASM_Release"
-# PROP Target_Dir ""
-CPP=cl.exe
-# ADD BASE CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /FD /c
-# SUBTRACT BASE CPP /YX /Yc /Yu
-# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "NDEBUG" /D "ASMV" /D "ASMINF" /FD /c
-# SUBTRACT CPP /YX /Yc /Yu
-RSC=rc.exe
-# ADD BASE RSC /l 0x409 /d "NDEBUG"
-# ADD RSC /l 0x409 /d "NDEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LIB32=link.exe -lib
-# ADD BASE LIB32 /nologo
-# ADD LIB32 /nologo
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB ASM Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "zlib___Win32_LIB_ASM_Debug"
-# PROP BASE Intermediate_Dir "zlib___Win32_LIB_ASM_Debug"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 1
-# PROP Output_Dir "Win32_LIB_ASM_Debug"
-# PROP Intermediate_Dir "Win32_LIB_ASM_Debug"
-# PROP Target_Dir ""
-CPP=cl.exe
-# ADD BASE CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /FD /GZ /c
-# SUBTRACT BASE CPP /YX /Yc /Yu
-# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "_DEBUG" /D "ASMV" /D "ASMINF" /FR /FD /GZ /c
-# SUBTRACT CPP /YX /Yc /Yu
-RSC=rc.exe
-# ADD BASE RSC /l 0x409 /d "_DEBUG"
-# ADD RSC /l 0x409 /d "_DEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LIB32=link.exe -lib
-# ADD BASE LIB32 /nologo
-# ADD LIB32 /nologo /out:"Win32_LIB_ASM_Debug\zlibd.lib"
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "zlib___Win32_LIB_Release"
-# PROP BASE Intermediate_Dir "zlib___Win32_LIB_Release"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir "Win32_LIB_Release"
-# PROP Intermediate_Dir "Win32_LIB_Release"
-# PROP Target_Dir ""
-CPP=cl.exe
-# ADD BASE CPP /nologo /MD /W3 /O2 /D "WIN32" /D "NDEBUG" /FD /c
-# SUBTRACT BASE CPP /YX /Yc /Yu
-# ADD CPP /nologo /MD /W3 /O2 /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "NDEBUG" /FD /c
-# SUBTRACT CPP /YX /Yc /Yu
-RSC=rc.exe
-# ADD BASE RSC /l 0x409 /d "NDEBUG"
-# ADD RSC /l 0x409 /d "NDEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LIB32=link.exe -lib
-# ADD BASE LIB32 /nologo
-# ADD LIB32 /nologo
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "zlib___Win32_LIB_Debug"
-# PROP BASE Intermediate_Dir "zlib___Win32_LIB_Debug"
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 1
-# PROP Output_Dir "Win32_LIB_Debug"
-# PROP Intermediate_Dir "Win32_LIB_Debug"
-# PROP Target_Dir ""
-CPP=cl.exe
-# ADD BASE CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_DEBUG" /FD /GZ /c
-# SUBTRACT BASE CPP /YX /Yc /Yu
-# ADD CPP /nologo /MDd /W3 /Gm /ZI /Od /D "WIN32" /D "_CRT_SECURE_NO_DEPRECATE" /D "_CRT_NONSTDC_NO_DEPRECATE" /D "_DEBUG" /FR /FD /GZ /c
-# SUBTRACT CPP /YX /Yc /Yu
-RSC=rc.exe
-# ADD BASE RSC /l 0x409 /d "_DEBUG"
-# ADD RSC /l 0x409 /d "_DEBUG"
-BSC32=bscmake.exe
-# ADD BASE BSC32 /nologo
-# ADD BSC32 /nologo
-LIB32=link.exe -lib
-# ADD BASE LIB32 /nologo
-# ADD LIB32 /nologo /out:"Win32_LIB_Debug\zlibd.lib"
-
-!ENDIF
-
-# Begin Target
-
-# Name "zlib - Win32 DLL ASM Release"
-# Name "zlib - Win32 DLL ASM Debug"
-# Name "zlib - Win32 DLL Release"
-# Name "zlib - Win32 DLL Debug"
-# Name "zlib - Win32 LIB ASM Release"
-# Name "zlib - Win32 LIB ASM Debug"
-# Name "zlib - Win32 LIB Release"
-# Name "zlib - Win32 LIB Debug"
-# Begin Group "Source Files"
-
-# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat"
-# Begin Source File
-
-SOURCE=..\..\adler32.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\compress.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\crc32.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\deflate.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\gzclose.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\gzlib.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\gzread.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\gzwrite.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\infback.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\inffast.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\inflate.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\inftrees.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\trees.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\uncompr.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\win32\zlib.def
-
-!IF "$(CFG)" == "zlib - Win32 DLL ASM Release"
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL ASM Debug"
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL Release"
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL Debug"
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB ASM Release"
-
-# PROP Exclude_From_Build 1
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB ASM Debug"
-
-# PROP Exclude_From_Build 1
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB Release"
-
-# PROP Exclude_From_Build 1
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB Debug"
-
-# PROP Exclude_From_Build 1
-
-!ENDIF
-
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\zutil.c
-# End Source File
-# End Group
-# Begin Group "Header Files"
-
-# PROP Default_Filter "h;hpp;hxx;hm;inl"
-# Begin Source File
-
-SOURCE=..\..\crc32.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\deflate.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\inffast.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\inffixed.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\inflate.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\inftrees.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\trees.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\zconf.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\zlib.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\zutil.h
-# End Source File
-# End Group
-# Begin Group "Resource Files"
-
-# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
-# Begin Source File
-
-SOURCE=..\..\win32\zlib1.rc
-# End Source File
-# End Group
-# Begin Group "Assembler Files (Unsupported)"
-
-# PROP Default_Filter "asm;obj;c;cpp;cxx;h;hpp;hxx"
-# Begin Source File
-
-SOURCE=..\..\contrib\masmx86\gvmat32.asm
-
-!IF "$(CFG)" == "zlib - Win32 DLL ASM Release"
-
-# Begin Custom Build - Assembling...
-IntDir=.\Win32_DLL_ASM_Release
-InputPath=..\..\contrib\masmx86\gvmat32.asm
-InputName=gvmat32
-
-"$(IntDir)\$(InputName).obj" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)"
- ml.exe /nologo /c /coff /Cx /Fo"$(IntDir)\$(InputName).obj" "$(InputPath)"
-
-# End Custom Build
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL ASM Debug"
-
-# Begin Custom Build - Assembling...
-IntDir=.\Win32_DLL_ASM_Debug
-InputPath=..\..\contrib\masmx86\gvmat32.asm
-InputName=gvmat32
-
-"$(IntDir)\$(InputName).obj" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)"
- ml.exe /nologo /c /coff /Cx /Zi /Fo"$(IntDir)\$(InputName).obj" "$(InputPath)"
-
-# End Custom Build
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL Release"
-
-# PROP Exclude_From_Build 1
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL Debug"
-
-# PROP Exclude_From_Build 1
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB ASM Release"
-
-# Begin Custom Build - Assembling...
-IntDir=.\Win32_LIB_ASM_Release
-InputPath=..\..\contrib\masmx86\gvmat32.asm
-InputName=gvmat32
-
-"$(IntDir)\$(InputName).obj" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)"
- ml.exe /nologo /c /coff /Cx /Fo"$(IntDir)\$(InputName).obj" "$(InputPath)"
-
-# End Custom Build
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB ASM Debug"
-
-# Begin Custom Build - Assembling...
-IntDir=.\Win32_LIB_ASM_Debug
-InputPath=..\..\contrib\masmx86\gvmat32.asm
-InputName=gvmat32
-
-"$(IntDir)\$(InputName).obj" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)"
- ml.exe /nologo /c /coff /Cx /Zi /Fo"$(IntDir)\$(InputName).obj" "$(InputPath)"
-
-# End Custom Build
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB Release"
-
-# PROP Exclude_From_Build 1
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB Debug"
-
-# PROP Exclude_From_Build 1
-
-!ENDIF
-
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\contrib\masmx86\gvmat32c.c
-
-!IF "$(CFG)" == "zlib - Win32 DLL ASM Release"
-
-# ADD CPP /I "..\.."
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL ASM Debug"
-
-# ADD CPP /I "..\.."
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL Release"
-
-# PROP Exclude_From_Build 1
-# ADD CPP /I "..\.."
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL Debug"
-
-# PROP Exclude_From_Build 1
-# ADD CPP /I "..\.."
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB ASM Release"
-
-# ADD CPP /I "..\.."
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB ASM Debug"
-
-# ADD CPP /I "..\.."
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB Release"
-
-# PROP Exclude_From_Build 1
-# ADD CPP /I "..\.."
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB Debug"
-
-# PROP Exclude_From_Build 1
-# ADD CPP /I "..\.."
-
-!ENDIF
-
-# End Source File
-# Begin Source File
-
-SOURCE=..\..\contrib\masmx86\inffas32.asm
-
-!IF "$(CFG)" == "zlib - Win32 DLL ASM Release"
-
-# Begin Custom Build - Assembling...
-IntDir=.\Win32_DLL_ASM_Release
-InputPath=..\..\contrib\masmx86\inffas32.asm
-InputName=inffas32
-
-"$(IntDir)\$(InputName).obj" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)"
- ml.exe /nologo /c /coff /Cx /Fo"$(IntDir)\$(InputName).obj" "$(InputPath)"
-
-# End Custom Build
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL ASM Debug"
-
-# Begin Custom Build - Assembling...
-IntDir=.\Win32_DLL_ASM_Debug
-InputPath=..\..\contrib\masmx86\inffas32.asm
-InputName=inffas32
-
-"$(IntDir)\$(InputName).obj" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)"
- ml.exe /nologo /c /coff /Cx /Zi /Fo"$(IntDir)\$(InputName).obj" "$(InputPath)"
-
-# End Custom Build
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL Release"
-
-# PROP Exclude_From_Build 1
-
-!ELSEIF "$(CFG)" == "zlib - Win32 DLL Debug"
-
-# PROP Exclude_From_Build 1
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB ASM Release"
-
-# Begin Custom Build - Assembling...
-IntDir=.\Win32_LIB_ASM_Release
-InputPath=..\..\contrib\masmx86\inffas32.asm
-InputName=inffas32
-
-"$(IntDir)\$(InputName).obj" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)"
- ml.exe /nologo /c /coff /Cx /Fo"$(IntDir)\$(InputName).obj" "$(InputPath)"
-
-# End Custom Build
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB ASM Debug"
-
-# Begin Custom Build - Assembling...
-IntDir=.\Win32_LIB_ASM_Debug
-InputPath=..\..\contrib\masmx86\inffas32.asm
-InputName=inffas32
-
-"$(IntDir)\$(InputName).obj" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)"
- ml.exe /nologo /c /coff /Cx /Zi /Fo"$(IntDir)\$(InputName).obj" "$(InputPath)"
-
-# End Custom Build
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB Release"
-
-# PROP Exclude_From_Build 1
-
-!ELSEIF "$(CFG)" == "zlib - Win32 LIB Debug"
-
-# PROP Exclude_From_Build 1
-
-!ENDIF
-
-# End Source File
-# End Group
-# Begin Source File
-
-SOURCE=.\README.txt
-# End Source File
-# End Target
-# End Project
diff --git a/compat/zlib/old/visualc6/zlib.dsw b/compat/zlib/old/visualc6/zlib.dsw
deleted file mode 100644
index 3a771fc..0000000
--- a/compat/zlib/old/visualc6/zlib.dsw
+++ /dev/null
@@ -1,59 +0,0 @@
-Microsoft Developer Studio Workspace File, Format Version 6.00
-# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
-
-###############################################################################
-
-Project: "example"=.\example.dsp - Package Owner=<4>
-
-Package=<5>
-{{{
-}}}
-
-Package=<4>
-{{{
- Begin Project Dependency
- Project_Dep_Name zlib
- End Project Dependency
-}}}
-
-###############################################################################
-
-Project: "minigzip"=.\minigzip.dsp - Package Owner=<4>
-
-Package=<5>
-{{{
-}}}
-
-Package=<4>
-{{{
- Begin Project Dependency
- Project_Dep_Name zlib
- End Project Dependency
-}}}
-
-###############################################################################
-
-Project: "zlib"=.\zlib.dsp - Package Owner=<4>
-
-Package=<5>
-{{{
-}}}
-
-Package=<4>
-{{{
-}}}
-
-###############################################################################
-
-Global:
-
-Package=<5>
-{{{
-}}}
-
-Package=<3>
-{{{
-}}}
-
-###############################################################################
-
diff --git a/compat/zlib/qnx/package.qpg b/compat/zlib/qnx/package.qpg
index 2bc63b2..26eed9b 100644
--- a/compat/zlib/qnx/package.qpg
+++ b/compat/zlib/qnx/package.qpg
@@ -25,10 +25,10 @@
<QPG:Files>
<QPG:Add file="../zconf.h" install="/opt/include/" user="root:sys" permission="644"/>
<QPG:Add file="../zlib.h" install="/opt/include/" user="root:sys" permission="644"/>
- <QPG:Add file="../libz.so.1.2.5" install="/opt/lib/" user="root:bin" permission="644"/>
- <QPG:Add file="libz.so" install="/opt/lib/" component="dev" filetype="symlink" linkto="libz.so.1.2.5"/>
- <QPG:Add file="libz.so.1" install="/opt/lib/" filetype="symlink" linkto="libz.so.1.2.5"/>
- <QPG:Add file="../libz.so.1.2.5" install="/opt/lib/" component="slib"/>
+ <QPG:Add file="../libz.so.1.2.7" install="/opt/lib/" user="root:bin" permission="644"/>
+ <QPG:Add file="libz.so" install="/opt/lib/" component="dev" filetype="symlink" linkto="libz.so.1.2.7"/>
+ <QPG:Add file="libz.so.1" install="/opt/lib/" filetype="symlink" linkto="libz.so.1.2.7"/>
+ <QPG:Add file="../libz.so.1.2.7" install="/opt/lib/" component="slib"/>
</QPG:Files>
<QPG:PackageFilter>
@@ -63,7 +63,7 @@
</QPM:ProductDescription>
<QPM:ReleaseDescription>
- <QPM:ReleaseVersion>1.2.5</QPM:ReleaseVersion>
+ <QPM:ReleaseVersion>1.2.7</QPM:ReleaseVersion>
<QPM:ReleaseUrgency>Medium</QPM:ReleaseUrgency>
<QPM:ReleaseStability>Stable</QPM:ReleaseStability>
<QPM:ReleaseNoteMinor></QPM:ReleaseNoteMinor>
diff --git a/compat/zlib/example.c b/compat/zlib/test/example.c
index c6c2905..f515a48 100644
--- a/compat/zlib/example.c
+++ b/compat/zlib/test/example.c
@@ -1,9 +1,9 @@
/* example.c -- usage example of the zlib compression library
- * Copyright (C) 1995-2006 Jean-loup Gailly.
+ * Copyright (C) 1995-2006, 2011 Jean-loup Gailly.
* For conditions of distribution and use, see copyright notice in zlib.h
*/
-/* @(#) $Id: example.c,v 1.3 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
#include "zlib.h"
#include <stdio.h>
@@ -34,10 +34,6 @@ const char hello[] = "hello, hello!";
const char dictionary[] = "hello";
uLong dictId; /* Adler32 value of the dictionary */
-void test_compress OF((Byte *compr, uLong comprLen,
- Byte *uncompr, uLong uncomprLen));
-void test_gzio OF((const char *fname,
- Byte *uncompr, uLong uncomprLen));
void test_deflate OF((Byte *compr, uLong comprLen));
void test_inflate OF((Byte *compr, uLong comprLen,
Byte *uncompr, uLong uncomprLen));
@@ -53,6 +49,39 @@ void test_dict_inflate OF((Byte *compr, uLong comprLen,
Byte *uncompr, uLong uncomprLen));
int main OF((int argc, char *argv[]));
+
+#ifdef Z_SOLO
+
+void *myalloc OF((void *, unsigned, unsigned));
+void myfree OF((void *, void *));
+
+void *myalloc(q, n, m)
+ void *q;
+ unsigned n, m;
+{
+ q = Z_NULL;
+ return calloc(n, m);
+}
+
+void myfree(void *q, void *p)
+{
+ q = Z_NULL;
+ free(p);
+}
+
+static alloc_func zalloc = myalloc;
+static free_func zfree = myfree;
+
+#else /* !Z_SOLO */
+
+static alloc_func zalloc = (alloc_func)0;
+static free_func zfree = (free_func)0;
+
+void test_compress OF((Byte *compr, uLong comprLen,
+ Byte *uncompr, uLong uncomprLen));
+void test_gzio OF((const char *fname,
+ Byte *uncompr, uLong uncomprLen));
+
/* ===========================================================================
* Test compress() and uncompress()
*/
@@ -163,6 +192,8 @@ void test_gzio(fname, uncompr, uncomprLen)
#endif
}
+#endif /* Z_SOLO */
+
/* ===========================================================================
* Test deflate() with small buffers
*/
@@ -174,8 +205,8 @@ void test_deflate(compr, comprLen)
int err;
uLong len = (uLong)strlen(hello)+1;
- c_stream.zalloc = (alloc_func)0;
- c_stream.zfree = (free_func)0;
+ c_stream.zalloc = zalloc;
+ c_stream.zfree = zfree;
c_stream.opaque = (voidpf)0;
err = deflateInit(&c_stream, Z_DEFAULT_COMPRESSION);
@@ -213,8 +244,8 @@ void test_inflate(compr, comprLen, uncompr, uncomprLen)
strcpy((char*)uncompr, "garbage");
- d_stream.zalloc = (alloc_func)0;
- d_stream.zfree = (free_func)0;
+ d_stream.zalloc = zalloc;
+ d_stream.zfree = zfree;
d_stream.opaque = (voidpf)0;
d_stream.next_in = compr;
@@ -252,8 +283,8 @@ void test_large_deflate(compr, comprLen, uncompr, uncomprLen)
z_stream c_stream; /* compression stream */
int err;
- c_stream.zalloc = (alloc_func)0;
- c_stream.zfree = (free_func)0;
+ c_stream.zalloc = zalloc;
+ c_stream.zfree = zfree;
c_stream.opaque = (voidpf)0;
err = deflateInit(&c_stream, Z_BEST_SPEED);
@@ -309,8 +340,8 @@ void test_large_inflate(compr, comprLen, uncompr, uncomprLen)
strcpy((char*)uncompr, "garbage");
- d_stream.zalloc = (alloc_func)0;
- d_stream.zfree = (free_func)0;
+ d_stream.zalloc = zalloc;
+ d_stream.zfree = zfree;
d_stream.opaque = (voidpf)0;
d_stream.next_in = compr;
@@ -349,8 +380,8 @@ void test_flush(compr, comprLen)
int err;
uInt len = (uInt)strlen(hello)+1;
- c_stream.zalloc = (alloc_func)0;
- c_stream.zfree = (free_func)0;
+ c_stream.zalloc = zalloc;
+ c_stream.zfree = zfree;
c_stream.opaque = (voidpf)0;
err = deflateInit(&c_stream, Z_DEFAULT_COMPRESSION);
@@ -388,8 +419,8 @@ void test_sync(compr, comprLen, uncompr, uncomprLen)
strcpy((char*)uncompr, "garbage");
- d_stream.zalloc = (alloc_func)0;
- d_stream.zfree = (free_func)0;
+ d_stream.zalloc = zalloc;
+ d_stream.zfree = zfree;
d_stream.opaque = (voidpf)0;
d_stream.next_in = compr;
@@ -430,15 +461,15 @@ void test_dict_deflate(compr, comprLen)
z_stream c_stream; /* compression stream */
int err;
- c_stream.zalloc = (alloc_func)0;
- c_stream.zfree = (free_func)0;
+ c_stream.zalloc = zalloc;
+ c_stream.zfree = zfree;
c_stream.opaque = (voidpf)0;
err = deflateInit(&c_stream, Z_BEST_COMPRESSION);
CHECK_ERR(err, "deflateInit");
err = deflateSetDictionary(&c_stream,
- (const Bytef*)dictionary, sizeof(dictionary));
+ (const Bytef*)dictionary, (int)sizeof(dictionary));
CHECK_ERR(err, "deflateSetDictionary");
dictId = c_stream.adler;
@@ -469,8 +500,8 @@ void test_dict_inflate(compr, comprLen, uncompr, uncomprLen)
strcpy((char*)uncompr, "garbage");
- d_stream.zalloc = (alloc_func)0;
- d_stream.zfree = (free_func)0;
+ d_stream.zalloc = zalloc;
+ d_stream.zfree = zfree;
d_stream.opaque = (voidpf)0;
d_stream.next_in = compr;
@@ -491,7 +522,7 @@ void test_dict_inflate(compr, comprLen, uncompr, uncomprLen)
exit(1);
}
err = inflateSetDictionary(&d_stream, (const Bytef*)dictionary,
- sizeof(dictionary));
+ (int)sizeof(dictionary));
}
CHECK_ERR(err, "inflate with dict");
}
@@ -540,10 +571,15 @@ int main(argc, argv)
printf("out of memory\n");
exit(1);
}
+
+#ifdef Z_SOLO
+ argc = strlen(argv[0]);
+#else
test_compress(compr, comprLen, uncompr, uncomprLen);
test_gzio((argc > 1 ? argv[1] : TESTFILE),
uncompr, uncomprLen);
+#endif
test_deflate(compr, comprLen);
test_inflate(compr, comprLen, uncompr, uncomprLen);
diff --git a/compat/zlib/test/infcover.c b/compat/zlib/test/infcover.c
new file mode 100644
index 0000000..fe3d920
--- /dev/null
+++ b/compat/zlib/test/infcover.c
@@ -0,0 +1,671 @@
+/* infcover.c -- test zlib's inflate routines with full code coverage
+ * Copyright (C) 2011 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* to use, do: ./configure --cover && make cover */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include "zlib.h"
+
+/* get definition of internal structure so we can mess with it (see pull()),
+ and so we can call inflate_trees() (see cover5()) */
+#define ZLIB_INTERNAL
+#include "inftrees.h"
+#include "inflate.h"
+
+#define local static
+
+/* -- memory tracking routines -- */
+
+/*
+ These memory tracking routines are provided to zlib and track all of zlib's
+ allocations and deallocations, check for LIFO operations, keep a current
+ and high water mark of total bytes requested, optionally set a limit on the
+ total memory that can be allocated, and when done check for memory leaks.
+
+ They are used as follows:
+
+ z_stream strm;
+ mem_setup(&strm) initializes the memory tracking and sets the
+ zalloc, zfree, and opaque members of strm to use
+ memory tracking for all zlib operations on strm
+ mem_limit(&strm, limit) sets a limit on the total bytes requested -- a
+ request that exceeds this limit will result in an
+ allocation failure (returns NULL) -- setting the
+ limit to zero means no limit, which is the default
+ after mem_setup()
+ mem_used(&strm, "msg") prints to stderr "msg" and the total bytes used
+ mem_high(&strm, "msg") prints to stderr "msg" and the high water mark
+ mem_done(&strm, "msg") ends memory tracking, releases all allocations
+ for the tracking as well as leaked zlib blocks, if
+ any. If there was anything unusual, such as leaked
+ blocks, non-FIFO frees, or frees of addresses not
+ allocated, then "msg" and information about the
+ problem is printed to stderr. If everything is
+ normal, nothing is printed. mem_done resets the
+ strm members to Z_NULL to use the default memory
+ allocation routines on the next zlib initialization
+ using strm.
+ */
+
+/* these items are strung together in a linked list, one for each allocation */
+struct mem_item {
+ void *ptr; /* pointer to allocated memory */
+ size_t size; /* requested size of allocation */
+ struct mem_item *next; /* pointer to next item in list, or NULL */
+};
+
+/* this structure is at the root of the linked list, and tracks statistics */
+struct mem_zone {
+ struct mem_item *first; /* pointer to first item in list, or NULL */
+ size_t total, highwater; /* total allocations, and largest total */
+ size_t limit; /* memory allocation limit, or 0 if no limit */
+ int notlifo, rogue; /* counts of non-LIFO frees and rogue frees */
+};
+
+/* memory allocation routine to pass to zlib */
+local void *mem_alloc(void *mem, unsigned count, unsigned size)
+{
+ void *ptr;
+ struct mem_item *item;
+ struct mem_zone *zone = mem;
+ size_t len = count * (size_t)size;
+
+ /* induced allocation failure */
+ if (zone == NULL || (zone->limit && zone->total + len > zone->limit))
+ return NULL;
+
+ /* perform allocation using the standard library, fill memory with a
+ non-zero value to make sure that the code isn't depending on zeros */
+ ptr = malloc(len);
+ if (ptr == NULL)
+ return NULL;
+ memset(ptr, 0xa5, len);
+
+ /* create a new item for the list */
+ item = malloc(sizeof(struct mem_item));
+ if (item == NULL) {
+ free(ptr);
+ return NULL;
+ }
+ item->ptr = ptr;
+ item->size = len;
+
+ /* insert item at the beginning of the list */
+ item->next = zone->first;
+ zone->first = item;
+
+ /* update the statistics */
+ zone->total += item->size;
+ if (zone->total > zone->highwater)
+ zone->highwater = zone->total;
+
+ /* return the allocated memory */
+ return ptr;
+}
+
+/* memory free routine to pass to zlib */
+local void mem_free(void *mem, void *ptr)
+{
+ struct mem_item *item, *next;
+ struct mem_zone *zone = mem;
+
+ /* if no zone, just do a free */
+ if (zone == NULL) {
+ free(ptr);
+ return;
+ }
+
+ /* point next to the item that matches ptr, or NULL if not found -- remove
+ the item from the linked list if found */
+ next = zone->first;
+ if (next) {
+ if (next->ptr == ptr)
+ zone->first = next->next; /* first one is it, remove from list */
+ else {
+ do { /* search the linked list */
+ item = next;
+ next = item->next;
+ } while (next != NULL && next->ptr != ptr);
+ if (next) { /* if found, remove from linked list */
+ item->next = next->next;
+ zone->notlifo++; /* not a LIFO free */
+ }
+
+ }
+ }
+
+ /* if found, update the statistics and free the item */
+ if (next) {
+ zone->total -= next->size;
+ free(next);
+ }
+
+ /* if not found, update the rogue count */
+ else
+ zone->rogue++;
+
+ /* in any case, do the requested free with the standard library function */
+ free(ptr);
+}
+
+/* set up a controlled memory allocation space for monitoring, set the stream
+ parameters to the controlled routines, with opaque pointing to the space */
+local void mem_setup(z_stream *strm)
+{
+ struct mem_zone *zone;
+
+ zone = malloc(sizeof(struct mem_zone));
+ assert(zone != NULL);
+ zone->first = NULL;
+ zone->total = 0;
+ zone->highwater = 0;
+ zone->limit = 0;
+ zone->notlifo = 0;
+ zone->rogue = 0;
+ strm->opaque = zone;
+ strm->zalloc = mem_alloc;
+ strm->zfree = mem_free;
+}
+
+/* set a limit on the total memory allocation, or 0 to remove the limit */
+local void mem_limit(z_stream *strm, size_t limit)
+{
+ struct mem_zone *zone = strm->opaque;
+
+ zone->limit = limit;
+}
+
+/* show the current total requested allocations in bytes */
+local void mem_used(z_stream *strm, char *prefix)
+{
+ struct mem_zone *zone = strm->opaque;
+
+ fprintf(stderr, "%s: %lu allocated\n", prefix, zone->total);
+}
+
+/* show the high water allocation in bytes */
+local void mem_high(z_stream *strm, char *prefix)
+{
+ struct mem_zone *zone = strm->opaque;
+
+ fprintf(stderr, "%s: %lu high water mark\n", prefix, zone->highwater);
+}
+
+/* release the memory allocation zone -- if there are any surprises, notify */
+local void mem_done(z_stream *strm, char *prefix)
+{
+ int count = 0;
+ struct mem_item *item, *next;
+ struct mem_zone *zone = strm->opaque;
+
+ /* show high water mark */
+ mem_high(strm, prefix);
+
+ /* free leftover allocations and item structures, if any */
+ item = zone->first;
+ while (item != NULL) {
+ free(item->ptr);
+ next = item->next;
+ free(item);
+ item = next;
+ count++;
+ }
+
+ /* issue alerts about anything unexpected */
+ if (count || zone->total)
+ fprintf(stderr, "** %s: %lu bytes in %d blocks not freed\n",
+ prefix, zone->total, count);
+ if (zone->notlifo)
+ fprintf(stderr, "** %s: %d frees not LIFO\n", prefix, zone->notlifo);
+ if (zone->rogue)
+ fprintf(stderr, "** %s: %d frees not recognized\n",
+ prefix, zone->rogue);
+
+ /* free the zone and delete from the stream */
+ free(zone);
+ strm->opaque = Z_NULL;
+ strm->zalloc = Z_NULL;
+ strm->zfree = Z_NULL;
+}
+
+/* -- inflate test routines -- */
+
+/* Decode a hexadecimal string, set *len to length, in[] to the bytes. This
+ decodes liberally, in that hex digits can be adjacent, in which case two in
+ a row writes a byte. Or they can delimited by any non-hex character, where
+ the delimiters are ignored except when a single hex digit is followed by a
+ delimiter in which case that single digit writes a byte. The returned
+ data is allocated and must eventually be freed. NULL is returned if out of
+ memory. If the length is not needed, then len can be NULL. */
+local unsigned char *h2b(const char *hex, unsigned *len)
+{
+ unsigned char *in;
+ unsigned next, val;
+
+ in = malloc((strlen(hex) + 1) >> 1);
+ if (in == NULL)
+ return NULL;
+ next = 0;
+ val = 1;
+ do {
+ if (*hex >= '0' && *hex <= '9')
+ val = (val << 4) + *hex - '0';
+ else if (*hex >= 'A' && *hex <= 'F')
+ val = (val << 4) + *hex - 'A' + 10;
+ else if (*hex >= 'a' && *hex <= 'f')
+ val = (val << 4) + *hex - 'a' + 10;
+ else if (val != 1 && val < 32) /* one digit followed by delimiter */
+ val += 240; /* make it look like two digits */
+ if (val > 255) { /* have two digits */
+ in[next++] = val & 0xff; /* save the decoded byte */
+ val = 1; /* start over */
+ }
+ } while (*hex++); /* go through the loop with the terminating null */
+ if (len != NULL)
+ *len = next;
+ in = reallocf(in, next);
+ return in;
+}
+
+/* generic inflate() run, where hex is the hexadecimal input data, what is the
+ text to include in an error message, step is how much input data to feed
+ inflate() on each call, or zero to feed it all, win is the window bits
+ parameter to inflateInit2(), len is the size of the output buffer, and err
+ is the error code expected from the first inflate() call (the second
+ inflate() call is expected to return Z_STREAM_END). If win is 47, then
+ header information is collected with inflateGetHeader(). If a zlib stream
+ is looking for a dictionary, then an empty dictionary is provided.
+ inflate() is run until all of the input data is consumed. */
+local void inf(char *hex, char *what, unsigned step, int win, unsigned len,
+ int err)
+{
+ int ret;
+ unsigned have;
+ unsigned char *in, *out;
+ z_stream strm, copy;
+ gz_header head;
+
+ mem_setup(&strm);
+ strm.avail_in = 0;
+ strm.next_in = Z_NULL;
+ ret = inflateInit2(&strm, win);
+ if (ret != Z_OK) {
+ mem_done(&strm, what);
+ return;
+ }
+ out = malloc(len); assert(out != NULL);
+ if (win == 47) {
+ head.extra = out;
+ head.extra_max = len;
+ head.name = out;
+ head.name_max = len;
+ head.comment = out;
+ head.comm_max = len;
+ ret = inflateGetHeader(&strm, &head); assert(ret == Z_OK);
+ }
+ in = h2b(hex, &have); assert(in != NULL);
+ if (step == 0 || step > have)
+ step = have;
+ strm.avail_in = step;
+ have -= step;
+ strm.next_in = in;
+ do {
+ strm.avail_out = len;
+ strm.next_out = out;
+ ret = inflate(&strm, Z_NO_FLUSH); assert(err == 9 || ret == err);
+ if (ret != Z_OK && ret != Z_BUF_ERROR && ret != Z_NEED_DICT)
+ break;
+ if (ret == Z_NEED_DICT) {
+ ret = inflateSetDictionary(&strm, in, 1);
+ assert(ret == Z_DATA_ERROR);
+ mem_limit(&strm, 1);
+ ret = inflateSetDictionary(&strm, out, 0);
+ assert(ret == Z_MEM_ERROR);
+ mem_limit(&strm, 0);
+ ((struct inflate_state *)strm.state)->mode = DICT;
+ ret = inflateSetDictionary(&strm, out, 0);
+ assert(ret == Z_OK);
+ ret = inflate(&strm, Z_NO_FLUSH); assert(ret == Z_BUF_ERROR);
+ }
+ ret = inflateCopy(&copy, &strm); assert(ret == Z_OK);
+ ret = inflateEnd(&copy); assert(ret == Z_OK);
+ err = 9; /* don't care next time around */
+ have += strm.avail_in;
+ strm.avail_in = step > have ? have : step;
+ have -= strm.avail_in;
+ } while (strm.avail_in);
+ free(in);
+ free(out);
+ ret = inflateReset2(&strm, -8); assert(ret == Z_OK);
+ ret = inflateEnd(&strm); assert(ret == Z_OK);
+ mem_done(&strm, what);
+}
+
+/* cover all of the lines in inflate.c up to inflate() */
+local void cover_support(void)
+{
+ int ret;
+ z_stream strm;
+
+ mem_setup(&strm);
+ strm.avail_in = 0;
+ strm.next_in = Z_NULL;
+ ret = inflateInit(&strm); assert(ret == Z_OK);
+ mem_used(&strm, "inflate init");
+ ret = inflatePrime(&strm, 5, 31); assert(ret == Z_OK);
+ ret = inflatePrime(&strm, -1, 0); assert(ret == Z_OK);
+ ret = inflateSetDictionary(&strm, Z_NULL, 0);
+ assert(ret == Z_STREAM_ERROR);
+ ret = inflateEnd(&strm); assert(ret == Z_OK);
+ mem_done(&strm, "prime");
+
+ inf("63 0", "force window allocation", 0, -15, 1, Z_OK);
+ inf("63 18 5", "force window replacement", 0, -8, 259, Z_OK);
+ inf("63 18 68 30 d0 0 0", "force split window update", 4, -8, 259, Z_OK);
+ inf("3 0", "use fixed blocks", 0, -15, 1, Z_STREAM_END);
+ inf("", "bad window size", 0, 1, 0, Z_STREAM_ERROR);
+
+ mem_setup(&strm);
+ strm.avail_in = 0;
+ strm.next_in = Z_NULL;
+ ret = inflateInit_(&strm, ZLIB_VERSION - 1, (int)sizeof(z_stream));
+ assert(ret == Z_VERSION_ERROR);
+ mem_done(&strm, "wrong version");
+
+ strm.avail_in = 0;
+ strm.next_in = Z_NULL;
+ ret = inflateInit(&strm); assert(ret == Z_OK);
+ ret = inflateEnd(&strm); assert(ret == Z_OK);
+ fputs("inflate built-in memory routines\n", stderr);
+}
+
+/* cover all inflate() header and trailer cases and code after inflate() */
+local void cover_wrap(void)
+{
+ int ret;
+ z_stream strm, copy;
+ unsigned char dict[257];
+
+ ret = inflate(Z_NULL, 0); assert(ret == Z_STREAM_ERROR);
+ ret = inflateEnd(Z_NULL); assert(ret == Z_STREAM_ERROR);
+ ret = inflateCopy(Z_NULL, Z_NULL); assert(ret == Z_STREAM_ERROR);
+ fputs("inflate bad parameters\n", stderr);
+
+ inf("1f 8b 0 0", "bad gzip method", 0, 31, 0, Z_DATA_ERROR);
+ inf("1f 8b 8 80", "bad gzip flags", 0, 31, 0, Z_DATA_ERROR);
+ inf("77 85", "bad zlib method", 0, 15, 0, Z_DATA_ERROR);
+ inf("8 99", "set window size from header", 0, 0, 0, Z_OK);
+ inf("78 9c", "bad zlib window size", 0, 8, 0, Z_DATA_ERROR);
+ inf("78 9c 63 0 0 0 1 0 1", "check adler32", 0, 15, 1, Z_STREAM_END);
+ inf("1f 8b 8 1e 0 0 0 0 0 0 1 0 0 0 0 0 0", "bad header crc", 0, 47, 1,
+ Z_DATA_ERROR);
+ inf("1f 8b 8 2 0 0 0 0 0 0 1d 26 3 0 0 0 0 0 0 0 0 0", "check gzip length",
+ 0, 47, 0, Z_STREAM_END);
+ inf("78 90", "bad zlib header check", 0, 47, 0, Z_DATA_ERROR);
+ inf("8 b8 0 0 0 1", "need dictionary", 0, 8, 0, Z_NEED_DICT);
+ inf("78 9c 63 0", "compute adler32", 0, 15, 1, Z_OK);
+
+ mem_setup(&strm);
+ strm.avail_in = 0;
+ strm.next_in = Z_NULL;
+ ret = inflateInit2(&strm, -8);
+ strm.avail_in = 2;
+ strm.next_in = (void *)"\x63";
+ strm.avail_out = 1;
+ strm.next_out = (void *)&ret;
+ mem_limit(&strm, 1);
+ ret = inflate(&strm, Z_NO_FLUSH); assert(ret == Z_MEM_ERROR);
+ ret = inflate(&strm, Z_NO_FLUSH); assert(ret == Z_MEM_ERROR);
+ mem_limit(&strm, 0);
+ memset(dict, 0, 257);
+ ret = inflateSetDictionary(&strm, dict, 257);
+ assert(ret == Z_OK);
+ mem_limit(&strm, (sizeof(struct inflate_state) << 1) + 256);
+ ret = inflatePrime(&strm, 16, 0); assert(ret == Z_OK);
+ strm.avail_in = 2;
+ strm.next_in = (void *)"\x80";
+ ret = inflateSync(&strm); assert(ret == Z_DATA_ERROR);
+ ret = inflate(&strm, Z_NO_FLUSH); assert(ret == Z_STREAM_ERROR);
+ strm.avail_in = 4;
+ strm.next_in = (void *)"\0\0\xff\xff";
+ ret = inflateSync(&strm); assert(ret == Z_OK);
+ (void)inflateSyncPoint(&strm);
+ ret = inflateCopy(&copy, &strm); assert(ret == Z_MEM_ERROR);
+ mem_limit(&strm, 0);
+ ret = inflateUndermine(&strm, 1); assert(ret == Z_DATA_ERROR);
+ (void)inflateMark(&strm);
+ ret = inflateEnd(&strm); assert(ret == Z_OK);
+ mem_done(&strm, "miscellaneous, force memory errors");
+}
+
+/* input and output functions for inflateBack() */
+local unsigned pull(void *desc, unsigned char **buf)
+{
+ static unsigned int next = 0;
+ static unsigned char dat[] = {0x63, 0, 2, 0};
+ struct inflate_state *state;
+
+ if (desc == Z_NULL) {
+ next = 0;
+ return 0; /* no input (already provided at next_in) */
+ }
+ state = (void *)((z_stream *)desc)->state;
+ if (state != Z_NULL)
+ state->mode = SYNC; /* force an otherwise impossible situation */
+ return next < sizeof(dat) ? (*buf = dat + next++, 1) : 0;
+}
+
+local int push(void *desc, unsigned char *buf, unsigned len)
+{
+ buf += len;
+ return desc != Z_NULL; /* force error if desc not null */
+}
+
+/* cover inflateBack() up to common deflate data cases and after those */
+local void cover_back(void)
+{
+ int ret;
+ z_stream strm;
+ unsigned char win[32768];
+
+ ret = inflateBackInit_(Z_NULL, 0, win, 0, 0);
+ assert(ret == Z_VERSION_ERROR);
+ ret = inflateBackInit(Z_NULL, 0, win); assert(ret == Z_STREAM_ERROR);
+ ret = inflateBack(Z_NULL, Z_NULL, Z_NULL, Z_NULL, Z_NULL);
+ assert(ret == Z_STREAM_ERROR);
+ ret = inflateBackEnd(Z_NULL); assert(ret == Z_STREAM_ERROR);
+ fputs("inflateBack bad parameters\n", stderr);
+
+ mem_setup(&strm);
+ ret = inflateBackInit(&strm, 15, win); assert(ret == Z_OK);
+ strm.avail_in = 2;
+ strm.next_in = (void *)"\x03";
+ ret = inflateBack(&strm, pull, Z_NULL, push, Z_NULL);
+ assert(ret == Z_STREAM_END);
+ /* force output error */
+ strm.avail_in = 3;
+ strm.next_in = (void *)"\x63\x00";
+ ret = inflateBack(&strm, pull, Z_NULL, push, &strm);
+ assert(ret == Z_BUF_ERROR);
+ /* force mode error by mucking with state */
+ ret = inflateBack(&strm, pull, &strm, push, Z_NULL);
+ assert(ret == Z_STREAM_ERROR);
+ ret = inflateBackEnd(&strm); assert(ret == Z_OK);
+ mem_done(&strm, "inflateBack bad state");
+
+ ret = inflateBackInit(&strm, 15, win); assert(ret == Z_OK);
+ ret = inflateBackEnd(&strm); assert(ret == Z_OK);
+ fputs("inflateBack built-in memory routines\n", stderr);
+}
+
+/* do a raw inflate of data in hexadecimal with both inflate and inflateBack */
+local int try(char *hex, char *id, int err)
+{
+ int ret;
+ unsigned len, size;
+ unsigned char *in, *out, *win;
+ char *prefix;
+ z_stream strm;
+
+ /* convert to hex */
+ in = h2b(hex, &len);
+ assert(in != NULL);
+
+ /* allocate work areas */
+ size = len << 3;
+ out = malloc(size);
+ assert(out != NULL);
+ win = malloc(32768);
+ assert(win != NULL);
+ prefix = malloc(strlen(id) + 6);
+ assert(prefix != NULL);
+
+ /* first with inflate */
+ strcpy(prefix, id);
+ strcat(prefix, "-late");
+ mem_setup(&strm);
+ strm.avail_in = 0;
+ strm.next_in = Z_NULL;
+ ret = inflateInit2(&strm, err < 0 ? 47 : -15);
+ assert(ret == Z_OK);
+ strm.avail_in = len;
+ strm.next_in = in;
+ do {
+ strm.avail_out = size;
+ strm.next_out = out;
+ ret = inflate(&strm, Z_TREES);
+ assert(ret != Z_STREAM_ERROR && ret != Z_MEM_ERROR);
+ if (ret == Z_DATA_ERROR || ret == Z_NEED_DICT)
+ break;
+ } while (strm.avail_in || strm.avail_out == 0);
+ if (err) {
+ assert(ret == Z_DATA_ERROR);
+ assert(strcmp(id, strm.msg) == 0);
+ }
+ inflateEnd(&strm);
+ mem_done(&strm, prefix);
+
+ /* then with inflateBack */
+ if (err >= 0) {
+ strcpy(prefix, id);
+ strcat(prefix, "-back");
+ mem_setup(&strm);
+ ret = inflateBackInit(&strm, 15, win);
+ assert(ret == Z_OK);
+ strm.avail_in = len;
+ strm.next_in = in;
+ ret = inflateBack(&strm, pull, Z_NULL, push, Z_NULL);
+ assert(ret != Z_STREAM_ERROR);
+ if (err) {
+ assert(ret == Z_DATA_ERROR);
+ assert(strcmp(id, strm.msg) == 0);
+ }
+ inflateBackEnd(&strm);
+ mem_done(&strm, prefix);
+ }
+
+ /* clean up */
+ free(prefix);
+ free(win);
+ free(out);
+ free(in);
+ return ret;
+}
+
+/* cover deflate data cases in both inflate() and inflateBack() */
+local void cover_inflate(void)
+{
+ try("0 0 0 0 0", "invalid stored block lengths", 1);
+ try("3 0", "fixed", 0);
+ try("6", "invalid block type", 1);
+ try("1 1 0 fe ff 0", "stored", 0);
+ try("fc 0 0", "too many length or distance symbols", 1);
+ try("4 0 fe ff", "invalid code lengths set", 1);
+ try("4 0 24 49 0", "invalid bit length repeat", 1);
+ try("4 0 24 e9 ff ff", "invalid bit length repeat", 1);
+ try("4 0 24 e9 ff 6d", "invalid code -- missing end-of-block", 1);
+ try("4 80 49 92 24 49 92 24 71 ff ff 93 11 0",
+ "invalid literal/lengths set", 1);
+ try("4 80 49 92 24 49 92 24 f b4 ff ff c3 84", "invalid distances set", 1);
+ try("4 c0 81 8 0 0 0 0 20 7f eb b 0 0", "invalid literal/length code", 1);
+ try("2 7e ff ff", "invalid distance code", 1);
+ try("c c0 81 0 0 0 0 0 90 ff 6b 4 0", "invalid distance too far back", 1);
+
+ /* also trailer mismatch just in inflate() */
+ try("1f 8b 8 0 0 0 0 0 0 0 3 0 0 0 0 1", "incorrect data check", -1);
+ try("1f 8b 8 0 0 0 0 0 0 0 3 0 0 0 0 0 0 0 0 1",
+ "incorrect length check", -1);
+ try("5 c0 21 d 0 0 0 80 b0 fe 6d 2f 91 6c", "pull 17", 0);
+ try("5 e0 81 91 24 cb b2 2c 49 e2 f 2e 8b 9a 47 56 9f fb fe ec d2 ff 1f",
+ "long code", 0);
+ try("ed c0 1 1 0 0 0 40 20 ff 57 1b 42 2c 4f", "length extra", 0);
+ try("ed cf c1 b1 2c 47 10 c4 30 fa 6f 35 1d 1 82 59 3d fb be 2e 2a fc f c",
+ "long distance and extra", 0);
+ try("ed c0 81 0 0 0 0 80 a0 fd a9 17 a9 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 "
+ "0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6", "window end", 0);
+ inf("2 8 20 80 0 3 0", "inflate_fast TYPE return", 0, -15, 258,
+ Z_STREAM_END);
+ inf("63 18 5 40 c 0", "window wrap", 3, -8, 300, Z_OK);
+}
+
+/* cover remaining lines in inftrees.c */
+local void cover_trees(void)
+{
+ int ret;
+ unsigned bits;
+ unsigned short lens[16], work[16];
+ code *next, table[ENOUGH_DISTS];
+
+ /* we need to call inflate_table() directly in order to manifest not-
+ enough errors, since zlib insures that enough is always enough */
+ for (bits = 0; bits < 15; bits++)
+ lens[bits] = (unsigned short)(bits + 1);
+ lens[15] = 15;
+ next = table;
+ bits = 15;
+ ret = inflate_table(DISTS, lens, 16, &next, &bits, work);
+ assert(ret == 1);
+ next = table;
+ bits = 1;
+ ret = inflate_table(DISTS, lens, 16, &next, &bits, work);
+ assert(ret == 1);
+ fputs("inflate_table not enough errors\n", stderr);
+}
+
+/* cover remaining inffast.c decoding and window copying */
+local void cover_fast(void)
+{
+ inf("e5 e0 81 ad 6d cb b2 2c c9 01 1e 59 63 ae 7d ee fb 4d fd b5 35 41 68"
+ " ff 7f 0f 0 0 0", "fast length extra bits", 0, -8, 258, Z_DATA_ERROR);
+ inf("25 fd 81 b5 6d 59 b6 6a 49 ea af 35 6 34 eb 8c b9 f6 b9 1e ef 67 49"
+ " 50 fe ff ff 3f 0 0", "fast distance extra bits", 0, -8, 258,
+ Z_DATA_ERROR);
+ inf("3 7e 0 0 0 0 0", "fast invalid distance code", 0, -8, 258,
+ Z_DATA_ERROR);
+ inf("1b 7 0 0 0 0 0", "fast invalid literal/length code", 0, -8, 258,
+ Z_DATA_ERROR);
+ inf("d c7 1 ae eb 38 c 4 41 a0 87 72 de df fb 1f b8 36 b1 38 5d ff ff 0",
+ "fast 2nd level codes and too far back", 0, -8, 258, Z_DATA_ERROR);
+ inf("63 18 5 8c 10 8 0 0 0 0", "very common case", 0, -8, 259, Z_OK);
+ inf("63 60 60 18 c9 0 8 18 18 18 26 c0 28 0 29 0 0 0",
+ "contiguous and wrap around window", 6, -8, 259, Z_OK);
+ inf("63 0 3 0 0 0 0 0", "copy direct from output", 0, -8, 259,
+ Z_STREAM_END);
+}
+
+int main(void)
+{
+ fprintf(stderr, "%s\n", zlibVersion());
+ cover_support();
+ cover_wrap();
+ cover_back();
+ cover_inflate();
+ cover_trees();
+ cover_fast();
+ return 0;
+}
diff --git a/compat/zlib/minigzip.c b/compat/zlib/test/minigzip.c
index 4f64c9a..aa7ac7a 100644
--- a/compat/zlib/minigzip.c
+++ b/compat/zlib/test/minigzip.c
@@ -1,5 +1,5 @@
/* minigzip.c -- simulate gzip using the zlib compression library
- * Copyright (C) 1995-2006, 2010 Jean-loup Gailly.
+ * Copyright (C) 1995-2006, 2010, 2011 Jean-loup Gailly.
* For conditions of distribution and use, see copyright notice in zlib.h
*/
@@ -13,7 +13,7 @@
* or in pipe mode.
*/
-/* @(#) $Id: minigzip.c,v 1.3 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
#include "zlib.h"
#include <stdio.h>
@@ -138,6 +138,197 @@ static void pwinerror (s)
# define local
#endif
+#ifdef Z_SOLO
+/* for Z_SOLO, create simplified gz* functions using deflate and inflate */
+
+#if defined(Z_HAVE_UNISTD_H) || defined(Z_LARGE)
+# include <unistd.h> /* for unlink() */
+#endif
+
+void *myalloc OF((void *, unsigned, unsigned));
+void myfree OF((void *, void *));
+
+void *myalloc(q, n, m)
+ void *q;
+ unsigned n, m;
+{
+ q = Z_NULL;
+ return calloc(n, m);
+}
+
+void myfree(q, p)
+ void *q, *p;
+{
+ q = Z_NULL;
+ free(p);
+}
+
+typedef struct gzFile_s {
+ FILE *file;
+ int write;
+ int err;
+ char *msg;
+ z_stream strm;
+} *gzFile;
+
+gzFile gzopen OF((const char *, const char *));
+gzFile gzdopen OF((int, const char *));
+gzFile gz_open OF((const char *, int, const char *));
+
+gzFile gzopen(path, mode)
+const char *path;
+const char *mode;
+{
+ return gz_open(path, -1, mode);
+}
+
+gzFile gzdopen(fd, mode)
+int fd;
+const char *mode;
+{
+ return gz_open(NULL, fd, mode);
+}
+
+gzFile gz_open(path, fd, mode)
+ const char *path;
+ int fd;
+ const char *mode;
+{
+ gzFile gz;
+ int ret;
+
+ gz = malloc(sizeof(struct gzFile_s));
+ if (gz == NULL)
+ return NULL;
+ gz->write = strchr(mode, 'w') != NULL;
+ gz->strm.zalloc = myalloc;
+ gz->strm.zfree = myfree;
+ gz->strm.opaque = Z_NULL;
+ if (gz->write)
+ ret = deflateInit2(&(gz->strm), -1, 8, 15 + 16, 8, 0);
+ else {
+ gz->strm.next_in = 0;
+ gz->strm.avail_in = Z_NULL;
+ ret = inflateInit2(&(gz->strm), 15 + 16);
+ }
+ if (ret != Z_OK) {
+ free(gz);
+ return NULL;
+ }
+ gz->file = path == NULL ? fdopen(fd, gz->write ? "wb" : "rb") :
+ fopen(path, gz->write ? "wb" : "rb");
+ if (gz->file == NULL) {
+ gz->write ? deflateEnd(&(gz->strm)) : inflateEnd(&(gz->strm));
+ free(gz);
+ return NULL;
+ }
+ gz->err = 0;
+ gz->msg = "";
+ return gz;
+}
+
+int gzwrite OF((gzFile, const void *, unsigned));
+
+int gzwrite(gz, buf, len)
+ gzFile gz;
+ const void *buf;
+ unsigned len;
+{
+ z_stream *strm;
+ unsigned char out[BUFLEN];
+
+ if (gz == NULL || !gz->write)
+ return 0;
+ strm = &(gz->strm);
+ strm->next_in = (void *)buf;
+ strm->avail_in = len;
+ do {
+ strm->next_out = out;
+ strm->avail_out = BUFLEN;
+ (void)deflate(strm, Z_NO_FLUSH);
+ fwrite(out, 1, BUFLEN - strm->avail_out, gz->file);
+ } while (strm->avail_out == 0);
+ return len;
+}
+
+int gzread OF((gzFile, void *, unsigned));
+
+int gzread(gz, buf, len)
+ gzFile gz;
+ void *buf;
+ unsigned len;
+{
+ int ret;
+ unsigned got;
+ unsigned char in[1];
+ z_stream *strm;
+
+ if (gz == NULL || gz->write)
+ return 0;
+ if (gz->err)
+ return 0;
+ strm = &(gz->strm);
+ strm->next_out = (void *)buf;
+ strm->avail_out = len;
+ do {
+ got = fread(in, 1, 1, gz->file);
+ if (got == 0)
+ break;
+ strm->next_in = in;
+ strm->avail_in = 1;
+ ret = inflate(strm, Z_NO_FLUSH);
+ if (ret == Z_DATA_ERROR) {
+ gz->err = Z_DATA_ERROR;
+ gz->msg = strm->msg;
+ return 0;
+ }
+ if (ret == Z_STREAM_END)
+ inflateReset(strm);
+ } while (strm->avail_out);
+ return len - strm->avail_out;
+}
+
+int gzclose OF((gzFile));
+
+int gzclose(gz)
+ gzFile gz;
+{
+ z_stream *strm;
+ unsigned char out[BUFLEN];
+
+ if (gz == NULL)
+ return Z_STREAM_ERROR;
+ strm = &(gz->strm);
+ if (gz->write) {
+ strm->next_in = Z_NULL;
+ strm->avail_in = 0;
+ do {
+ strm->next_out = out;
+ strm->avail_out = BUFLEN;
+ (void)deflate(strm, Z_FINISH);
+ fwrite(out, 1, BUFLEN - strm->avail_out, gz->file);
+ } while (strm->avail_out == 0);
+ deflateEnd(strm);
+ }
+ else
+ inflateEnd(strm);
+ fclose(gz->file);
+ free(gz);
+ return Z_OK;
+}
+
+const char *gzerror OF((gzFile, int *));
+
+const char *gzerror(gz, err)
+ gzFile gz;
+ int *err;
+{
+ *err = gz->err;
+ return gz->msg;
+}
+
+#endif
+
char *prog;
void error OF((const char *msg));
diff --git a/compat/zlib/treebuild.xml b/compat/zlib/treebuild.xml
index 6b8f542..1f4d15f 100644
--- a/compat/zlib/treebuild.xml
+++ b/compat/zlib/treebuild.xml
@@ -1,6 +1,6 @@
<?xml version="1.0" ?>
-<package name="zlib" version="1.2.5">
- <library name="zlib" dlversion="1.2.5" dlname="z">
+<package name="zlib" version="1.2.7">
+ <library name="zlib" dlversion="1.2.7" dlname="z">
<property name="description"> zip compression library </property>
<property name="include-target-dir" value="$(@PACKAGE/install-includedir)" />
diff --git a/compat/zlib/trees.c b/compat/zlib/trees.c
index b207380..8c32b21 100644
--- a/compat/zlib/trees.c
+++ b/compat/zlib/trees.c
@@ -1,5 +1,5 @@
/* trees.c -- output deflated data using Huffman coding
- * Copyright (C) 1995-2010 Jean-loup Gailly
+ * Copyright (C) 1995-2012 Jean-loup Gailly
* detect_data_type() function provided freely by Cosmin Truta, 2006
* For conditions of distribution and use, see copyright notice in zlib.h
*/
@@ -30,7 +30,7 @@
* Addison-Wesley, 1983. ISBN 0-201-06672-6.
*/
-/* @(#) $Id: trees.c,v 1.3 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
/* #define GEN_TREES_H */
@@ -74,11 +74,6 @@ local const uch bl_order[BL_CODES]
* probability, to avoid transmitting the lengths for unused bit length codes.
*/
-#define Buf_size (8 * 2*sizeof(char))
-/* Number of bits used within bi_buf. (bi_buf might be implemented on
- * more than 16 bits on some systems.)
- */
-
/* ===========================================================================
* Local data. These are initialized only once.
*/
@@ -399,7 +394,6 @@ void ZLIB_INTERNAL _tr_init(s)
s->bi_buf = 0;
s->bi_valid = 0;
- s->last_eob_len = 8; /* enough lookahead for inflate */
#ifdef DEBUG
s->compressed_len = 0L;
s->bits_sent = 0L;
@@ -883,15 +877,17 @@ void ZLIB_INTERNAL _tr_stored_block(s, buf, stored_len, last)
}
/* ===========================================================================
+ * Flush the bits in the bit buffer to pending output (leaves at most 7 bits)
+ */
+void ZLIB_INTERNAL _tr_flush_bits(s)
+ deflate_state *s;
+{
+ bi_flush(s);
+}
+
+/* ===========================================================================
* Send one empty static block to give enough lookahead for inflate.
* This takes 10 bits, of which 7 may remain in the bit buffer.
- * The current inflate code requires 9 bits of lookahead. If the
- * last two codes for the previous block (real code plus EOB) were coded
- * on 5 bits or less, inflate may have only 5+3 bits of lookahead to decode
- * the last real code. In this case we send two empty static blocks instead
- * of one. (There are no problems if the previous block is stored or fixed.)
- * To simplify the code, we assume the worst case of last real code encoded
- * on one bit only.
*/
void ZLIB_INTERNAL _tr_align(s)
deflate_state *s;
@@ -902,20 +898,6 @@ void ZLIB_INTERNAL _tr_align(s)
s->compressed_len += 10L; /* 3 for block type, 7 for EOB */
#endif
bi_flush(s);
- /* Of the 10 bits for the empty block, we have already sent
- * (10 - bi_valid) bits. The lookahead for the last real code (before
- * the EOB of the previous block) was thus at least one plus the length
- * of the EOB plus what we have just sent of the empty static block.
- */
- if (1 + s->last_eob_len + 10 - s->bi_valid < 9) {
- send_bits(s, STATIC_TREES<<1, 3);
- send_code(s, END_BLOCK, static_ltree);
-#ifdef DEBUG
- s->compressed_len += 10L;
-#endif
- bi_flush(s);
- }
- s->last_eob_len = 7;
}
/* ===========================================================================
@@ -1118,7 +1100,6 @@ local void compress_block(s, ltree, dtree)
} while (lx < s->last_lit);
send_code(s, END_BLOCK, ltree);
- s->last_eob_len = ltree[END_BLOCK].Len;
}
/* ===========================================================================
@@ -1226,7 +1207,6 @@ local void copy_block(s, buf, len, header)
int header; /* true if block header must be written */
{
bi_windup(s); /* align on byte boundary */
- s->last_eob_len = 8; /* enough lookahead for inflate */
if (header) {
put_short(s, (ush)len);
diff --git a/compat/zlib/uncompr.c b/compat/zlib/uncompr.c
index 5cbf08f..ad98be3 100644
--- a/compat/zlib/uncompr.c
+++ b/compat/zlib/uncompr.c
@@ -3,7 +3,7 @@
* For conditions of distribution and use, see copyright notice in zlib.h
*/
-/* @(#) $Id: uncompr.c,v 1.3 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
#define ZLIB_INTERNAL
#include "zlib.h"
diff --git a/compat/zlib/win32/Makefile.bor b/compat/zlib/win32/Makefile.bor
index 3981d42..d152bbb 100644
--- a/compat/zlib/win32/Makefile.bor
+++ b/compat/zlib/win32/Makefile.bor
@@ -74,9 +74,9 @@ uncompr.obj: uncompr.c zlib.h zconf.h
zutil.obj: zutil.c zutil.h zlib.h zconf.h
-example.obj: example.c zlib.h zconf.h
+example.obj: test/example.c zlib.h zconf.h
-minigzip.obj: minigzip.c zlib.h zconf.h
+minigzip.obj: test/minigzip.c zlib.h zconf.h
# For the sake of the old Borland make,
diff --git a/compat/zlib/win32/Makefile.gcc b/compat/zlib/win32/Makefile.gcc
index 0a33bf6..6d1ded6 100644
--- a/compat/zlib/win32/Makefile.gcc
+++ b/compat/zlib/win32/Makefile.gcc
@@ -1,23 +1,29 @@
# Makefile for zlib, derived from Makefile.dj2.
# Modified for mingw32 by C. Spieler, 6/16/98.
# Updated for zlib 1.2.x by Christian Spieler and Cosmin Truta, Mar-2003.
-# Last updated: 1-Aug-2003.
+# Last updated: Mar 2012.
# Tested under Cygwin and MinGW.
# Copyright (C) 1995-2003 Jean-loup Gailly.
# For conditions of distribution and use, see copyright notice in zlib.h
-# To compile, or to compile and test, type:
+# To compile, or to compile and test, type from the top level zlib directory:
#
-# make -fmakefile.gcc; make test testdll -fmakefile.gcc
+# make -fwin32/Makefile.gcc; make test testdll -fwin32/Makefile.gcc
#
# To use the asm code, type:
# cp contrib/asm?86/match.S ./match.S
-# make LOC=-DASMV OBJA=match.o -fmakefile.gcc
+# make LOC=-DASMV OBJA=match.o -fwin32/Makefile.gcc
#
# To install libz.a, zconf.h and zlib.h in the system directories, type:
#
-# make install -fmakefile.gcc
+# make install -fwin32/Makefile.gcc
+#
+# BINARY_PATH, INCLUDE_PATH and LIBRARY_PATH must be set.
+#
+# To install the shared lib, append SHARED_MODE=1 to the make command :
+#
+# make install -fwin32/Makefile.gcc SHARED_MODE=1
# Note:
# If the platform is *not* MinGW (e.g. it is Cygwin or UWIN),
@@ -25,7 +31,7 @@
STATICLIB = libz.a
SHAREDLIB = zlib1.dll
-IMPLIB = libzdll.a
+IMPLIB = libz.dll.a
#
# Set to 1 if shared object needs to be installed
@@ -38,7 +44,6 @@ SHARED_MODE=0
PREFIX =
CC = $(PREFIX)gcc
CFLAGS = $(LOC) -O3 -Wall
-EXTRA_CFLAGS = -DNO_VIZ
AS = $(CC)
ASFLAGS = $(LOC) -Wall
@@ -59,7 +64,7 @@ CP = cp -fp
INSTALL = $(CP)
RM = rm -f
-prefix = /usr/local
+prefix ?= /usr/local
exec_prefix = $(prefix)
OBJS = adler32.o compress.o crc32.o deflate.o gzclose.o gzlib.o gzread.o \
@@ -77,7 +82,7 @@ testdll: example_d.exe minigzip_d.exe
echo hello world | ./minigzip_d | ./minigzip_d -d
.c.o:
- $(CC) $(CFLAGS) $(EXTRA_CFLAGS) -c -o $@ $<
+ $(CC) $(CFLAGS) -c -o $@ $<
.S.o:
$(AS) $(ASFLAGS) -c -o $@ $<
@@ -108,34 +113,49 @@ minigzip_d.exe: minigzip.o $(IMPLIB)
$(LD) $(LDFLAGS) -o $@ minigzip.o $(IMPLIB)
$(STRIP) $@
-zlibrc.o: win32/zlib1.rc
- $(RC) $(RCFLAGS) -o $@ win32/zlib1.rc
+example.o: test/example.c zlib.h zconf.h
+ $(CC) $(CFLAGS) -I. -c -o $@ test/example.c
+minigzip.o: test/minigzip.c zlib.h zconf.h
+ $(CC) $(CFLAGS) -I. -c -o $@ test/minigzip.c
-# BINARY_PATH, INCLUDE_PATH and LIBRARY_PATH must be set.
+zlibrc.o: win32/zlib1.rc
+ $(RC) $(RCFLAGS) -o $@ win32/zlib1.rc
.PHONY: install uninstall clean
install: zlib.h zconf.h $(STATICLIB) $(IMPLIB)
- -@mkdir -p $(INCLUDE_PATH)
- -@mkdir -p $(LIBRARY_PATH)
+ @if test -z "$(DESTDIR)$(INCLUDE_PATH)" -o -z "$(DESTDIR)$(LIBRARY_PATH)" -o -z "$(DESTDIR)$(BINARY_PATH)"; then \
+ echo INCLUDE_PATH, LIBRARY_PATH, and BINARY_PATH must be specified; \
+ exit 1; \
+ fi
+ -@mkdir -p '$(DESTDIR)$(INCLUDE_PATH)'
+ -@mkdir -p '$(DESTDIR)$(LIBRARY_PATH)' '$(DESTDIR)$(LIBRARY_PATH)'/pkgconfig
-if [ "$(SHARED_MODE)" = "1" ]; then \
- mkdir -p $(BINARY_PATH); \
- $(INSTALL) $(SHAREDLIB) $(BINARY_PATH); \
- $(INSTALL) $(IMPLIB) $(LIBRARY_PATH); \
+ mkdir -p '$(DESTDIR)$(BINARY_PATH)'; \
+ $(INSTALL) $(SHAREDLIB) '$(DESTDIR)$(BINARY_PATH)'; \
+ $(INSTALL) $(IMPLIB) '$(DESTDIR)$(LIBRARY_PATH)'; \
fi
- -$(INSTALL) zlib.h $(INCLUDE_PATH)
- -$(INSTALL) zconf.h $(INCLUDE_PATH)
- -$(INSTALL) $(STATICLIB) $(LIBRARY_PATH)
+ -$(INSTALL) zlib.h '$(DESTDIR)$(INCLUDE_PATH)'
+ -$(INSTALL) zconf.h '$(DESTDIR)$(INCLUDE_PATH)'
+ -$(INSTALL) $(STATICLIB) '$(DESTDIR)$(LIBRARY_PATH)'
+ sed \
+ -e 's|@prefix@|${prefix}|g' \
+ -e 's|@exec_prefix@|${exec_prefix}|g' \
+ -e 's|@libdir@|$(LIBRARY_PATH)|g' \
+ -e 's|@sharedlibdir@|$(LIBRARY_PATH)|g' \
+ -e 's|@includedir@|$(INCLUDE_PATH)|g' \
+ -e 's|@VERSION@|'`sed -n -e '/VERSION "/s/.*"\(.*\)".*/\1/p' zlib.h`'|g' \
+ zlib.pc.in > '$(DESTDIR)$(LIBRARY_PATH)'/pkgconfig/zlib.pc
uninstall:
-if [ "$(SHARED_MODE)" = "1" ]; then \
- $(RM) $(BINARY_PATH)/$(SHAREDLIB); \
- $(RM) $(LIBRARY_PATH)/$(IMPLIB); \
+ $(RM) '$(DESTDIR)$(BINARY_PATH)'/$(SHAREDLIB); \
+ $(RM) '$(DESTDIR)$(LIBRARY_PATH)'/$(IMPLIB); \
fi
- -$(RM) $(INCLUDE_PATH)/zlib.h
- -$(RM) $(INCLUDE_PATH)/zconf.h
- -$(RM) $(LIBRARY_PATH)/$(STATICLIB)
+ -$(RM) '$(DESTDIR)$(INCLUDE_PATH)'/zlib.h
+ -$(RM) '$(DESTDIR)$(INCLUDE_PATH)'/zconf.h
+ -$(RM) '$(DESTDIR)$(LIBRARY_PATH)'/$(STATICLIB)
clean:
-$(RM) $(STATICLIB)
@@ -149,7 +169,6 @@ adler32.o: zlib.h zconf.h
compress.o: zlib.h zconf.h
crc32.o: crc32.h zlib.h zconf.h
deflate.o: deflate.h zutil.h zlib.h zconf.h
-example.o: zlib.h zconf.h
gzclose.o: zlib.h zconf.h gzguts.h
gzlib.o: zlib.h zconf.h gzguts.h
gzread.o: zlib.h zconf.h gzguts.h
@@ -158,7 +177,6 @@ inffast.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
inflate.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
infback.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
inftrees.o: zutil.h zlib.h zconf.h inftrees.h
-minigzip.o: zlib.h zconf.h
trees.o: deflate.h zutil.h zlib.h zconf.h trees.h
uncompr.o: zlib.h zconf.h
zutil.o: zutil.h zlib.h zconf.h
diff --git a/compat/zlib/win32/Makefile.msc b/compat/zlib/win32/Makefile.msc
index fa10a1a..59bb0da 100644
--- a/compat/zlib/win32/Makefile.msc
+++ b/compat/zlib/win32/Makefile.msc
@@ -6,8 +6,8 @@
# nmake -f win32/Makefile.msc LOC=-DFOO (nonstandard build)
# nmake -f win32/Makefile.msc LOC="-DASMV -DASMINF" \
# OBJA="inffas32.obj match686.obj" (use ASM code, x86)
-# nmake -f win32/Makefile.msc AS=ml64 LOC="-DASMV -DASMINF" \
-# OBJA="inffasx64.obj gvmat64.obj inffas8664.c" (use ASM code, x64)
+# nmake -f win32/Makefile.msc AS=ml64 LOC="-DASMV -DASMINF -I." \
+# OBJA="inffasx64.obj gvmat64.obj inffas8664.obj" (use ASM code, x64)
# optional build flags
LOC =
@@ -30,7 +30,7 @@ ARFLAGS = -nologo
RCFLAGS = /dWIN32 /r
OBJS = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj \
- gzwrite.obj infback.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
+ gzwrite.obj infback.obj inflate.obj inftrees.obj inffast.obj trees.obj uncompr.obj zutil.obj
OBJA =
@@ -72,6 +72,9 @@ minigzip_d.exe: minigzip.obj $(IMPLIB)
.c.obj:
$(CC) -c $(WFLAGS) $(CFLAGS) $<
+{test}.c.obj:
+ $(CC) -c -I. $(WFLAGS) $(CFLAGS) $<
+
{contrib/masmx64}.c.obj:
$(CC) -c $(WFLAGS) $(CFLAGS) $<
@@ -125,9 +128,9 @@ inffas32.obj: contrib\masmx86\inffas32.asm
match686.obj: contrib\masmx86\match686.asm
-example.obj: example.c zlib.h zconf.h
+example.obj: test/example.c zlib.h zconf.h
-minigzip.obj: minigzip.c zlib.h zconf.h
+minigzip.obj: test/minigzip.c zlib.h zconf.h
zlib1.res: win32/zlib1.rc
$(RC) $(RCFLAGS) /fo$@ win32/zlib1.rc
diff --git a/compat/zlib/win32/README-WIN32.txt b/compat/zlib/win32/README-WIN32.txt
index 1e4c093..46c5923 100644
--- a/compat/zlib/win32/README-WIN32.txt
+++ b/compat/zlib/win32/README-WIN32.txt
@@ -1,6 +1,6 @@
ZLIB DATA COMPRESSION LIBRARY
-zlib 1.2.4 is a general purpose data compression library. All the code is
+zlib 1.2.7 is a general purpose data compression library. All the code is
thread safe. The data format used by the zlib library is described by RFCs
(Request for Comments) 1950 to 1952 in the files
http://www.ietf.org/rfc/rfc1950.txt (zlib format), rfc1951.txt (deflate format)
@@ -22,7 +22,7 @@ before asking for help.
Manifest:
-The package zlib-1.2.4-win32-x86.zip contains the following files:
+The package zlib-1.2.7-win32-x86.zip will contain the following files:
README-WIN32.txt This document
ChangeLog Changes since previous zlib packages
@@ -58,7 +58,7 @@ The package zlib-1.2.4-win32-x86.zip contains the following files:
All .pdb files above are entirely optional, but are very useful to a developer
attempting to diagnose program misbehavior or a crash. Many additional
-important files for developers can be found in the zlib124.zip source package
+important files for developers can be found in the zlib127.zip source package
available from http://zlib.net/ - review that package's README file for details.
@@ -72,7 +72,7 @@ are too numerous to cite here.
Copyright notice:
- (C) 1995-2010 Jean-loup Gailly and Mark Adler
+ (C) 1995-2012 Jean-loup Gailly and Mark Adler
This software is provided 'as-is', without any express or implied
warranty. In no event will the authors be held liable for any damages
diff --git a/compat/zlib/win32/zdll.lib b/compat/zlib/win32/zdll.lib
index 4e53491..669b186 100644
--- a/compat/zlib/win32/zdll.lib
+++ b/compat/zlib/win32/zdll.lib
Binary files differ
diff --git a/compat/zlib/win32/zlib.def b/compat/zlib/win32/zlib.def
index 03df8bf..0489615 100644
--- a/compat/zlib/win32/zlib.def
+++ b/compat/zlib/win32/zlib.def
@@ -1,6 +1,4 @@
-LIBRARY
; zlib data compression library
-
EXPORTS
; basic functions
zlibVersion
@@ -15,6 +13,7 @@ EXPORTS
deflateParams
deflateTune
deflateBound
+ deflatePending
deflatePrime
deflateSetHeader
inflateSetDictionary
@@ -57,6 +56,13 @@ EXPORTS
gzclose_w
gzerror
gzclearerr
+; large file functions
+ gzopen64
+ gzseek64
+ gztell64
+ gzoffset64
+ adler32_combine64
+ crc32_combine64
; checksum functions
adler32
crc32
@@ -68,7 +74,11 @@ EXPORTS
inflateInit_
inflateInit2_
inflateBackInit_
+ gzgetc_
zError
inflateSyncPoint
get_crc_table
inflateUndermine
+ inflateResetKeep
+ deflateResetKeep
+ gzopen_w
diff --git a/compat/zlib/win32/zlib1.dll b/compat/zlib/win32/zlib1.dll
index 869b00d..9943b3e 100644
--- a/compat/zlib/win32/zlib1.dll
+++ b/compat/zlib/win32/zlib1.dll
Binary files differ
diff --git a/compat/zlib/win64/zdll.lib b/compat/zlib/win64/zdll.lib
new file mode 100644
index 0000000..d7dfb09
--- /dev/null
+++ b/compat/zlib/win64/zdll.lib
Binary files differ
diff --git a/compat/zlib/win64/zlib1.dll b/compat/zlib/win64/zlib1.dll
new file mode 100644
index 0000000..631439b
--- /dev/null
+++ b/compat/zlib/win64/zlib1.dll
Binary files differ
diff --git a/compat/zlib/zconf.h b/compat/zlib/zconf.h
index e9f7bd7..8a46a58 100644
--- a/compat/zlib/zconf.h
+++ b/compat/zlib/zconf.h
@@ -1,9 +1,9 @@
/* zconf.h -- configuration of the zlib compression library
- * Copyright (C) 1995-2010 Jean-loup Gailly.
+ * Copyright (C) 1995-2012 Jean-loup Gailly.
* For conditions of distribution and use, see copyright notice in zlib.h
*/
-/* @(#) $Id: zconf.h,v 1.3 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
#ifndef ZCONF_H
#define ZCONF_H
@@ -15,6 +15,7 @@
* this permanently in zconf.h using "./configure --zprefix".
*/
#ifdef Z_PREFIX /* may be set to #if 1 by ./configure */
+# define Z_PREFIX_SET
/* all linked symbols */
# define _dist_code z__dist_code
@@ -27,9 +28,11 @@
# define adler32 z_adler32
# define adler32_combine z_adler32_combine
# define adler32_combine64 z_adler32_combine64
-# define compress z_compress
-# define compress2 z_compress2
-# define compressBound z_compressBound
+# ifndef Z_SOLO
+# define compress z_compress
+# define compress2 z_compress2
+# define compressBound z_compressBound
+# endif
# define crc32 z_crc32
# define crc32_combine z_crc32_combine
# define crc32_combine64 z_crc32_combine64
@@ -40,44 +43,52 @@
# define deflateInit2_ z_deflateInit2_
# define deflateInit_ z_deflateInit_
# define deflateParams z_deflateParams
+# define deflatePending z_deflatePending
# define deflatePrime z_deflatePrime
# define deflateReset z_deflateReset
+# define deflateResetKeep z_deflateResetKeep
# define deflateSetDictionary z_deflateSetDictionary
# define deflateSetHeader z_deflateSetHeader
# define deflateTune z_deflateTune
# define deflate_copyright z_deflate_copyright
# define get_crc_table z_get_crc_table
-# define gz_error z_gz_error
-# define gz_intmax z_gz_intmax
-# define gz_strwinerror z_gz_strwinerror
-# define gzbuffer z_gzbuffer
-# define gzclearerr z_gzclearerr
-# define gzclose z_gzclose
-# define gzclose_r z_gzclose_r
-# define gzclose_w z_gzclose_w
-# define gzdirect z_gzdirect
-# define gzdopen z_gzdopen
-# define gzeof z_gzeof
-# define gzerror z_gzerror
-# define gzflush z_gzflush
-# define gzgetc z_gzgetc
-# define gzgets z_gzgets
-# define gzoffset z_gzoffset
-# define gzoffset64 z_gzoffset64
-# define gzopen z_gzopen
-# define gzopen64 z_gzopen64
-# define gzprintf z_gzprintf
-# define gzputc z_gzputc
-# define gzputs z_gzputs
-# define gzread z_gzread
-# define gzrewind z_gzrewind
-# define gzseek z_gzseek
-# define gzseek64 z_gzseek64
-# define gzsetparams z_gzsetparams
-# define gztell z_gztell
-# define gztell64 z_gztell64
-# define gzungetc z_gzungetc
-# define gzwrite z_gzwrite
+# ifndef Z_SOLO
+# define gz_error z_gz_error
+# define gz_intmax z_gz_intmax
+# define gz_strwinerror z_gz_strwinerror
+# define gzbuffer z_gzbuffer
+# define gzclearerr z_gzclearerr
+# define gzclose z_gzclose
+# define gzclose_r z_gzclose_r
+# define gzclose_w z_gzclose_w
+# define gzdirect z_gzdirect
+# define gzdopen z_gzdopen
+# define gzeof z_gzeof
+# define gzerror z_gzerror
+# define gzflush z_gzflush
+# define gzgetc z_gzgetc
+# define gzgetc_ z_gzgetc_
+# define gzgets z_gzgets
+# define gzoffset z_gzoffset
+# define gzoffset64 z_gzoffset64
+# define gzopen z_gzopen
+# define gzopen64 z_gzopen64
+# ifdef _WIN32
+# define gzopen_w z_gzopen_w
+# endif
+# define gzprintf z_gzprintf
+# define gzputc z_gzputc
+# define gzputs z_gzputs
+# define gzread z_gzread
+# define gzrewind z_gzrewind
+# define gzseek z_gzseek
+# define gzseek64 z_gzseek64
+# define gzsetparams z_gzsetparams
+# define gztell z_gztell
+# define gztell64 z_gztell64
+# define gzungetc z_gzungetc
+# define gzwrite z_gzwrite
+# endif
# define inflate z_inflate
# define inflateBack z_inflateBack
# define inflateBackEnd z_inflateBackEnd
@@ -95,13 +106,18 @@
# define inflateSync z_inflateSync
# define inflateSyncPoint z_inflateSyncPoint
# define inflateUndermine z_inflateUndermine
+# define inflateResetKeep z_inflateResetKeep
# define inflate_copyright z_inflate_copyright
# define inflate_fast z_inflate_fast
# define inflate_table z_inflate_table
-# define uncompress z_uncompress
+# ifndef Z_SOLO
+# define uncompress z_uncompress
+# endif
# define zError z_zError
-# define zcalloc z_zcalloc
-# define zcfree z_zcfree
+# ifndef Z_SOLO
+# define zcalloc z_zcalloc
+# define zcfree z_zcfree
+# endif
# define zlibCompileFlags z_zlibCompileFlags
# define zlibVersion z_zlibVersion
@@ -111,7 +127,9 @@
# define alloc_func z_alloc_func
# define charf z_charf
# define free_func z_free_func
-# define gzFile z_gzFile
+# ifndef Z_SOLO
+# define gzFile z_gzFile
+# endif
# define gz_header z_gz_header
# define gz_headerp z_gz_headerp
# define in_func z_in_func
@@ -197,6 +215,12 @@
# endif
#endif
+#if defined(ZLIB_CONST) && !defined(z_const)
+# define z_const const
+#else
+# define z_const
+#endif
+
/* Some Mac compilers merge all .h files incorrectly: */
#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__)
# define NO_DUMMY_DECL
@@ -243,6 +267,14 @@
# endif
#endif
+#ifndef Z_ARG /* function prototypes for stdarg */
+# if defined(STDC) || defined(Z_HAVE_STDARG_H)
+# define Z_ARG(args) args
+# else
+# define Z_ARG(args) ()
+# endif
+#endif
+
/* The following definitions for FAR are needed only for MSDOS mixed
* model programming (small or medium model with some far allocations).
* This was tested only with MSC; for other MSDOS compilers you may have
@@ -356,12 +388,45 @@ typedef uLong FAR uLongf;
typedef Byte *voidp;
#endif
+/* ./configure may #define Z_U4 here */
+
+#if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC)
+# include <limits.h>
+# if (UINT_MAX == 0xffffffffUL)
+# define Z_U4 unsigned
+# else
+# if (ULONG_MAX == 0xffffffffUL)
+# define Z_U4 unsigned long
+# else
+# if (USHRT_MAX == 0xffffffffUL)
+# define Z_U4 unsigned short
+# endif
+# endif
+# endif
+#endif
+
+#ifdef Z_U4
+ typedef Z_U4 z_crc_t;
+#else
+ typedef unsigned long z_crc_t;
+#endif
+
#ifdef HAVE_UNISTD_H /* may be set to #if 1 by ./configure */
# define Z_HAVE_UNISTD_H
#endif
+#ifdef HAVE_STDARG_H /* may be set to #if 1 by ./configure */
+# define Z_HAVE_STDARG_H
+#endif
+
#ifdef STDC
-# include <sys/types.h> /* for off_t */
+# ifndef Z_SOLO
+# include <sys/types.h> /* for off_t */
+# endif
+#endif
+
+#ifdef _WIN32
+# include <stddef.h> /* for wchar_t */
#endif
/* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and
@@ -370,21 +435,38 @@ typedef uLong FAR uLongf;
* both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as
* equivalently requesting no 64-bit operations
*/
-#if -_LARGEFILE64_SOURCE - -1 == 1
+#if defined(LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1
# undef _LARGEFILE64_SOURCE
#endif
-#if defined(Z_HAVE_UNISTD_H) || defined(_LARGEFILE64_SOURCE)
-# include <unistd.h> /* for SEEK_* and off_t */
-# ifdef VMS
-# include <unixio.h> /* for off_t */
-# endif
-# ifndef z_off_t
-# define z_off_t off_t
+#if defined(__WATCOMC__) && !defined(Z_HAVE_UNISTD_H)
+# define Z_HAVE_UNISTD_H
+#endif
+#ifndef Z_SOLO
+# if defined(Z_HAVE_UNISTD_H) || defined(LARGEFILE64_SOURCE)
+# include <unistd.h> /* for SEEK_*, off_t, and _LFS64_LARGEFILE */
+# ifdef VMS
+# include <unixio.h> /* for off_t */
+# endif
+# ifndef z_off_t
+# define z_off_t off_t
+# endif
# endif
#endif
-#ifndef SEEK_SET
+#if defined(_LFS64_LARGEFILE) && _LFS64_LARGEFILE-0
+# define Z_LFS64
+#endif
+
+#if defined(_LARGEFILE64_SOURCE) && defined(Z_LFS64)
+# define Z_LARGE64
+#endif
+
+#if defined(_FILE_OFFSET_BITS) && _FILE_OFFSET_BITS-0 == 64 && defined(Z_LFS64)
+# define Z_WANT64
+#endif
+
+#if !defined(SEEK_SET) && !defined(Z_SOLO)
# define SEEK_SET 0 /* Seek from beginning of file. */
# define SEEK_CUR 1 /* Seek from current position. */
# define SEEK_END 2 /* Set file pointer to EOF plus "offset" */
@@ -394,18 +476,14 @@ typedef uLong FAR uLongf;
# define z_off_t long
#endif
-#if defined(_LARGEFILE64_SOURCE) && _LFS64_LARGEFILE-0
+#if !defined(_WIN32) && defined(Z_LARGE64)
# define z_off64_t off64_t
#else
-# define z_off64_t z_off_t
-#endif
-
-#if defined(__OS400__)
-# define NO_vsnprintf
-#endif
-
-#if defined(__MVS__)
-# define NO_vsnprintf
+# if defined(_WIN32) && !defined(__GNUC__) && !defined(Z_SOLO)
+# define z_off64_t __int64
+# else
+# define z_off64_t z_off_t
+# endif
#endif
/* MVS linker does not support external names larger than 8 bytes */
diff --git a/compat/zlib/zconf.h.cmakein b/compat/zlib/zconf.h.cmakein
index 9e69b1b..b6ca59a 100644
--- a/compat/zlib/zconf.h.cmakein
+++ b/compat/zlib/zconf.h.cmakein
@@ -1,9 +1,9 @@
/* zconf.h -- configuration of the zlib compression library
- * Copyright (C) 1995-2010 Jean-loup Gailly.
+ * Copyright (C) 1995-2012 Jean-loup Gailly.
* For conditions of distribution and use, see copyright notice in zlib.h
*/
-/* @(#) $Id: zconf.h.cmakein,v 1.2 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
#ifndef ZCONF_H
#define ZCONF_H
@@ -17,6 +17,7 @@
* this permanently in zconf.h using "./configure --zprefix".
*/
#ifdef Z_PREFIX /* may be set to #if 1 by ./configure */
+# define Z_PREFIX_SET
/* all linked symbols */
# define _dist_code z__dist_code
@@ -29,9 +30,11 @@
# define adler32 z_adler32
# define adler32_combine z_adler32_combine
# define adler32_combine64 z_adler32_combine64
-# define compress z_compress
-# define compress2 z_compress2
-# define compressBound z_compressBound
+# ifndef Z_SOLO
+# define compress z_compress
+# define compress2 z_compress2
+# define compressBound z_compressBound
+# endif
# define crc32 z_crc32
# define crc32_combine z_crc32_combine
# define crc32_combine64 z_crc32_combine64
@@ -42,44 +45,52 @@
# define deflateInit2_ z_deflateInit2_
# define deflateInit_ z_deflateInit_
# define deflateParams z_deflateParams
+# define deflatePending z_deflatePending
# define deflatePrime z_deflatePrime
# define deflateReset z_deflateReset
+# define deflateResetKeep z_deflateResetKeep
# define deflateSetDictionary z_deflateSetDictionary
# define deflateSetHeader z_deflateSetHeader
# define deflateTune z_deflateTune
# define deflate_copyright z_deflate_copyright
# define get_crc_table z_get_crc_table
-# define gz_error z_gz_error
-# define gz_intmax z_gz_intmax
-# define gz_strwinerror z_gz_strwinerror
-# define gzbuffer z_gzbuffer
-# define gzclearerr z_gzclearerr
-# define gzclose z_gzclose
-# define gzclose_r z_gzclose_r
-# define gzclose_w z_gzclose_w
-# define gzdirect z_gzdirect
-# define gzdopen z_gzdopen
-# define gzeof z_gzeof
-# define gzerror z_gzerror
-# define gzflush z_gzflush
-# define gzgetc z_gzgetc
-# define gzgets z_gzgets
-# define gzoffset z_gzoffset
-# define gzoffset64 z_gzoffset64
-# define gzopen z_gzopen
-# define gzopen64 z_gzopen64
-# define gzprintf z_gzprintf
-# define gzputc z_gzputc
-# define gzputs z_gzputs
-# define gzread z_gzread
-# define gzrewind z_gzrewind
-# define gzseek z_gzseek
-# define gzseek64 z_gzseek64
-# define gzsetparams z_gzsetparams
-# define gztell z_gztell
-# define gztell64 z_gztell64
-# define gzungetc z_gzungetc
-# define gzwrite z_gzwrite
+# ifndef Z_SOLO
+# define gz_error z_gz_error
+# define gz_intmax z_gz_intmax
+# define gz_strwinerror z_gz_strwinerror
+# define gzbuffer z_gzbuffer
+# define gzclearerr z_gzclearerr
+# define gzclose z_gzclose
+# define gzclose_r z_gzclose_r
+# define gzclose_w z_gzclose_w
+# define gzdirect z_gzdirect
+# define gzdopen z_gzdopen
+# define gzeof z_gzeof
+# define gzerror z_gzerror
+# define gzflush z_gzflush
+# define gzgetc z_gzgetc
+# define gzgetc_ z_gzgetc_
+# define gzgets z_gzgets
+# define gzoffset z_gzoffset
+# define gzoffset64 z_gzoffset64
+# define gzopen z_gzopen
+# define gzopen64 z_gzopen64
+# ifdef _WIN32
+# define gzopen_w z_gzopen_w
+# endif
+# define gzprintf z_gzprintf
+# define gzputc z_gzputc
+# define gzputs z_gzputs
+# define gzread z_gzread
+# define gzrewind z_gzrewind
+# define gzseek z_gzseek
+# define gzseek64 z_gzseek64
+# define gzsetparams z_gzsetparams
+# define gztell z_gztell
+# define gztell64 z_gztell64
+# define gzungetc z_gzungetc
+# define gzwrite z_gzwrite
+# endif
# define inflate z_inflate
# define inflateBack z_inflateBack
# define inflateBackEnd z_inflateBackEnd
@@ -97,13 +108,18 @@
# define inflateSync z_inflateSync
# define inflateSyncPoint z_inflateSyncPoint
# define inflateUndermine z_inflateUndermine
+# define inflateResetKeep z_inflateResetKeep
# define inflate_copyright z_inflate_copyright
# define inflate_fast z_inflate_fast
# define inflate_table z_inflate_table
-# define uncompress z_uncompress
+# ifndef Z_SOLO
+# define uncompress z_uncompress
+# endif
# define zError z_zError
-# define zcalloc z_zcalloc
-# define zcfree z_zcfree
+# ifndef Z_SOLO
+# define zcalloc z_zcalloc
+# define zcfree z_zcfree
+# endif
# define zlibCompileFlags z_zlibCompileFlags
# define zlibVersion z_zlibVersion
@@ -113,7 +129,9 @@
# define alloc_func z_alloc_func
# define charf z_charf
# define free_func z_free_func
-# define gzFile z_gzFile
+# ifndef Z_SOLO
+# define gzFile z_gzFile
+# endif
# define gz_header z_gz_header
# define gz_headerp z_gz_headerp
# define in_func z_in_func
@@ -199,6 +217,12 @@
# endif
#endif
+#if defined(ZLIB_CONST) && !defined(z_const)
+# define z_const const
+#else
+# define z_const
+#endif
+
/* Some Mac compilers merge all .h files incorrectly: */
#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__)
# define NO_DUMMY_DECL
@@ -245,6 +269,14 @@
# endif
#endif
+#ifndef Z_ARG /* function prototypes for stdarg */
+# if defined(STDC) || defined(Z_HAVE_STDARG_H)
+# define Z_ARG(args) args
+# else
+# define Z_ARG(args) ()
+# endif
+#endif
+
/* The following definitions for FAR are needed only for MSDOS mixed
* model programming (small or medium model with some far allocations).
* This was tested only with MSC; for other MSDOS compilers you may have
@@ -358,12 +390,45 @@ typedef uLong FAR uLongf;
typedef Byte *voidp;
#endif
+/* ./configure may #define Z_U4 here */
+
+#if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC)
+# include <limits.h>
+# if (UINT_MAX == 0xffffffffUL)
+# define Z_U4 unsigned
+# else
+# if (ULONG_MAX == 0xffffffffUL)
+# define Z_U4 unsigned long
+# else
+# if (USHRT_MAX == 0xffffffffUL)
+# define Z_U4 unsigned short
+# endif
+# endif
+# endif
+#endif
+
+#ifdef Z_U4
+ typedef Z_U4 z_crc_t;
+#else
+ typedef unsigned long z_crc_t;
+#endif
+
#ifdef HAVE_UNISTD_H /* may be set to #if 1 by ./configure */
# define Z_HAVE_UNISTD_H
#endif
+#ifdef HAVE_STDARG_H /* may be set to #if 1 by ./configure */
+# define Z_HAVE_STDARG_H
+#endif
+
#ifdef STDC
-# include <sys/types.h> /* for off_t */
+# ifndef Z_SOLO
+# include <sys/types.h> /* for off_t */
+# endif
+#endif
+
+#ifdef _WIN32
+# include <stddef.h> /* for wchar_t */
#endif
/* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and
@@ -372,21 +437,38 @@ typedef uLong FAR uLongf;
* both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as
* equivalently requesting no 64-bit operations
*/
-#if -_LARGEFILE64_SOURCE - -1 == 1
+#if defined(LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1
# undef _LARGEFILE64_SOURCE
#endif
-#if defined(Z_HAVE_UNISTD_H) || defined(_LARGEFILE64_SOURCE)
-# include <unistd.h> /* for SEEK_* and off_t */
-# ifdef VMS
-# include <unixio.h> /* for off_t */
-# endif
-# ifndef z_off_t
-# define z_off_t off_t
+#if defined(__WATCOMC__) && !defined(Z_HAVE_UNISTD_H)
+# define Z_HAVE_UNISTD_H
+#endif
+#ifndef Z_SOLO
+# if defined(Z_HAVE_UNISTD_H) || defined(LARGEFILE64_SOURCE)
+# include <unistd.h> /* for SEEK_*, off_t, and _LFS64_LARGEFILE */
+# ifdef VMS
+# include <unixio.h> /* for off_t */
+# endif
+# ifndef z_off_t
+# define z_off_t off_t
+# endif
# endif
#endif
-#ifndef SEEK_SET
+#if defined(_LFS64_LARGEFILE) && _LFS64_LARGEFILE-0
+# define Z_LFS64
+#endif
+
+#if defined(_LARGEFILE64_SOURCE) && defined(Z_LFS64)
+# define Z_LARGE64
+#endif
+
+#if defined(_FILE_OFFSET_BITS) && _FILE_OFFSET_BITS-0 == 64 && defined(Z_LFS64)
+# define Z_WANT64
+#endif
+
+#if !defined(SEEK_SET) && !defined(Z_SOLO)
# define SEEK_SET 0 /* Seek from beginning of file. */
# define SEEK_CUR 1 /* Seek from current position. */
# define SEEK_END 2 /* Set file pointer to EOF plus "offset" */
@@ -396,18 +478,14 @@ typedef uLong FAR uLongf;
# define z_off_t long
#endif
-#if defined(_LARGEFILE64_SOURCE) && _LFS64_LARGEFILE-0
+#if !defined(_WIN32) && defined(Z_LARGE64)
# define z_off64_t off64_t
#else
-# define z_off64_t z_off_t
-#endif
-
-#if defined(__OS400__)
-# define NO_vsnprintf
-#endif
-
-#if defined(__MVS__)
-# define NO_vsnprintf
+# if defined(_WIN32) && !defined(__GNUC__) && !defined(Z_SOLO)
+# define z_off64_t __int64
+# else
+# define z_off64_t z_off_t
+# endif
#endif
/* MVS linker does not support external names larger than 8 bytes */
diff --git a/compat/zlib/zconf.h.in b/compat/zlib/zconf.h.in
index d0a2267..8a46a58 100644
--- a/compat/zlib/zconf.h.in
+++ b/compat/zlib/zconf.h.in
@@ -1,9 +1,9 @@
/* zconf.h -- configuration of the zlib compression library
- * Copyright (C) 1995-2010 Jean-loup Gailly.
+ * Copyright (C) 1995-2012 Jean-loup Gailly.
* For conditions of distribution and use, see copyright notice in zlib.h
*/
-/* @(#) $Id: zconf.h.in,v 1.2 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
#ifndef ZCONF_H
#define ZCONF_H
@@ -15,6 +15,7 @@
* this permanently in zconf.h using "./configure --zprefix".
*/
#ifdef Z_PREFIX /* may be set to #if 1 by ./configure */
+# define Z_PREFIX_SET
/* all linked symbols */
# define _dist_code z__dist_code
@@ -27,9 +28,11 @@
# define adler32 z_adler32
# define adler32_combine z_adler32_combine
# define adler32_combine64 z_adler32_combine64
-# define compress z_compress
-# define compress2 z_compress2
-# define compressBound z_compressBound
+# ifndef Z_SOLO
+# define compress z_compress
+# define compress2 z_compress2
+# define compressBound z_compressBound
+# endif
# define crc32 z_crc32
# define crc32_combine z_crc32_combine
# define crc32_combine64 z_crc32_combine64
@@ -40,44 +43,52 @@
# define deflateInit2_ z_deflateInit2_
# define deflateInit_ z_deflateInit_
# define deflateParams z_deflateParams
+# define deflatePending z_deflatePending
# define deflatePrime z_deflatePrime
# define deflateReset z_deflateReset
+# define deflateResetKeep z_deflateResetKeep
# define deflateSetDictionary z_deflateSetDictionary
# define deflateSetHeader z_deflateSetHeader
# define deflateTune z_deflateTune
# define deflate_copyright z_deflate_copyright
# define get_crc_table z_get_crc_table
-# define gz_error z_gz_error
-# define gz_intmax z_gz_intmax
-# define gz_strwinerror z_gz_strwinerror
-# define gzbuffer z_gzbuffer
-# define gzclearerr z_gzclearerr
-# define gzclose z_gzclose
-# define gzclose_r z_gzclose_r
-# define gzclose_w z_gzclose_w
-# define gzdirect z_gzdirect
-# define gzdopen z_gzdopen
-# define gzeof z_gzeof
-# define gzerror z_gzerror
-# define gzflush z_gzflush
-# define gzgetc z_gzgetc
-# define gzgets z_gzgets
-# define gzoffset z_gzoffset
-# define gzoffset64 z_gzoffset64
-# define gzopen z_gzopen
-# define gzopen64 z_gzopen64
-# define gzprintf z_gzprintf
-# define gzputc z_gzputc
-# define gzputs z_gzputs
-# define gzread z_gzread
-# define gzrewind z_gzrewind
-# define gzseek z_gzseek
-# define gzseek64 z_gzseek64
-# define gzsetparams z_gzsetparams
-# define gztell z_gztell
-# define gztell64 z_gztell64
-# define gzungetc z_gzungetc
-# define gzwrite z_gzwrite
+# ifndef Z_SOLO
+# define gz_error z_gz_error
+# define gz_intmax z_gz_intmax
+# define gz_strwinerror z_gz_strwinerror
+# define gzbuffer z_gzbuffer
+# define gzclearerr z_gzclearerr
+# define gzclose z_gzclose
+# define gzclose_r z_gzclose_r
+# define gzclose_w z_gzclose_w
+# define gzdirect z_gzdirect
+# define gzdopen z_gzdopen
+# define gzeof z_gzeof
+# define gzerror z_gzerror
+# define gzflush z_gzflush
+# define gzgetc z_gzgetc
+# define gzgetc_ z_gzgetc_
+# define gzgets z_gzgets
+# define gzoffset z_gzoffset
+# define gzoffset64 z_gzoffset64
+# define gzopen z_gzopen
+# define gzopen64 z_gzopen64
+# ifdef _WIN32
+# define gzopen_w z_gzopen_w
+# endif
+# define gzprintf z_gzprintf
+# define gzputc z_gzputc
+# define gzputs z_gzputs
+# define gzread z_gzread
+# define gzrewind z_gzrewind
+# define gzseek z_gzseek
+# define gzseek64 z_gzseek64
+# define gzsetparams z_gzsetparams
+# define gztell z_gztell
+# define gztell64 z_gztell64
+# define gzungetc z_gzungetc
+# define gzwrite z_gzwrite
+# endif
# define inflate z_inflate
# define inflateBack z_inflateBack
# define inflateBackEnd z_inflateBackEnd
@@ -95,13 +106,18 @@
# define inflateSync z_inflateSync
# define inflateSyncPoint z_inflateSyncPoint
# define inflateUndermine z_inflateUndermine
+# define inflateResetKeep z_inflateResetKeep
# define inflate_copyright z_inflate_copyright
# define inflate_fast z_inflate_fast
# define inflate_table z_inflate_table
-# define uncompress z_uncompress
+# ifndef Z_SOLO
+# define uncompress z_uncompress
+# endif
# define zError z_zError
-# define zcalloc z_zcalloc
-# define zcfree z_zcfree
+# ifndef Z_SOLO
+# define zcalloc z_zcalloc
+# define zcfree z_zcfree
+# endif
# define zlibCompileFlags z_zlibCompileFlags
# define zlibVersion z_zlibVersion
@@ -111,7 +127,9 @@
# define alloc_func z_alloc_func
# define charf z_charf
# define free_func z_free_func
-# define gzFile z_gzFile
+# ifndef Z_SOLO
+# define gzFile z_gzFile
+# endif
# define gz_header z_gz_header
# define gz_headerp z_gz_headerp
# define in_func z_in_func
@@ -197,6 +215,12 @@
# endif
#endif
+#if defined(ZLIB_CONST) && !defined(z_const)
+# define z_const const
+#else
+# define z_const
+#endif
+
/* Some Mac compilers merge all .h files incorrectly: */
#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__)
# define NO_DUMMY_DECL
@@ -243,6 +267,14 @@
# endif
#endif
+#ifndef Z_ARG /* function prototypes for stdarg */
+# if defined(STDC) || defined(Z_HAVE_STDARG_H)
+# define Z_ARG(args) args
+# else
+# define Z_ARG(args) ()
+# endif
+#endif
+
/* The following definitions for FAR are needed only for MSDOS mixed
* model programming (small or medium model with some far allocations).
* This was tested only with MSC; for other MSDOS compilers you may have
@@ -356,12 +388,45 @@ typedef uLong FAR uLongf;
typedef Byte *voidp;
#endif
+/* ./configure may #define Z_U4 here */
+
+#if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC)
+# include <limits.h>
+# if (UINT_MAX == 0xffffffffUL)
+# define Z_U4 unsigned
+# else
+# if (ULONG_MAX == 0xffffffffUL)
+# define Z_U4 unsigned long
+# else
+# if (USHRT_MAX == 0xffffffffUL)
+# define Z_U4 unsigned short
+# endif
+# endif
+# endif
+#endif
+
+#ifdef Z_U4
+ typedef Z_U4 z_crc_t;
+#else
+ typedef unsigned long z_crc_t;
+#endif
+
#ifdef HAVE_UNISTD_H /* may be set to #if 1 by ./configure */
# define Z_HAVE_UNISTD_H
#endif
+#ifdef HAVE_STDARG_H /* may be set to #if 1 by ./configure */
+# define Z_HAVE_STDARG_H
+#endif
+
#ifdef STDC
-# include <sys/types.h> /* for off_t */
+# ifndef Z_SOLO
+# include <sys/types.h> /* for off_t */
+# endif
+#endif
+
+#ifdef _WIN32
+# include <stddef.h> /* for wchar_t */
#endif
/* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and
@@ -370,21 +435,38 @@ typedef uLong FAR uLongf;
* both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as
* equivalently requesting no 64-bit operations
*/
-#if -_LARGEFILE64_SOURCE - -1 == 1
+#if defined(LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1
# undef _LARGEFILE64_SOURCE
#endif
-#if defined(Z_HAVE_UNISTD_H) || defined(_LARGEFILE64_SOURCE)
-# include <unistd.h> /* for SEEK_* and off_t */
-# ifdef VMS
-# include <unixio.h> /* for off_t */
-# endif
-# ifndef z_off_t
-# define z_off_t off_t
+#if defined(__WATCOMC__) && !defined(Z_HAVE_UNISTD_H)
+# define Z_HAVE_UNISTD_H
+#endif
+#ifndef Z_SOLO
+# if defined(Z_HAVE_UNISTD_H) || defined(LARGEFILE64_SOURCE)
+# include <unistd.h> /* for SEEK_*, off_t, and _LFS64_LARGEFILE */
+# ifdef VMS
+# include <unixio.h> /* for off_t */
+# endif
+# ifndef z_off_t
+# define z_off_t off_t
+# endif
# endif
#endif
-#ifndef SEEK_SET
+#if defined(_LFS64_LARGEFILE) && _LFS64_LARGEFILE-0
+# define Z_LFS64
+#endif
+
+#if defined(_LARGEFILE64_SOURCE) && defined(Z_LFS64)
+# define Z_LARGE64
+#endif
+
+#if defined(_FILE_OFFSET_BITS) && _FILE_OFFSET_BITS-0 == 64 && defined(Z_LFS64)
+# define Z_WANT64
+#endif
+
+#if !defined(SEEK_SET) && !defined(Z_SOLO)
# define SEEK_SET 0 /* Seek from beginning of file. */
# define SEEK_CUR 1 /* Seek from current position. */
# define SEEK_END 2 /* Set file pointer to EOF plus "offset" */
@@ -394,18 +476,14 @@ typedef uLong FAR uLongf;
# define z_off_t long
#endif
-#if defined(_LARGEFILE64_SOURCE) && _LFS64_LARGEFILE-0
+#if !defined(_WIN32) && defined(Z_LARGE64)
# define z_off64_t off64_t
#else
-# define z_off64_t z_off_t
-#endif
-
-#if defined(__OS400__)
-# define NO_vsnprintf
-#endif
-
-#if defined(__MVS__)
-# define NO_vsnprintf
+# if defined(_WIN32) && !defined(__GNUC__) && !defined(Z_SOLO)
+# define z_off64_t __int64
+# else
+# define z_off64_t z_off_t
+# endif
#endif
/* MVS linker does not support external names larger than 8 bytes */
diff --git a/compat/zlib/zlib.3 b/compat/zlib/zlib.3
index 27adc4c..79d3402 100644
--- a/compat/zlib/zlib.3
+++ b/compat/zlib/zlib.3
@@ -1,4 +1,4 @@
-.TH ZLIB 3 "19 Apr 2010"
+.TH ZLIB 3 "2 May 2012"
.SH NAME
zlib \- compression/decompression library
.SH SYNOPSIS
@@ -36,9 +36,9 @@ All functions of the compression library are documented in the file
.IR zlib.h .
The distribution source includes examples of use of the library
in the files
-.I example.c
+.I test/example.c
and
-.IR minigzip.c,
+.IR test/minigzip.c,
as well as other examples in the
.IR examples/
directory.
@@ -65,7 +65,7 @@ A Python interface to
written by A.M. Kuchling (amk@magnet.com),
is available in Python 1.5 and later versions:
.IP
-http://www.python.org/doc/lib/module-zlib.html
+http://docs.python.org/library/zlib.html
.LP
.I zlib
is built into
@@ -95,11 +95,11 @@ http://zlib.net/
The data format used by the zlib library is described by RFC
(Request for Comments) 1950 to 1952 in the files:
.IP
-http://www.ietf.org/rfc/rfc1950.txt (for the zlib header and trailer format)
+http://tools.ietf.org/html/rfc1950 (for the zlib header and trailer format)
.br
-http://www.ietf.org/rfc/rfc1951.txt (for the deflate compressed data format)
+http://tools.ietf.org/html/rfc1951 (for the deflate compressed data format)
.br
-http://www.ietf.org/rfc/rfc1952.txt (for the gzip header and trailer format)
+http://tools.ietf.org/html/rfc1952 (for the gzip header and trailer format)
.LP
Mark Nelson wrote an article about
.I zlib
@@ -125,8 +125,8 @@ before asking for help.
Send questions and/or comments to zlib@gzip.org,
or (for the Windows DLL version) to Gilles Vollant (info@winimage.com).
.SH AUTHORS
-Version 1.2.5
-Copyright (C) 1995-2010 Jean-loup Gailly (jloup@gzip.org)
+Version 1.2.7
+Copyright (C) 1995-2012 Jean-loup Gailly (jloup@gzip.org)
and Mark Adler (madler@alumni.caltech.edu).
.LP
This software is provided "as-is,"
diff --git a/compat/zlib/zlib.3.pdf b/compat/zlib/zlib.3.pdf
index 9f8a2c3..485306c 100644
--- a/compat/zlib/zlib.3.pdf
+++ b/compat/zlib/zlib.3.pdf
Binary files differ
diff --git a/compat/zlib/zlib.h b/compat/zlib/zlib.h
index bfbba83..3edf3ac 100644
--- a/compat/zlib/zlib.h
+++ b/compat/zlib/zlib.h
@@ -1,7 +1,7 @@
/* zlib.h -- interface of the 'zlib' general purpose compression library
- version 1.2.5, April 19th, 2010
+ version 1.2.7, May 2nd, 2012
- Copyright (C) 1995-2010 Jean-loup Gailly and Mark Adler
+ Copyright (C) 1995-2012 Jean-loup Gailly and Mark Adler
This software is provided 'as-is', without any express or implied
warranty. In no event will the authors be held liable for any damages
@@ -24,8 +24,8 @@
The data format used by the zlib library is described by RFCs (Request for
- Comments) 1950 to 1952 in the files http://www.ietf.org/rfc/rfc1950.txt
- (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format).
+ Comments) 1950 to 1952 in the files http://tools.ietf.org/html/rfc1950
+ (zlib format), rfc1951 (deflate format) and rfc1952 (gzip format).
*/
#ifndef ZLIB_H
@@ -37,11 +37,11 @@
extern "C" {
#endif
-#define ZLIB_VERSION "1.2.5"
-#define ZLIB_VERNUM 0x1250
+#define ZLIB_VERSION "1.2.7"
+#define ZLIB_VERNUM 0x1270
#define ZLIB_VER_MAJOR 1
#define ZLIB_VER_MINOR 2
-#define ZLIB_VER_REVISION 5
+#define ZLIB_VER_REVISION 7
#define ZLIB_VER_SUBREVISION 0
/*
@@ -83,15 +83,15 @@ typedef void (*free_func) OF((voidpf opaque, voidpf address));
struct internal_state;
typedef struct z_stream_s {
- Bytef *next_in; /* next input byte */
+ z_const Bytef *next_in; /* next input byte */
uInt avail_in; /* number of bytes available at next_in */
- uLong total_in; /* total nb of input bytes read so far */
+ uLong total_in; /* total number of input bytes read so far */
Bytef *next_out; /* next output byte should be put there */
uInt avail_out; /* remaining free space at next_out */
- uLong total_out; /* total nb of bytes output so far */
+ uLong total_out; /* total number of bytes output so far */
- char *msg; /* last error message, NULL if no error */
+ z_const char *msg; /* last error message, NULL if no error */
struct internal_state FAR *state; /* not visible by applications */
alloc_func zalloc; /* used to allocate the internal state */
@@ -327,8 +327,9 @@ ZEXTERN int ZEXPORT deflate OF((z_streamp strm, int flush));
Z_FINISH can be used immediately after deflateInit if all the compression
is to be done in a single step. In this case, avail_out must be at least the
- value returned by deflateBound (see below). If deflate does not return
- Z_STREAM_END, then it must be called again as described above.
+ value returned by deflateBound (see below). Then deflate is guaranteed to
+ return Z_STREAM_END. If not enough output space is provided, deflate will
+ not return Z_STREAM_END, and it must be called again as described above.
deflate() sets strm->adler to the adler32 checksum of all input read
so far (that is, total_in bytes).
@@ -451,23 +452,29 @@ ZEXTERN int ZEXPORT inflate OF((z_streamp strm, int flush));
error. However if all decompression is to be performed in a single step (a
single call of inflate), the parameter flush should be set to Z_FINISH. In
this case all pending input is processed and all pending output is flushed;
- avail_out must be large enough to hold all the uncompressed data. (The size
- of the uncompressed data may have been saved by the compressor for this
- purpose.) The next operation on this stream must be inflateEnd to deallocate
- the decompression state. The use of Z_FINISH is never required, but can be
- used to inform inflate that a faster approach may be used for the single
- inflate() call.
+ avail_out must be large enough to hold all of the uncompressed data for the
+ operation to complete. (The size of the uncompressed data may have been
+ saved by the compressor for this purpose.) The use of Z_FINISH is not
+ required to perform an inflation in one step. However it may be used to
+ inform inflate that a faster approach can be used for the single inflate()
+ call. Z_FINISH also informs inflate to not maintain a sliding window if the
+ stream completes, which reduces inflate's memory footprint. If the stream
+ does not complete, either because not all of the stream is provided or not
+ enough output space is provided, then a sliding window will be allocated and
+ inflate() can be called again to continue the operation as if Z_NO_FLUSH had
+ been used.
In this implementation, inflate() always flushes as much output as
possible to the output buffer, and always uses the faster approach on the
- first call. So the only effect of the flush parameter in this implementation
- is on the return value of inflate(), as noted below, or when it returns early
- because Z_BLOCK or Z_TREES is used.
+ first call. So the effects of the flush parameter in this implementation are
+ on the return value of inflate() as noted below, when inflate() returns early
+ when Z_BLOCK or Z_TREES is used, and when inflate() avoids the allocation of
+ memory for a sliding window when Z_FINISH is used.
If a preset dictionary is needed after this call (see inflateSetDictionary
- below), inflate sets strm->adler to the adler32 checksum of the dictionary
+ below), inflate sets strm->adler to the Adler-32 checksum of the dictionary
chosen by the compressor and returns Z_NEED_DICT; otherwise it sets
- strm->adler to the adler32 checksum of all output produced so far (that is,
+ strm->adler to the Adler-32 checksum of all output produced so far (that is,
total_out bytes) and returns Z_OK, Z_STREAM_END or an error code as described
below. At the end of the stream, inflate() checks that its computed adler32
checksum is equal to that saved by the compressor and returns Z_STREAM_END
@@ -478,7 +485,9 @@ ZEXTERN int ZEXPORT inflate OF((z_streamp strm, int flush));
initializing with inflateInit2(). Any information contained in the gzip
header is not retained, so applications that need that information should
instead use raw inflate, see inflateInit2() below, or inflateBack() and
- perform their own processing of the gzip header and trailer.
+ perform their own processing of the gzip header and trailer. When processing
+ gzip-wrapped deflate data, strm->adler32 is set to the CRC-32 of the output
+ producted so far. The CRC-32 is checked against the gzip trailer.
inflate() returns Z_OK if some progress has been made (more input processed
or more output produced), Z_STREAM_END if the end of the compressed data has
@@ -580,10 +589,15 @@ ZEXTERN int ZEXPORT deflateSetDictionary OF((z_streamp strm,
uInt dictLength));
/*
Initializes the compression dictionary from the given byte sequence
- without producing any compressed output. This function must be called
- immediately after deflateInit, deflateInit2 or deflateReset, before any call
- of deflate. The compressor and decompressor must use exactly the same
- dictionary (see inflateSetDictionary).
+ without producing any compressed output. When using the zlib format, this
+ function must be called immediately after deflateInit, deflateInit2 or
+ deflateReset, and before any call of deflate. When doing raw deflate, this
+ function must be called either before any call of deflate, or immediately
+ after the completion of a deflate block, i.e. after all input has been
+ consumed and all output has been delivered when using any of the flush
+ options Z_BLOCK, Z_PARTIAL_FLUSH, Z_SYNC_FLUSH, or Z_FULL_FLUSH. The
+ compressor and decompressor must use exactly the same dictionary (see
+ inflateSetDictionary).
The dictionary should consist of strings (byte sequences) that are likely
to be encountered later in the data to be compressed, with the most commonly
@@ -610,8 +624,8 @@ ZEXTERN int ZEXPORT deflateSetDictionary OF((z_streamp strm,
deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a
parameter is invalid (e.g. dictionary being Z_NULL) or the stream state is
inconsistent (for example if deflate has already been called for this stream
- or if the compression method is bsort). deflateSetDictionary does not
- perform any compression: this will be done by deflate().
+ or if not at a block boundary for raw deflate). deflateSetDictionary does
+ not perform any compression: this will be done by deflate().
*/
ZEXTERN int ZEXPORT deflateCopy OF((z_streamp dest,
@@ -688,8 +702,28 @@ ZEXTERN uLong ZEXPORT deflateBound OF((z_streamp strm,
deflation of sourceLen bytes. It must be called after deflateInit() or
deflateInit2(), and after deflateSetHeader(), if used. This would be used
to allocate an output buffer for deflation in a single pass, and so would be
- called before deflate().
-*/
+ called before deflate(). If that first deflate() call is provided the
+ sourceLen input bytes, an output buffer allocated to the size returned by
+ deflateBound(), and the flush value Z_FINISH, then deflate() is guaranteed
+ to return Z_STREAM_END. Note that it is possible for the compressed size to
+ be larger than the value returned by deflateBound() if flush options other
+ than Z_FINISH or Z_NO_FLUSH are used.
+*/
+
+ZEXTERN int ZEXPORT deflatePending OF((z_streamp strm,
+ unsigned *pending,
+ int *bits));
+/*
+ deflatePending() returns the number of bytes and bits of output that have
+ been generated, but not yet provided in the available output. The bytes not
+ provided would be due to the available output space having being consumed.
+ The number of bits of output not provided are between 0 and 7, where they
+ await more bits to join them in order to fill out a full byte. If pending
+ or bits are Z_NULL, then those values are not set.
+
+ deflatePending returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent.
+ */
ZEXTERN int ZEXPORT deflatePrime OF((z_streamp strm,
int bits,
@@ -703,8 +737,9 @@ ZEXTERN int ZEXPORT deflatePrime OF((z_streamp strm,
than or equal to 16, and that many of the least significant bits of value
will be inserted in the output.
- deflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source
- stream state was inconsistent.
+ deflatePrime returns Z_OK if success, Z_BUF_ERROR if there was not enough
+ room in the internal buffer to insert the bits, or Z_STREAM_ERROR if the
+ source stream state was inconsistent.
*/
ZEXTERN int ZEXPORT deflateSetHeader OF((z_streamp strm,
@@ -790,10 +825,11 @@ ZEXTERN int ZEXPORT inflateSetDictionary OF((z_streamp strm,
if that call returned Z_NEED_DICT. The dictionary chosen by the compressor
can be determined from the adler32 value returned by that call of inflate.
The compressor and decompressor must use exactly the same dictionary (see
- deflateSetDictionary). For raw inflate, this function can be called
- immediately after inflateInit2() or inflateReset() and before any call of
- inflate() to set the dictionary. The application must insure that the
- dictionary that was used for compression is provided.
+ deflateSetDictionary). For raw inflate, this function can be called at any
+ time to set the dictionary. If the provided dictionary is smaller than the
+ window and there is already data in the window, then the provided dictionary
+ will amend what's there. The application must insure that the dictionary
+ that was used for compression is provided.
inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a
parameter is invalid (e.g. dictionary being Z_NULL) or the stream state is
@@ -805,17 +841,21 @@ ZEXTERN int ZEXPORT inflateSetDictionary OF((z_streamp strm,
ZEXTERN int ZEXPORT inflateSync OF((z_streamp strm));
/*
- Skips invalid compressed data until a full flush point (see above the
- description of deflate with Z_FULL_FLUSH) can be found, or until all
+ Skips invalid compressed data until a possible full flush point (see above
+ for the description of deflate with Z_FULL_FLUSH) can be found, or until all
available input is skipped. No output is provided.
- inflateSync returns Z_OK if a full flush point has been found, Z_BUF_ERROR
- if no more input was provided, Z_DATA_ERROR if no flush point has been
- found, or Z_STREAM_ERROR if the stream structure was inconsistent. In the
- success case, the application may save the current current value of total_in
- which indicates where valid compressed data was found. In the error case,
- the application may repeatedly call inflateSync, providing more input each
- time, until success or end of the input data.
+ inflateSync searches for a 00 00 FF FF pattern in the compressed data.
+ All full flush points have this pattern, but not all occurences of this
+ pattern are full flush points.
+
+ inflateSync returns Z_OK if a possible full flush point has been found,
+ Z_BUF_ERROR if no more input was provided, Z_DATA_ERROR if no flush point
+ has been found, or Z_STREAM_ERROR if the stream structure was inconsistent.
+ In the success case, the application may save the current current value of
+ total_in which indicates where valid compressed data was found. In the
+ error case, the application may repeatedly call inflateSync, providing more
+ input each time, until success or end of the input data.
*/
ZEXTERN int ZEXPORT inflateCopy OF((z_streamp dest,
@@ -962,7 +1002,7 @@ ZEXTERN int ZEXPORT inflateBackInit OF((z_streamp strm, int windowBits,
See inflateBack() for the usage of these routines.
inflateBackInit will return Z_OK on success, Z_STREAM_ERROR if any of
- the paramaters are invalid, Z_MEM_ERROR if the internal state could not be
+ the parameters are invalid, Z_MEM_ERROR if the internal state could not be
allocated, or Z_VERSION_ERROR if the version of the library does not match
the version of the header file.
*/
@@ -1088,6 +1128,7 @@ ZEXTERN uLong ZEXPORT zlibCompileFlags OF((void));
27-31: 0 (reserved)
*/
+#ifndef Z_SOLO
/* utility functions */
@@ -1149,10 +1190,11 @@ ZEXTERN int ZEXPORT uncompress OF((Bytef *dest, uLongf *destLen,
uncompress returns Z_OK if success, Z_MEM_ERROR if there was not
enough memory, Z_BUF_ERROR if there was not enough room in the output
- buffer, or Z_DATA_ERROR if the input data was corrupted or incomplete.
+ buffer, or Z_DATA_ERROR if the input data was corrupted or incomplete. In
+ the case where there is not enough room, uncompress() will fill the output
+ buffer with the uncompressed data up to that point.
*/
-
/* gzip file access functions */
/*
@@ -1162,7 +1204,7 @@ ZEXTERN int ZEXPORT uncompress OF((Bytef *dest, uLongf *destLen,
wrapper, documented in RFC 1952, wrapped around a deflate stream.
*/
-typedef voidp gzFile; /* opaque gzip file descriptor */
+typedef struct gzFile_s *gzFile; /* semi-opaque gzip file descriptor */
/*
ZEXTERN gzFile ZEXPORT gzopen OF((const char *path, const char *mode));
@@ -1172,13 +1214,28 @@ ZEXTERN gzFile ZEXPORT gzopen OF((const char *path, const char *mode));
a strategy: 'f' for filtered data as in "wb6f", 'h' for Huffman-only
compression as in "wb1h", 'R' for run-length encoding as in "wb1R", or 'F'
for fixed code compression as in "wb9F". (See the description of
- deflateInit2 for more information about the strategy parameter.) Also "a"
- can be used instead of "w" to request that the gzip stream that will be
- written be appended to the file. "+" will result in an error, since reading
- and writing to the same gzip file is not supported.
+ deflateInit2 for more information about the strategy parameter.) 'T' will
+ request transparent writing or appending with no compression and not using
+ the gzip format.
+
+ "a" can be used instead of "w" to request that the gzip stream that will
+ be written be appended to the file. "+" will result in an error, since
+ reading and writing to the same gzip file is not supported. The addition of
+ "x" when writing will create the file exclusively, which fails if the file
+ already exists. On systems that support it, the addition of "e" when
+ reading or writing will set the flag to close the file on an execve() call.
+
+ These functions, as well as gzip, will read and decode a sequence of gzip
+ streams in a file. The append function of gzopen() can be used to create
+ such a file. (Also see gzflush() for another way to do this.) When
+ appending, gzopen does not test whether the file begins with a gzip stream,
+ nor does it look for the end of the gzip streams to begin appending. gzopen
+ will simply append a gzip stream to the existing file.
gzopen can be used to read a file which is not in gzip format; in this
- case gzread will directly read from the file without decompression.
+ case gzread will directly read from the file without decompression. When
+ reading, this will be detected automatically by looking for the magic two-
+ byte gzip header.
gzopen returns NULL if the file could not be opened, if there was
insufficient memory to allocate the gzFile state, or if an invalid mode was
@@ -1197,7 +1254,11 @@ ZEXTERN gzFile ZEXPORT gzdopen OF((int fd, const char *mode));
descriptor fd, just like fclose(fdopen(fd, mode)) closes the file descriptor
fd. If you want to keep fd open, use fd = dup(fd_keep); gz = gzdopen(fd,
mode);. The duplicated descriptor should be saved to avoid a leak, since
- gzdopen does not close fd if it fails.
+ gzdopen does not close fd if it fails. If you are using fileno() to get the
+ file descriptor from a FILE *, then you will have to use dup() to avoid
+ double-close()ing the file descriptor. Both gzclose() and fclose() will
+ close the associated file descriptor, so they need to have different file
+ descriptors.
gzdopen returns NULL if there was insufficient memory to allocate the
gzFile state, if an invalid mode was specified (an 'r', 'w', or 'a' was not
@@ -1235,14 +1296,26 @@ ZEXTERN int ZEXPORT gzsetparams OF((gzFile file, int level, int strategy));
ZEXTERN int ZEXPORT gzread OF((gzFile file, voidp buf, unsigned len));
/*
Reads the given number of uncompressed bytes from the compressed file. If
- the input file was not in gzip format, gzread copies the given number of
- bytes into the buffer.
+ the input file is not in gzip format, gzread copies the given number of
+ bytes into the buffer directly from the file.
After reaching the end of a gzip stream in the input, gzread will continue
- to read, looking for another gzip stream, or failing that, reading the rest
- of the input file directly without decompression. The entire input file
- will be read if gzread is called until it returns less than the requested
- len.
+ to read, looking for another gzip stream. Any number of gzip streams may be
+ concatenated in the input file, and will all be decompressed by gzread().
+ If something other than a gzip stream is encountered after a gzip stream,
+ that remaining trailing garbage is ignored (and no error is returned).
+
+ gzread can be used to read a gzip file that is being concurrently written.
+ Upon reaching the end of the input, gzread will return with the available
+ data. If the error code returned by gzerror is Z_OK or Z_BUF_ERROR, then
+ gzclearerr can be used to clear the end of file indicator in order to permit
+ gzread to be tried again. Z_OK indicates that a gzip stream was completed
+ on the last gzread. Z_BUF_ERROR indicates that the input file ended in the
+ middle of a gzip stream. Note that gzread does not return -1 in the event
+ of an incomplete gzip stream. This error is deferred until gzclose(), which
+ will return Z_BUF_ERROR if the last gzread ended in the middle of a gzip
+ stream. Alternatively, gzerror can be used before gzclose to detect this
+ case.
gzread returns the number of uncompressed bytes actually read, less than
len for end of file, or -1 for error.
@@ -1256,7 +1329,7 @@ ZEXTERN int ZEXPORT gzwrite OF((gzFile file,
error.
*/
-ZEXTERN int ZEXPORTVA gzprintf OF((gzFile file, const char *format, ...));
+ZEXTERN int ZEXPORTVA gzprintf Z_ARG((gzFile file, const char *format, ...));
/*
Converts, formats, and writes the arguments to the compressed file under
control of the format string, as in fprintf. gzprintf returns the number of
@@ -1301,7 +1374,10 @@ ZEXTERN int ZEXPORT gzputc OF((gzFile file, int c));
ZEXTERN int ZEXPORT gzgetc OF((gzFile file));
/*
Reads one byte from the compressed file. gzgetc returns this byte or -1
- in case of end of file or error.
+ in case of end of file or error. This is implemented as a macro for speed.
+ As such, it does not do all of the checking the other functions do. I.e.
+ it does not check to see if file is NULL, nor whether the structure file
+ points to has been clobbered or not.
*/
ZEXTERN int ZEXPORT gzungetc OF((int c, gzFile file));
@@ -1397,9 +1473,7 @@ ZEXTERN int ZEXPORT gzeof OF((gzFile file));
ZEXTERN int ZEXPORT gzdirect OF((gzFile file));
/*
Returns true (1) if file is being copied directly while reading, or false
- (0) if file is a gzip stream being decompressed. This state can change from
- false to true while reading the input file if the end of a gzip stream is
- reached, but is followed by data that is not another gzip stream.
+ (0) if file is a gzip stream being decompressed.
If the input file is empty, gzdirect() will return true, since the input
does not contain a gzip stream.
@@ -1408,6 +1482,13 @@ ZEXTERN int ZEXPORT gzdirect OF((gzFile file));
cause buffers to be allocated to allow reading the file to determine if it
is a gzip file. Therefore if gzbuffer() is used, it should be called before
gzdirect().
+
+ When writing, gzdirect() returns true (1) if transparent writing was
+ requested ("wT" for the gzopen() mode), or false (0) otherwise. (Note:
+ gzdirect() is not needed when writing. Transparent writing must be
+ explicitly requested, so the application already knows the answer. When
+ linking statically, using gzdirect() will include all of the zlib code for
+ gzip file reading and decompression, which may not be desired.)
*/
ZEXTERN int ZEXPORT gzclose OF((gzFile file));
@@ -1419,7 +1500,8 @@ ZEXTERN int ZEXPORT gzclose OF((gzFile file));
must not be called more than once on the same allocation.
gzclose will return Z_STREAM_ERROR if file is not valid, Z_ERRNO on a
- file operation error, or Z_OK on success.
+ file operation error, Z_MEM_ERROR if out of memory, Z_BUF_ERROR if the
+ last read ended in the middle of a gzip stream, or Z_OK on success.
*/
ZEXTERN int ZEXPORT gzclose_r OF((gzFile file));
@@ -1457,6 +1539,7 @@ ZEXTERN void ZEXPORT gzclearerr OF((gzFile file));
file that is being written concurrently.
*/
+#endif /* !Z_SOLO */
/* checksum functions */
@@ -1492,16 +1575,17 @@ ZEXTERN uLong ZEXPORT adler32_combine OF((uLong adler1, uLong adler2,
Combine two Adler-32 checksums into one. For two sequences of bytes, seq1
and seq2 with lengths len1 and len2, Adler-32 checksums were calculated for
each, adler1 and adler2. adler32_combine() returns the Adler-32 checksum of
- seq1 and seq2 concatenated, requiring only adler1, adler2, and len2.
+ seq1 and seq2 concatenated, requiring only adler1, adler2, and len2. Note
+ that the z_off_t type (like off_t) is a signed integer. If len2 is
+ negative, the result has no meaning or utility.
*/
ZEXTERN uLong ZEXPORT crc32 OF((uLong crc, const Bytef *buf, uInt len));
/*
Update a running CRC-32 with the bytes buf[0..len-1] and return the
updated CRC-32. If buf is Z_NULL, this function returns the required
- initial value for the for the crc. Pre- and post-conditioning (one's
- complement) is performed within this function so it shouldn't be done by the
- application.
+ initial value for the crc. Pre- and post-conditioning (one's complement) is
+ performed within this function so it shouldn't be done by the application.
Usage example:
@@ -1544,17 +1628,42 @@ ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits,
const char *version,
int stream_size));
#define deflateInit(strm, level) \
- deflateInit_((strm), (level), ZLIB_VERSION, sizeof(z_stream))
+ deflateInit_((strm), (level), ZLIB_VERSION, (int)sizeof(z_stream))
#define inflateInit(strm) \
- inflateInit_((strm), ZLIB_VERSION, sizeof(z_stream))
+ inflateInit_((strm), ZLIB_VERSION, (int)sizeof(z_stream))
#define deflateInit2(strm, level, method, windowBits, memLevel, strategy) \
deflateInit2_((strm),(level),(method),(windowBits),(memLevel),\
- (strategy), ZLIB_VERSION, sizeof(z_stream))
+ (strategy), ZLIB_VERSION, (int)sizeof(z_stream))
#define inflateInit2(strm, windowBits) \
- inflateInit2_((strm), (windowBits), ZLIB_VERSION, sizeof(z_stream))
+ inflateInit2_((strm), (windowBits), ZLIB_VERSION, \
+ (int)sizeof(z_stream))
#define inflateBackInit(strm, windowBits, window) \
inflateBackInit_((strm), (windowBits), (window), \
- ZLIB_VERSION, sizeof(z_stream))
+ ZLIB_VERSION, (int)sizeof(z_stream))
+
+#ifndef Z_SOLO
+
+/* gzgetc() macro and its supporting function and exposed data structure. Note
+ * that the real internal state is much larger than the exposed structure.
+ * This abbreviated structure exposes just enough for the gzgetc() macro. The
+ * user should not mess with these exposed elements, since their names or
+ * behavior could change in the future, perhaps even capriciously. They can
+ * only be used by the gzgetc() macro. You have been warned.
+ */
+struct gzFile_s {
+ unsigned have;
+ unsigned char *next;
+ z_off64_t pos;
+};
+ZEXTERN int ZEXPORT gzgetc_ OF((gzFile file)); /* backward compatibility */
+#ifdef Z_PREFIX_SET
+# undef z_gzgetc
+# define z_gzgetc(g) \
+ ((g)->have ? ((g)->have--, (g)->pos++, *((g)->next)++) : gzgetc(g))
+#else
+# define gzgetc(g) \
+ ((g)->have ? ((g)->have--, (g)->pos++, *((g)->next)++) : gzgetc(g))
+#endif
/* provide 64-bit offset functions if _LARGEFILE64_SOURCE defined, and/or
* change the regular functions to 64 bits if _FILE_OFFSET_BITS is 64 (if
@@ -1562,7 +1671,7 @@ ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits,
* functions are changed to 64 bits) -- in case these are set on systems
* without large file support, _LFS64_LARGEFILE must also be true
*/
-#if defined(_LARGEFILE64_SOURCE) && _LFS64_LARGEFILE-0
+#ifdef Z_LARGE64
ZEXTERN gzFile ZEXPORT gzopen64 OF((const char *, const char *));
ZEXTERN z_off64_t ZEXPORT gzseek64 OF((gzFile, z_off64_t, int));
ZEXTERN z_off64_t ZEXPORT gztell64 OF((gzFile));
@@ -1571,14 +1680,23 @@ ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits,
ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off64_t));
#endif
-#if !defined(ZLIB_INTERNAL) && _FILE_OFFSET_BITS-0 == 64 && _LFS64_LARGEFILE-0
-# define gzopen gzopen64
-# define gzseek gzseek64
-# define gztell gztell64
-# define gzoffset gzoffset64
-# define adler32_combine adler32_combine64
-# define crc32_combine crc32_combine64
-# ifdef _LARGEFILE64_SOURCE
+#if !defined(ZLIB_INTERNAL) && defined(Z_WANT64)
+# ifdef Z_PREFIX_SET
+# define z_gzopen z_gzopen64
+# define z_gzseek z_gzseek64
+# define z_gztell z_gztell64
+# define z_gzoffset z_gzoffset64
+# define z_adler32_combine z_adler32_combine64
+# define z_crc32_combine z_crc32_combine64
+# else
+# define gzopen gzopen64
+# define gzseek gzseek64
+# define gztell gztell64
+# define gzoffset gzoffset64
+# define adler32_combine adler32_combine64
+# define crc32_combine crc32_combine64
+# endif
+# ifndef Z_LARGE64
ZEXTERN gzFile ZEXPORT gzopen64 OF((const char *, const char *));
ZEXTERN z_off_t ZEXPORT gzseek64 OF((gzFile, z_off_t, int));
ZEXTERN z_off_t ZEXPORT gztell64 OF((gzFile));
@@ -1595,6 +1713,13 @@ ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits,
ZEXTERN uLong ZEXPORT crc32_combine OF((uLong, uLong, z_off_t));
#endif
+#else /* Z_SOLO */
+
+ ZEXTERN uLong ZEXPORT adler32_combine OF((uLong, uLong, z_off_t));
+ ZEXTERN uLong ZEXPORT crc32_combine OF((uLong, uLong, z_off_t));
+
+#endif /* !Z_SOLO */
+
/* hack for buggy compilers */
#if !defined(ZUTIL_H) && !defined(NO_DUMMY_DECL)
struct internal_state {int dummy;};
@@ -1603,8 +1728,14 @@ ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits,
/* undocumented functions */
ZEXTERN const char * ZEXPORT zError OF((int));
ZEXTERN int ZEXPORT inflateSyncPoint OF((z_streamp));
-ZEXTERN const uLongf * ZEXPORT get_crc_table OF((void));
+ZEXTERN const z_crc_t FAR * ZEXPORT get_crc_table OF((void));
ZEXTERN int ZEXPORT inflateUndermine OF((z_streamp, int));
+ZEXTERN int ZEXPORT inflateResetKeep OF((z_streamp));
+ZEXTERN int ZEXPORT deflateResetKeep OF((z_streamp));
+#if defined(_WIN32) && !defined(Z_SOLO)
+ZEXTERN gzFile ZEXPORT gzopen_w OF((const wchar_t *path,
+ const char *mode));
+#endif
#ifdef __cplusplus
}
diff --git a/compat/zlib/zlib.map b/compat/zlib/zlib.map
index f282d36..771f420 100644
--- a/compat/zlib/zlib.map
+++ b/compat/zlib/zlib.map
@@ -66,3 +66,13 @@ ZLIB_1.2.3.5 {
gzclose_r;
gzclose_w;
} ZLIB_1.2.3.4;
+
+ZLIB_1.2.5.1 {
+ deflatePending;
+} ZLIB_1.2.3.5;
+
+ZLIB_1.2.5.2 {
+ deflateResetKeep;
+ gzgetc_;
+ inflateResetKeep;
+} ZLIB_1.2.5.1;
diff --git a/compat/zlib/zlib.pc.cmakein b/compat/zlib/zlib.pc.cmakein
new file mode 100644
index 0000000..a5e6429
--- /dev/null
+++ b/compat/zlib/zlib.pc.cmakein
@@ -0,0 +1,13 @@
+prefix=@CMAKE_INSTALL_PREFIX@
+exec_prefix=@CMAKE_INSTALL_PREFIX@
+libdir=@INSTALL_LIB_DIR@
+sharedlibdir=@INSTALL_LIB_DIR@
+includedir=@INSTALL_INC_DIR@
+
+Name: zlib
+Description: zlib compression library
+Version: @VERSION@
+
+Requires:
+Libs: -L${libdir} -L${sharedlibdir} -lz
+Cflags: -I${includedir}
diff --git a/compat/zlib/zutil.c b/compat/zlib/zutil.c
index 7a55c44..65e0d3b 100644
--- a/compat/zlib/zutil.c
+++ b/compat/zlib/zutil.c
@@ -1,11 +1,14 @@
/* zutil.c -- target dependent utility functions for the compression library
- * Copyright (C) 1995-2005, 2010 Jean-loup Gailly.
+ * Copyright (C) 1995-2005, 2010, 2011, 2012 Jean-loup Gailly.
* For conditions of distribution and use, see copyright notice in zlib.h
*/
-/* @(#) $Id: zutil.c,v 1.3 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
#include "zutil.h"
+#ifndef Z_SOLO
+# include "gzguts.h"
+#endif
#ifndef NO_DUMMY_DECL
struct internal_state {int dummy;}; /* for buggy compilers */
@@ -85,27 +88,27 @@ uLong ZEXPORT zlibCompileFlags()
#ifdef FASTEST
flags += 1L << 21;
#endif
-#ifdef STDC
+#if defined(STDC) || defined(Z_HAVE_STDARG_H)
# ifdef NO_vsnprintf
- flags += 1L << 25;
+ flags += 1L << 25;
# ifdef HAS_vsprintf_void
- flags += 1L << 26;
+ flags += 1L << 26;
# endif
# else
# ifdef HAS_vsnprintf_void
- flags += 1L << 26;
+ flags += 1L << 26;
# endif
# endif
#else
- flags += 1L << 24;
+ flags += 1L << 24;
# ifdef NO_snprintf
- flags += 1L << 25;
+ flags += 1L << 25;
# ifdef HAS_sprintf_void
- flags += 1L << 26;
+ flags += 1L << 26;
# endif
# else
# ifdef HAS_snprintf_void
- flags += 1L << 26;
+ flags += 1L << 26;
# endif
# endif
#endif
@@ -181,6 +184,7 @@ void ZLIB_INTERNAL zmemzero(dest, len)
}
#endif
+#ifndef Z_SOLO
#ifdef SYS16BIT
@@ -316,3 +320,5 @@ void ZLIB_INTERNAL zcfree (opaque, ptr)
}
#endif /* MY_ZCALLOC */
+
+#endif /* !Z_SOLO */
diff --git a/compat/zlib/zutil.h b/compat/zlib/zutil.h
index 51a43fb..4e3dcc6 100644
--- a/compat/zlib/zutil.h
+++ b/compat/zlib/zutil.h
@@ -1,5 +1,5 @@
/* zutil.h -- internal interface and configuration of the compression library
- * Copyright (C) 1995-2010 Jean-loup Gailly.
+ * Copyright (C) 1995-2012 Jean-loup Gailly.
* For conditions of distribution and use, see copyright notice in zlib.h
*/
@@ -8,12 +8,12 @@
subject to change. Applications should only use zlib.h.
*/
-/* @(#) $Id: zutil.h,v 1.3 2010/04/20 14:50:10 nijtmans Exp $ */
+/* @(#) $Id$ */
#ifndef ZUTIL_H
#define ZUTIL_H
-#if ((__GNUC__-0) * 10 + __GNUC_MINOR__-0 >= 33) && !defined(NO_VIZ)
+#ifdef HAVE_HIDDEN
# define ZLIB_INTERNAL __attribute__((visibility ("hidden")))
#else
# define ZLIB_INTERNAL
@@ -21,7 +21,7 @@
#include "zlib.h"
-#ifdef STDC
+#if defined(STDC) && !defined(Z_SOLO)
# if !(defined(_WIN32_WCE) && defined(_MSC_VER))
# include <stddef.h>
# endif
@@ -29,6 +29,10 @@
# include <stdlib.h>
#endif
+#ifdef Z_SOLO
+ typedef long ptrdiff_t; /* guess -- will be caught if guess is wrong */
+#endif
+
#ifndef local
# define local static
#endif
@@ -78,16 +82,18 @@ extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */
#if defined(MSDOS) || (defined(WINDOWS) && !defined(WIN32))
# define OS_CODE 0x00
-# if defined(__TURBOC__) || defined(__BORLANDC__)
-# if (__STDC__ == 1) && (defined(__LARGE__) || defined(__COMPACT__))
- /* Allow compilation with ANSI keywords only enabled */
- void _Cdecl farfree( void *block );
- void *_Cdecl farmalloc( unsigned long nbytes );
-# else
-# include <alloc.h>
+# ifndef Z_SOLO
+# if defined(__TURBOC__) || defined(__BORLANDC__)
+# if (__STDC__ == 1) && (defined(__LARGE__) || defined(__COMPACT__))
+ /* Allow compilation with ANSI keywords only enabled */
+ void _Cdecl farfree( void *block );
+ void *_Cdecl farmalloc( unsigned long nbytes );
+# else
+# include <alloc.h>
+# endif
+# else /* MSC or DJGPP */
+# include <malloc.h>
# endif
-# else /* MSC or DJGPP */
-# include <malloc.h>
# endif
#endif
@@ -107,18 +113,20 @@ extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */
#ifdef OS2
# define OS_CODE 0x06
-# ifdef M_I86
+# if defined(M_I86) && !defined(Z_SOLO)
# include <malloc.h>
# endif
#endif
#if defined(MACOS) || defined(TARGET_OS_MAC)
# define OS_CODE 0x07
-# if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os
-# include <unix.h> /* for fdopen */
-# else
-# ifndef fdopen
-# define fdopen(fd,mode) NULL /* No fdopen() */
+# ifndef Z_SOLO
+# if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os
+# include <unix.h> /* for fdopen */
+# else
+# ifndef fdopen
+# define fdopen(fd,mode) NULL /* No fdopen() */
+# endif
# endif
# endif
#endif
@@ -153,14 +161,14 @@ extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */
# endif
#endif
-#if defined(__BORLANDC__)
+#if defined(__BORLANDC__) && !defined(MSDOS)
#pragma warn -8004
#pragma warn -8008
#pragma warn -8066
#endif
/* provide prototypes for these when building zlib without LFS */
-#if !defined(_LARGEFILE64_SOURCE) || _LFS64_LARGEFILE-0 == 0
+#if !defined(_WIN32) && (!defined(_LARGEFILE64_SOURCE) || _LFS64_LARGEFILE-0 == 0)
ZEXTERN uLong ZEXPORT adler32_combine64 OF((uLong, uLong, z_off_t));
ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off_t));
#endif
@@ -177,42 +185,7 @@ extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */
/* functions */
-#if defined(STDC99) || (defined(__TURBOC__) && __TURBOC__ >= 0x550)
-# ifndef HAVE_VSNPRINTF
-# define HAVE_VSNPRINTF
-# endif
-#endif
-#if defined(__CYGWIN__)
-# ifndef HAVE_VSNPRINTF
-# define HAVE_VSNPRINTF
-# endif
-#endif
-#ifndef HAVE_VSNPRINTF
-# ifdef MSDOS
- /* vsnprintf may exist on some MS-DOS compilers (DJGPP?),
- but for now we just assume it doesn't. */
-# define NO_vsnprintf
-# endif
-# ifdef __TURBOC__
-# define NO_vsnprintf
-# endif
-# ifdef WIN32
- /* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */
-# if !defined(vsnprintf) && !defined(NO_vsnprintf)
-# if !defined(_MSC_VER) || ( defined(_MSC_VER) && _MSC_VER < 1500 )
-# define vsnprintf _vsnprintf
-# endif
-# endif
-# endif
-# ifdef __SASC
-# define NO_vsnprintf
-# endif
-#endif
-#ifdef VMS
-# define NO_vsnprintf
-#endif
-
-#if defined(pyr)
+#if defined(pyr) || defined(Z_SOLO)
# define NO_MEMCPY
#endif
#if defined(SMALL_MEDIUM) && !defined(_MSC_VER) && !defined(__SC__)
@@ -261,14 +234,19 @@ extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */
# define Tracecv(c,x)
#endif
-
-voidpf ZLIB_INTERNAL zcalloc OF((voidpf opaque, unsigned items,
- unsigned size));
-void ZLIB_INTERNAL zcfree OF((voidpf opaque, voidpf ptr));
+#ifndef Z_SOLO
+ voidpf ZLIB_INTERNAL zcalloc OF((voidpf opaque, unsigned items,
+ unsigned size));
+ void ZLIB_INTERNAL zcfree OF((voidpf opaque, voidpf ptr));
+#endif
#define ZALLOC(strm, items, size) \
(*((strm)->zalloc))((strm)->opaque, (items), (size))
#define ZFREE(strm, addr) (*((strm)->zfree))((strm)->opaque, (voidpf)(addr))
#define TRY_FREE(s, p) {if (p) ZFREE(s, p);}
+/* Reverse the bytes in a 32-bit value */
+#define ZSWAP32(q) ((((q) >> 24) & 0xff) + (((q) >> 8) & 0xff00) + \
+ (((q) & 0xff00) << 8) + (((q) & 0xff) << 24))
+
#endif /* ZUTIL_H */
diff --git a/doc/Access.3 b/doc/Access.3
index 6ee1f26..1e82e07 100644
--- a/doc/Access.3
+++ b/doc/Access.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Access.3,v 1.10 2008/12/18 21:23:47 dkf Exp $
-'\"
.so man.macros
.TH Tcl_Access 3 8.1 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3
index 783a1e0..b9c6a63 100644
--- a/doc/AddErrInfo.3
+++ b/doc/AddErrInfo.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: AddErrInfo.3,v 1.26 2010/01/14 11:47:07 dkf Exp $
-'\"
.so man.macros
.TH Tcl_AddErrorInfo 3 8.5 Tcl "Tcl Library Procedures"
.BS
@@ -109,7 +107,12 @@ with the value of \fIcode\fR. The \fB(Tcl_Obj *)\fR returned
by \fBTcl_GetReturnOptions\fR points to an unshared
\fBTcl_Obj\fR with reference count of zero. The dictionary
may be written to, either adding, removing, or overwriting
-any entries in it, with the need to check for a shared object.
+any entries in it, without the need to check for a shared value.
+As with any \fBTcl_Obj\fR with reference count of zero, it is up to
+the caller to arrange for its disposal with \fBTcl_DecrRefCount\fR or
+to a reference to it via \fBTcl_IncrRefCount\fR (or one of the many
+functions that call that, notably including \fBTcl_SetObjResult\fR and
+\fBTcl_SetVar2Ex\fR).
.PP
A typical usage for \fBTcl_GetReturnOptions\fR is to
retrieve the stack trace when script evaluation returns
@@ -125,6 +128,7 @@ if (code == TCL_ERROR) {
Tcl_DictObjGet(NULL, options, key, &stackTrace);
Tcl_DecrRefCount(key);
/* Do something with stackTrace */
+ Tcl_DecrRefCount(options);
}
.CE
.PP
@@ -228,7 +232,7 @@ the need for a null byte. If the \fBTcl_AddObjErrorInfo\fR
interface is used at all, it should be with a negative \fIlength\fR value.
.PP
The procedure \fBTcl_SetObjErrorCode\fR is used to set the
-\fB\-errorcode\fR return option to the list object \fIerrorObjPtr\fR
+\fB\-errorcode\fR return option to the list value \fIerrorObjPtr\fR
built up by the caller.
\fBTcl_SetObjErrorCode\fR is typically invoked just
before returning an error. If an error is
@@ -238,7 +242,7 @@ the \fB\-errorcode\fR return option to \fBNONE\fR.
.PP
The procedure \fBTcl_SetErrorCode\fR is also used to set the
\fB\-errorcode\fR return option. However, it takes one or more strings to
-record instead of an object. Otherwise, it is similar to
+record instead of a value. Otherwise, it is similar to
\fBTcl_SetObjErrorCode\fR in behavior.
.PP
\fBTcl_SetErrorCodeVA\fR is the same as \fBTcl_SetErrorCode\fR except that
@@ -305,4 +309,4 @@ most recent error seen in an interpreter.
Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_Interp(3), Tcl_ResetResult(3),
Tcl_SetErrno(3), tclvars(n)
.SH KEYWORDS
-error, object, object result, stack, trace, variable
+error, value, value result, stack, trace, variable
diff --git a/doc/Alloc.3 b/doc/Alloc.3
index 3204026..ca4f949 100644
--- a/doc/Alloc.3
+++ b/doc/Alloc.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Alloc.3,v 1.11 2009/03/30 18:49:12 dgp Exp $
-'\"
.so man.macros
.TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/AllowExc.3 b/doc/AllowExc.3
index 4e6be72..ae595f1 100644
--- a/doc/AllowExc.3
+++ b/doc/AllowExc.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: AllowExc.3,v 1.5 2004/10/07 14:44:31 dkf Exp $
-'\"
.so man.macros
.TH Tcl_AllowExceptions 3 7.4 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/AppInit.3 b/doc/AppInit.3
index bd3c665..e4ae971 100644
--- a/doc/AppInit.3
+++ b/doc/AppInit.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: AppInit.3,v 1.11 2008/12/15 15:48:33 dgp Exp $
-'\"
.so man.macros
.TH Tcl_AppInit 3 7.0 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/AssocData.3 b/doc/AssocData.3
index 6366cdf..59c26a4 100644
--- a/doc/AssocData.3
+++ b/doc/AssocData.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\"
-'\" RCS: @(#) $Id: AssocData.3,v 1.9 2008/10/15 10:43:37 dkf Exp $
.so man.macros
.TH Tcl_SetAssocData 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Async.3 b/doc/Async.3
index dba4400..d02f76d 100644
--- a/doc/Async.3
+++ b/doc/Async.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Async.3,v 1.14 2008/10/15 10:43:37 dkf Exp $
-'\"
.so man.macros
.TH Tcl_AsyncCreate 3 7.0 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/BackgdErr.3 b/doc/BackgdErr.3
index ba53dc6..3116671 100644
--- a/doc/BackgdErr.3
+++ b/doc/BackgdErr.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: BackgdErr.3,v 1.9 2008/12/09 20:16:29 dgp Exp $
-'\"
.so man.macros
.TH Tcl_BackgroundError 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Backslash.3 b/doc/Backslash.3
index e48bcce..8b399fc 100644
--- a/doc/Backslash.3
+++ b/doc/Backslash.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Backslash.3,v 1.10 2007/12/13 15:22:30 dgp Exp $
-'\"
.so man.macros
.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/BoolObj.3 b/doc/BoolObj.3
index e8563d3..6691140 100644
--- a/doc/BoolObj.3
+++ b/doc/BoolObj.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: BoolObj.3,v 1.12 2009/11/27 14:35:10 dkf Exp $
-'\"
.so man.macros
.TH Tcl_BooleanObj 3 8.5 Tcl "Tcl Library Procedures"
.BS
@@ -32,7 +30,7 @@ Points to the Tcl_Obj in which to store, or from which to
retrieve a boolean value.
.AP Tcl_Interp *interp in/out
If a boolean value cannot be retrieved,
-an error message is left in the interpreter's result object
+an error message is left in the interpreter's result value
unless \fIinterp\fR is NULL.
.AP int *boolPtr out
Points to place where \fBTcl_GetBooleanFromObj\fR
@@ -94,4 +92,4 @@ a \fBTCL_ERROR\fR return.
Tcl_NewObj, Tcl_IsShared, Tcl_GetBoolean
.SH KEYWORDS
-boolean, object
+boolean, value
diff --git a/doc/ByteArrObj.3 b/doc/ByteArrObj.3
index 6d0822d..2921f68 100644
--- a/doc/ByteArrObj.3
+++ b/doc/ByteArrObj.3
@@ -4,13 +4,11 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: ByteArrObj.3,v 1.7 2008/11/07 20:10:19 patthoyts Exp $
-'\"
.so man.macros
.TH Tcl_ByteArrayObj 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetByteArrayFromObj, Tcl_SetByteArrayLength \- manipulate Tcl objects as a arrays of bytes
+Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetByteArrayFromObj, Tcl_SetByteArrayLength \- manipulate Tcl values as a arrays of bytes
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -29,65 +27,65 @@ unsigned char *
.SH ARGUMENTS
.AS "const unsigned char" *lengthPtr in/out
.AP "const unsigned char" *bytes in
-The array of bytes used to initialize or set a byte-array object. May be NULL
+The array of bytes used to initialize or set a byte-array value. May be NULL
even if \fIlength\fR is non-zero.
.AP int length in
The length of the array of bytes. It must be >= 0.
.AP Tcl_Obj *objPtr in/out
-For \fBTcl_SetByteArrayObj\fR, this points to the object to be converted to
+For \fBTcl_SetByteArrayObj\fR, this points to the value to be converted to
byte-array type. For \fBTcl_GetByteArrayFromObj\fR and
-\fBTcl_SetByteArrayLength\fR, this points to the object from which to get
+\fBTcl_SetByteArrayLength\fR, this points to the value from which to get
the byte-array value; if \fIobjPtr\fR does not already point to a byte-array
-object, it will be converted to one.
+value, it will be converted to one.
.AP int *lengthPtr out
-If non-NULL, filled with the length of the array of bytes in the object.
+If non-NULL, filled with the length of the array of bytes in the value.
.BE
.SH DESCRIPTION
.PP
-These procedures are used to create, modify, and read Tcl byte-array objects
-from C code. Byte-array objects are typically used to hold the
+These procedures are used to create, modify, and read Tcl byte-array values
+from C code. Byte-array values are typically used to hold the
results of binary IO operations or data structures created with the
\fBbinary\fR command. In Tcl, an array of bytes is not equivalent to a
string. Conceptually, a string is an array of Unicode characters, while a
byte-array is an array of 8-bit quantities with no implicit meaning.
Accessor functions are provided to get the string representation of a
-byte-array or to convert an arbitrary object to a byte-array. Obtaining the
-string representation of a byte-array object (by calling
+byte-array or to convert an arbitrary value to a byte-array. Obtaining the
+string representation of a byte-array value (by calling
\fBTcl_GetStringFromObj\fR) produces a properly formed UTF-8 sequence with a
one-to-one mapping between the bytes in the internal representation and the
UTF-8 characters in the string representation.
.PP
\fBTcl_NewByteArrayObj\fR and \fBTcl_SetByteArrayObj\fR will
-create a new object of byte-array type or modify an existing object to have a
-byte-array type. Both of these procedures set the object's type to be
-byte-array and set the object's internal representation to a copy of the
+create a new value of byte-array type or modify an existing value to have a
+byte-array type. Both of these procedures set the value's type to be
+byte-array and set the value's internal representation to a copy of the
array of bytes given by \fIbytes\fR. \fBTcl_NewByteArrayObj\fR returns a
-pointer to a newly allocated object with a reference count of zero.
+pointer to a newly allocated value with a reference count of zero.
\fBTcl_SetByteArrayObj\fR invalidates any old string representation and, if
-the object is not already a byte-array object, frees any old internal
+the value is not already a byte-array value, frees any old internal
representation. If \fIbytes\fR is NULL then the new byte array contains
arbitrary values.
.PP
-\fBTcl_GetByteArrayFromObj\fR converts a Tcl object to byte-array type and
-returns a pointer to the object's new internal representation as an array of
+\fBTcl_GetByteArrayFromObj\fR converts a Tcl value to byte-array type and
+returns a pointer to the value's new internal representation as an array of
bytes. The length of this array is stored in \fIlengthPtr\fR if
\fIlengthPtr\fR is non-NULL. The storage for the array of bytes is owned by
-the object and should not be freed. The contents of the array may be
-modified by the caller only if the object is not shared and the caller
+the value and should not be freed. The contents of the array may be
+modified by the caller only if the value is not shared and the caller
invalidates the string representation.
.PP
-\fBTcl_SetByteArrayLength\fR converts the Tcl object to byte-array type
-and changes the length of the object's internal representation as an
+\fBTcl_SetByteArrayLength\fR converts the Tcl value to byte-array type
+and changes the length of the value's internal representation as an
array of bytes. If \fIlength\fR is greater than the space currently
allocated for the array, the array is reallocated to the new length; the
newly allocated bytes at the end of the array have arbitrary values. If
\fIlength\fR is less than the space currently allocated for the array,
the length of array is reduced to the new length. The return value is a
-pointer to the object's new array of bytes.
+pointer to the value's new array of bytes.
.SH "SEE ALSO"
Tcl_GetStringFromObj, Tcl_NewObj, Tcl_IncrRefCount, Tcl_DecrRefCount
.SH KEYWORDS
-object, byte array, utf, unicode, internationalization
+value, binary data, byte array, utf, unicode, internationalization
diff --git a/doc/CallDel.3 b/doc/CallDel.3
index 0dbed27..dec4392 100644
--- a/doc/CallDel.3
+++ b/doc/CallDel.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CallDel.3,v 1.8 2008/10/15 10:43:37 dkf Exp $
-'\"
.so man.macros
.TH Tcl_CallWhenDeleted 3 7.0 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Cancel.3 b/doc/Cancel.3
index 506b0fe..80db3a3 100644
--- a/doc/Cancel.3
+++ b/doc/Cancel.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Cancel.3,v 1.2 2009/11/02 00:04:48 mistachkin Exp $
-'\"
.so man.macros
.TH Tcl_Cancel 3 8.6 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/ChnlStack.3 b/doc/ChnlStack.3
index be22a88..9ec38b4 100644
--- a/doc/ChnlStack.3
+++ b/doc/ChnlStack.3
@@ -3,8 +3,6 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
-'\" RCS: @(#) $Id: ChnlStack.3,v 1.9 2008/10/04 12:33:34 nijtmans Exp $
.so man.macros
.TH Tcl_StackChannel 3 8.3 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Class.3 b/doc/Class.3
index 0dea97f..28cea9b 100644
--- a/doc/Class.3
+++ b/doc/Class.3
@@ -4,14 +4,12 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Class.3,v 1.6 2010/06/16 14:49:51 nijtmans Exp $
-'\"
.so man.macros
.TH Tcl_Class 3 0.1 TclOO "TclOO Library Functions"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_ClassGetMetadata, Tcl_ClassSetMetadata, Tcl_CopyObjectInstance, Tcl_GetClassAsObject, Tcl_GetObjectAsClass, Tcl_GetObjectCommand, Tcl_GetObjectNamespace, Tcl_NewObjectInstance, Tcl_ObjectDeleted, Tcl_ObjectGetMetadata, Tcl_ObjectGetMethodNameMapper, Tcl_ObjectSetMetadata, Tcl_ObjectSetMethodNameMapper \- manipulate objects and classes
+Tcl_ClassGetMetadata, Tcl_ClassSetMetadata, Tcl_CopyObjectInstance, Tcl_GetClassAsObject, Tcl_GetObjectAsClass, Tcl_GetObjectCommand, Tcl_GetObjectFromObj, Tcl_GetObjectName, Tcl_GetObjectNamespace, Tcl_NewObjectInstance, Tcl_ObjectDeleted, Tcl_ObjectGetMetadata, Tcl_ObjectGetMethodNameMapper, Tcl_ObjectSetMetadata, Tcl_ObjectSetMethodNameMapper \- manipulate objects and classes
.SH SYNOPSIS
.nf
\fB#include <tclOO.h>\fR
@@ -127,7 +125,7 @@ any constructors.
Every object and every class may have arbitrary amounts of metadata attached
to it, which the object or class attaches no meaning to beyond what is
described in a Tcl_ObjectMetadataType structure instance. Metadata to be
-attached is described by the the type of the metadata (given in the
+attached is described by the type of the metadata (given in the
\fImetaTypePtr\fR argument) and an arbitrary pointer (the \fImetadata\fR
argument) that are given to \fBTcl_ObjectSetMetadata\fR and
\fBTcl_ClassSetMetadata\fR, and a particular piece of metadata can be
diff --git a/doc/CmdCmplt.3 b/doc/CmdCmplt.3
index 152655a..eeae039 100644
--- a/doc/CmdCmplt.3
+++ b/doc/CmdCmplt.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CmdCmplt.3,v 1.4 2004/10/07 15:15:35 dkf Exp $
-'\"
.so man.macros
.TH Tcl_CommandComplete 3 "" Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Concat.3 b/doc/Concat.3
index d4ba689..c38bf82 100644
--- a/doc/Concat.3
+++ b/doc/Concat.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Concat.3,v 1.9 2005/05/10 18:33:54 kennykb Exp $
-'\"
.so man.macros
.TH Tcl_Concat 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3
index d306d64..55a4024 100644
--- a/doc/CrtChannel.3
+++ b/doc/CrtChannel.3
@@ -4,8 +4,6 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
-'\" RCS: @(#) $Id: CrtChannel.3,v 1.46 2010/01/14 11:47:07 dkf Exp $
.so man.macros
.TH Tcl_CreateChannel 3 8.4 Tcl "Tcl Library Procedures"
.BS
@@ -213,7 +211,7 @@ call to \fBTcl_GetStdChannel\fR or a call to \fBTcl_SetStdChannel\fR
closing this standard channel will cause the next call to
\fBTcl_CreateChannel\fR to make the new channel the new standard
channel too. See \fBTcl_StandardChannels\fR for a general treatise
-about standard channels and the behaviour of the Tcl library with
+about standard channels and the behavior of the Tcl library with
regard to them.
.PP
\fBTcl_GetChannelInstanceData\fR returns the instance data associated with
@@ -848,7 +846,7 @@ the generic options error message string.
.PP
It always returns \fBTCL_ERROR\fR
.PP
-An error message is generated in \fIinterp\fR's result object to
+An error message is generated in \fIinterp\fR's result value to
indicate that a command was invoked with a bad option.
The message has the form
.CS
diff --git a/doc/CrtChnlHdlr.3 b/doc/CrtChnlHdlr.3
index 08f419e..1451e30 100644
--- a/doc/CrtChnlHdlr.3
+++ b/doc/CrtChnlHdlr.3
@@ -4,7 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtChnlHdlr.3,v 1.8 2008/10/17 10:22:25 dkf Exp $
.so man.macros
.TH Tcl_CreateChannelHandler 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/CrtCloseHdlr.3 b/doc/CrtCloseHdlr.3
index 4fe6c5c..a114f9c 100644
--- a/doc/CrtCloseHdlr.3
+++ b/doc/CrtCloseHdlr.3
@@ -4,7 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtCloseHdlr.3,v 1.4 2008/06/29 22:28:23 dkf Exp $
.so man.macros
.TH Tcl_CreateCloseHandler 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/CrtCommand.3 b/doc/CrtCommand.3
index 4e8daaf..c921999 100644
--- a/doc/CrtCommand.3
+++ b/doc/CrtCommand.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtCommand.3,v 1.17 2008/12/15 18:33:25 dgp Exp $
-'\"
.so man.macros
.TH Tcl_CreateCommand 3 "" Tcl "Tcl Library Procedures"
.BS
@@ -43,18 +41,18 @@ will call \fIproc\fR to process the command.
It differs from \fBTcl_CreateObjCommand\fR in that a new string-based
command is defined;
that is, a command procedure is defined that takes an array of
-argument strings instead of objects.
-The object-based command procedures registered by \fBTcl_CreateObjCommand\fR
+argument strings instead of values.
+The value-based command procedures registered by \fBTcl_CreateObjCommand\fR
can execute significantly faster than the string-based command procedures
defined by \fBTcl_CreateCommand\fR.
-This is because they take Tcl objects as arguments
-and those objects can retain an internal representation that
+This is because they take Tcl values as arguments
+and those values can retain an internal representation that
can be manipulated more efficiently.
-Also, Tcl's interpreter now uses objects internally.
+Also, Tcl's interpreter now uses values internally.
In order to invoke a string-based command procedure
registered by \fBTcl_CreateCommand\fR,
it must generate and fetch a string representation
-from each argument object before the call.
+from each argument value before the call.
New commands should be defined using \fBTcl_CreateObjCommand\fR.
We support \fBTcl_CreateCommand\fR for backwards compatibility.
.PP
diff --git a/doc/CrtFileHdlr.3 b/doc/CrtFileHdlr.3
index 00a6a48..cbc5e9f 100644
--- a/doc/CrtFileHdlr.3
+++ b/doc/CrtFileHdlr.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtFileHdlr.3,v 1.10 2008/10/15 10:43:37 dkf Exp $
-'\"
.so man.macros
.TH Tcl_CreateFileHandler 3 8.0 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3
index 6f4176b..a248cf4 100644
--- a/doc/CrtInterp.3
+++ b/doc/CrtInterp.3
@@ -5,13 +5,11 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtInterp.3,v 1.11 2010/01/14 11:47:07 dkf Exp $
-'\"
.so man.macros
.TH Tcl_CreateInterp 3 7.5 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_CreateInterp, Tcl_DeleteInterp, Tcl_InterpDeleted \- create and delete Tcl command interpreters
+Tcl_CreateInterp, Tcl_DeleteInterp, Tcl_InterpActive, Tcl_InterpDeleted \- create and delete Tcl command interpreters
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
diff --git a/doc/CrtMathFnc.3 b/doc/CrtMathFnc.3
index 3f4f7c0..cdde20b 100644
--- a/doc/CrtMathFnc.3
+++ b/doc/CrtMathFnc.3
@@ -5,13 +5,18 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtMathFnc.3,v 1.19 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions
+.SH "NOTICE OF EVENTUAL DEPRECATION"
+.PP
+The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions
+are rendered somewhat obsolete by the ability to create functions for
+expressions by placing commands in the \fBtcl::mathfunc\fR namespace,
+as described in the \fBmathfunc\fR manual page; the API described on
+this page is not expected to be maintained indefinitely.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -148,9 +153,9 @@ will not be modified. The variable pointed to by \fInumArgsPointer\fR
will contain -1, and no argument types will be stored in the variable
pointed to by \fIargTypesPointer\fR.
.PP
-\fBTcl_ListMathFuncs\fR returns a Tcl object containing a list of all
+\fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all
the math functions defined in the interpreter whose name matches
-\fIpattern\fR. The returned object has a reference count of zero.
+\fIpattern\fR. The returned value has a reference count of zero.
.SH "SEE ALSO"
expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3)
.SH KEYWORDS
diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3
index 43a855b..faf8b74 100644
--- a/doc/CrtObjCmd.3
+++ b/doc/CrtObjCmd.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtObjCmd.3,v 1.19 2008/10/15 10:43:37 dkf Exp $
-'\"
.so man.macros
.TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures"
.BS
@@ -66,7 +64,7 @@ The command must not have been deleted.
Pointer to structure containing various information about a
Tcl command.
.AP Tcl_Obj *objPtr in
-Object containing the name of a Tcl command.
+Value containing the name of a Tcl command.
.BE
.SH DESCRIPTION
.PP
@@ -104,10 +102,10 @@ will be copies of the \fIclientData\fR and \fIinterp\fR arguments given to
\fBTcl_CreateObjCommand\fR. Typically, \fIclientData\fR points to an
application-specific data structure that describes what to do when the
command procedure is invoked. \fIObjc\fR and \fIobjv\fR describe the
-arguments to the command, \fIobjc\fR giving the number of argument objects
+arguments to the command, \fIobjc\fR giving the number of argument values
(including the command name) and \fIobjv\fR giving the values of the
arguments. The \fIobjv\fR array will contain \fIobjc\fR values, pointing to
-the argument objects. Unlike \fIargv\fR[\fIargv\fR] used in a
+the argument values. Unlike \fIargv\fR[\fIargv\fR] used in a
string-based command procedure, \fIobjv\fR[\fIobjc\fR] will not contain NULL.
.PP
Additionally, when \fIproc\fR is invoked, it must not modify the contents
@@ -117,9 +115,9 @@ cause memory to be lost and the runtime stack to be corrupted. The
\fBconst\fR in the declaration of \fIobjv\fR will cause ANSI-compliant
compilers to report any such attempted assignment as an error. However,
it is acceptable to modify the internal representation of any individual
-object argument. For instance, the user may call
+value argument. For instance, the user may call
\fBTcl_GetIntFromObj\fR on \fIobjv\fR[\fB2\fR] to obtain the integer
-representation of that object; that call may change the type of the object
+representation of that value; that call may change the type of the value
that \fIobjv\fR[\fB2\fR] points at, but will not change where
\fIobjv\fR[\fB2\fR] points.
.PP
@@ -135,7 +133,7 @@ of the command,
and in the case of \fBTCL_ERROR\fR this gives an error message.
Before invoking a command procedure,
\fBTcl_EvalObjEx\fR sets interpreter's result to
-point to an object representing an empty string, so simple
+point to a value representing an empty string, so simple
commands can return an empty result by doing nothing at all.
.PP
The contents of the \fIobjv\fR array belong to Tcl and are not
@@ -227,7 +225,7 @@ if \fIisNativeObjectProc\fR has the value 1.
The fields \fIobjProc\fR and \fIobjClientData\fR
have the same meaning as the \fIproc\fR and \fIclientData\fR
arguments to \fBTcl_CreateObjCommand\fR;
-they hold information about the object-based command procedure
+they hold information about the value-based command procedure
that the Tcl interpreter calls to implement the command.
The fields \fIproc\fR and \fIclientData\fR
hold information about the string-based command procedure
@@ -237,7 +235,7 @@ this is the procedure passed to it;
otherwise, this is a compatibility procedure
registered by \fBTcl_CreateObjCommand\fR
that simply calls the command's
-object-based procedure after converting its string arguments to Tcl objects.
+value-based procedure after converting its string arguments to Tcl values.
The field \fIdeleteData\fR is the ClientData value
to pass to \fIdeleteProc\fR; it is normally the same as
\fIclientData\fR but may be set independently using the
@@ -292,7 +290,7 @@ they need to keep it for a long time.
\fBTcl_GetCommandFullName\fR produces the fully qualified name
of a command from a command token.
The name, including all namespace prefixes,
-is appended to the object specified by \fIobjPtr\fR.
+is appended to the value specified by \fIobjPtr\fR.
.PP
\fBTcl_GetCommandFromObj\fR returns a token for the command
specified by the name in a \fBTcl_Obj\fR.
@@ -301,4 +299,4 @@ Returns NULL if the command is not found.
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3)
.SH KEYWORDS
-bind, command, create, delete, namespace, object
+bind, command, create, delete, namespace, value
diff --git a/doc/CrtSlave.3 b/doc/CrtSlave.3
index 9727740..000ae58 100644
--- a/doc/CrtSlave.3
+++ b/doc/CrtSlave.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtSlave.3,v 1.20 2007/12/13 15:22:30 dgp Exp $
-'\"
.so man.macros
.TH Tcl_CreateSlave 3 7.6 Tcl "Tcl Library Procedures"
.BS
@@ -80,10 +78,10 @@ Count of additional arguments to pass to the alias command.
Vector of strings, the additional arguments to pass to the alias command.
This storage is owned by the caller.
.AP int objc in
-Count of additional object arguments to pass to the alias object command.
+Count of additional value arguments to pass to the aliased command.
.AP Tcl_Obj **objv in
-Vector of Tcl_Obj structures, the additional object arguments to pass to
-the alias object command.
+Vector of Tcl_Obj structures, the additional value arguments to pass to
+the aliased command.
This storage is owned by the caller.
.AP Tcl_Interp **targetInterpPtr in
Pointer to location to store the address of the interpreter where a target
@@ -99,11 +97,11 @@ Pointer to location to store a vector of strings, the additional arguments
to pass to an alias. The location is in storage owned by the caller, the
vector of strings is owned by the called function.
.AP int *objcPtr out
-Pointer to location to store count of additional object arguments to be
+Pointer to location to store count of additional value arguments to be
passed to the alias. The location is in storage owned by the caller.
.AP Tcl_Obj ***objvPtr out
Pointer to location to store a vector of Tcl_Obj structures, the additional
-arguments to pass to an object alias command. The location is in storage
+arguments to pass to an alias command. The location is in storage
owned by the caller, the vector of Tcl_Obj structures is owned by the
called function.
.AP "const char" *cmdName in
@@ -167,13 +165,13 @@ of the relative path succeeds, \fBTCL_OK\fR is returned, else
\fBTCL_ERROR\fR is returned and the \fIresult\fR field in
\fIaskingInterp\fR contains the error message.
.PP
-\fBTcl_CreateAlias\fR creates an object command named \fIslaveCmd\fR in
+\fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in
\fIslaveInterp\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.
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 object result
+it fails; in that case, an error message is left in the value result
of \fIslaveInterp\fR.
Note that there are no restrictions on the ancestry relationship (as
created by \fBTcl_CreateSlave\fR) between \fIslaveInterp\fR and
@@ -181,7 +179,7 @@ created by \fBTcl_CreateSlave\fR) between \fIslaveInterp\fR and
restrictions on how they are related.
.PP
\fBTcl_CreateAliasObj\fR is similar to \fBTcl_CreateAlias\fR except
-that it takes a vector of objects to pass as additional arguments instead
+that it takes a vector of values to pass as additional arguments instead
of a vector of strings.
.PP
\fBTcl_GetAlias\fR returns information about an alias \fIaliasName\fR
@@ -204,7 +202,7 @@ command, or the operation will return \fBTCL_ERROR\fR and leave an error
message in the \fIresult\fR field in \fIinterp\fR.
If an exposed command named \fIcmdName\fR already exists,
the operation returns \fBTCL_ERROR\fR and leaves an error message in the
-object result of \fIinterp\fR.
+value result of \fIinterp\fR.
If the operation succeeds, it returns \fBTCL_OK\fR.
After executing this command, attempts to use \fIcmdName\fR in a call to
\fBTcl_Eval\fR or with the Tcl \fBeval\fR command will again succeed.
@@ -214,10 +212,10 @@ exposed commands to the set of hidden commands, under the name
\fIhiddenCmdName\fR.
\fICmdName\fR must be the name of an existing exposed
command, or the operation will return \fBTCL_ERROR\fR and leave an error
-message in the object result of \fIinterp\fR.
+message in the value result of \fIinterp\fR.
Currently both \fIcmdName\fR and \fIhiddenCmdName\fR must not contain
namespace qualifiers, or the operation will return \fBTCL_ERROR\fR and
-leave an error message in the object result of \fIinterp\fR.
+leave an error message in the value result of \fIinterp\fR.
The \fICmdName\fR will be looked up in the global namespace, and not
relative to the current namespace, even if the current namespace is not the
global one.
diff --git a/doc/CrtTimerHdlr.3 b/doc/CrtTimerHdlr.3
index 841b465..2c9f90a 100644
--- a/doc/CrtTimerHdlr.3
+++ b/doc/CrtTimerHdlr.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtTimerHdlr.3,v 1.8 2008/10/15 10:43:37 dkf Exp $
-'\"
.so man.macros
.TH Tcl_CreateTimerHandler 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/CrtTrace.3 b/doc/CrtTrace.3
index b56a878..3689add 100644
--- a/doc/CrtTrace.3
+++ b/doc/CrtTrace.3
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtTrace.3,v 1.17 2009/01/14 14:14:03 dgp Exp $
-'\"
.so man.macros
.TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/DString.3 b/doc/DString.3
index db0c4dd..a85b1cf 100644
--- a/doc/DString.3
+++ b/doc/DString.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: DString.3,v 1.17 2007/12/13 15:22:31 dgp Exp $
-'\"
.so man.macros
.TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/DetachPids.3 b/doc/DetachPids.3
index f992f43..0535cd8 100644
--- a/doc/DetachPids.3
+++ b/doc/DetachPids.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: DetachPids.3,v 1.7 2007/12/13 15:22:31 dgp Exp $
-'\"
.so man.macros
.TH Tcl_DetachPids 3 "" Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/DictObj.3 b/doc/DictObj.3
index b54ee20..db8f39a 100644
--- a/doc/DictObj.3
+++ b/doc/DictObj.3
@@ -4,14 +4,12 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: DictObj.3,v 1.13 2009/11/27 14:35:10 dkf Exp $
-'\"
.so man.macros
.TH Tcl_DictObj 3 8.5 Tcl "Tcl Library Procedures"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_NewDictObj, Tcl_DictObjPut, Tcl_DictObjGet, Tcl_DictObjRemove, Tcl_DictObjSize, Tcl_DictObjFirst, Tcl_DictObjNext, Tcl_DictObjDone, Tcl_DictObjPutKeyList, Tcl_DictObjRemoveKeyList \- manipulate Tcl objects as dictionaries
+Tcl_NewDictObj, Tcl_DictObjPut, Tcl_DictObjGet, Tcl_DictObjRemove, Tcl_DictObjSize, Tcl_DictObjFirst, Tcl_DictObjNext, Tcl_DictObjDone, Tcl_DictObjPutKeyList, Tcl_DictObjRemoveKeyList \- manipulate Tcl values as dictionaries
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -49,23 +47,23 @@ int
.SH ARGUMENTS
.AS Tcl_DictSearch "**valuePtrPtr" in/out
.AP Tcl_Interp *interp in
-If an error occurs while converting an object to be a dictionary object,
-an error message is left in the interpreter's result object
+If an error occurs while converting a value to be a dictionary value,
+an error message is left in the interpreter's result value
unless \fIinterp\fR is NULL.
.AP Tcl_Obj *dictPtr in/out
-Points to the dictionary object to be manipulated.
-If \fIdictPtr\fR does not already point to a dictionary object,
+Points to the dictionary value to be manipulated.
+If \fIdictPtr\fR does not already point to a dictionary value,
an attempt will be made to convert it to one.
.AP Tcl_Obj *keyPtr in
Points to the key for the key/value pair being manipulated within the
-dictionary object.
+dictionary value.
.AP Tcl_Obj **keyPtrPtr out
Points to a variable that will have the key from a key/value pair
placed within it. May be NULL to indicate that the caller is not
interested in the key.
.AP Tcl_Obj *valuePtr in
-Points to the value for the key/value pair being manipulate within the
-dictionary object (or sub-object, in the case of
+Points to the value for the key/value pair being manipulated within the
+dictionary value (or sub-value, in the case of
\fBTcl_DictObjPutKeyList\fR.)
.AP Tcl_Obj **valuePtrPtr out
Points to a variable that will have the value from a key/value pair
@@ -90,15 +88,15 @@ completed, and a zero otherwise.
Indicates the number of keys that will be supplied in the \fIkeyv\fR
array.
.AP "Tcl_Obj *const" *keyv in
-Array of \fIkeyc\fR pointers to objects that
+Array of \fIkeyc\fR pointers to values that
\fBTcl_DictObjPutKeyList\fR and \fBTcl_DictObjRemoveKeyList\fR will
use to locate the key/value pair to manipulate within the
-sub-dictionaries of the main dictionary object passed to them.
+sub-dictionaries of the main dictionary value passed to them.
.BE
.SH DESCRIPTION
.PP
-Tcl dictionary objects have an internal representation that supports
+Tcl dictionary values have an internal representation that supports
efficient mapping from keys to values and which guarantees that the
particular ordering of keys within the dictionary remains the same
modulo any keys being deleted (which removes them from the order) or
@@ -108,11 +106,11 @@ keys of the dictionary, and each will be followed (in the odd-valued
index) by the value associated with that key.
.PP
The procedures described in this man page are used to
-create, modify, index, and iterate over dictionary objects from C code.
+create, modify, index, and iterate over dictionary values from C code.
.PP
-\fBTcl_NewDictObj\fR creates a new, empty dictionary object. The
-string representation of the object will be invalid, and the reference
-count of the object will be zero.
+\fBTcl_NewDictObj\fR creates a new, empty dictionary value. The
+string representation of the value will be invalid, and the reference
+count of the value will be zero.
.PP
\fBTcl_DictObjGet\fR looks up the given key within the given
dictionary and writes a pointer to the value associated with that key
@@ -219,7 +217,7 @@ if (\fBTcl_DictObjFirst\fR(interp, objPtr, &search,
for (; !done ; \fBTcl_DictObjNext\fR(&search, &key, &value, &done)) {
/*
* Note that strcmp() is not a good way of comparing
- * objects and is just used here for demonstration
+ * values and is just used here for demonstration
* purposes.
*/
if (!strcmp(Tcl_GetString(key), Tcl_GetString(value))) {
@@ -233,4 +231,4 @@ return TCL_OK;
.SH "SEE ALSO"
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_InitObjHashTable
.SH KEYWORDS
-dict, dict object, dictionary, dictionary object, hash table, iteration, object
+dict, dict value, dictionary, dictionary value, hash table, iteration, value
diff --git a/doc/DoOneEvent.3 b/doc/DoOneEvent.3
index 2243a1b..9bdf926 100644
--- a/doc/DoOneEvent.3
+++ b/doc/DoOneEvent.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: DoOneEvent.3,v 1.6 2007/12/13 15:22:31 dgp Exp $
-'\"
.so man.macros
.TH Tcl_DoOneEvent 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/DoWhenIdle.3 b/doc/DoWhenIdle.3
index 37b4cec..27a4b8c 100644
--- a/doc/DoWhenIdle.3
+++ b/doc/DoWhenIdle.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: DoWhenIdle.3,v 1.7 2008/10/15 10:43:37 dkf Exp $
-'\"
.so man.macros
.TH Tcl_DoWhenIdle 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/DoubleObj.3 b/doc/DoubleObj.3
index 3fd6730..f811c89 100644
--- a/doc/DoubleObj.3
+++ b/doc/DoubleObj.3
@@ -4,13 +4,11 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: DoubleObj.3,v 1.5 2009/11/27 14:35:10 dkf Exp $
-'\"
.so man.macros
.TH Tcl_DoubleObj 3 8.0 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_NewDoubleObj, Tcl_SetDoubleObj, Tcl_GetDoubleFromObj \- manipulate Tcl objects as floating-point values
+Tcl_NewDoubleObj, Tcl_SetDoubleObj, Tcl_GetDoubleFromObj \- manipulate Tcl values as floating-point values
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -25,11 +23,11 @@ int
.SH ARGUMENTS
.AS Tcl_Interp doubleValue in/out
.AP double doubleValue in
-A double-precision floating-point value used to initialize or set a Tcl object.
+A double-precision floating-point value used to initialize or set a Tcl value.
.AP Tcl_Obj *objPtr in/out
-For \fBTcl_SetDoubleObj\fR, this points to the object in which to store a
+For \fBTcl_SetDoubleObj\fR, this points to the value in which to store a
double value.
-For \fBTcl_GetDoubleFromObj\fR, this refers to the object
+For \fBTcl_GetDoubleFromObj\fR, this refers to the value
from which to retrieve a double value.
.AP Tcl_Interp *interp in/out
When non-NULL, an error message is left here when double value retrieval fails.
@@ -39,21 +37,21 @@ Points to place to store the double value obtained from \fIobjPtr\fR.
.SH DESCRIPTION
.PP
-These procedures are used to create, modify, and read Tcl objects that
+These procedures are used to create, modify, and read Tcl values that
hold double-precision floating-point values.
.PP
-\fBTcl_NewDoubleObj\fR creates and returns a new Tcl object initialized to
-the double value \fIdoubleValue\fR. The returned Tcl object is unshared.
+\fBTcl_NewDoubleObj\fR creates and returns a new Tcl value initialized to
+the double value \fIdoubleValue\fR. The returned Tcl value is unshared.
.PP
-\fBTcl_SetDoubleObj\fR sets the value of an existing Tcl object pointed to
+\fBTcl_SetDoubleObj\fR sets the value of an existing Tcl value pointed to
by \fIobjPtr\fR to the double value \fIdoubleValue\fR. The \fIobjPtr\fR
-argument must point to an unshared Tcl object. Any attempt to set the value
-of a shared Tcl object violates Tcl's copy-on-write policy. Any existing
-string representation or internal representation in the unshared Tcl object
+argument must point to an unshared Tcl value. Any attempt to set the value
+of a shared Tcl value violates Tcl's copy-on-write policy. Any existing
+string representation or internal representation in the unshared Tcl value
will be freed as a consequence of setting the new value.
.PP
\fBTcl_GetDoubleFromObj\fR attempts to retrieve a double value from the
-Tcl object \fIobjPtr\fR. If the attempt succeeds, then \fBTCL_OK\fR is
+Tcl value \fIobjPtr\fR. If the attempt succeeds, then \fBTCL_OK\fR is
returned, and the double value is written to the storage pointed to by
\fIdoublePtr\fR. If the attempt fails, then \fBTCL_ERROR\fR is returned,
and if \fIinterp\fR is non-NULL, an error message is left in \fIinterp\fR.
@@ -63,4 +61,4 @@ calls to \fBTcl_GetDoubleFromObj\fR more efficient.
.SH "SEE ALSO"
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
.SH KEYWORDS
-double, double object, double type, internal representation, object, object type, string representation
+double, double value, double type, internal representation, value, value type, string representation
diff --git a/doc/DumpActiveMemory.3 b/doc/DumpActiveMemory.3
index bdab746..1f6cb46 100644
--- a/doc/DumpActiveMemory.3
+++ b/doc/DumpActiveMemory.3
@@ -3,8 +3,6 @@
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
-'\" RCS: @(#) $Id: DumpActiveMemory.3,v 1.8 2004/10/07 15:15:36 dkf Exp $
-'\"
.so man.macros
.TH "Tcl_DumpActiveMemory" 3 8.1 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Encoding.3 b/doc/Encoding.3
index 1545c21..7bcb285 100644
--- a/doc/Encoding.3
+++ b/doc/Encoding.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Encoding.3,v 1.32 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH Tcl_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Ensemble.3 b/doc/Ensemble.3
index 34a7a85..cd69bbd 100644
--- a/doc/Ensemble.3
+++ b/doc/Ensemble.3
@@ -4,15 +4,13 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Ensemble.3,v 1.9 2010/01/10 20:36:49 dkf Exp $
-'\"
'\" This documents the C API introduced in TIP#235
'\"
.so man.macros
.TH Tcl_Ensemble 3 8.5 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_CreateEnsemble, Tcl_FindEnsemble, Tcl_GetEnsembleFlags, Tcl_GetEnsembleMappingDict, Tcl_GetEnsembleNamespace, Tcl_GetEnsembleUnknownHandler, Tcl_GetEnsembleSubcommandList, Tcl_IsEnsemble, Tcl_SetEnsembleFlags, Tcl_SetEnsembleMappingDict, Tcl_SetEnsembleSubcommandList, Tcl_SetEnsembleUnknownHandler \- manipulate ensemble commands
+Tcl_CreateEnsemble, Tcl_FindEnsemble, Tcl_GetEnsembleFlags, Tcl_GetEnsembleMappingDict, Tcl_GetEnsembleNamespace, Tcl_GetEnsembleParameterList, Tcl_GetEnsembleUnknownHandler, Tcl_GetEnsembleSubcommandList, Tcl_IsEnsemble, Tcl_SetEnsembleFlags, Tcl_SetEnsembleMappingDict, Tcl_SetEnsembleParameterList, Tcl_SetEnsembleSubcommandList, Tcl_SetEnsembleUnknownHandler \- manipulate ensemble commands
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -97,7 +95,7 @@ Pointer to a variable into which to write the current ensemble mapping
dictionary.
.AP Tcl_Obj *listObj in
A list value to use for the list of formal pre-subcommand parameters, the
-defined list of subcommands in the dictionary or the unknown subcommmand
+defined list of subcommands in the dictionary or the unknown subcommand
handler command prefix. May be NULL if the subcommand list or unknown handler
are to be removed.
.AP Tcl_Obj **listObjPtr out
@@ -161,6 +159,8 @@ code (\fBTCL_OK\fR, or \fBTCL_ERROR\fR if the token does not refer to an
ensemble) and the dictionary obtained from
\fBTcl_GetEnsembleMappingDict\fR should always be treated as immutable
even if it is unshared.
+All command names in prefixes set via \fBTcl_SetEnsembleMappingDict\fR
+must be fully qualified.
.TP
\fBformal pre-subcommand parameter list\fR (read-write)
.VS 8.6
diff --git a/doc/Environment.3 b/doc/Environment.3
index 5a7c059..3753f43 100644
--- a/doc/Environment.3
+++ b/doc/Environment.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Environment.3,v 1.7 2009/11/27 14:35:10 dkf Exp $
-'\"
.so man.macros
.TH Tcl_PutEnv 3 "7.5" Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Eval.3 b/doc/Eval.3
index efd82ad..0ecf7fa 100644
--- a/doc/Eval.3
+++ b/doc/Eval.3
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Eval.3,v 1.29 2009/11/01 18:15:40 jenglish Exp $
-'\"
.so man.macros
.TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures"
.BS
@@ -49,17 +47,17 @@ int
Interpreter in which to execute the script. The interpreter's result is
modified to hold the result or error message from the script.
.AP Tcl_Obj *objPtr in
-A Tcl object containing the script to execute.
+A Tcl value containing the script to execute.
.AP int flags in
ORed combination of flag bits that specify additional options.
\fBTCL_EVAL_GLOBAL\fR and \fBTCL_EVAL_DIRECT\fR are currently supported.
.AP "const char" *fileName in
Name of a file containing a Tcl script.
.AP int objc in
-The number of objects in the array pointed to by \fIobjPtr\fR;
+The number of values in the array pointed to by \fIobjPtr\fR;
this is also the number of words in the command.
.AP Tcl_Obj **objv in
-Points to an array of pointers to objects; each object holds the
+Points to an array of pointers to values; each value holds the
value of a single word in the command to execute.
.AP int numBytes in
The number of bytes in \fIscript\fR, not including any
@@ -85,7 +83,7 @@ If this is the first time \fIobjPtr\fR has been executed,
its commands are compiled into bytecode instructions
which are then executed. The
bytecodes are saved in \fIobjPtr\fR so that the compilation step
-can be skipped if the object is evaluated again in the future.
+can be skipped if the value is evaluated again in the future.
.PP
The return value from \fBTcl_EvalObjEx\fR (and all the other procedures
described here) is a Tcl completion code with
@@ -113,15 +111,15 @@ which will be safely substituted by the Tcl interpreter into
.PP
\fBTcl_EvalObjv\fR executes a single pre-parsed command instead of a
script. The \fIobjc\fR and \fIobjv\fR arguments contain the values
-of the words for the Tcl command, one word in each object in
+of the words for the Tcl command, one word in each value in
\fIobjv\fR. \fBTcl_EvalObjv\fR evaluates the command and returns
a completion code and result just like \fBTcl_EvalObjEx\fR.
The caller of \fBTcl_EvalObjv\fR has to manage the reference count of the
-elements of \fIobjv\fR, insuring that the objects are valid until
+elements of \fIobjv\fR, insuring that the values are valid until
\fBTcl_EvalObjv\fR returns.
.PP
\fBTcl_Eval\fR is similar to \fBTcl_EvalObjEx\fR except that the script to
-be executed is supplied as a string instead of an object and no compilation
+be executed is supplied as a string instead of a value and no compilation
occurs. The string should be a proper UTF-8 string as converted by
\fBTcl_ExternalToUtfDString\fR or \fBTcl_ExternalToUtf\fR when it is known
to possibly contain upper ASCII characters whose possible combinations
@@ -131,7 +129,7 @@ bytecodes. In situations where it is known that the script will never be
executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR.
\fBTcl_Eval\fR returns a completion code and result just like
\fBTcl_EvalObjEx\fR. Note: for backward compatibility with versions before
-Tcl 8.0, \fBTcl_Eval\fR copies the object result in \fIinterp\fR to
+Tcl 8.0, \fBTcl_Eval\fR copies the value result in \fIinterp\fR to
\fIinterp->result\fR (use is deprecated) where it can be accessed directly.
This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which
does not do the copy.
@@ -161,24 +159,27 @@ instead of taking a variable number of arguments it takes an argument
list. Like \fBTcl_VarEval\fR, \fBTcl_VarEvalVA\fR is deprecated.
.SH "FLAG BITS"
+.PP
Any ORed combination of the following values may be used for the
\fIflags\fR argument to procedures such as \fBTcl_EvalObjEx\fR:
.TP 23
\fBTCL_EVAL_DIRECT\fR
+.
This flag is only used by \fBTcl_EvalObjEx\fR; it is ignored by
other procedures. If this flag bit is set, the script is not
compiled to bytecodes; instead it is executed directly
as is done by \fBTcl_EvalEx\fR. The
\fBTCL_EVAL_DIRECT\fR flag is useful in situations where the
-contents of an object are going to change immediately, so the
+contents of a value are going to change immediately, so the
bytecodes will not be reused in a future execution. In this case,
it is faster to execute the script directly.
.TP 23
\fBTCL_EVAL_GLOBAL\fR
+.
If this flag is set, the script is processed at global level. This
means that it is evaluated in the global namespace and its variable
context consists of global variables only (it ignores any Tcl
-procedures at are active).
+procedures that are active).
.SH "MISCELLANEOUS DETAILS"
.PP
@@ -207,4 +208,4 @@ This means that top-level applications should never see a return code
from \fBTcl_EvalObjEx\fR other then \fBTCL_OK\fR or \fBTCL_ERROR\fR.
.SH KEYWORDS
-execute, file, global, object, result, script
+execute, file, global, result, script, value
diff --git a/doc/Exit.3 b/doc/Exit.3
index 66ce3be..fd251c7 100644
--- a/doc/Exit.3
+++ b/doc/Exit.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Exit.3,v 1.10 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH Tcl_Exit 3 8.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/ExprLong.3 b/doc/ExprLong.3
index 66f39ac..4fa972e 100644
--- a/doc/ExprLong.3
+++ b/doc/ExprLong.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: ExprLong.3,v 1.15 2007/12/13 15:22:31 dgp Exp $
-'\"
.so man.macros
.TH Tcl_ExprLong 3 7.0 Tcl "Tcl Library Procedures"
.BS
@@ -51,11 +49,11 @@ given by the \fIexpr\fR argument
and return the result in one of four different forms.
The expression can have any of the forms accepted by the \fBexpr\fR command.
Note that these procedures have been largely replaced by the
-object-based procedures \fBTcl_ExprLongObj\fR, \fBTcl_ExprDoubleObj\fR,
+value-based procedures \fBTcl_ExprLongObj\fR, \fBTcl_ExprDoubleObj\fR,
\fBTcl_ExprBooleanObj\fR, and \fBTcl_ExprObj\fR.
-Those object-based procedures evaluate an expression held in a Tcl object
+Those value-based procedures evaluate an expression held in a Tcl value
instead of a string.
-The object argument can retain an internal representation
+The value argument can retain an internal representation
that is more efficient to execute.
.PP
The \fIinterp\fR argument refers to an interpreter used to
@@ -105,4 +103,4 @@ string stored in the interpreter's result.
Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj
.SH KEYWORDS
-boolean, double, evaluate, expression, integer, object, string
+boolean, double, evaluate, expression, integer, value, string
diff --git a/doc/ExprLongObj.3 b/doc/ExprLongObj.3
index cf57921..686c1cb 100644
--- a/doc/ExprLongObj.3
+++ b/doc/ExprLongObj.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: ExprLongObj.3,v 1.9 2007/12/13 15:22:31 dgp Exp $
-'\"
.so man.macros
.TH Tcl_ExprLongObj 3 8.0 Tcl "Tcl Library Procedures"
.BS
@@ -31,7 +29,7 @@ int
.AP Tcl_Interp *interp in
Interpreter in whose context to evaluate \fIobjPtr\fR.
.AP Tcl_Obj *objPtr in
-Pointer to an object containing the expression to evaluate.
+Pointer to a value containing the expression to evaluate.
.AP long *longPtr out
Pointer to location in which to store the integer value of the
expression.
@@ -42,7 +40,7 @@ expression.
Pointer to location in which to store the 0/1 boolean value of the
expression.
.AP Tcl_Obj **resultPtrPtr out
-Pointer to location in which to store a pointer to the object
+Pointer to location in which to store a pointer to the value
that is the result of the expression.
.BE
@@ -95,14 +93,14 @@ or
or else an error occurs.
.PP
If \fBTcl_ExprObj\fR successfully evaluates the expression,
-it stores a pointer to the Tcl object
+it stores a pointer to the Tcl value
containing the expression's value at \fI*resultPtrPtr\fR.
In this case, the caller is responsible for calling
-\fBTcl_DecrRefCount\fR to decrement the object's reference count
-when it is finished with the object.
+\fBTcl_DecrRefCount\fR to decrement the value's reference count
+when it is finished with the value.
.SH "SEE ALSO"
Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString, Tcl_GetObjResult
.SH KEYWORDS
-boolean, double, evaluate, expression, integer, object, string
+boolean, double, evaluate, expression, integer, value, string
diff --git a/doc/FileSystem.3 b/doc/FileSystem.3
index d53fccc..dd9eb77 100644
--- a/doc/FileSystem.3
+++ b/doc/FileSystem.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: FileSystem.3,v 1.72 2010/08/14 17:13:02 nijtmans Exp $
-'\"
.so man.macros
.TH Filesystem 3 8.4 Tcl "Tcl Library Procedures"
.BS
@@ -88,7 +86,7 @@ int
int
\fBTcl_FSFileAttrsSet\fR(\fIinterp, int index, pathPtr, Tcl_Obj *objPtr\fR)
.sp
-const char **
+const char *const *
\fBTcl_FSFileAttrStrings\fR(\fIpathPtr, objPtrRef\fR)
.sp
int
@@ -194,8 +192,8 @@ int
Points to a structure containing the addresses of procedures that
can be called to perform the various filesystem operations.
.AP Tcl_Obj *pathPtr in
-The path represented by this object is used for the operation in
-question. If the object does not already have an internal \fBpath\fR
+The path represented by this value is used for the operation in
+question. If the value does not already have an internal \fBpath\fR
representation, it will be converted to have one.
.AP Tcl_Obj *srcPathPtr in
As for \fIpathPtr\fR, but used for the source file for a copy or
@@ -215,12 +213,12 @@ this structure will be returned. This parameter may be NULL.
Interpreter to use either for results, evaluation, or reporting error
messages.
.AP ClientData clientData in
-The native description of the path object to create.
+The native description of the path value to create.
.AP Tcl_Obj *firstPtr in
-The first of two path objects to compare. The object may be converted
+The first of two path values to compare. The value may be converted
to \fBpath\fR type.
.AP Tcl_Obj *secondPtr in
-The second of two path objects to compare. The object may be converted
+The second of two path values to compare. The value may be converted
to \fBpath\fR type.
.AP Tcl_Obj *listObj in
The list of path elements to operate on with a \fBjoin\fR operation.
@@ -228,12 +226,12 @@ The list of path elements to operate on with a \fBjoin\fR operation.
If non-negative, the number of elements in the \fIlistObj\fR which should
be joined together. If negative, then all elements are joined.
.AP Tcl_Obj **errorPtr out
-In the case of an error, filled with an object containing the name of
+In the case of an error, filled with a value containing the name of
the file which caused an error in the various copy/rename operations.
.AP Tcl_Obj **objPtrRef out
-Filled with an object containing the result of the operation.
+Filled with a value containing the result of the operation.
.AP Tcl_Obj *resultPtr out
-Pre-allocated object in which to store (using
+Pre-allocated value in which to store (using
\fBTcl_ListObjAppendElement\fR) the list of
files or directories which are successfully matched.
.AP int mode in
@@ -333,17 +331,17 @@ buffer is actually
declared to be, allowing the same code to be used both on systems with
and systems without support for files larger than 2GB in size.
.PP
-The \fBTcl_FS\fR API is objectified and may cache internal
+The \fBTcl_FS\fR API is \fBTcl_Obj\fR-ified and may cache internal
representations and other path-related strings (e.g.\ the current working
-directory). One side-effect of this is that one must not pass in objects
+directory). One side-effect of this is that one must not pass in values
with a reference count of zero to any of these functions. If such calls were
handled, they might result
in memory leaks (under some circumstances, the filesystem code may wish
-to retain a reference to the passed in object, and so one must not assume
-that after any of these calls return, the object still has a reference count of
+to retain a reference to the passed in value, and so one must not assume
+that after any of these calls return, the value still has a reference count of
zero - it may have been incremented) or in a direct segmentation fault
(or other memory access error)
-due to the object being freed part way through the complex object
+due to the value being freed part way through the complex value
manipulation required to ensure that the path is fully normalized and
absolute for filesystem determination. The practical lesson to learn
from this is that
@@ -356,9 +354,9 @@ Tcl_DecrRefCount(path);
.PP
is wrong, and may cause memory errors. The \fIpath\fR must have its
reference count incremented before passing it in, or
-decrementing it. For this reason, objects with a reference count of zero are
+decrementing it. For this reason, values with a reference count of zero are
considered not to be valid filesystem paths and calling any Tcl_FS API
-function with such an object will result in no action being taken.
+function with such a value will result in no action being taken.
.SS "FS API FUNCTIONS"
\fBTcl_FSCopyFile\fR attempts to copy the file given by \fIsrcPathPtr\fR to the
path name given by \fIdestPathPtr\fR. If the two paths given lie in the same
@@ -486,7 +484,7 @@ If the \fItoPtr\fR is NULL, a
action is performed. The result
is a Tcl_Obj specifying the contents of the symbolic link given by
\fIlinkNamePtr\fR, or NULL if the link could not be read. The result is owned
-by the caller, which should call Tcl_DecrRefCount when the result is no
+by the caller, which should call \fBTcl_DecrRefCount\fR when the result is no
longer needed. If the \fItoPtr\fR is not NULL, Tcl should create a link
of one of the types passed in in the \fIlinkAction\fR flag. This flag is
an ORed combination of \fBTCL_CREATE_SYMBOLIC_LINK\fR and \fBTCL_CREATE_HARD_LINK\fR.
@@ -502,8 +500,9 @@ directories named in the path leading to the file. The \fITcl_StatBuf\fR
structure includes info regarding device, inode (always 0 on Windows),
privilege mode, nlink (always 1 on Windows), user id (always 0 on
Windows), group id (always 0 on Windows), rdev (same as device on
-Windows), size, last access time, last modification time, and creation
-time. See \fBPORTABLE STAT RESULT API\fR for a description of how to write
+Windows), size, last access time, last modification time, and
+last metadata change time.
+See \fBPORTABLE STAT RESULT API\fR for a description of how to write
portable code to allocate and access the \fITcl_StatBuf\fR structure.
.PP
If \fIpath\fR exists, \fBTcl_FSLstat\fR returns 0 and the stat structure
@@ -524,7 +523,7 @@ values of the file given.
attributes\fR subcommand. The appropriate function for the filesystem to
which \fIpathPtr\fR belongs will be called.
.PP
-If the result is \fBTCL_OK\fR, then an object was placed in
+If the result is \fBTCL_OK\fR, then a value was placed in
\fIobjPtrRef\fR, which
will only be temporarily valid (unless \fBTcl_IncrRefCount\fR is called).
.PP
@@ -542,7 +541,7 @@ will take that list and first increment its reference count before using it.
On completion of that use, Tcl will decrement its reference count. Hence if
the list should be disposed of by Tcl when done, it should have a
reference count of zero, and if the list should not be disposed of, the
-filesystem should ensure it retains a reference count to the object.
+filesystem should ensure it retains a reference count to the value.
.PP
\fBTcl_FSAccess\fR checks whether the process would be allowed to read,
write or test for existence of the file (or other filesystem object)
@@ -561,8 +560,9 @@ directories named in the path leading to the file. The \fITcl_StatBuf\fR
structure includes info regarding device, inode (always 0 on Windows),
privilege mode, nlink (always 1 on Windows), user id (always 0 on
Windows), group id (always 0 on Windows), rdev (same as device on
-Windows), size, last access time, last modification time, and creation
-time. See \fBPORTABLE STAT RESULT API\fR for a description of how to write
+Windows), size, last access time, last modification time, and
+last metadata change time.
+See \fBPORTABLE STAT RESULT API\fR for a description of how to write
portable code to allocate and access the \fITcl_StatBuf\fR structure.
.PP
If \fIpath\fR exists, \fBTcl_FSStat\fR returns 0 and the stat structure
@@ -582,7 +582,7 @@ In addition, if \fIinterp\fR is non-NULL, \fBTcl_FSOpenFileChannel\fR
leaves an error message in \fIinterp\fR's result after any error.
.PP
The newly created channel is not registered in the supplied interpreter; to
-register it, use \fBTcl_RegisterChannel\fR, described below.
+register it, use \fBTcl_RegisterChannel\fR.
If one of the standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR was
previously closed, the act of creating the new channel also assigns it as a
replacement for the standard channel.
@@ -622,35 +622,34 @@ The separator is returned as a Tcl_Obj containing a string of length
.PP
\fBTcl_FSJoinPath\fR takes the given Tcl_Obj, which must be a valid
list (which is allowed to have a reference count of zero), and returns the path
-object given by considering the first \fIelements\fR elements as valid path
+value given by considering the first \fIelements\fR elements as valid path
segments (each path segment may be a complete path, a partial path or
just a single possible directory or file name). If any path segment is
actually an absolute path, then all prior path segments are discarded.
If \fIelements\fR is less than 0, we use the entire list.
.PP
-It is possible that the returned object is actually an element
+It is possible that the returned value is actually an element
of the given list, so the caller should be careful to increment the
reference count of the result before freeing the list.
.PP
-The returned object, typically with a reference count of zero (but it
+The returned value, typically with a reference count of zero (but it
could be shared
under some conditions), contains the joined path. The caller must
-add a reference count to the object before using it. In particular, the
-returned object could be an element of the given list, so freeing the
-list might free the object prematurely if no reference count has been taken.
-If the number of elements is zero, then the returned object will be
+add a reference count to the value before using it. In particular, the
+returned value could be an element of the given list, so freeing the
+list might free the value prematurely if no reference count has been taken.
+If the number of elements is zero, then the returned value will be
an empty-string Tcl_Obj.
.PP
\fBTcl_FSSplitPath\fR takes the given Tcl_Obj, which should be a valid path,
-and returns a Tcl list object containing each segment of that path as
+and returns a Tcl list value containing each segment of that path as
an element.
-It returns a list object with a reference count of zero. If the
+It returns a list value with a reference count of zero. If the
passed in \fIlenPtr\fR is non-NULL, the variable it points to will be
updated to contain the number of elements in the returned list.
.PP
\fBTcl_FSEqualPaths\fR tests whether the two paths given represent the same
-filesystem object
-.PP
+filesystem object.
It returns 1 if the paths are equal, and 0 if they are different. If
either path is NULL, 0 is always returned.
.PP
@@ -658,7 +657,7 @@ either path is NULL, 0 is always returned.
from the given Tcl_Obj a unique normalized path representation, whose
string value can be used as a unique identifier for the file.
.PP
-It returns the normalized path object, owned by Tcl, or NULL if the path
+It returns the normalized path value, owned by Tcl, or NULL if the path
was invalid or could otherwise not be successfully converted.
Extraction of absolute, normalized paths is very efficient (because the
filesystem operates on these representations internally), although the
@@ -666,35 +665,36 @@ result when the filesystem contains numerous symbolic links may not be
the most user-friendly version of a path. The return value is owned by
Tcl and has a lifetime equivalent to that of the \fIpathPtr\fR passed in
(unless that is a relative path, in which case the normalized path
-object may be freed any time the cwd changes) - the caller can of
-course increment the refCount if it wishes to maintain a copy for longer.
+value may be freed any time the cwd changes) - the caller can of
+course increment the reference count if it wishes to maintain a copy for longer.
.PP
-\fBTcl_FSJoinToPath\fR takes the given object, which should usually be a
+\fBTcl_FSJoinToPath\fR takes the given value, which should usually be a
valid path or NULL, and joins onto it the array of paths segments
given.
.PP
-Returns object, typically with refCount of zero (but it could be shared
+Returns a value, typically with reference count of zero (but it could be shared
under some conditions), containing the joined path. The caller must
-add a refCount to the object before using it. If any of the objects
-passed into this function (pathPtr or path elements) have a refCount
+add a reference count to the value before using it. If any of the values
+passed into this function (\fIpathPtr\fR or \fIpath\fR elements) have
+a reference count
of zero, they will be freed when this function returns.
.PP
\fBTcl_FSConvertToPathType\fR tries to convert the given Tcl_Obj to a valid
Tcl path type, taking account of the fact that the cwd may have changed
-even if this object is already supposedly of the correct type.
+even if this value is already supposedly of the correct type.
The filename may begin with
.QW ~
(to indicate current user's home directory) or
.QW ~<user>
(to indicate any user's home directory).
.PP
-If the conversion succeeds (i.e.\ the object is a valid path in one of
+If the conversion succeeds (i.e.\ the value is a valid path in one of
the current filesystems), then \fBTCL_OK\fR is returned. Otherwise
\fBTCL_ERROR\fR is returned, and an error message may
be left in the interpreter.
.PP
\fBTcl_FSGetInternalRep\fR extracts the internal representation of a given
-path object, in the given filesystem. If the path object belongs to a
+path value, in the given filesystem. If the path value belongs to a
different filesystem, we return NULL. If the internal representation is
currently NULL, we attempt to generate it, by calling the filesystem's
\fBTcl_FSCreateInternalRepProc\fR.
@@ -706,7 +706,7 @@ not require additional conversions.
\fBTcl_FSGetTranslatedPath\fR attempts to extract the translated path
from the given Tcl_Obj.
.PP
-If the translation succeeds (i.e.\ the object is a valid path), then it is
+If the translation succeeds (i.e.\ the value is a valid path), then it is
returned. Otherwise NULL will be returned, and an error message may be
left in the interpreter. A
.QW translated
@@ -715,28 +715,28 @@ path is one which contains no
or
.QW ~user
sequences (these have been expanded to their current
-representation in the filesystem). The object returned is owned by the
-caller, which must store it or call Tcl_DecrRefCount to ensure memory is
+representation in the filesystem). The value returned is owned by the
+caller, which must store it or call \fBTcl_DecrRefCount\fR to ensure memory is
freed. This function is of little practical use, and
-\fBTcl_FSGetNormalizedPath\fR or \fBTcl_GetNativePath\fR are usually
+\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually
better functions to use for most purposes.
.PP
\fBTcl_FSGetTranslatedStringPath\fR does the same as
\fBTcl_FSGetTranslatedPath\fR, but returns a character string or NULL.
The string returned is dynamically allocated and owned by the caller,
which must store it or call \fBckfree\fR to ensure it is freed. Again,
-\fBTcl_FSGetNormalizedPath\fR or \fBTcl_GetNativePath\fR are usually
+\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually
better functions to use for most purposes.
.PP
\fBTcl_FSNewNativePath\fR performs something like the reverse of the
usual obj->path->nativerep conversions. If some code retrieves a path
in native form (from, e.g.\ \fBreadlink\fR or a native dialog), and that path
is to be used at the Tcl level, then calling this function is an
-efficient way of creating the appropriate path object type.
+efficient way of creating the appropriate path value type.
.PP
-The resulting object is a pure
+The resulting value is a pure
.QW path
-object, which will only receive
+value, which will only receive
a UTF-8 string representation if that is required by some Tcl code.
.PP
\fBTcl_FSGetNativePath\fR is for use by the Win/Unix native
@@ -774,7 +774,7 @@ given path within that filesystem (which is filesystem dependent). The
second element may be empty if the filesystem does not provide a
further categorization of files.
.PP
-A valid list object is returned, unless the path object is not
+A valid list value is returned, unless the path value is not
recognized, when NULL will be returned.
.PP
\fBTcl_FSGetFileSystemForPath\fR returns a pointer to the
@@ -792,7 +792,7 @@ It returns one of \fBTCL_PATH_ABSOLUTE\fR, \fBTCL_PATH_RELATIVE\fR, or
.PP
\fBTcl_AllocStatBuf\fR allocates a \fITcl_StatBuf\fR on the system heap (which
may be deallocated by being passed to \fBckfree\fR). This allows extensions to
-invoke \fBTcl_FSStat\fR and \fBTcl_FSLStat\fR without being dependent on the
+invoke \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR without being dependent on the
size of the buffer. That in turn depends on the flags used to build Tcl.
.PP
.VS 8.6
@@ -1002,14 +1002,14 @@ The \fIversion\fR field should be set to \fBTCL_FILESYSTEM_VERSION_1\fR.
.SS PATHINFILESYSTEMPROC
.PP
The \fIpathInFilesystemProc\fR field contains the address of a function
-which is called to determine whether a given path object belongs to this
+which is called to determine whether a given path value belongs to this
filesystem or not. Tcl will only call the rest of the filesystem
functions with a path for which this function has returned \fBTCL_OK\fR.
-If the path does not belong, -1 should be returned (the behaviour of Tcl
+If the path does not belong, -1 should be returned (the behavior of Tcl
for any other return value is not defined). If \fBTCL_OK\fR is returned,
then the optional \fIclientDataPtr\fR output parameter can be used to
return an internal (filesystem specific) representation of the path,
-which will be cached inside the path object, and may be retrieved
+which will be cached inside the path value, and may be retrieved
efficiently by the other filesystem functions. Tcl will simultaneously
cache the fact that this path belongs to this filesystem. Such caches
are invalidated when filesystem structures are added or removed from
@@ -1023,7 +1023,7 @@ typedef int \fBTcl_FSPathInFilesystemProc\fR(
.SS DUPINTERNALREPPROC
.PP
This function makes a copy of a path's internal representation, and is
-called when Tcl needs to duplicate a path object. If NULL, Tcl will
+called when Tcl needs to duplicate a path value. If NULL, Tcl will
simply not copy the internal representation, which may then need to be
regenerated later.
.PP
@@ -1043,8 +1043,8 @@ typedef void \fBTcl_FSFreeInternalRepProc\fR(
.SS INTERNALTONORMALIZEDPROC
.PP
Function to convert internal representation to a normalized path. Only
-required if the filesystem creates pure path objects with no string/path
-representation. The return value is a Tcl object whose string
+required if the filesystem creates pure path values with no string/path
+representation. The return value is a Tcl value whose string
representation is the normalized path.
.PP
.CS
@@ -1053,9 +1053,9 @@ typedef Tcl_Obj *\fBTcl_FSInternalToNormalizedProc\fR(
.CE
.SS CREATEINTERNALREPPROC
.PP
-Function to take a path object, and calculate an internal
+Function to take a path value, and calculate an internal
representation for it, and store that native representation in the
-object. May be NULL if paths have no internal representation, or if
+value. May be NULL if paths have no internal representation, or if
the \fITcl_FSPathInFilesystemProc\fR for this filesystem always
immediately creates an internal representation for paths it accepts.
.PP
@@ -1067,7 +1067,7 @@ typedef ClientData \fBTcl_FSCreateInternalRepProc\fR(
.PP
Function to normalize a path. Should be implemented for all
filesystems which can have multiple string representations for the same
-path object. In Tcl, every
+path value. In Tcl, every
.QW path
must have a single unique
.QW normalized
@@ -1079,7 +1079,7 @@ reference to a home directory such as
.QW ~ ,
a path containing symbolic
links, etc). If the very last component in the path is a symbolic
-link, it should not be converted into the object it points to (but
+link, it should not be converted into the value it points to (but
its case or other aspects should be made unique). All other path
components should be converted from symbolic links. This one
exception is required to agree with Tcl's semantics with \fBfile
@@ -1123,7 +1123,7 @@ which is returned. A typical return value might be
or
.QW ftp .
The Tcl_Obj result is owned by the filesystem and so Tcl will
-increment the refCount of that object if it wishes to retain a reference
+increment the reference count of that value if it wishes to retain a reference
to it.
.PP
.CS
@@ -1138,7 +1138,7 @@ different separator than the standard string
.QW / .
Amongst other
uses, it is returned by the \fBfile separator\fR command. The
-return value should be an object with refCount of zero.
+return value should be a value with reference count of zero.
.PP
.CS
typedef Tcl_Obj *\fBTcl_FSFilesystemSeparatorProc\fR(
@@ -1164,8 +1164,8 @@ to all directories named in the path leading to the file. The stat
structure includes info regarding device, inode (always 0 on Windows),
privilege mode, nlink (always 1 on Windows), user id (always 0 on
Windows), group id (always 0 on Windows), rdev (same as device on
-Windows), size, last access time, last modification time, and creation
-time.
+Windows), size, last access time, last modification time, and
+last metadata change time.
.PP
If the file represented by \fIpathPtr\fR exists, the
\fBTcl_FSStatProc\fR returns 0 and the stat structure is filled with
@@ -1219,8 +1219,9 @@ In addition, if \fIinterp\fR is non-NULL, the
\fBTcl_FSOpenFileChannelProc\fR leaves an error message in \fIinterp\fR's
result after any error.
.PP
-The newly created channel is not registered in the supplied
-interpreter; to register it, use \fBTcl_RegisterChannel\fR. If one of
+The newly created channel must not be registered in the supplied interpreter
+by a \fBTcl_FSOpenFileChannelProc\fR; that task is up to the caller of
+\fBTcl_FSOpenFileChannel\fR (if necessary). If one of
the standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR was
previously closed, the act of creating the new channel also assigns it
as a replacement for the standard channel.
@@ -1256,7 +1257,7 @@ The return value is a standard Tcl result indicating whether an error
occurred in the matching process. Error messages are placed in
\fIinterp\fR, unless \fIinterp\fR in NULL in which case no error
message need be generated; on a \fBTCL_OK\fR result, results should be
-added to the \fIresultPtr\fR object given (which can be assumed to be a
+added to the \fIresultPtr\fR value given (which can be assumed to be a
valid unshared Tcl list). The matches added
to \fIresultPtr\fR should include any path prefix given in \fIpathPtr\fR
(this usually means they will be absolute path specifications).
@@ -1326,7 +1327,7 @@ contents of a link. The result is a Tcl_Obj specifying the contents of
the link given by \fIlinkNamePtr\fR, or NULL if the link could
not be read. The result is owned by the caller (and should therefore
have its ref count incremented before being returned). Any callers
-should call Tcl_DecrRefCount on this result when it is no longer needed.
+should call \fBTcl_DecrRefCount\fR on this result when it is no longer needed.
If \fItoPtr\fR is not NULL, the function should attempt to create a link.
The result in this case should be \fItoPtr\fR if the link was successful
and NULL otherwise. In this case the result is not owned by the caller
@@ -1344,16 +1345,16 @@ typedef Tcl_Obj *\fBTcl_FSListVolumesProc\fR(void);
.CE
.PP
The result should be a list of volumes added by this filesystem, or
-NULL (or an empty list) if no volumes are provided. The result object
+NULL (or an empty list) if no volumes are provided. The result value
is considered to be owned by the filesystem (not by Tcl's core), but
-should be given a refCount for Tcl. Tcl will use the contents of the
-list and then decrement that refCount. This allows filesystems to
+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"
of volumes
or not (if not, they generate the list on the fly and pass it to Tcl
-with a refCount of 1 and then forget about the list, if yes, then
-they simply increment the refCount of their master list and pass it
+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
to Tcl which will copy the contents and then decrement the count back
to where it was).
.PP
@@ -1379,7 +1380,7 @@ will take that list and first increment its reference count before using it.
On completion of that use, Tcl will decrement its reference count. Hence if
the list should be disposed of by Tcl when done, it should have a
reference count of zero, and if the list should not be disposed of, the
-filesystem should ensure it returns an object with a reference count
+filesystem should ensure it returns a value with a reference count
of at least one.
.SS FILEATTRSGETPROC
.PP
diff --git a/doc/FindExec.3 b/doc/FindExec.3
index 10a3c72..e4b4ed0 100644
--- a/doc/FindExec.3
+++ b/doc/FindExec.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: FindExec.3,v 1.7 2004/10/07 15:15:38 dkf Exp $
-'\"
.so man.macros
.TH Tcl_FindExecutable 3 8.1 Tcl "Tcl Library Procedures"
.BS
@@ -47,6 +45,13 @@ application's executable, if possible. If it fails to find
the binary, then future calls to \fBinfo nameofexecutable\fR
will return an empty string.
.PP
+On Windows platforms this procedure is typically invoked as the very
+first thing in the application's main program as well; Its \fIargv[0]\fR
+argument is only used to indicate whether the executable has a stderr
+channel (any non-null value) or not (the value null). If \fBTcl_SetPanicProc\fR
+is never called and no debugger is running, this determines whether
+the panic message is sent to stderr or to a standard system dialog.
+.PP
\fBTcl_GetNameOfExecutable\fR simply returns a pointer to the
internal full path name of the executable file as computed by
\fBTcl_FindExecutable\fR. This procedure call is the C API
diff --git a/doc/GetCwd.3 b/doc/GetCwd.3
index d333fca..964e237 100755
--- a/doc/GetCwd.3
+++ b/doc/GetCwd.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: GetCwd.3,v 1.9 2007/12/13 15:22:31 dgp Exp $
-'\"
.so man.macros
.TH Tcl_GetCwd 3 8.1 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/GetHostName.3 b/doc/GetHostName.3
index 37252dc..28f3a4f 100644
--- a/doc/GetHostName.3
+++ b/doc/GetHostName.3
@@ -2,8 +2,6 @@
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
-'\" RCS: @(#) $Id: GetHostName.3,v 1.4 2004/10/07 15:15:38 dkf Exp $
-'\"
.so man.macros
.TH Tcl_GetHostName 3 8.3 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/GetIndex.3 b/doc/GetIndex.3
index 7d138eb..d32561a 100644
--- a/doc/GetIndex.3
+++ b/doc/GetIndex.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: GetIndex.3,v 1.24 2008/10/19 16:22:20 dkf Exp $
-'\"
.so man.macros
.TH Tcl_GetIndexFromObj 3 8.1 Tcl "Tcl Library Procedures"
.BS
@@ -28,16 +26,22 @@ int
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 object is used to search through \fItablePtr\fR.
+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
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
+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
+internal representation of \fIobjPtr\fR, so this should represent the
+address of a statically-allocated array of structures.
.AP int offset in
The offset to add to structTablePtr to get to the next entry.
The end of the array is marked by a NULL string pointer.
@@ -53,10 +57,10 @@ The index of the string in \fItablePtr\fR that matches the value of
.BE
.SH DESCRIPTION
.PP
-This procedure provides an efficient way for looking up keywords,
-switch names, option names, and similar things where the value of
-an object must be one of a predefined set of values.
-\fIObjPtr\fR is compared against each of
+These procedures provide an efficient way for looking up keywords,
+switch names, option names, and similar things where the literal value of
+a Tcl value must be chosen from a predefined set.
+\fBTcl_GetIndexFromObj\fR compares \fIobjPtr\fR against each of
the strings in \fItablePtr\fR to find a match. A match occurs if
\fIobjPtr\fR's string value is identical to one of the strings in
\fItablePtr\fR, or if it is a non-empty unique abbreviation
@@ -97,4 +101,4 @@ each of several array elements.
.SH "SEE ALSO"
prefix(n), Tcl_WrongNumArgs(3)
.SH KEYWORDS
-index, object, table lookup
+index, option, value, table lookup
diff --git a/doc/GetInt.3 b/doc/GetInt.3
index 00ce1c9..f77d337 100644
--- a/doc/GetInt.3
+++ b/doc/GetInt.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: GetInt.3,v 1.14 2007/12/13 15:22:31 dgp Exp $
-'\"
.so man.macros
.TH Tcl_GetInt 3 "" Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/GetOpnFl.3 b/doc/GetOpnFl.3
index 45271ad..38aa976 100644
--- a/doc/GetOpnFl.3
+++ b/doc/GetOpnFl.3
@@ -4,7 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: GetOpnFl.3,v 1.14 2007/12/13 15:22:31 dgp Exp $
.so man.macros
.TH Tcl_GetOpenFile 3 8.0 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/GetStdChan.3 b/doc/GetStdChan.3
index fb91517..e76ad66 100644
--- a/doc/GetStdChan.3
+++ b/doc/GetStdChan.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: GetStdChan.3,v 1.9 2008/10/15 10:43:37 dkf Exp $
-'\"
.so man.macros
.TH Tcl_GetStdChannel 3 7.5 Tcl "Tcl Library Procedures"
.BS
@@ -79,7 +77,7 @@ assigned starting with standard input, followed by standard output, with
standard error being last.
.PP
See \fBTcl_StandardChannels\fR for a general treatise about standard
-channels and the behaviour of the Tcl library with regard to them.
+channels and the behavior of the Tcl library with regard to them.
.SH "SEE ALSO"
Tcl_Close(3), Tcl_CreateChannel(3), Tcl_Main(3), tclsh(1)
diff --git a/doc/GetTime.3 b/doc/GetTime.3
index be6c1ba..f4da364 100644
--- a/doc/GetTime.3
+++ b/doc/GetTime.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id$
-'\"
.so man.macros
.TH Tcl_GetTime 3 8.4 Tcl "Tcl Library Procedures"
.BS
@@ -92,21 +90,19 @@ typedef void \fBTcl_ScaleTimeProc\fR(
.CE
.PP
The \fItimebuf\fR fields contain the time to manipulate, and the
-\fIclientData\fR fields contain a pointer supplied at the time the
-handler functions were registered.
+\fIclientData\fR fields contain a pointer supplied at the time the handler
+functions were registered.
.PP
-Any handler pair specified has to return data which is consistent
-between them. In other words, setting one handler of the pair to
-something assuming a 10-times slowdown, and the other handler of the
-pair to something assuming a two-times slowdown is wrong and not
-allowed.
+Any handler pair specified has to return data which is consistent between
+them. In other words, setting one handler of the pair to something assuming a
+10-times slowdown, and the other handler of the pair to something assuming a
+two-times slowdown is wrong and not allowed.
.PP
-The set handler functions are allowed to run the delivered time
-backwards, however this should be avoided. We have to allow it as the
-native time can run backwards as the user can fiddle with the system
-time one way or other. Note that the insertion of the hooks will not
-change the behaviour of the Tcl core with regard to this situation,
-i.e. the existing behaviour is retained.
+The set handler functions are allowed to run the delivered time backwards,
+however this should be avoided. We have to allow it as the native time can run
+backwards as the user can fiddle with the system time one way or other. Note
+that the insertion of the hooks will not change the behavior of the Tcl core
+with regard to this situation, i.e. the existing behavior is retained.
.SH "SEE ALSO"
clock(n)
.SH KEYWORDS
diff --git a/doc/GetVersion.3 b/doc/GetVersion.3
index 8082425..47034d0 100755
--- a/doc/GetVersion.3
+++ b/doc/GetVersion.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: GetVersion.3,v 1.4 2004/10/07 14:44:32 dkf Exp $
-'\"
.so man.macros
.TH Tcl_GetVersion 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Hash.3 b/doc/Hash.3
index 38a71ba..73b89c5 100644
--- a/doc/Hash.3
+++ b/doc/Hash.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Hash.3,v 1.34 2010/08/14 20:58:30 nijtmans Exp $
-'\"
.so man.macros
.TH Tcl_Hash 3 "" Tcl "Tcl Library Procedures"
.BS
@@ -59,7 +57,7 @@ Kind of keys to use for new hash table. Must be either
\fBTCL_STRING_KEYS\fR, \fBTCL_ONE_WORD_KEYS\fR, \fBTCL_CUSTOM_TYPE_KEYS\fR,
\fBTCL_CUSTOM_PTR_KEYS\fR, or an integer value greater than 1.
.AP Tcl_HashKeyType *typePtr in
-Address of structure which defines the behaviour of the hash table.
+Address of structure which defines the behavior of the hash table.
.AP "const void" *key in
Key to use for probe into table. Exact form depends on
\fIkeyType\fR used to create table.
@@ -312,14 +310,14 @@ typedef Tcl_HashEntry *\fBTcl_AllocHashEntryProc\fR(
void *\fIkeyPtr\fR);
.CE
.PP
-If this is NULL then Tcl_Alloc is used to allocate enough space for a
+If this is NULL then \fBTcl_Alloc\fR is used to allocate enough space for a
Tcl_HashEntry, the key pointer is assigned to key.oneWordValue and the
clientData is set to NULL. String keys and array keys use this function to
allocate enough space for the entry and the key in one block, rather than
doing it in two blocks. This saves space for a pointer to the key from the
entry and another memory allocation. Tcl_Obj* keys use this function to
allocate enough space for an entry and increment the reference count on the
-object.
+value.
.PP
The \fIfreeEntryProc\fR member contains the address of a function called to
free space for an entry.
@@ -329,8 +327,8 @@ typedef void \fBTcl_FreeHashEntryProc\fR(
Tcl_HashEntry *\fIhPtr\fR);
.CE
.PP
-If this is NULL then Tcl_Free is used to free the space for the entry.
+If this is NULL then \fBTcl_Free\fR is used to free the space for the entry.
Tcl_Obj* keys use this function to decrement the reference count on the
-object.
+value.
.SH KEYWORDS
hash table, key, lookup, search, value
diff --git a/doc/Init.3 b/doc/Init.3
index 94c4fff..f421479 100644
--- a/doc/Init.3
+++ b/doc/Init.3
@@ -2,8 +2,6 @@
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
-'\" RCS: @(#) $Id: Init.3,v 1.6 2007/12/13 15:22:31 dgp Exp $
-'\"
.so man.macros
.TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/InitStubs.3 b/doc/InitStubs.3
index 0c42814..5f56278 100644
--- a/doc/InitStubs.3
+++ b/doc/InitStubs.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: InitStubs.3,v 1.11 2004/10/07 15:15:38 dkf Exp $
-'\"
.so man.macros
.TH Tcl_InitStubs 3 8.1 Tcl "Tcl Library Procedures"
.BS
@@ -65,9 +63,9 @@ Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the
\fB\-DUSE_TCL_STUBS\fR flag when compiling the extension.
.IP 3) 5
Link the extension with the Tcl stubs library instead of the standard
-Tcl library. On Unix platforms, the library name is
-\fIlibtclstub8.1.a\fR; on Windows platforms, the library name is
-\fItclstub81.lib\fR.
+Tcl library. For example, to use the Tcl 8.1 ABI on Unix platforms,
+the library name is \fIlibtclstub8.1.a\fR; on Windows platforms, the
+library name is \fItclstub81.lib\fR.
.PP
If the extension also requires the Tk API, it must also call
\fBTk_InitStubs\fR to initialize the Tk stubs interface and link
diff --git a/doc/IntObj.3 b/doc/IntObj.3
index 99e6ab6..4b7b8a6 100644
--- a/doc/IntObj.3
+++ b/doc/IntObj.3
@@ -4,13 +4,11 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: IntObj.3,v 1.17 2009/11/27 14:35:10 dkf Exp $
-'\"
.so man.macros
.TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl objects as integer values
+Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -58,17 +56,17 @@ int
.SH ARGUMENTS
.AS Tcl_WideInt doubleValue in/out
.AP int intValue in
-Integer value used to initialize or set a Tcl object.
+Integer value used to initialize or set a Tcl value.
.AP long longValue in
-Long integer value used to initialize or set a Tcl object.
+Long integer value used to initialize or set a Tcl value.
.AP Tcl_WideInt wideValue in
-Wide integer value used to initialize or set a Tcl object.
+Wide integer value used to initialize or set a Tcl value.
.AP Tcl_Obj *objPtr in/out
For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR,
-and \fBTcl_SetBignumObj\fR, this points to the object in which to store an
+and \fBTcl_SetBignumObj\fR, this points to the value in which to store an
integral value. For \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR,
\fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and
-\fBTcl_TakeBignumFromObj\fR, this refers to the object from which
+\fBTcl_TakeBignumFromObj\fR, this refers to the value from which
to retrieve an integral value.
.AP Tcl_Interp *interp in/out
When non-NULL, an error message is left here when integral value
@@ -88,7 +86,7 @@ used to initialize a multi-precision integer value.
.BE
.SH DESCRIPTION
.PP
-These procedures are used to create, modify, and read Tcl objects
+These procedures are used to create, modify, and read Tcl values
that hold integral values.
.PP
The different routines exist to accommodate different integral types in C
@@ -105,22 +103,22 @@ by the LibTomMath multiple-precision integer library.
.PP
The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR,
and \fBTcl_NewBignumObj\fR routines each create and return a new
-Tcl object initialized to the integral value of the argument. The
-returned Tcl object is unshared.
+Tcl value initialized to the integral value of the argument. The
+returned Tcl value is unshared.
.PP
The \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR,
and \fBTcl_SetBignumObj\fR routines each set the value of an existing
-Tcl object pointed to by \fIobjPtr\fR to the integral value provided
+Tcl value pointed to by \fIobjPtr\fR to the integral value provided
by the other argument. The \fIobjPtr\fR argument must point to an
-unshared Tcl object. Any attempt to set the value of a shared Tcl object
+unshared Tcl value. Any attempt to set the value of a shared Tcl value
violates Tcl's copy-on-write policy. Any existing string representation
-or internal representation in the unshared Tcl object will be freed
+or internal representation in the unshared Tcl value will be freed
as a consequence of setting the new value.
.PP
The \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR,
\fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and
\fBTcl_TakeBignumFromObj\fR routines attempt to retrieve an integral
-value of the appropriate type from the Tcl object \fIobjPtr\fR. If the
+value of the appropriate type from the Tcl value \fIobjPtr\fR. If the
attempt succeeds, then \fBTCL_OK\fR is returned, and the value is
written to the storage provided by the caller. The attempt might
fail if \fIobjPtr\fR does not hold an integral value, or if the
@@ -129,7 +127,7 @@ then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL,
an error message is left in \fIinterp\fR. The \fBTcl_ObjType\fR
of \fIobjPtr\fR may be changed to make subsequent calls to the
same routine more efficient. Unlike the other functions,
-\fBTcl_TakeBignumFromObj\fR may set the content of the Tcl object
+\fBTcl_TakeBignumFromObj\fR may set the content of the Tcl value
\fIobjPtr\fR to an empty string in the process of retrieving the
multiple-precision integer value.
.PP
@@ -150,4 +148,5 @@ integer value in the \fBmp_int\fR value \fIbigValue\fR.
.SH "SEE ALSO"
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
.SH KEYWORDS
-integer, integer object, integer type, internal representation, object, object type, string representation
+integer, integer value, integer type, internal representation, value,
+value type, string representation
diff --git a/doc/Interp.3 b/doc/Interp.3
index 4f0a250..d908057 100644
--- a/doc/Interp.3
+++ b/doc/Interp.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Interp.3,v 1.15 2008/12/15 18:33:25 dgp Exp $
-'\"
.so man.macros
.TH Tcl_Interp 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Limit.3 b/doc/Limit.3
index be4373d..2941ee8 100644
--- a/doc/Limit.3
+++ b/doc/Limit.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Limit.3,v 1.9 2009/11/27 14:35:10 dkf Exp $
-'\"
.so man.macros
.TH Tcl_LimitCheck 3 8.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/LinkVar.3 b/doc/LinkVar.3
index 3801026..dc71a45 100644
--- a/doc/LinkVar.3
+++ b/doc/LinkVar.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: LinkVar.3,v 1.19 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/ListObj.3 b/doc/ListObj.3
index 6215fc2..bc6917d 100644
--- a/doc/ListObj.3
+++ b/doc/ListObj.3
@@ -4,13 +4,11 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: ListObj.3,v 1.13 2008/12/18 21:23:47 dkf Exp $
-'\"
.so man.macros
.TH Tcl_ListObj 3 8.0 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_ListObjAppendList, Tcl_ListObjAppendElement, Tcl_NewListObj, Tcl_SetListObj, Tcl_ListObjGetElements, Tcl_ListObjLength, Tcl_ListObjIndex, Tcl_ListObjReplace \- manipulate Tcl objects as lists
+Tcl_ListObjAppendList, Tcl_ListObjAppendElement, Tcl_NewListObj, Tcl_SetListObj, Tcl_ListObjGetElements, Tcl_ListObjLength, Tcl_ListObjIndex, Tcl_ListObjReplace \- manipulate Tcl values as lists
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -40,44 +38,44 @@ int
.SH ARGUMENTS
.AS "Tcl_Obj *const" *elemListPtr in/out
.AP Tcl_Interp *interp in
-If an error occurs while converting an object to be a list object,
-an error message is left in the interpreter's result object
+If an error occurs while converting a value to be a list value,
+an error message is left in the interpreter's result value
unless \fIinterp\fR is NULL.
.AP Tcl_Obj *listPtr in/out
-Points to the list object to be manipulated.
-If \fIlistPtr\fR does not already point to a list object,
+Points to the list value to be manipulated.
+If \fIlistPtr\fR does not already point to a list value,
an attempt will be made to convert it to one.
.AP Tcl_Obj *elemListPtr in/out
-For \fBTcl_ListObjAppendList\fR, this points to a list object
+For \fBTcl_ListObjAppendList\fR, this points to a list value
containing elements to be appended onto \fIlistPtr\fR.
Each element of *\fIelemListPtr\fR will
become a new element of \fIlistPtr\fR.
If *\fIelemListPtr\fR is not NULL and
-does not already point to a list object,
+does not already point to a list value,
an attempt will be made to convert it to one.
.AP Tcl_Obj *objPtr in
For \fBTcl_ListObjAppendElement\fR,
-points to the Tcl object that will be appended to \fIlistPtr\fR.
+points to the Tcl value that will be appended to \fIlistPtr\fR.
For \fBTcl_SetListObj\fR,
-this points to the Tcl object that will be converted to a list object
+this points to the Tcl value that will be converted to a list value
containing the \fIobjc\fR elements of the array referenced by \fIobjv\fR.
.AP int *objcPtr in
Points to location where \fBTcl_ListObjGetElements\fR
-stores the number of element objects in \fIlistPtr\fR.
+stores the number of element values in \fIlistPtr\fR.
.AP Tcl_Obj ***objvPtr out
A location where \fBTcl_ListObjGetElements\fR stores a pointer to an array
-of pointers to the element objects of \fIlistPtr\fR.
+of pointers to the element values of \fIlistPtr\fR.
.AP int objc in
-The number of Tcl objects that \fBTcl_NewListObj\fR
-will insert into a new list object,
+The number of Tcl values that \fBTcl_NewListObj\fR
+will insert into a new list value,
and \fBTcl_ListObjReplace\fR will insert into \fIlistPtr\fR.
For \fBTcl_SetListObj\fR,
-the number of Tcl objects to insert into \fIobjPtr\fR.
+the number of Tcl values to insert into \fIobjPtr\fR.
.AP "Tcl_Obj *const" objv[] in
-An array of pointers to objects.
-\fBTcl_NewListObj\fR will insert these objects into a new list object
+An array of pointers to values.
+\fBTcl_NewListObj\fR will insert these values into a new list value
and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR.
-Each object will become a separate list element.
+Each value will become a separate list element.
.AP int *intPtr out
Points to location where \fBTcl_ListObjLength\fR
stores the length of the list.
@@ -87,7 +85,7 @@ is to return.
The first element has index 0.
.AP Tcl_Obj **objPtrPtr out
Points to place where \fBTcl_ListObjIndex\fR is to store
-a pointer to the resulting list element object.
+a pointer to the resulting list element value.
.AP int first in
Index of the starting list element that \fBTcl_ListObjReplace\fR
is to replace.
@@ -99,85 +97,85 @@ is to replace.
.SH DESCRIPTION
.PP
-Tcl list objects have an internal representation that supports
+Tcl list values have an internal representation that supports
the efficient indexing and appending.
The procedures described in this man page are used to
-create, modify, index, and append to Tcl list objects from C code.
+create, modify, index, and append to Tcl list values from C code.
.PP
\fBTcl_ListObjAppendList\fR and \fBTcl_ListObjAppendElement\fR
-both add one or more objects
-to the end of the list object referenced by \fIlistPtr\fR.
-\fBTcl_ListObjAppendList\fR appends each element of the list object
+both add one or more values
+to the end of the list value referenced by \fIlistPtr\fR.
+\fBTcl_ListObjAppendList\fR appends each element of the list value
referenced by \fIelemListPtr\fR while
-\fBTcl_ListObjAppendElement\fR appends the single object
+\fBTcl_ListObjAppendElement\fR appends the single value
referenced by \fIobjPtr\fR.
-Both procedures will convert the object referenced by \fIlistPtr\fR
-to a list object if necessary.
+Both procedures will convert the value referenced by \fIlistPtr\fR
+to a list value if necessary.
If an error occurs during conversion,
both procedures return \fBTCL_ERROR\fR and leave an error message
-in the interpreter's result object if \fIinterp\fR is not NULL.
-Similarly, if \fIelemListPtr\fR does not already refer to a list object,
+in the interpreter's result value if \fIinterp\fR is not NULL.
+Similarly, if \fIelemListPtr\fR does not already refer to a list value,
\fBTcl_ListObjAppendList\fR will attempt to convert it to one
and if an error occurs during conversion,
will return \fBTCL_ERROR\fR
-and leave an error message in the interpreter's result object
+and leave an error message in the interpreter's result value
if interp is not NULL.
Both procedures invalidate any old string representation of \fIlistPtr\fR
-and, if it was converted to a list object,
+and, if it was converted to a list value,
free any old internal representation.
Similarly, \fBTcl_ListObjAppendList\fR frees any old internal representation
-of \fIelemListPtr\fR if it converts it to a list object.
+of \fIelemListPtr\fR if it converts it to a list value.
After appending each element in \fIelemListPtr\fR,
\fBTcl_ListObjAppendList\fR increments the element's reference count
since \fIlistPtr\fR now also refers to it.
For the same reason, \fBTcl_ListObjAppendElement\fR
increments \fIobjPtr\fR's reference count.
If no error occurs,
-the two procedures return \fBTCL_OK\fR after appending the objects.
+the two procedures return \fBTCL_OK\fR after appending the values.
.PP
\fBTcl_NewListObj\fR and \fBTcl_SetListObj\fR
-create a new object or modify an existing object to hold
+create a new value or modify an existing value to hold
the \fIobjc\fR elements of the array referenced by \fIobjv\fR
-where each element is a pointer to a Tcl object.
+where each element is a pointer to a Tcl value.
If \fIobjc\fR is less than or equal to zero,
-they return an empty object.
-The new object's string representation is left invalid.
+they return an empty value.
+The new value's string representation is left invalid.
The two procedures increment the reference counts
-of the elements in \fIobjc\fR since the list object now refers to them.
-The new list object returned by \fBTcl_NewListObj\fR
+of the elements in \fIobjc\fR since the list value now refers to them.
+The new list value returned by \fBTcl_NewListObj\fR
has reference count zero.
.PP
\fBTcl_ListObjGetElements\fR returns a count and a pointer to an array of
-the elements in a list object. It returns the count by storing it in the
+the elements in a list value. It returns the count by storing it in the
address \fIobjcPtr\fR. Similarly, it returns the array pointer by storing
it in the address \fIobjvPtr\fR.
The memory pointed to is managed by Tcl and should not be freed or written
to by the caller. If the list is empty, 0 is stored at \fIobjcPtr\fR
and NULL at \fIobjvPtr\fR.
-If \fIlistPtr\fR is not already a list object, \fBTcl_ListObjGetElements\fR
+If \fIlistPtr\fR is not already a list value, \fBTcl_ListObjGetElements\fR
will attempt to convert it to one; if the conversion fails, it returns
\fBTCL_ERROR\fR and leaves an error message in the interpreter's result
-object if \fIinterp\fR is not NULL.
+value if \fIinterp\fR is not NULL.
Otherwise it returns \fBTCL_OK\fR after storing the count and array pointer.
.PP
-\fBTcl_ListObjLength\fR returns the number of elements in the list object
+\fBTcl_ListObjLength\fR returns the number of elements in the list value
referenced by \fIlistPtr\fR.
It returns this count by storing an integer in the address \fIintPtr\fR.
-If the object is not already a list object,
+If the value is not already a list value,
\fBTcl_ListObjLength\fR will attempt to convert it to one;
if the conversion fails, it returns \fBTCL_ERROR\fR
-and leaves an error message in the interpreter's result object
+and leaves an error message in the interpreter's result value
if \fIinterp\fR is not NULL.
Otherwise it returns \fBTCL_OK\fR after storing the list's length.
.PP
-The procedure \fBTcl_ListObjIndex\fR returns a pointer to the object
+The procedure \fBTcl_ListObjIndex\fR returns a pointer to the value
at element \fIindex\fR in the list referenced by \fIlistPtr\fR.
-It returns this object by storing a pointer to it
+It returns this value by storing a pointer to it
in the address \fIobjPtrPtr\fR.
-If \fIlistPtr\fR does not already refer to a list object,
+If \fIlistPtr\fR does not already refer to a list value,
\fBTcl_ListObjIndex\fR will attempt to convert it to one;
if the conversion fails, it returns \fBTCL_ERROR\fR
-and leaves an error message in the interpreter's result object
+and leaves an error message in the interpreter's result value
if \fIinterp\fR is not NULL.
If the index is out of range,
that is, \fIindex\fR is negative or
@@ -185,19 +183,19 @@ greater than or equal to the number of elements in the list,
\fBTcl_ListObjIndex\fR stores a NULL in \fIobjPtrPtr\fR
and returns \fBTCL_OK\fR.
Otherwise it returns \fBTCL_OK\fR after storing the element's
-object pointer.
+value pointer.
The reference count for the list element is not incremented;
the caller must do that if it needs to retain a pointer to the element.
.PP
\fBTcl_ListObjReplace\fR replaces zero or more elements
of the list referenced by \fIlistPtr\fR
-with the \fIobjc\fR objects in the array referenced by \fIobjv\fR.
-If \fIlistPtr\fR does not point to a list object,
+with the \fIobjc\fR values in the array referenced by \fIobjv\fR.
+If \fIlistPtr\fR does not point to a list value,
\fBTcl_ListObjReplace\fR will attempt to convert it to one;
if the conversion fails, it returns \fBTCL_ERROR\fR
-and leaves an error message in the interpreter's result object
+and leaves an error message in the interpreter's result value
if \fIinterp\fR is not NULL.
-Otherwise, it returns \fBTCL_OK\fR after replacing the objects.
+Otherwise, it returns \fBTCL_OK\fR after replacing the values.
If \fIobjv\fR is NULL, no new elements are added.
If the argument \fIfirst\fR is zero or negative,
it refers to the first element.
@@ -212,13 +210,13 @@ designated by \fIfirst\fR.
old string representation.
The reference counts of any elements inserted from \fIobjv\fR
are incremented since the resulting list now refers to them.
-Similarly, the reference counts for any replaced objects are decremented.
+Similarly, the reference counts for any replaced values are decremented.
.PP
Because \fBTcl_ListObjReplace\fR combines
both element insertion and deletion,
it can be used to implement a number of list operations.
-For example, the following code inserts the \fIobjc\fR objects
-referenced by the array of object pointers \fIobjv\fR
+For example, the following code inserts the \fIobjc\fR values
+referenced by the array of value pointers \fIobjv\fR
just before the element \fIindex\fR of the list referenced by \fIlistPtr\fR:
.PP
.CS
@@ -226,7 +224,7 @@ result = \fBTcl_ListObjReplace\fR(interp, listPtr, index, 0,
objc, objv);
.CE
.PP
-Similarly, the following code appends the \fIobjc\fR objects
+Similarly, the following code appends the \fIobjc\fR values
referenced by the array \fIobjv\fR
to the end of the list \fIlistPtr\fR:
.PP
@@ -249,4 +247,5 @@ result = \fBTcl_ListObjReplace\fR(interp, listPtr, first, count,
.SH "SEE ALSO"
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_GetObjResult(3)
.SH KEYWORDS
-append, index, insert, internal representation, length, list, list object, list type, object, object type, replace, string representation
+append, index, insert, internal representation, length, list, list value,
+list type, value, value type, replace, string representation
diff --git a/doc/Load.3 b/doc/Load.3
index 9b9ffab..bbfc662 100644
--- a/doc/Load.3
+++ b/doc/Load.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Load.3,v 1.3 2010/04/06 12:51:44 dkf Exp $
-'\"
.so man.macros
.TH Load 3 8.6 Tcl "Tcl Library Procedures"
.BS
@@ -33,7 +31,8 @@ Array of names of symbols to be resolved during the load of the library, or
NULL if no symbols are to be resolved. If an array is given, the last entry in
the array must be NULL.
.AP int flags in
-Reserved for future expansion. Must be 0.
+The value should normally be 0, but \fITCL_LOAD_GLOBAL\fR or \fITCL_LOAD_LAZY\fR
+or a combination of those two is allowed as well.
.AP void *procPtrs out
Points to an array that will hold the addresses of the functions described in
the \fIsymbols\fR argument. Should be NULL if no symbols are to be resolved.
diff --git a/doc/Method.3 b/doc/Method.3
index 79e9b9f..43b3609 100644
--- a/doc/Method.3
+++ b/doc/Method.3
@@ -4,14 +4,12 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Method.3,v 1.5 2010/08/20 23:01:27 nijtmans Exp $
-'\"
.so man.macros
.TH Tcl_Method 3 0.1 TclOO "TclOO Library Functions"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
+Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
.SH SYNOPSIS
.nf
\fB#include <tclOO.h>\fR
diff --git a/doc/NRE.3 b/doc/NRE.3
index 465a8e7..4ad78b3 100644
--- a/doc/NRE.3
+++ b/doc/NRE.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: NRE.3,v 1.8 2010/01/10 12:32:51 dkf Exp $
-'\"
.so man.macros
.TH NRE 3 8.6 Tcl "Tcl Library Procedures"
.BS
@@ -59,7 +57,7 @@ is \fBNULL\fR, then no procedure is called before the command is deleted.
.AP int objc in
Count of parameters provided to the implementation of a command.
.AP Tcl_Obj **objv in
-Pointer to an array of Tcl objects. Each object holds the value of a
+Pointer to an array of Tcl values. Each value holds the value of a
single word in the command to execute.
.AP Tcl_Obj *objPtr in
Pointer to a Tcl_Obj whose value is a script or expression to execute.
@@ -143,7 +141,7 @@ trampoline.
.PP
\fBTcl_NRCmdSwap\fR allows for trampoline evaluation of a command whose
resolution is already known. The \fIcmd\fR parameter gives a
-\fBTcl_Command\fR object (returned from \fBTcl_CreateObjCmd\fR or
+\fBTcl_Command\fR token (returned from \fBTcl_CreateObjCommand\fR or
\fBTcl_GetCommandFromObj\fR) identifying the command to be invoked in
the trampoline; this command must match the word in \fIobjv[0]\fR.
The remaining arguments are as for \fBTcl_NREvalObj\fR.
@@ -297,7 +295,7 @@ int
int result)
{
/* \fIdata[0] .. data[3]\fR are the four words of data
- * passed to \fBTcl_NREvalObj\fR */
+ * passed to \fBTcl_NRAddCallback\fR */
\fI... postprocessing ...\fR
@@ -325,6 +323,6 @@ and the second is for use when there is already a trampoline in place.
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
.SH KEYWORDS
-stackless, nonrecursive, execute, command, global, object, result, script
+stackless, nonrecursive, execute, command, global, value, result, script
.SH COPYRIGHT
Copyright (c) 2008 by Kevin B. Kenny
diff --git a/doc/Namespace.3 b/doc/Namespace.3
index 629eba9..2b47128 100644
--- a/doc/Namespace.3
+++ b/doc/Namespace.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Namespace.3,v 1.11 2008/10/17 10:22:25 dkf Exp $
-'\"
'\" Note that some of these functions do not seem to belong, but they
'\" were all introduced with the same TIP (#139)
'\"
@@ -69,7 +67,7 @@ if no such callback is to be performed.
The namespace to be manipulated, or NULL (for other than
\fBTcl_DeleteNamespace\fR) to manipulate the current namespace.
.AP Tcl_Obj *objPtr out
-A reference to an unshared object to which the function output will be
+A reference to an unshared value to which the function output will be
written.
.AP "const char" *pattern in
The glob-style pattern (see \fBTcl_StringMatch\fR) that describes the
@@ -162,6 +160,6 @@ for the namespace, or NULL if none is set.
the namespace. If \fIhandlerPtr\fR is NULL, then the handler is reset to
its default.
.SH "SEE ALSO"
-Tcl_CreateCommand(3), Tcl_ListObjAppendElements(3), Tcl_SetVar(3)
+Tcl_CreateCommand(3), Tcl_ListObjAppendList(3), Tcl_SetVar(3)
.SH KEYWORDS
namespace, command
diff --git a/doc/Notifier.3 b/doc/Notifier.3
index 8239d8d..f65d580 100644
--- a/doc/Notifier.3
+++ b/doc/Notifier.3
@@ -5,13 +5,11 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Notifier.3,v 1.25 2008/12/18 21:23:47 dkf Exp $
-'\"
.so man.macros
.TH Notifier 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_SetMaxBlockTime, Tcl_QueueEvent, Tcl_ThreadQueueEvent, Tcl_ThreadAlert, Tcl_GetCurrentThread, Tcl_DeleteEvents, Tcl_InitNotifier, Tcl_FinalizeNotifier, Tcl_WaitForEvent, Tcl_AlertNotifier, Tcl_SetTimer, Tcl_ServiceAll, Tcl_ServiceEvent, Tcl_GetServiceMode, Tcl_SetServiceMode \- the event queue and notifier interfaces
+Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_SetMaxBlockTime, Tcl_QueueEvent, Tcl_ThreadQueueEvent, Tcl_ThreadAlert, Tcl_GetCurrentThread, Tcl_DeleteEvents, Tcl_InitNotifier, Tcl_FinalizeNotifier, Tcl_WaitForEvent, Tcl_AlertNotifier, Tcl_SetTimer, Tcl_ServiceAll, Tcl_ServiceEvent, Tcl_GetServiceMode, Tcl_SetServiceMode, Tcl_ServiceModeHook, Tcl_SetNotifier \- the event queue and notifier interfaces
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -413,7 +411,7 @@ an event to the current thread's queue.
To add an event to another thread's queue, use \fBTcl_ThreadQueueEvent\fR.
\fBTcl_ThreadQueueEvent\fR accepts as an argument a Tcl_ThreadId argument,
which uniquely identifies a thread in a Tcl application. To obtain the
-Tcl_ThreadID for the current thread, use the \fBTcl_GetCurrentThread\fR
+Tcl_ThreadId for the current thread, use the \fBTcl_GetCurrentThread\fR
procedure. (A thread would then need to pass this identifier to other
threads for those threads to be able to add events to its queue.)
After adding an event to another thread's queue, you then typically
diff --git a/doc/Object.3 b/doc/Object.3
index 9992653..3d52f61 100644
--- a/doc/Object.3
+++ b/doc/Object.3
@@ -4,13 +4,11 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Object.3,v 1.23 2008/12/18 21:23:47 dkf Exp $
-'\"
.so man.macros
.TH Tcl_Obj 3 8.5 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_NewObj, Tcl_DuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_IsShared, Tcl_InvalidateStringRep \- manipulate Tcl objects
+Tcl_NewObj, Tcl_DuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_IsShared, Tcl_InvalidateStringRep \- manipulate Tcl values
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -32,35 +30,36 @@ int
.SH ARGUMENTS
.AS Tcl_Obj *objPtr
.AP Tcl_Obj *objPtr in
-Points to an object;
+Points to a value;
must have been the result of a previous call to \fBTcl_NewObj\fR.
.BE
.SH INTRODUCTION
.PP
-This man page presents an overview of Tcl objects and how they are used.
-It also describes generic procedures for managing Tcl objects.
-These procedures are used to create and copy objects,
-and increment and decrement the count of references (pointers) to objects.
+This man page presents an overview of Tcl values (called \fBTcl_Obj\fRs for
+historical reasons) and how they are used.
+It also describes generic procedures for managing Tcl values.
+These procedures are used to create and copy values,
+and increment and decrement the count of references (pointers) to values.
The procedures are used in conjunction with ones
-that operate on specific types of objects such as
+that operate on specific types of values such as
\fBTcl_GetIntFromObj\fR and \fBTcl_ListObjAppendElement\fR.
The individual procedures are described along with the data structures
they manipulate.
.PP
-Tcl's \fIdual-ported\fR objects provide a general-purpose mechanism
+Tcl's \fIdual-ported\fR values provide a general-purpose mechanism
for storing and exchanging Tcl values.
They largely replace the use of strings in Tcl.
For example, they are used to store variable values,
command arguments, command results, and scripts.
-Tcl objects behave like strings but also hold an internal representation
+Tcl values behave like strings but also hold an internal representation
that can be manipulated more efficiently.
-For example, a Tcl list is now represented as an object
+For example, a Tcl list is now represented as a value
that holds the list's string representation
-as well as an array of pointers to the objects for each list element.
-Dual-ported objects avoid most runtime type conversions.
+as well as an array of pointers to the values for each list element.
+Dual-ported values avoid most runtime type conversions.
They also improve the speed of many operations
since an appropriate representation is immediately available.
-The compiler itself uses Tcl objects to
+The compiler itself uses Tcl values to
cache the instruction bytecodes resulting from compiling scripts.
.PP
The two representations are a cache of each other and are computed lazily.
@@ -75,39 +74,39 @@ between integers and strings.
Only when it needs a string representing the variable's value,
say to print it,
will the program regenerate the string representation from the integer.
-Although objects contain an internal representation,
+Although values contain an internal representation,
their semantics are defined in terms of strings:
an up-to-date string can always be obtained,
-and any change to the object will be reflected in that string
-when the object's string representation is fetched.
+and any change to the value will be reflected in that string
+when the value's string representation is fetched.
Because of this representation invalidation and regeneration,
it is dangerous for extension writers to access
\fBTcl_Obj\fR fields directly.
It is better to access Tcl_Obj information using
procedures like \fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR.
.PP
-Objects are allocated on the heap
+Values are allocated on the heap
and are referenced using a pointer to their \fBTcl_Obj\fR structure.
-Objects are shared as much as possible.
+Values are shared as much as possible.
This significantly reduces storage requirements
-because some objects such as long lists are very large.
+because some values such as long lists are very large.
Also, most Tcl values are only read and never modified.
This is especially true for procedure arguments,
which can be shared between the caller and the called procedure.
Assignment and argument binding is done by
simply assigning a pointer to the value.
Reference counting is used to determine when it is safe to
-reclaim an object's storage.
+reclaim a value's storage.
.PP
-Tcl objects are typed.
-An object's internal representation is controlled by its type.
+Tcl values are typed.
+A value's internal representation is controlled by its type.
Several types are predefined in the Tcl core
including integer, double, list, and bytecode.
Extension writers can extend the set of types
by defining their own \fBTcl_ObjType\fR structs.
.SH "THE TCL_OBJ STRUCTURE"
.PP
-Each Tcl object is represented by a \fBTcl_Obj\fR structure
+Each Tcl value is represented by a \fBTcl_Obj\fR structure
which is defined as follows.
.PP
.CS
@@ -134,7 +133,7 @@ typedef struct Tcl_Obj {
.CE
.PP
The \fIbytes\fR and the \fIlength\fR members together hold
-an object's UTF-8 string representation,
+a value's UTF-8 string representation,
which is a \fIcounted string\fR not containing null bytes (UTF-8 null
characters should be encoded as a two byte sequence: 192, 128.)
\fIbytes\fR points to the first byte of the string representation.
@@ -144,31 +143,31 @@ at offset \fIlength\fR;
this allows string representations
to be treated as conventional null-terminated C strings.
C programs use \fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR to get
-an object's string representation.
+a value's string representation.
If \fIbytes\fR is NULL,
the string representation is invalid.
.PP
-An object's type manages its internal representation.
+A value's type manages its internal representation.
The member \fItypePtr\fR points to the Tcl_ObjType structure
that describes the type.
If \fItypePtr\fR is NULL,
the internal representation is invalid.
.PP
The \fIinternalRep\fR union member holds
-an object's internal representation.
+a value's internal representation.
This is either a (long) integer, a double-precision floating-point number,
a pointer to a value containing additional information
-needed by the object's type to represent the object, a Tcl_WideInt
+needed by the value's type to represent the value, a Tcl_WideInt
integer, two arbitrary pointers, or a pair made up of an unsigned long
integer and a pointer.
.PP
The \fIrefCount\fR member is used to tell when it is safe to free
-an object's storage.
-It holds the count of active references to the object.
+a value's storage.
+It holds the count of active references to the value.
Maintaining the correct reference count is a key responsibility
of extension writers.
Reference counting is discussed below
-in the section \fBSTORAGE MANAGEMENT OF OBJECTS\fR.
+in the section \fBSTORAGE MANAGEMENT OF VALUES\fR.
.PP
Although extension writers can directly access
the members of a Tcl_Obj structure,
@@ -178,21 +177,21 @@ read or update \fIrefCount\fR directly;
they should use macros such as
\fBTcl_IncrRefCount\fR and \fBTcl_IsShared\fR instead.
.PP
-A key property of Tcl objects is that they hold two representations.
-An object typically starts out containing only a string representation:
+A key property of Tcl values is that they hold two representations.
+A value typically starts out containing only a string representation:
it is untyped and has a NULL \fItypePtr\fR.
-An object containing an empty string or a copy of a specified string
+A value containing an empty string or a copy of a specified string
is created using \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR respectively.
-An object's string value is gotten with
+A value's string value is gotten with
\fBTcl_GetStringFromObj\fR or \fBTcl_GetString\fR
and changed with \fBTcl_SetStringObj\fR.
-If the object is later passed to a procedure like \fBTcl_GetIntFromObj\fR
+If the value is later passed to a procedure like \fBTcl_GetIntFromObj\fR
that requires a specific internal representation,
-the procedure will create one and set the object's \fItypePtr\fR.
+the procedure will create one and set the value's \fItypePtr\fR.
The internal representation is computed from the string representation.
-An object's two representations are duals of each other:
+A value's two representations are duals of each other:
changes made to one are reflected in the other.
-For example, \fBTcl_ListObjReplace\fR will modify an object's
+For example, \fBTcl_ListObjReplace\fR will modify a value's
internal representation and the next call to \fBTcl_GetStringFromObj\fR
or \fBTcl_GetString\fR will reflect that change.
.PP
@@ -205,43 +204,43 @@ so that it is only regenerated if it is needed later.
Most C programmers never have to be concerned with how this is done
and simply use procedures such as \fBTcl_GetBooleanFromObj\fR or
\fBTcl_ListObjIndex\fR.
-Programmers that implement their own object types
+Programmers that implement their own value types
must check for invalid representations
and mark representations invalid when necessary.
The procedure \fBTcl_InvalidateStringRep\fR is used
-to mark an object's string representation invalid and to
+to mark a value's string representation invalid and to
free any storage associated with the old string representation.
.PP
-Objects usually remain one type over their life,
-but occasionally an object must be converted from one type to another.
-For example, a C program might build up a string in an object
+Values usually remain one type over their life,
+but occasionally a value must be converted from one type to another.
+For example, a C program might build up a string in a value
with repeated calls to \fBTcl_AppendToObj\fR,
and then call \fBTcl_ListObjIndex\fR to extract a list element from
-the object.
-The same object holding the same string value
+the value.
+The same value holding the same string value
can have several different internal representations
at different times.
-Extension writers can also force an object to be converted from one type
+Extension writers can also force a value to be converted from one type
to another using the \fBTcl_ConvertToType\fR procedure.
-Only programmers that create new object types need to be concerned
+Only programmers that create new value types need to be concerned
about how this is done.
-A procedure defined as part of the object type's implementation
-creates a new internal representation for an object
+A procedure defined as part of the value type's implementation
+creates a new internal representation for a value
and changes its \fItypePtr\fR.
See the man page for \fBTcl_RegisterObjType\fR
-to see how to create a new object type.
-.SH "EXAMPLE OF THE LIFETIME OF AN OBJECT"
+to see how to create a new value type.
+.SH "EXAMPLE OF THE LIFETIME OF A VALUE"
.PP
-As an example of the lifetime of an object,
+As an example of the lifetime of a value,
consider the following sequence of commands:
.PP
.CS
\fBset x 123\fR
.CE
.PP
-This assigns to \fIx\fR an untyped object whose
+This assigns to \fIx\fR an untyped value whose
\fIbytes\fR member points to \fB123\fR and \fIlength\fR member contains 3.
-The object's \fItypePtr\fR member is NULL.
+The value's \fItypePtr\fR member is NULL.
.PP
.CS
\fBputs "x is $x"\fR
@@ -254,16 +253,16 @@ and is fetched for the command.
\fBincr x\fR
.CE
.PP
-The \fBincr\fR command first gets an integer from \fIx\fR's object
+The \fBincr\fR command first gets an integer from \fIx\fR's value
by calling \fBTcl_GetIntFromObj\fR.
-This procedure checks whether the object is already an integer object.
-Since it is not, it converts the object
-by setting the object's \fIinternalRep.longValue\fR member
+This procedure checks whether the value is already an integer value.
+Since it is not, it converts the value
+by setting the value's \fIinternalRep.longValue\fR member
to the integer \fB123\fR
-and setting the object's \fItypePtr\fR
+and setting the value's \fItypePtr\fR
to point to the integer Tcl_ObjType structure.
Both representations are now valid.
-\fBincr\fR increments the object's integer internal representation
+\fBincr\fR increments the value's integer internal representation
then invalidates its string representation
(by calling \fBTcl_InvalidateStringRep\fR)
since the string representation
@@ -273,31 +272,31 @@ no longer corresponds to the internal representation.
\fBputs "x is now $x"\fR
.CE
.PP
-The string representation of \fIx\fR's object is needed
+The string representation of \fIx\fR's value is needed
and is recomputed.
The string representation is now \fB124\fR
and both representations are again valid.
-.SH "STORAGE MANAGEMENT OF OBJECTS"
+.SH "STORAGE MANAGEMENT OF VALUES"
.PP
-Tcl objects are allocated on the heap and are shared as much as possible
+Tcl values are allocated on the heap and are shared as much as possible
to reduce storage requirements.
-Reference counting is used to determine when an object is
+Reference counting is used to determine when a value is
no longer needed and can safely be freed.
-An object just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR
+A value just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR
has \fIrefCount\fR 0.
The macro \fBTcl_IncrRefCount\fR increments the reference count
-when a new reference to the object is created.
+when a new reference to the value is created.
The macro \fBTcl_DecrRefCount\fR decrements the count
when a reference is no longer needed and,
-if the object's reference count drops to zero, frees its storage.
-An object shared by different code or data structures has
+if the value's reference count drops to zero, frees its storage.
+A value shared by different code or data structures has
\fIrefCount\fR greater than 1.
-Incrementing an object's reference count ensures that
+Incrementing a value's reference count ensures that
it will not be freed too early or have its value change accidentally.
.PP
-As an example, the bytecode interpreter shares argument objects
-between calling and called Tcl procedures to avoid having to copy objects.
-It assigns the call's argument objects to the procedure's
+As an example, the bytecode interpreter shares argument values
+between calling and called Tcl procedures to avoid having to copy values.
+It assigns the call's argument values to the procedure's
formal parameter variables.
In doing so, it calls \fBTcl_IncrRefCount\fR to increment
the reference count of each argument since there is now a new
@@ -305,31 +304,31 @@ reference to it from the formal parameter.
When the called procedure returns,
the interpreter calls \fBTcl_DecrRefCount\fR to decrement
each argument's reference count.
-When an object's reference count drops less than or equal to zero,
+When a value's reference count drops less than or equal to zero,
\fBTcl_DecrRefCount\fR reclaims its storage.
Most command procedures do not have to be concerned about
-reference counting since they use an object's value immediately
-and do not retain a pointer to the object after they return.
-However, if they do retain a pointer to an object in a data structure,
+reference counting since they use a value's value immediately
+and do not retain a pointer to the value after they return.
+However, if they do retain a pointer to a value in a data structure,
they must be careful to increment its reference count
since the retained pointer is a new reference.
.PP
-Command procedures that directly modify objects
+Command procedures that directly modify values
such as those for \fBlappend\fR and \fBlinsert\fR must be careful to
-copy a shared object before changing it.
-They must first check whether the object is shared
+copy a shared value before changing it.
+They must first check whether the value is shared
by calling \fBTcl_IsShared\fR.
-If the object is shared they must copy the object
+If the value is shared they must copy the value
by using \fBTcl_DuplicateObj\fR;
-this returns a new duplicate of the original object
+this returns a new duplicate of the original value
that has \fIrefCount\fR 0.
-If the object is not shared,
+If the value is not shared,
the command procedure
.QW "owns"
-the object and can safely modify it directly.
+the value and can safely modify it directly.
For example, the following code appears in the command procedure
that implements \fBlinsert\fR.
-This procedure modifies the list object passed to it in \fIobjv[1]\fR
+This procedure modifies the list value passed to it in \fIobjv[1]\fR
by inserting \fIobjc-3\fR new elements before \fIindex\fR.
.PP
.CS
@@ -342,11 +341,12 @@ result = Tcl_ListObjReplace(interp, listPtr, index, 0,
.CE
.PP
As another example, \fBincr\fR's command procedure
-must check whether the variable's object is shared before
+must check whether the variable's value is shared before
incrementing the integer in its internal representation.
-If it is shared, it needs to duplicate the object
+If it is shared, it needs to duplicate the value
in order to avoid accidentally changing values in other data structures.
.SH "SEE ALSO"
Tcl_ConvertToType(3), Tcl_GetIntFromObj(3), Tcl_ListObjAppendElement(3), Tcl_ListObjIndex(3), Tcl_ListObjReplace(3), Tcl_RegisterObjType(3)
.SH KEYWORDS
-internal representation, object, object creation, object type, reference counting, string representation, type conversion
+internal representation, value, value creation, value type,
+reference counting, string representation, type conversion
diff --git a/doc/ObjectType.3 b/doc/ObjectType.3
index 47ed451..ca2c7a0 100644
--- a/doc/ObjectType.3
+++ b/doc/ObjectType.3
@@ -4,13 +4,11 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: ObjectType.3,v 1.22 2009/11/27 14:35:10 dkf Exp $
-'\"
.so man.macros
.TH Tcl_ObjType 3 8.0 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType \- manipulate Tcl object types
+Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType \- manipulate Tcl value types
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -28,31 +26,32 @@ int
.SH ARGUMENTS
.AS "const char" *typeName
.AP "const Tcl_ObjType" *typePtr in
-Points to the structure containing information about the Tcl object type.
+Points to the structure containing information about the Tcl value type.
This storage must live forever,
typically by being statically allocated.
.AP "const char" *typeName in
-The name of a Tcl object type that \fBTcl_GetObjType\fR should look up.
+The name of a Tcl value type that \fBTcl_GetObjType\fR should look up.
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP Tcl_Obj *objPtr in
-For \fBTcl_AppendAllObjTypes\fR, this points to the object onto which
-it appends the name of each object type as a list element.
-For \fBTcl_ConvertToType\fR, this points to an object that
+For \fBTcl_AppendAllObjTypes\fR, this points to the value onto which
+it appends the name of each value type as a list element.
+For \fBTcl_ConvertToType\fR, this points to a value that
must have been the result of a previous call to \fBTcl_NewObj\fR.
.BE
.SH DESCRIPTION
.PP
-The procedures in this man page manage Tcl object types.
-They are used to register new object types, look up types,
+The procedures in this man page manage Tcl value types (sometimes
+referred to as object types or \fBTcl_ObjType\fRs for historical reasons).
+They are used to register new value types, look up types,
and force conversions from one type to another.
.PP
-\fBTcl_RegisterObjType\fR registers a new Tcl object type
-in the table of all object types that \fBTcl_GetObjType\fR
-can look up by name. There are other object types supported by Tcl
+\fBTcl_RegisterObjType\fR registers a new Tcl value type
+in the table of all value types that \fBTcl_GetObjType\fR
+can look up by name. There are other value types supported by Tcl
as well, which Tcl chooses not to register. Extensions can likewise
-choose to register the object types they create or not.
+choose to register the value types they create or not.
The argument \fItypePtr\fR points to a Tcl_ObjType structure that
describes the new type by giving its name
and by supplying pointers to four procedures
@@ -67,13 +66,13 @@ in the section \fBTHE TCL_OBJTYPE STRUCTURE\fR below.
with name \fItypeName\fR.
It returns NULL if no type with that name is registered.
.PP
-\fBTcl_AppendAllObjTypes\fR appends the name of each registered object type
-as a list element onto the Tcl object referenced by \fIobjPtr\fR.
+\fBTcl_AppendAllObjTypes\fR appends the name of each registered value type
+as a list element onto the Tcl value referenced by \fIobjPtr\fR.
The return value is \fBTCL_OK\fR unless there was an error
-converting \fIobjPtr\fR to a list object;
+converting \fIobjPtr\fR to a list value;
in that case \fBTCL_ERROR\fR is returned.
.PP
-\fBTcl_ConvertToType\fR converts an object from one type to another
+\fBTcl_ConvertToType\fR converts a value from one type to another
if possible.
It creates a new internal representation for \fIobjPtr\fR
appropriate for the target type \fItypePtr\fR
@@ -81,7 +80,7 @@ and sets its \fItypePtr\fR member as determined by calling the
\fItypePtr->setFromAnyProc\fR routine.
Any internal representation for \fIobjPtr\fR's old type is freed.
If an error occurs during conversion, it returns \fBTCL_ERROR\fR
-and leaves an error message in the result object for \fIinterp\fR
+and leaves an error message in the result value for \fIinterp\fR
unless \fIinterp\fR is NULL.
Otherwise, it returns \fBTCL_OK\fR.
Passing a NULL \fIinterp\fR allows this procedure to be used
@@ -96,7 +95,7 @@ use of another related Tcl_ObjType, if it sees fit.
.VE 8.5
.SH "THE TCL_OBJTYPE STRUCTURE"
.PP
-Extension writers can define new object types by defining four
+Extension writers can define new value types by defining four
procedures and
initializing a Tcl_ObjType structure to describe the type.
Extension writers may also pass a pointer to their Tcl_ObjType
@@ -121,12 +120,12 @@ When a type is registered, this is the name used by callers
of \fBTcl_GetObjType\fR to lookup the type. For unregistered
types, the \fIname\fR field is primarily of value for debugging.
The remaining four members are pointers to procedures
-called by the generic Tcl object code:
+called by the generic Tcl value code:
.SS "THE SETFROMANYPROC FIELD"
.PP
The \fIsetFromAnyProc\fR member contains the address of a function
called to create a valid internal representation
-from an object's string representation.
+from a value's string representation.
.PP
.CS
typedef int \fBTcl_SetFromAnyProc\fR(
@@ -136,7 +135,7 @@ typedef int \fBTcl_SetFromAnyProc\fR(
.PP
If an internal representation cannot be created from the string,
it returns \fBTCL_ERROR\fR and puts a message
-describing the error in the result object for \fIinterp\fR
+describing the error in the result value for \fIinterp\fR
unless \fIinterp\fR is NULL.
If \fIsetFromAnyProc\fR is successful,
it stores the new internal representation,
@@ -171,7 +170,7 @@ should \fInot\fR be registered.
.PP
The \fIupdateStringProc\fR member contains the address of a function
called to create a valid string representation
-from an object's internal representation.
+from a value's internal representation.
.PP
.CS
typedef void \fBTcl_UpdateStringProc\fR(
@@ -205,7 +204,7 @@ or other similar routines ask for the string representation.
.SS "THE DUPINTREPPROC FIELD"
.PP
The \fIdupIntRepProc\fR member contains the address of a function
-called to copy an internal representation from one object to another.
+called to copy an internal representation from one value to another.
.PP
.CS
typedef void \fBTcl_DupInternalRepProc\fR(
@@ -217,7 +216,7 @@ typedef void \fBTcl_DupInternalRepProc\fR(
internal representation.
Before the call,
\fIsrcPtr\fR's internal representation is valid and \fIdupPtr\fR's is not.
-\fIsrcPtr\fR's object type determines what
+\fIsrcPtr\fR's value type determines what
copying its internal representation means.
.PP
For example, the \fIdupIntRepProc\fR for the Tcl integer type
@@ -228,7 +227,7 @@ reasonably can.
.SS "THE FREEINTREPPROC FIELD"
.PP
The \fIfreeIntRepProc\fR member contains the address of a function
-that is called when an object is freed.
+that is called when a value is freed.
.PP
.CS
typedef void \fBTcl_FreeInternalRepProc\fR(
@@ -236,22 +235,22 @@ typedef void \fBTcl_FreeInternalRepProc\fR(
.CE
.PP
The \fIfreeIntRepProc\fR function can deallocate the storage
-for the object's internal representation
-and do other type-specific processing necessary when an object is freed.
+for the value's internal representation
+and do other type-specific processing necessary when a value is freed.
.PP
For example, the list type's \fIfreeIntRepProc\fR respects
the storage sharing scheme established by the \fIdupIntRepProc\fR
-so that it only frees storage when the last object sharing it
+so that it only frees storage when the last value sharing it
is being freed.
.PP
The \fIfreeIntRepProc\fR member can be set to NULL
to indicate that the internal representation does not require freeing.
The \fIfreeIntRepProc\fR implementation must not access the
-\fIbytes\fR member of the object, since Tcl makes its own internal
-uses of that field during object deletion. The defined tasks for
+\fIbytes\fR member of the value, since Tcl makes its own internal
+uses of that field during value deletion. The defined tasks for
the \fIfreeIntRepProc\fR have no need to consult the \fIbytes\fR
member.
.SH "SEE ALSO"
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3)
.SH KEYWORDS
-internal representation, object, object type, string representation, type conversion
+internal representation, value, value type, string representation, type conversion
diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3
index e5083a2..82f51ce 100644
--- a/doc/OpenFileChnl.3
+++ b/doc/OpenFileChnl.3
@@ -4,7 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: OpenFileChnl.3,v 1.38 2010/01/14 11:47:08 dkf Exp $
.so man.macros
.TH Tcl_OpenFileChannel 3 8.3 Tcl "Tcl Library Procedures"
.BS
@@ -153,24 +152,24 @@ The pattern to match on, passed to Tcl_StringMatch, or NULL.
A Tcl channel for input or output. Must have been the return value
from a procedure such as \fBTcl_OpenFileChannel\fR.
.AP Tcl_Obj *readObjPtr in/out
-A pointer to a Tcl Object in which to store the characters read from the
+A pointer to a Tcl value in which to store the characters read from the
channel.
.AP int charsToRead in
The number of characters to read from the channel. If the channel's encoding
is \fBbinary\fR, this is equivalent to the number of bytes to read from the
channel.
.AP int appendFlag in
-If non-zero, data read from the channel will be appended to the object.
-Otherwise, the data will replace the existing contents of the object.
+If non-zero, data read from the channel will be appended to the value.
+Otherwise, the data will replace the existing contents of the value.
.AP char *readBuf out
A buffer in which to store the bytes read from the channel.
.AP int bytesToRead in
The number of bytes to read from the channel. The buffer \fIreadBuf\fR must
be large enough to hold this many bytes.
.AP Tcl_Obj *lineObjPtr in/out
-A pointer to a Tcl object in which to store the line read from the
+A pointer to a Tcl value in which to store the line read from the
channel. The line read will be appended to the current value of the
-object.
+value.
.AP Tcl_DString *lineRead in/out
A pointer to a Tcl dynamic string in which to store the line read from the
channel. Must have been initialized by the caller. The line read will be
@@ -183,7 +182,7 @@ Length of the input
Flag indicating whether the input should be added to the end or
beginning of the channel buffer.
.AP Tcl_Obj *writeObjPtr in
-A pointer to a Tcl Object whose contents will be output to the channel.
+A pointer to a Tcl value whose contents will be output to the channel.
.AP "const char" *charBuf in
A buffer containing the characters to output to the channel.
.AP "const char" *byteBuf in
@@ -240,7 +239,7 @@ returns NULL and records a POSIX error code that can be
retrieved with \fBTcl_GetErrno\fR.
In addition, if \fIinterp\fR is non-NULL, \fBTcl_OpenFileChannel\fR
leaves an error message in \fIinterp\fR's result after any error.
-As of Tcl 8.4, the object-based API \fBTcl_FSOpenFileChannel\fR should
+As of Tcl 8.4, the value-based API \fBTcl_FSOpenFileChannel\fR should
be used in preference to \fBTcl_OpenFileChannel\fR wherever possible.
.PP
The newly created channel is not registered in the supplied interpreter; to
@@ -306,7 +305,7 @@ open for reading and writing.
.PP
\fBTcl_GetChannelNames\fR and \fBTcl_GetChannelNamesEx\fR write the
names of the registered channels to the interpreter's result as a
-list object. \fBTcl_GetChannelNamesEx\fR will filter these names
+list value. \fBTcl_GetChannelNamesEx\fR will filter these names
according to the \fIpattern\fR. If \fIpattern\fR is NULL, then it
will not do any filtering. The return value is \fBTCL_OK\fR if no
errors occurred writing to the result, otherwise it is \fBTCL_ERROR\fR,
@@ -333,7 +332,7 @@ This procedure interacts with the code managing the standard
channels. If no standard channels were initialized before the first
call to \fBTcl_RegisterChannel\fR, they will get initialized by that
call. See \fBTcl_StandardChannels\fR for a general treatise about
-standard channels and the behaviour of the Tcl library with regard to
+standard channels and the behavior of the Tcl library with regard to
them.
.SH TCL_UNREGISTERCHANNEL
.PP
@@ -436,7 +435,7 @@ platform-specific modes are described in the manual entry for the Tcl
As a performance optimization, when reading from a channel with the encoding
\fBbinary\fR, the bytes are not converted to UTF-8 as they are read.
Instead, they are stored in \fIreadObjPtr\fR's internal representation as a
-byte-array object. The string representation of this object will only be
+byte-array value. The string representation of this value will only be
constructed if it is needed (e.g., because of a call to
\fBTcl_GetStringFromObj\fR). In this way, byte-oriented data can be read
from a channel, manipulated by calling \fBTcl_GetByteArrayFromObj\fR and
@@ -485,7 +484,7 @@ of input unavailability.
.PP
\fBTcl_Gets\fR is the same as \fBTcl_GetsObj\fR except the resulting
characters are appended to the dynamic string given by
-\fIlineRead\fR rather than a Tcl object.
+\fIlineRead\fR rather than a Tcl value.
.SH "TCL_UNGETS"
.PP
\fBTcl_Ungets\fR is used to add data to the input queue of a channel,
@@ -524,14 +523,14 @@ end-of-line sequences according to the \fB\-translation\fR option for the
channel. This is done even if the channel has no encoding.
.PP
\fBTcl_WriteObj\fR is similar to \fBTcl_WriteChars\fR except it
-accepts a Tcl object whose contents will be output to the channel. The
+accepts a Tcl value whose contents will be output to the channel. The
UTF-8 characters in \fIwriteObjPtr\fR's string representation are converted
to the channel's encoding and queued for output to \fIchannel\fR.
As a performance optimization, when writing to a channel with the encoding
\fBbinary\fR, UTF-8 characters are not converted as they are written.
Instead, the bytes in \fIwriteObjPtr\fR's internal representation as a
-byte-array object are written to the channel. The byte-array representation
-of the object will be constructed if it is needed. In this way,
+byte-array value are written to the channel. The byte-array representation
+of the value will be constructed if it is needed. In this way,
byte-oriented data can be read from a channel, manipulated by calling
\fBTcl_GetByteArrayFromObj\fR and related functions, and then written to a
channel without the expense of ever converting to or from UTF-8.
diff --git a/doc/OpenTcp.3 b/doc/OpenTcp.3
index 0dff4c4..78ac70b 100644
--- a/doc/OpenTcp.3
+++ b/doc/OpenTcp.3
@@ -4,7 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: OpenTcp.3,v 1.14 2010/01/14 11:47:08 dkf Exp $
.so man.macros
.TH Tcl_OpenTcpClient 3 8.0 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Panic.3 b/doc/Panic.3
index 00187ff..48aed2b 100644
--- a/doc/Panic.3
+++ b/doc/Panic.3
@@ -2,8 +2,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Panic.3,v 1.9 2008/06/29 22:28:24 dkf Exp $
-'\"
.so man.macros
.TH Tcl_Panic 3 8.4 Tcl "Tcl Library Procedures"
.BS
@@ -51,7 +49,10 @@ same formatting rules are also used by the built-in Tcl command
In a freshly loaded Tcl library, \fBTcl_Panic\fR prints the formatted
error message to the standard error file of the process, and then
calls \fBabort\fR to terminate the process. \fBTcl_Panic\fR does not
-return.
+return. On Windows, when a debugger is running, the formatted error
+message is sent to the debugger in stead. If the windows executable
+does not have a stderr channel (e.g. \fBwish.exe\fR), then a
+system dialog box is used to display the panic message.
.PP
\fBTcl_SetPanicProc\fR may be used to modify the behavior of
\fBTcl_Panic\fR. The \fIpanicProc\fR argument should match the
@@ -65,19 +66,14 @@ typedef void \fBTcl_PanicProc\fR(
.PP
After \fBTcl_SetPanicProc\fR returns, any future calls to
\fBTcl_Panic\fR will call \fIpanicProc\fR, passing along the
-\fIformat\fR and \fIarg\fR arguments. To maintain consistency with the
-callers of \fBTcl_Panic\fR, \fIpanicProc\fR must not return; it must
-call \fBabort\fR. \fIpanicProc\fR should avoid making calls into the
-Tcl library, or into other libraries that may call the Tcl library,
-since the original call to \fBTcl_Panic\fR indicates the Tcl library is
-not in a state of reliable operation.
+\fIformat\fR and \fIarg\fR arguments. \fIpanicProc\fR should avoid
+making calls into the Tcl library, or into other libraries that may
+call the Tcl library, since the original call to \fBTcl_Panic\fR
+indicates the Tcl library is not in a state of reliable operation.
.PP
The typical use of \fBTcl_SetPanicProc\fR arranges for the error message
to be displayed or reported in a manner more suitable for the
-application or the platform. As an example, the Windows implementation
-of \fBwish\fR calls \fBTcl_SetPanicProc\fR to force all panic messages
-to be displayed in a system dialog box, rather than to be printed to the
-standard error file (usually not visible under Windows).
+application or the platform.
.PP
Although the primary callers of \fBTcl_Panic\fR are the procedures of
the Tcl library, \fBTcl_Panic\fR is a public function and may be called
diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3
index 1711b8c..1ceafe5 100644
--- a/doc/ParseArgs.3
+++ b/doc/ParseArgs.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: ParseArgs.3,v 1.2 2010/01/29 16:17:21 nijtmans Exp $
-'\"
.so man.macros
.TH Tcl_ParseArgsObjv 3 8.6 Tcl "Tcl Library Procedures"
.BS
@@ -136,7 +134,7 @@ typedef int (\fBTcl_ArgvFuncProc\fR)(
.PP
The result is a boolean value indicating whether to consume the following
argument. The \fIclientData\fR is the value from the table entry, the
-\fIobjPtr\fR is the object that represents the following argument or NULL if
+\fIobjPtr\fR is the value that represents the following argument or NULL if
there are no following arguments at all, and the \fIdstPtr\fR argument to the
\fBTcl_ArgvFuncProc\fR is the location to write the parsed value to.
.RE
@@ -188,7 +186,7 @@ marks all following arguments to be left unprocessed. The \fIsrcPtr\fR,
.
This argument takes a following string value argument. A pointer to the string
will be stored at \fIdstPtr\fR; the string inside will have a lifetime linked
-to the lifetime of the string representation of the argument object that it
+to the lifetime of the string representation of the argument value that it
came from, and so should be copied if it needs to be retained. The
\fIsrcPtr\fR and \fIclientData\fR fields are ignored.
.SH "SEE ALSO"
diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3
index b134a1e..5fd9b9c 100644
--- a/doc/ParseCmd.3
+++ b/doc/ParseCmd.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: ParseCmd.3,v 1.29 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures"
.BS
@@ -196,9 +194,9 @@ result; it can be retrieved using \fBTcl_GetObjResult\fR.
.PP
\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in
the return convention used: it returns the result in a new Tcl_Obj.
-The reference count of the object returned as result has been
+The reference count of the value returned as result has been
incremented, so the caller must
-invoke \fBTcl_DecrRefCount\fR when it is finished with the object.
+invoke \fBTcl_DecrRefCount\fR when it is finished with the value.
If an error or other exception occurs while evaluating the tokens
(such as a reference to a non-existent variable) then the return value
is NULL and an error message is left in \fIinterp\fR's result. The use
diff --git a/doc/PkgRequire.3 b/doc/PkgRequire.3
index 7581bed..d54d7af 100644
--- a/doc/PkgRequire.3
+++ b/doc/PkgRequire.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: PkgRequire.3,v 1.15 2010/08/31 20:53:17 nijtmans Exp $
-'\"
.so man.macros
.TH Tcl_PkgRequire 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Preserve.3 b/doc/Preserve.3
index 1a48a56..905a31d 100644
--- a/doc/Preserve.3
+++ b/doc/Preserve.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Preserve.3,v 1.8 2008/10/15 10:43:37 dkf Exp $
-'\"
.so man.macros
.TH Tcl_Preserve 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/PrintDbl.3 b/doc/PrintDbl.3
index d0d2307..99b0113 100644
--- a/doc/PrintDbl.3
+++ b/doc/PrintDbl.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: PrintDbl.3,v 1.12 2008/06/29 22:28:24 dkf Exp $
-'\"
.so man.macros
.TH Tcl_PrintDouble 3 8.0 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/RecEvalObj.3 b/doc/RecEvalObj.3
index 98c3149..44888f6 100644
--- a/doc/RecEvalObj.3
+++ b/doc/RecEvalObj.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: RecEvalObj.3,v 1.8 2007/12/13 15:22:31 dgp Exp $
-'\"
.so man.macros
.TH Tcl_RecordAndEvalObj 3 8.0 Tcl "Tcl Library Procedures"
.BS
@@ -22,7 +20,7 @@ int
.AP Tcl_Interp *interp in
Tcl interpreter in which to evaluate command.
.AP Tcl_Obj *cmdPtr in
-Points to a Tcl object containing a command (or sequence of commands)
+Points to a Tcl value containing a command (or sequence of commands)
to execute.
.AP int flags in
An OR'ed combination of flag bits. \fBTCL_NO_EVAL\fR means record the
@@ -37,7 +35,7 @@ on the history list and then execute it using \fBTcl_EvalObjEx\fR
(or \fBTcl_GlobalEvalObj\fR if the \fBTCL_EVAL_GLOBAL\fR bit is set
in \fIflags\fR).
It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR,
-as well as a result object containing additional information
+as well as a result value containing additional information
(a result value or error message)
that can be retrieved using \fBTcl_GetObjResult\fR.
If you do not want the command recorded on the history list then
@@ -52,4 +50,4 @@ the command is recorded without being evaluated.
Tcl_EvalObjEx, Tcl_GetObjResult
.SH KEYWORDS
-command, event, execute, history, interpreter, object, record
+command, event, execute, history, interpreter, value, record
diff --git a/doc/RecordEval.3 b/doc/RecordEval.3
index 003f1f2..a29f974 100644
--- a/doc/RecordEval.3
+++ b/doc/RecordEval.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: RecordEval.3,v 1.10 2007/12/13 15:22:31 dgp Exp $
-'\"
.so man.macros
.TH Tcl_RecordAndEval 3 7.4 Tcl "Tcl Library Procedures"
.BS
@@ -46,9 +44,9 @@ If the \fIflags\fR argument contains the \fBTCL_NO_EVAL\fR bit then
the command is recorded without being evaluated.
.PP
Note that \fBTcl_RecordAndEval\fR has been largely replaced by the
-object-based procedure \fBTcl_RecordAndEvalObj\fR.
-That object-based procedure records and optionally executes
-a command held in a Tcl object instead of a string.
+value-based procedure \fBTcl_RecordAndEvalObj\fR.
+That value-based procedure records and optionally executes
+a command held in a Tcl value instead of a string.
.SH "SEE ALSO"
Tcl_RecordAndEvalObj
diff --git a/doc/RegConfig.3 b/doc/RegConfig.3
index 19a7c7a..063cc85 100644
--- a/doc/RegConfig.3
+++ b/doc/RegConfig.3
@@ -4,7 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: RegConfig.3,v 1.11 2008/10/04 11:34:19 nijtmans Exp $
.so man.macros
.TH Tcl_RegisterConfig 3 8.4 Tcl "Tcl Library Procedures"
.BS
@@ -81,7 +80,7 @@ create a namespace having the provided \fIpkgName\fR, if not yet
existing.
.IP (2)
create the command \fBpkgconfig\fR in that namespace and link it to
-the provided information so that the keys from _configuration_ and
+the provided information so that the keys from \fIconfiguration\fR and
their associated values can be retrieved through calls to
\fBpkgconfig\fR.
.PP
diff --git a/doc/RegExp.3 b/doc/RegExp.3
index 2c999ea..882976c 100644
--- a/doc/RegExp.3
+++ b/doc/RegExp.3
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: RegExp.3,v 1.29 2008/06/29 22:28:24 dkf Exp $
-'\"
.so man.macros
.TH Tcl_RegExpMatch 3 8.1 Tcl "Tcl Library Procedures"
.BS
@@ -47,12 +45,12 @@ void
Tcl interpreter to use for error reporting. The interpreter may be
NULL if no error reporting is desired.
.AP Tcl_Obj *textObj in/out
-Refers to the object from which to get the text to search. The
-internal representation of the object may be converted to a form that
+Refers to the value from which to get the text to search. The
+internal representation of the value may be converted to a form that
can be efficiently searched.
.AP Tcl_Obj *patObj in/out
-Refers to the object from which to get a regular expression. The
-compiled regular expression is cached in the object.
+Refers to the value from which to get a regular expression. The
+compiled regular expression is cached in the value.
.AP char *text in
Text to search for a match with a regular expression.
.AP "const char" *pattern in
@@ -112,7 +110,7 @@ If an error occurs in the matching process (e.g. \fIpattern\fR
is not a valid regular expression) then \fBTcl_RegExpMatch\fR
returns \-1 and leaves an error message in the interpreter result.
\fBTcl_RegExpMatchObj\fR is similar to \fBTcl_RegExpMatch\fR except it
-operates on the Tcl objects \fItextObj\fR and \fIpatObj\fR instead of
+operates on the Tcl values \fItextObj\fR and \fIpatObj\fR instead of
UTF strings.
\fBTcl_RegExpMatchObj\fR is generally more efficient than
\fBTcl_RegExpMatch\fR, so it is the preferred interface.
@@ -166,18 +164,18 @@ If there is no range corresponding to \fIindex\fR then NULL
is stored in \fI*startPtr\fR and \fI*endPtr\fR.
.PP
\fBTcl_GetRegExpFromObj\fR, \fBTcl_RegExpExecObj\fR, and
-\fBTcl_RegExpGetInfo\fR are object interfaces that provide the most
+\fBTcl_RegExpGetInfo\fR are value interfaces that provide the most
direct control of Henry Spencer's regular expression library. For
users that need to modify compilation and execution options directly,
it is recommended that you use these interfaces instead of calling the
internal regexp functions. These interfaces handle the details of UTF
to Unicode translations as well as providing improved performance
-through caching in the pattern and string objects.
+through caching in the pattern and string values.
.PP
\fBTcl_GetRegExpFromObj\fR attempts to return a compiled regular
-expression from the \fIpatObj\fR. If the object does not already
+expression from the \fIpatObj\fR. If the value does not already
contain a compiled regular expression it will attempt to create one
-from the string in the object and assign it to the internal
+from the string in the value and assign it to the internal
representation of the \fIpatObj\fR. The return value of this function
is of type \fBTcl_RegExp\fR. The return value is a token for this
compiled form, which can be used in subsequent calls to
@@ -348,7 +346,7 @@ typedef struct Tcl_RegExpInfo {
The \fInsubs\fR field contains a count of the number of parenthesized
subexpressions within the regular expression. If the \fBTCL_REG_NOSUB\fR
was used, then this value will be zero. The \fImatches\fR field
-points to an array of \fInsubs\fR values that indicate the bounds of each
+points to an array of \fInsubs\fR+1 values that indicate the bounds of each
subexpression matched. The first element in the array refers to the
range matched by the entire regular expression, and subsequent elements
refer to the parenthesized subexpressions in the order that they
diff --git a/doc/SaveResult.3 b/doc/SaveResult.3
index f2ed536..8eaf38f 100644
--- a/doc/SaveResult.3
+++ b/doc/SaveResult.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: SaveResult.3,v 1.10 2008/06/29 22:28:24 dkf Exp $
-'\"
.so man.macros
.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures"
.BS
@@ -98,12 +96,12 @@ or \fBTcl_DiscardInterpState\fR to avoid a memory leak. Once
the \fBTcl_InterpState\fR token is passed to one of them, the
token is no longer valid and should not be used anymore.
.PP
-\fBTcl_SaveResult\fR moves the string and object results
+\fBTcl_SaveResult\fR moves the string and value results
of \fIinterp\fR into the location specified by \fIstatePtr\fR.
\fBTcl_SaveResult\fR clears the result for \fIinterp\fR and
leaves the result in its normal empty initialized state.
.PP
-\fBTcl_RestoreResult\fR moves the string and object results from
+\fBTcl_RestoreResult\fR moves the string and value results from
\fIstatePtr\fR back into \fIinterp\fR. Any result or error that was
already in the interpreter will be cleared. The \fIstatePtr\fR is left
in an uninitialized state and cannot be used until another call to
diff --git a/doc/SetChanErr.3 b/doc/SetChanErr.3
index e4066e8..3d37f59 100644
--- a/doc/SetChanErr.3
+++ b/doc/SetChanErr.3
@@ -4,7 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: SetChanErr.3,v 1.6 2009/11/27 14:35:10 dkf Exp $
.so man.macros
.TH Tcl_SetChannelError 3 8.5 Tcl "Tcl Library Procedures"
.BS
@@ -52,16 +51,16 @@ allowed to use \fBTcl_SetChannelError\fR and \fBTcl_SetChannelErrorInterp\fR
to place arbitrary error messages in \fBbypass areas\fR defined for channels
and interpreters. And the generic I/O layer uses \fBTcl_GetChannelError\fR and
\fBTcl_GetChannelErrorInterp\fR to look for messages in the bypass areas and
-arrange for their return as errors. The posix error codes set by a driver are
+arrange for their return as errors. The POSIX error codes set by a driver are
used now if and only if no messages are present.
.PP
\fBTcl_SetChannelError\fR stores error information in the bypass area of the
-specified channel. The number of references to the \fBmsg\fR object goes up by
+specified channel. The number of references to the \fBmsg\fR value goes up by
one. Previously stored information will be discarded, by releasing the
reference held by the channel. The channel reference must not be NULL.
.PP
\fBTcl_SetChannelErrorInterp\fR stores error information in the bypass area of
-the specified interpreter. The number of references to the \fBmsg\fR object
+the specified interpreter. The number of references to the \fBmsg\fR value
goes up by one. Previously stored information will be discarded, by releasing
the reference held by the interpreter. The interpreter reference must not be
NULL.
@@ -73,7 +72,7 @@ NULL, until an intervening invocation of \fBTcl_SetChannelError\fR with a
non-NULL message. The \fImsgPtr\fR must not be NULL. The reference count of
the message is not touched. The reference previously held by the channel is
now held by the caller of the function and it is its responsibility to release
-that reference when it is done with the object.
+that reference when it is done with the value.
.PP
\fBTcl_GetChannelErrorInterp\fR places either the error message held in the
bypass area of the specified interpreter into \fImsgPtr\fR, or NULL; and
@@ -83,7 +82,7 @@ return NULL, until an intervening invocation of
not be NULL. The reference count of the message is not touched. The reference
previously held by the interpreter is now held by the caller of the function
and it is its responsibility to release that reference when it is done with
-the object.
+the value.
.PP
Which functions of a channel driver are allowed to use which bypass function
is listed below, as is which functions of the public channel API may leave a
diff --git a/doc/SetErrno.3 b/doc/SetErrno.3
index 469bd37..1735952 100644
--- a/doc/SetErrno.3
+++ b/doc/SetErrno.3
@@ -4,7 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: SetErrno.3,v 1.9 2007/12/13 15:22:31 dgp Exp $
.so man.macros
.TH Tcl_SetErrno 3 8.3 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/SetRecLmt.3 b/doc/SetRecLmt.3
index 599e46f..e38ba2f 100644
--- a/doc/SetRecLmt.3
+++ b/doc/SetRecLmt.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: SetRecLmt.3,v 1.3 1999/04/16 00:46:33 stanton Exp $
-'\"
.so man.macros
.TH Tcl_SetRecursionLimit 3 7.0 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/SetResult.3 b/doc/SetResult.3
index edd74c6..bbeedf1 100644
--- a/doc/SetResult.3
+++ b/doc/SetResult.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: SetResult.3,v 1.25 2009/11/27 14:35:10 dkf Exp $
-'\"
.so man.macros
.TH Tcl_SetResult 3 8.0 Tcl "Tcl Library Procedures"
.BS
@@ -44,7 +42,7 @@ const char *
.AP Tcl_Interp *interp out
Interpreter whose result is to be modified or read.
.AP Tcl_Obj *objPtr in
-Object value to become result for \fIinterp\fR.
+Tcl value to become result for \fIinterp\fR.
.AP char *result in
String value to become result for \fIinterp\fR or to be
appended to the existing result.
@@ -76,32 +74,32 @@ information as well.
.PP
The procedures described here are utilities for manipulating the
result value in a Tcl interpreter.
-The interpreter result may be either a Tcl object or a string.
+The interpreter result may be either a Tcl value or a string.
For example, \fBTcl_SetObjResult\fR and \fBTcl_SetResult\fR
-set the interpreter result to, respectively, an object and a string.
+set the interpreter result to, respectively, a value and a string.
Similarly, \fBTcl_GetObjResult\fR and \fBTcl_GetStringResult\fR
-return the interpreter result as an object and as a string.
-The procedures always keep the string and object forms
+return the interpreter result as a value and as a string.
+The procedures always keep the string and value forms
of the interpreter result consistent.
For example, if \fBTcl_SetObjResult\fR is called to set
-the result to an object,
+the result to a value,
then \fBTcl_GetStringResult\fR is called,
-it will return the object's string value.
+it will return the value's string representation.
.PP
\fBTcl_SetObjResult\fR
arranges for \fIobjPtr\fR to be the result for \fIinterp\fR,
replacing any existing result.
-The result is left pointing to the object
+The result is left pointing to the value
referenced by \fIobjPtr\fR.
\fIobjPtr\fR's reference count is incremented
since there is now a new reference to it from \fIinterp\fR.
-The reference count for any old result object
-is decremented and the old result object is freed if no
+The reference count for any old result value
+is decremented and the old result value is freed if no
references to it remain.
.PP
-\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR as an object.
-The object's reference count is not incremented;
-if the caller needs to retain a long-term pointer to the object
+\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR as a value.
+The value's reference count is not incremented;
+if the caller needs to retain a long-term pointer to the value
they should use \fBTcl_IncrRefCount\fR to increment its reference count
in order to keep it from being freed too early or accidentally changed.
.PP
@@ -117,19 +115,19 @@ and \fBTcl_SetResult\fR
re-initializes \fIinterp\fR's result to point to an empty string.
.PP
\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as a string.
-If the result was set to an object by a \fBTcl_SetObjResult\fR call,
-the object form will be converted to a string and returned.
-If the object's string representation contains null bytes,
+If the result was set to a value by a \fBTcl_SetObjResult\fR call,
+the value form will be converted to a string and returned.
+If the value's string representation contains null bytes,
this conversion will lose information.
For this reason, programmers are encouraged to
-write their code to use the new object API procedures
+write their code to use the new value API procedures
and to call \fBTcl_GetObjResult\fR instead.
.PP
\fBTcl_ResetResult\fR clears the result for \fIinterp\fR
and leaves the result in its normal empty initialized state.
-If the result is an object,
+If the result is a value,
its reference count is decremented and the result is left
-pointing to an unshared object representing an empty string.
+pointing to an unshared value representing an empty string.
If the result is a dynamically allocated string, its memory is free*d
and the result is left as a empty string.
\fBTcl_ResetResult\fR also clears the error state managed by
@@ -169,7 +167,7 @@ The source interpreter will have its result reset by this operation.
Use of the following procedures (is deprecated
since they manipulate the Tcl result as a string.
Procedures such as \fBTcl_SetObjResult\fR
-that manipulate the result as an object
+that manipulate the result as a value
can be significantly more efficient.
.PP
\fBTcl_AppendElement\fR is similar to \fBTcl_AppendResult\fR in
@@ -254,4 +252,4 @@ the value of \fIresult\fR passed to \fBTcl_SetResult\fR.
.SH "SEE ALSO"
Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp
.SH KEYWORDS
-append, command, element, list, object, result, return value, interpreter
+append, command, element, list, value, result, return value, interpreter
diff --git a/doc/SetVar.3 b/doc/SetVar.3
index 7f5e234..0605ff2 100644
--- a/doc/SetVar.3
+++ b/doc/SetVar.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: SetVar.3,v 1.16 2007/12/13 15:22:32 dgp Exp $
-'\"
.so man.macros
.TH Tcl_SetVar 3 8.1 Tcl "Tcl Library Procedures"
.BS
@@ -59,7 +57,7 @@ to specify a variable in a particular namespace.
If non-NULL, gives name of element within array; in this
case \fIname1\fR must refer to an array variable.
.AP Tcl_Obj *newValuePtr in
-Points to a Tcl object containing the new value for the variable.
+Points to a Tcl value containing the new value for the variable.
.AP int flags in
OR-ed combination of bits providing additional information. See below
for valid values.
@@ -73,12 +71,12 @@ an array.
New value for variable, specified as a null-terminated string.
A copy of this value is stored in the variable.
.AP Tcl_Obj *part1Ptr in
-Points to a Tcl object containing the variable's name.
+Points to a Tcl value containing the variable's name.
The name may include a series of \fB::\fR namespace qualifiers
to specify a variable in a particular namespace.
May refer to a scalar variable or an element of an array variable.
.AP Tcl_Obj *part2Ptr in
-If non-NULL, points to an object containing the name of an element
+If non-NULL, points to a value containing the name of an element
within an array and \fIpart1Ptr\fR must refer to an array variable.
.BE
@@ -248,4 +246,4 @@ array is removed.
Tcl_GetObjResult, Tcl_GetStringResult, Tcl_TraceVar
.SH KEYWORDS
-array, get variable, interpreter, object, scalar, set, unset, variable
+array, get variable, interpreter, scalar, set, unset, value, variable
diff --git a/doc/Signal.3 b/doc/Signal.3
index 801c4f5..5b12654 100644
--- a/doc/Signal.3
+++ b/doc/Signal.3
@@ -4,7 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Signal.3,v 1.6 2007/12/13 15:22:32 dgp Exp $
.so man.macros
.TH Tcl_SignalId 3 8.3 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Sleep.3 b/doc/Sleep.3
index 340d3ec..2423ba1 100644
--- a/doc/Sleep.3
+++ b/doc/Sleep.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Sleep.3,v 1.6 2007/12/13 15:22:32 dgp Exp $
-'\"
.so man.macros
.TH Tcl_Sleep 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/SourceRCFile.3 b/doc/SourceRCFile.3
index f003a8c..eabc47c 100644
--- a/doc/SourceRCFile.3
+++ b/doc/SourceRCFile.3
@@ -1,9 +1,6 @@
'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
-'\"
-'\" RCS: @(#) $Id: SourceRCFile.3,v 1.4 2004/10/07 15:37:44 dkf Exp $
-'\"
'\"
.so man.macros
.TH Tcl_SourceRCFile 3 8.3 Tcl "Tcl Library Procedures"
diff --git a/doc/SplitList.3 b/doc/SplitList.3
index b57911b..219dfc7 100644
--- a/doc/SplitList.3
+++ b/doc/SplitList.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: SplitList.3,v 1.17 2008/12/18 21:23:47 dkf Exp $
-'\"
.so man.macros
.TH Tcl_SplitList 3 8.0 Tcl "Tcl Library Procedures"
.BS
@@ -184,7 +182,7 @@ with \fBTCL_DONT_QUOTE_HASH\fR.
the same as \fBTcl_ScanElement\fR and \fBTcl_ConvertElement\fR, except
the length of string \fIsrc\fR is specified by the \fIlength\fR
argument, and the string may contain embedded nulls.
+.SH "SEE ALSO"
+Tcl_ListObjGetElements(3)
.SH KEYWORDS
backslash, convert, element, list, merge, split, strings
-.SH "SEE ALSO"
-Tcl_GetListFromObj(3)
diff --git a/doc/SplitPath.3 b/doc/SplitPath.3
index e992db4..3fd92ac 100644
--- a/doc/SplitPath.3
+++ b/doc/SplitPath.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: SplitPath.3,v 1.10 2008/10/15 10:43:37 dkf Exp $
-'\"
.so man.macros
.TH Tcl_SplitPath 3 7.5 Tcl "Tcl Library Procedures"
.BS
@@ -45,7 +43,7 @@ A pointer to an initialized \fBTcl_DString\fR to which the result of
.SH DESCRIPTION
.PP
-These procedures have been superceded by the objectified procedures in
+These procedures have been superseded by the Tcl-value-aware procedures in
the \fBFileSystem\fR man page, which are more efficient.
.PP
These procedures may be used to disassemble and reassemble file
diff --git a/doc/StaticPkg.3 b/doc/StaticPkg.3
index 4a194dc..fa6c32f 100644
--- a/doc/StaticPkg.3
+++ b/doc/StaticPkg.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: StaticPkg.3,v 1.12 2008/12/18 21:23:47 dkf Exp $
-'\"
.so man.macros
.TH Tcl_StaticPackage 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/StdChannels.3 b/doc/StdChannels.3
index 85247b5..b5b020e 100644
--- a/doc/StdChannels.3
+++ b/doc/StdChannels.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: StdChannels.3,v 1.14 2007/12/13 15:22:32 dgp Exp $
-'\"
.so man.macros
.TH "Standard Channels" 3 7.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/StrMatch.3 b/doc/StrMatch.3
index dede549..5adaf6e 100644
--- a/doc/StrMatch.3
+++ b/doc/StrMatch.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: StrMatch.3,v 1.14 2007/12/13 15:22:32 dgp Exp $
-'\"
.so man.macros
.TH Tcl_StringMatch 3 8.5 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/StringObj.3 b/doc/StringObj.3
index 8091e2b..e6f9d32 100644
--- a/doc/StringObj.3
+++ b/doc/StringObj.3
@@ -4,13 +4,11 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: StringObj.3,v 1.31 2009/04/10 13:14:38 dkf Exp $
-'\"
.so man.macros
.TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl objects as strings
+Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -90,7 +88,7 @@ Tcl_Obj *
.AS "const Tcl_UniChar" *appendObjPtr in/out
.AP "const char" *bytes in
Points to the first byte of an array of UTF-8-encoded bytes
-used to set or append to a string object.
+used to set or append to a string value.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative. (Applications needing null bytes
should represent them as the two-byte sequence \fI\e700\e600\fR, use
@@ -98,36 +96,36 @@ should represent them as the two-byte sequence \fI\e700\e600\fR, use
the string is a collection of uninterpreted bytes.)
.AP int length in
The number of bytes to copy from \fIbytes\fR when
-initializing, setting, or appending to a string object.
+initializing, setting, or appending to a string value.
If negative, all bytes up to the first null are used.
.AP "const Tcl_UniChar" *unicode in
Points to the first byte of an array of Unicode characters
-used to set or append to a string object.
+used to set or append to a string value.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative.
.AP int numChars in
The number of Unicode characters to copy from \fIunicode\fR when
-initializing, setting, or appending to a string object.
+initializing, setting, or appending to a string value.
If negative, all characters up to the first null character are used.
.AP int index in
The index of the Unicode character to return.
.AP int first in
The index of the first Unicode character in the Unicode range to be
-returned as a new object.
+returned as a new value.
.AP int last in
The index of the last Unicode character in the Unicode range to be
-returned as a new object.
+returned as a new value.
.AP Tcl_Obj *objPtr in/out
-Points to an object to manipulate.
+Points to a value to manipulate.
.AP Tcl_Obj *appendObjPtr in
-The object to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
+The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
.AP int *lengthPtr out
If non-NULL, the location where \fBTcl_GetStringFromObj\fR will store
-the length of an object's string representation.
+the length of a value's string representation.
.AP "const char" *string in
Null-terminated string value to append to \fIobjPtr\fR.
.AP va_list argList in
-An argument list which must have been initialised using
+An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
.AP int limit in
Maximum number of bytes to be appended.
@@ -141,46 +139,46 @@ Format control string including % conversion specifiers.
.AP int objc in
The number of elements to format or concatenate.
.AP Tcl_Obj *objv[] in
-The array of objects to format or concatenate.
+The array of values to format or concatenate.
.AP int newLength in
New length for the string value of \fIobjPtr\fR, not including the
final null character.
.BE
.SH DESCRIPTION
.PP
-The procedures described in this manual entry allow Tcl objects to
+The procedures described in this manual entry allow Tcl values to
be manipulated as string values. They use the internal representation
-of the object to store additional information to make the string
+of the value to store additional information to make the string
manipulations more efficient. In particular, they make a series of
append operations efficient by allocating extra storage space for the
string so that it does not have to be copied for each append.
Also, indexing and length computations are optimized because the
Unicode string representation is calculated and cached as needed.
When using the \fBTcl_Append*\fR family of functions where the
-interpreter's result is the object being appended to, it is important
+interpreter's result is the value being appended to, it is important
to call Tcl_ResetResult first to ensure you are not unintentionally
-appending to existing data in the result object.
+appending to existing data in the result value.
.PP
-\fBTcl_NewStringObj\fR and \fBTcl_SetStringObj\fR create a new object
-or modify an existing object to hold a copy of the string given by
+\fBTcl_NewStringObj\fR and \fBTcl_SetStringObj\fR create a new value
+or modify an existing value to hold a copy of the string given by
\fIbytes\fR and \fIlength\fR. \fBTcl_NewUnicodeObj\fR and
-\fBTcl_SetUnicodeObj\fR create a new object or modify an existing
-object to hold a copy of the Unicode string given by \fIunicode\fR and
+\fBTcl_SetUnicodeObj\fR create a new value or modify an existing
+value to hold a copy of the Unicode string given by \fIunicode\fR and
\fInumChars\fR. \fBTcl_NewStringObj\fR and \fBTcl_NewUnicodeObj\fR
-return a pointer to a newly created object with reference count zero.
-All four procedures set the object to hold a copy of the specified
+return a pointer to a newly created value with reference count zero.
+All four procedures set the value to hold a copy of the specified
string. \fBTcl_SetStringObj\fR and \fBTcl_SetUnicodeObj\fR free any
old string representation as well as any old internal representation
-of the object.
+of the value.
.PP
-\fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR return an object's
+\fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR return a value's
string representation. This is given by the returned byte pointer and
(for \fBTcl_GetStringFromObj\fR) length, which is stored in
-\fIlengthPtr\fR if it is non-NULL. If the object's UTF string
+\fIlengthPtr\fR if it is non-NULL. If the value's UTF string
representation is invalid (its byte pointer is NULL), the string
-representation is regenerated from the object's internal
+representation is regenerated from the value's internal
representation. The storage referenced by the returned byte pointer
-is owned by the object manager. It is passed back as a writable
+is owned by the value manager. It is passed back as a writable
pointer so that extension author creating their own \fBTcl_ObjType\fR
will be able to modify the string representation within the
\fBTcl_UpdateStringProc\fR of their \fBTcl_ObjType\fR. Except for that
@@ -196,45 +194,45 @@ The procedure \fBTcl_GetString\fR is used in the common case
where the caller does not need the length of the string
representation.
.PP
-\fBTcl_GetUnicodeFromObj\fR and \fBTcl_GetUnicode\fR return an object's
+\fBTcl_GetUnicodeFromObj\fR and \fBTcl_GetUnicode\fR return a value's
value as a Unicode string. This is given by the returned pointer and
(for \fBTcl_GetUnicodeFromObj\fR) length, which is stored in
\fIlengthPtr\fR if it is non-NULL. The storage referenced by the returned
-byte pointer is owned by the object manager and should not be modified by
+byte pointer is owned by the value manager and should not be modified by
the caller. The procedure \fBTcl_GetUnicode\fR is used in the common case
where the caller does not need the length of the unicode string
representation.
.PP
\fBTcl_GetUniChar\fR returns the \fIindex\fR'th character in the
-object's Unicode representation.
+value's Unicode representation.
.PP
-\fBTcl_GetRange\fR returns a newly created object comprised of the
+\fBTcl_GetRange\fR returns a newly created value comprised of the
characters between \fIfirst\fR and \fIlast\fR (inclusive) in the
-object's Unicode representation. If the object's Unicode
+value's Unicode representation. If the value's Unicode
representation is invalid, the Unicode representation is regenerated
-from the object's string representation.
+from the value's string representation.
.PP
\fBTcl_GetCharLength\fR returns the number of characters (as opposed
-to bytes) in the string object.
+to bytes) in the string value.
.PP
\fBTcl_AppendToObj\fR appends the data given by \fIbytes\fR and
-\fIlength\fR to the string representation of the object specified by
-\fIobjPtr\fR. If the object has an invalid string representation,
+\fIlength\fR to the string representation of the value specified by
+\fIobjPtr\fR. If the value has an invalid string representation,
then an attempt is made to convert \fIbytes\fR is to the Unicode
format. If the conversion is successful, then the converted form of
-\fIbytes\fR is appended to the object's Unicode representation.
-Otherwise, the object's Unicode representation is invalidated and
+\fIbytes\fR is appended to the value's Unicode representation.
+Otherwise, the value's Unicode representation is invalidated and
converted to the UTF format, and \fIbytes\fR is appended to the
-object's new string representation.
+value's new string representation.
.PP
\fBTcl_AppendUnicodeToObj\fR appends the Unicode string given by
-\fIunicode\fR and \fInumChars\fR to the object specified by
-\fIobjPtr\fR. If the object has an invalid Unicode representation,
+\fIunicode\fR and \fInumChars\fR to the value specified by
+\fIobjPtr\fR. If the value has an invalid Unicode representation,
then \fIunicode\fR is converted to the UTF format and appended to the
-object's string representation. Appends are optimized to handle
-repeated appends relatively efficiently (it overallocates the string
+value's string representation. Appends are optimized to handle
+repeated appends relatively efficiently (it over-allocates the string
or Unicode space to avoid repeated reallocations and copies of
-object's string value).
+value's string value).
.PP
\fBTcl_AppendObjToObj\fR is similar to \fBTcl_AppendToObj\fR, but it
appends the string or Unicode value (whichever exists and is best
@@ -330,7 +328,10 @@ Tcl_Obj *objPtr = \fBTcl_ObjPrintf\fR("Value is %d", x);
.PP
If the value of \fIformat\fR contains internal inconsistencies or invalid
specifier formats, the formatted string result produced by
-\fBTcl_ObjPrintf\fR will be an error message describing the error.
+\fBTcl_ObjPrintf\fR will be an error message describing the error.
+It is impossible however to provide runtime protection against
+mismatches between the format and any subsequent arguments.
+Compile-time protection may be provided by some compilers.
.PP
\fBTcl_AppendPrintfToObj\fR is an appending alternative form
of \fBTcl_ObjPrintf\fR with functionality equivalent to
@@ -344,14 +345,14 @@ functionality is needed.
.PP
The \fBTcl_SetObjLength\fR procedure changes the length of the
string value of its \fIobjPtr\fR argument. If the \fInewLength\fR
-argument is greater than the space allocated for the object's
+argument is greater than the space allocated for the value's
string, then the string space is reallocated and the old value
is copied to the new space; the bytes between the old length of
the string and the new length may have arbitrary values.
If the \fInewLength\fR argument is less than the current length
-of the object's string, with \fIobjPtr->length\fR is reduced without
+of the value's string, with \fIobjPtr->length\fR is reduced without
reallocating the string space; the original allocated size for the
-string is recorded in the object, so that the string length can be
+string is recorded in the value, so that the string length can be
enlarged in a subsequent call to \fBTcl_SetObjLength\fR without
reallocating storage. In all cases \fBTcl_SetObjLength\fR leaves
a null character at \fIobjPtr->bytes[newLength]\fR.
@@ -360,24 +361,24 @@ a null character at \fIobjPtr->bytes[newLength]\fR.
\fBTcl_SetObjLength\fR except that if sufficient memory to satisfy the
request cannot be allocated, it does not cause the Tcl interpreter to
\fBpanic\fR. Thus, if \fInewLength\fR is greater than the space
-allocated for the object's string, and there is not enough memory
+allocated for the value's string, and there is not enough memory
available to satisfy the request, \fBTcl_AttemptSetObjLength\fR will take
no action and return 0 to indicate failure. If there is enough memory
to satisfy the request, \fBTcl_AttemptSetObjLength\fR behaves just like
\fBTcl_SetObjLength\fR and returns 1 to indicate success.
.PP
-The \fBTcl_ConcatObj\fR function returns a new string object whose
+The \fBTcl_ConcatObj\fR function returns a new string value whose
value is the space-separated concatenation of the string
-representations of all of the objects in the \fIobjv\fR
+representations of all of the values in the \fIobjv\fR
array. \fBTcl_ConcatObj\fR eliminates leading and trailing white space
as it copies the string representations of the \fIobjv\fR array to the
result. If an element of the \fIobjv\fR array consists of nothing but
-white space, then that object is ignored entirely. This white-space
+white space, then that value is ignored entirely. This white-space
removal was added to make the output of the \fBconcat\fR command
cleaner-looking. \fBTcl_ConcatObj\fR returns a pointer to a
-newly-created object whose ref count is zero.
+newly-created value whose ref count is zero.
.SH "SEE ALSO"
Tcl_NewObj(3), Tcl_IncrRefCount(3), Tcl_DecrRefCount(3), format(n), sprintf(3)
.SH KEYWORDS
-append, internal representation, object, object type, string object,
+append, internal representation, value, value type, string value,
string type, string representation, concat, concatenate, unicode
diff --git a/doc/SubstObj.3 b/doc/SubstObj.3
index de38723..d5a52c3 100644
--- a/doc/SubstObj.3
+++ b/doc/SubstObj.3
@@ -4,13 +4,11 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: SubstObj.3,v 1.7 2007/12/13 15:22:32 dgp Exp $
-'\"
.so man.macros
.TH Tcl_SubstObj 3 8.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_SubstObj \- perform substitutions on Tcl objects
+Tcl_SubstObj \- perform substitutions on Tcl values
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -24,7 +22,7 @@ Interpreter in which to execute Tcl scripts and lookup variables. If
an error occurs, the interpreter's result is modified to hold an error
message.
.AP Tcl_Obj *objPtr in
-A Tcl object containing the string to perform substitutions on.
+A Tcl value containing the string to perform substitutions on.
.AP int flags in
ORed combination of flag bits that specify which substitutions to
perform. The flags \fBTCL_SUBST_COMMANDS\fR,
@@ -38,7 +36,7 @@ The \fBTcl_SubstObj\fR function is used to perform substitutions on
strings in the fashion of the \fBsubst\fR command. It gets the value
of the string contained in \fIobjPtr\fR and scans it, copying
characters and performing the chosen substitutions as it goes to an
-output object which is returned as the result of the function. In the
+output value which is returned as the result of the function. In the
event of an error occurring during the execution of a command or
variable substitution, the function returns NULL and an error message
is left in \fIinterp\fR's result.
diff --git a/doc/TCL_MEM_DEBUG.3 b/doc/TCL_MEM_DEBUG.3
index ca9acd3..5a3e08a 100644
--- a/doc/TCL_MEM_DEBUG.3
+++ b/doc/TCL_MEM_DEBUG.3
@@ -3,8 +3,6 @@
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
-'\" RCS: @(#) $Id: TCL_MEM_DEBUG.3,v 1.11 2007/12/13 15:22:32 dgp Exp $
-'\"
.so man.macros
.TH TCL_MEM_DEBUG 3 8.1 Tcl "Tcl Library Procedures"
.BS
@@ -28,7 +26,7 @@ version of \fBTcl_InitMemory\fR to add the \fBmemory\fR command to Tcl.
\fBTCL_MEM_DEBUG\fR must be either left defined for all modules or undefined
for all modules that are going to be linked together. If they are not, link
errors will occur, with either \fBTcl_DbCkfree\fR and \fBTcl_DbCkalloc\fR or
-\fBTcl_Ckalloc\fR and \fBTcl_Ckfree\fR being undefined.
+\fBTcl_Alloc\fR and \fBTcl_Free\fR being undefined.
.PP
Once memory debugging support has been compiled into Tcl, the C
functions \fBTcl_ValidateAllMemory\fR, and \fBTcl_DumpActiveMemory\fR,
diff --git a/doc/Tcl.n b/doc/Tcl.n
index fd31dfc..68146ab 100644
--- a/doc/Tcl.n
+++ b/doc/Tcl.n
@@ -4,11 +4,9 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
-'\" RCS: @(#) $Id: Tcl.n,v 1.24 2010/01/13 12:08:30 dkf Exp $
'\"
.so man.macros
-.TH Tcl n "8.5" Tcl "Tcl Built-In Commands"
+.TH Tcl n "8.6" Tcl "Tcl Built-In Commands"
.BS
.SH NAME
Tcl \- Tool Command Language
@@ -110,6 +108,8 @@ Variable substitution may take any of the following forms:
\fIName\fR is the name of a scalar variable; the name is a sequence
of one or more characters that are a letter, digit, underscore,
or namespace separators (two or more colons).
+Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR,
+\fBA\fR\-\fBZ\fR and \fBa\fR\-\fBz\fR).
.TP 15
\fB$\fIname\fB(\fIindex\fB)\fR
.
@@ -117,6 +117,8 @@ or namespace separators (two or more colons).
the name of an element within that array.
\fIName\fR must contain only letters, digits, underscores, and
namespace separators, and may be an empty string.
+Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR,
+\fBA\fR\-\fBZ\fR and \fBa\fR\-\fBz\fR).
Command substitutions, variable substitutions, and backslash
substitutions are performed on the characters of \fIindex\fR.
.TP 15
@@ -136,6 +138,10 @@ substitutions are performed during the parsing of \fIname\fR.
.PP
There may be any number of variable substitutions in a single word.
Variable substitution is not performed on words enclosed in braces.
+.PP
+Note that variables may contain character sequences other than those listed
+above, but in that case other mechanisms must be used to access them (e.g.,
+via the \fBset\fR command's single-argument form).
.RE
.IP "[9] \fBBackslash substitution.\fR"
If a backslash
@@ -187,23 +193,33 @@ Backslash
.TP 7
\e\fIooo\fR
.
-The digits \fIooo\fR (one, two, or three of them) give an eight-bit octal
-value for the Unicode character that will be inserted. The upper bits of the
-Unicode character will be 0.
+The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal
+value for the Unicode character that will be inserted, in the range \fI000\fR
+- \fI377\fR. The parser will stop just before this range overflows, or when
+the maximum of three digits is reached. The upper bits of the Unicode
+character will be 0.
.TP 7
\e\fBx\fIhh\fR
.
-The hexadecimal digits \fIhh\fR give an eight-bit hexadecimal value for the
-Unicode character that will be inserted. Any number of hexadecimal digits
-may be present; however, all but the last two are ignored (the result is
-always a one-byte quantity). The upper bits of the Unicode character will
-be 0.
+The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit
+hexadecimal value for the Unicode character that will be inserted. The upper
+bits of the Unicode character will be 0.
.TP 7
\e\fBu\fIhhhh\fR
.
The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a
sixteen-bit hexadecimal value for the Unicode character that will be
-inserted.
+inserted. The upper bits of the Unicode character will be 0.
+.TP 7
+\e\fBU\fIhhhhhhhh\fR
+.
+The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a
+twenty-one-bit hexadecimal value for the Unicode character that will be
+inserted, in the range U+0000..U+10FFFF. The parser will stop just
+before this range overflows, or when the maximum of eight digits
+is reached. The upper bits of the Unicode character will be 0.
+.PP
+The range U+010000..U+10FFFD is reserved for the future.
.PP
Backslash substitution is not performed on words enclosed in braces,
except for backslash-newline as described above.
diff --git a/doc/TclZlib.3 b/doc/TclZlib.3
index 6d5ec7f..854a525 100644
--- a/doc/TclZlib.3
+++ b/doc/TclZlib.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: TclZlib.3,v 1.6 2010/02/10 23:17:06 dkf Exp $
-'\"
.so man.macros
.TH TclZlib 3 8.6 Tcl "Tcl Library Procedures"
.BS
@@ -51,9 +49,11 @@ int
.sp
int
\fBTcl_ZlibStreamGet\fR(\fIzshandle, dataObj, count\fR)
+.sp
+\fBTcl_ZlibStreamSetCompressionDictionary\fR(\fIzshandle, compDict\fR)
.fi
.SH ARGUMENTS
-.AS Tcl_ZlibStream *zshandlePtr out
+.AS Tcl_ZlibStream zshandle in
.AP Tcl_Interp *interp in
The interpreter to store resulting compressed or uncompressed data in. Also
where any error messages are written. For \fBTcl_ZlibStreamInit\fR, this can
@@ -66,7 +66,7 @@ addition, for decompression only, \fBTCL_ZLIB_FORMAT_AUTO\fR may also be
chosen which can automatically detect whether the compressed data was in zlib
or gzip format.
.AP Tcl_Obj *dataObj in/out
-A byte-array object containing the data to be compressed or decompressed, or
+A byte-array value containing the data to be compressed or decompressed, or
to which the data extracted from the stream is appended when passed to
\fBTcl_ZlibStreamGet\fR.
.AP int level in
@@ -110,6 +110,13 @@ trailer demanded by the format is written.
.AP int count in
The maximum number of bytes to get from the stream, or -1 to get all remaining
bytes from the stream's buffers.
+.AP Tcl_Obj *compDict in
+A byte array value that is the compression dictionary to use with the stream.
+Note that this is \fInot a Tcl dictionary\fR, and it is recommended that this
+only ever be used with streams that were created with their \fIformat\fR set
+to \fBTCL_ZLIB_FORMAT_ZLIB\fR because the other formats have no mechanism to
+indicate whether a compression dictionary was present other than to fail on
+decompression.
.BE
.SH DESCRIPTION
These functions form the interface from the Tcl library to the Zlib
@@ -124,7 +131,7 @@ the dictionary is only used when the \fIformat\fR parameter is
\fBTCL_ZLIB_FORMAT_GZIP\fR or \fBTCL_ZLIB_FORMAT_AUTO\fR. For details of the
contents of the dictionary, see the \fBGZIP OPTIONS DICTIONARY\fR section
below. Upon success, both functions leave the resulting compressed or
-decompressed data in a byte-array object that is the Tcl interpreter's result;
+decompressed data in a byte-array value that is the Tcl interpreter's result;
the returned value is a standard Tcl result code.
.PP
\fBTcl_ZlibAdler32\fR and \fBTcl_ZlibCRC32\fR compute checksums on arrays of
@@ -156,7 +163,7 @@ the \fBGZIP OPTIONS DICTIONARY\fR section below) can be given via the
headers, and on decompression allows discovery of the existing headers. Note
that the dictionary will be written to on decompression once sufficient data
has been read to have a complete header. This means that the dictionary must
-be an unshared object in that case; a blank object created with
+be an unshared value in that case; a blank value created with
\fBTcl_NewObj\fR is suggested.
.PP
Once a stream has been constructed, \fBTcl_ZlibStreamPut\fR is used to add
@@ -164,8 +171,8 @@ data to the stream and \fBTcl_ZlibStreamGet\fR is used to retrieve data from
the stream after processing. Both return normal Tcl result codes and leave an
error message in the result of the interpreter that the stream is registered
with in the error case (if such a registration has been performed). With
-\fBTcl_ZlibStreamPut\fR, the data buffer object passed to it should not be
-modified afterwards. With \fBTcl_ZlibStreamGet\fR, the data buffer object
+\fBTcl_ZlibStreamPut\fR, the data buffer value passed to it should not be
+modified afterwards. With \fBTcl_ZlibStreamGet\fR, the data buffer value
passed to it will have the data bytes appended to it. Internally to the
stream, data is kept compressed so as to minimize the cost of buffer space.
.PP
@@ -174,6 +181,25 @@ uncompressed data according to the format, and \fBTcl_ZlibStreamEof\fR returns
a boolean value indicating whether the end of the uncompressed data has been
reached.
.PP
+\fBTcl_ZlibStreamSetCompressionDictionary\fR is used to control the
+compression dictionary used with the stream, a compression dictionary being an
+array of bytes (such as might be created with \fBTcl_NewByteArrayObj\fR) that
+is used to initialize the compression engine rather than leaving it to create
+it on the fly from the data being compressed. Setting a compression dictionary
+allows for more efficient compression in the case where the start of the data
+is highly regular, but it does require both the compressor and the
+decompressor to agreee on the value to use. Compression dictionaries are only
+fully supported for zlib-format data; on compression, they must be set before
+any data is sent in with \fBTcl_ZlibStreamPut\fR, and on decompression they
+should be set when \fBTcl_ZlibStreamGet\fR produces an \fBerror\fR with its
+\fB\-errorcode\fR set to
+.QW "\fBZLIB NEED_DICT\fI code\fR" ;
+the \fIcode\fR will be the Adler-32 checksum (see \fBTcl_ZlibAdler32\fR) of
+the compression dictionary sought. (Note that this is only true for
+zlib-format streams; gzip streams ignore compression dictionaries as the
+format specification doesn't permit them, and raw streams just produce a data
+error if the compression dictionary is missing or incorrect.)
+.PP
If you wish to clear a stream and reuse it for a new compression or
decompression action, \fBTcl_ZlibStreamReset\fR will do this and return a
normal Tcl result code to indicate whether it was successful; if the stream is
@@ -189,9 +215,9 @@ and \fBTcl_ZlibStreamInit\fR is used to pass a dictionary of options about
that is used to describe the gzip header in the compressed data. When creating
compressed data, the dictionary is read and when unpacking compressed data the
dictionary is written (in which case the \fIdictObj\fR parameter must refer to
-an unshared dictionary object).
+an unshared dictionary value).
.PP
-The following fields in the dictionary object are understood. All other fields
+The following fields in the dictionary value are understood. All other fields
are ignored. No field is required when creating a gzip-format stream.
.TP
\fBcomment\fR
diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3
index e37ffe4..0a69835 100644
--- a/doc/Tcl_Main.3
+++ b/doc/Tcl_Main.3
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Tcl_Main.3,v 1.20 2008/12/19 18:23:04 dgp Exp $
-'\"
.so man.macros
.TH Tcl_Main 3 8.4 Tcl "Tcl Library Procedures"
.BS
@@ -30,7 +28,8 @@ Tcl_Obj *
.AP int argc in
Number of elements in \fIargv\fR.
.AP char *argv[] in
-Array of strings containing command-line arguments.
+Array of strings containing command-line arguments. On Windows, when
+using -DUNICODE, the parameter type changes to wchar_t *.
.AP Tcl_AppInitProc *appInitProc in
Address of an application-specific initialization procedure.
The value for this argument is usually \fBTcl_AppInit\fR.
diff --git a/doc/Thread.3 b/doc/Thread.3
index 9b9912e..ca135ee 100644
--- a/doc/Thread.3
+++ b/doc/Thread.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Thread.3,v 1.32 2010/06/16 14:49:51 nijtmans Exp $
-'\"
.so man.macros
.TH Threads 3 "8.1" Tcl "Tcl Library Procedures"
.BS
@@ -72,7 +70,7 @@ Arbitrary information. Passed as sole argument to the \fIproc\fR.
.AP int stackSize in
The size of the stack given to the new thread.
.AP int flags in
-Bitmask containing flags allowing the caller to modify behaviour of
+Bitmask containing flags allowing the caller to modify behavior of
the new thread.
.AP int *result out
The referred storage is used to place the exit code of the thread
@@ -93,15 +91,15 @@ and use multiple interpreters.)
.SH DESCRIPTION
Tcl provides \fBTcl_CreateThread\fR for creating threads. The
caller can determine the size of the stack given to the new thread and
-modify the behaviour through the supplied \fIflags\fR. The value
+modify the behavior through the supplied \fIflags\fR. The value
\fBTCL_THREAD_STACK_DEFAULT\fR for the \fIstackSize\fR indicates that
the default size as specified by the operating system is to be used
for the new thread. As for the flags, currently only the values
\fBTCL_THREAD_NOFLAGS\fR and \fBTCL_THREAD_JOINABLE\fR are defined. The
-first of them invokes the default behaviour with no
-specialties. Using the second value marks the new thread as
-\fIjoinable\fR. This means that another thread can wait for the such
-marked thread to exit and join it.
+first of them invokes the default behavior with no special settings.
+Using the second value marks the new thread as \fIjoinable\fR. This
+means that another thread can wait for the such marked thread to exit
+and join it.
.PP
Restrictions: On some UNIX systems the pthread-library does not
contain the functionality to specify the stack size of a thread. The
diff --git a/doc/ToUpper.3 b/doc/ToUpper.3
index 15539ad..d6b3006 100644
--- a/doc/ToUpper.3
+++ b/doc/ToUpper.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: ToUpper.3,v 1.3 2004/09/06 09:44:57 dkf Exp $
-'\"
.so man.macros
.TH Tcl_UtfToUpper 3 "8.1" Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/TraceCmd.3 b/doc/TraceCmd.3
index ee8198f..5cc1337 100644
--- a/doc/TraceCmd.3
+++ b/doc/TraceCmd.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" CVS: @(#) $Id: TraceCmd.3,v 1.13 2008/10/15 10:43:37 dkf Exp $
-'\"
.so man.macros
.TH Tcl_TraceCommand 3 7.4 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/TraceVar.3 b/doc/TraceVar.3
index 7ba525d..6201a4f 100644
--- a/doc/TraceVar.3
+++ b/doc/TraceVar.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: TraceVar.3,v 1.22 2009/09/03 08:01:22 dkf Exp $
-'\"
.so man.macros
.TH Tcl_TraceVar 3 7.4 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Translate.3 b/doc/Translate.3
index c6e6217..55233c3 100644
--- a/doc/Translate.3
+++ b/doc/Translate.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Translate.3,v 1.13 2007/12/13 15:22:32 dgp Exp $
-'\"
.so man.macros
.TH Tcl_TranslateFileName 3 8.1 Tcl "Tcl Library Procedures"
.BS
@@ -31,7 +29,6 @@ At the time of the call it should be uninitialized or free. The
caller must eventually call \fBTcl_DStringFree\fR to free up
anything stored here.
.BE
-
.SH DESCRIPTION
.PP
This utility procedure translates a file name to a platform-specific form
@@ -40,11 +37,11 @@ passing to the local operating system. In particular, it converts
network names into native form and does tilde substitution.
.PP
However, with the advent of the newer \fBTcl_FSGetNormalizedPath\fR and
-\fBTcl_GetNativePath\fR, there is no longer any need to use this
-procedure. In particular, \fBTcl_GetNativePath\fR performs all the
+\fBTcl_FSGetNativePath\fR, there is no longer any need to use this
+procedure. In particular, \fBTcl_FSGetNativePath\fR performs all the
necessary translation and encoding conversion, is virtual-filesystem
aware, and caches the native result for faster repeated calls.
-Finally \fBTcl_GetNativePath\fR does not require you to free anything
+Finally \fBTcl_FSGetNativePath\fR does not require you to free anything
afterwards.
.PP
If
@@ -68,9 +65,7 @@ frees the dynamic string itself so that the caller need not call
.PP
The caller is responsible for making sure that the interpreter's result
has its default empty value when \fBTcl_TranslateFileName\fR is invoked.
-
.SH "SEE ALSO"
-filename
-
+filename(n)
.SH KEYWORDS
file name, home directory, tilde, translate, user
diff --git a/doc/UniCharIsAlpha.3 b/doc/UniCharIsAlpha.3
index 26d9eb3..6029b2d 100644
--- a/doc/UniCharIsAlpha.3
+++ b/doc/UniCharIsAlpha.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: UniCharIsAlpha.3,v 1.5 2007/12/13 15:22:32 dgp Exp $
-'\"
.so man.macros
.TH Tcl_UniCharIsAlpha 3 "8.1" Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/UpVar.3 b/doc/UpVar.3
index 01b0221..f1e6fe4 100644
--- a/doc/UpVar.3
+++ b/doc/UpVar.3
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: UpVar.3,v 1.11 2006/10/09 23:38:56 msofer Exp $
-'\"
.so man.macros
.TH Tcl_UpVar 3 7.4 Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/Utf.3 b/doc/Utf.3
index 848a997..55906e7 100644
--- a/doc/Utf.3
+++ b/doc/Utf.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Utf.3,v 1.26 2008/06/29 22:28:24 dkf Exp $
-'\"
.so man.macros
.TH Utf 3 "8.1" Tcl "Tcl Library Procedures"
.BS
diff --git a/doc/WrongNumArgs.3 b/doc/WrongNumArgs.3
index 323ad40..15d5caf 100644
--- a/doc/WrongNumArgs.3
+++ b/doc/WrongNumArgs.3
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: WrongNumArgs.3,v 1.13 2008/10/15 10:43:37 dkf Exp $
-'\"
.so man.macros
.TH Tcl_WrongNumArgs 3 8.0 Tcl "Tcl Library Procedures"
.BS
@@ -20,7 +18,7 @@ Tcl_WrongNumArgs \- generate standard error message for wrong number of argument
.AS "Tcl_Obj *const" *message
.AP Tcl_Interp interp in
Interpreter in which error will be reported: error message gets stored
-in its result object.
+in its result value.
.AP int objc in
Number of leading arguments from \fIobjv\fR to include in error
message.
@@ -36,13 +34,13 @@ of the command. This argument may be NULL.
\fBTcl_WrongNumArgs\fR is a utility procedure that is invoked by
command procedures when they discover that they have received the
wrong number of arguments. \fBTcl_WrongNumArgs\fR generates a
-standard error message and stores it in the result object of
+standard error message and stores it in the result value of
\fIinterp\fR. The message includes the \fIobjc\fR initial
elements of \fIobjv\fR plus \fImessage\fR. For example, if
\fIobjv\fR consists of the values \fBfoo\fR and \fBbar\fR,
\fIobjc\fR is 1, and \fImessage\fR is
.QW "\fBfileName count\fR"
-then \fIinterp\fR's result object will be set to the following
+then \fIinterp\fR's result value will be set to the following
string:
.PP
.CS
@@ -59,17 +57,17 @@ wrong # args: should be "foo bar fileName count"
\fBstring\fR and the Tk widget commands, which use the first argument
as a subcommand.
.PP
-Some of the objects in the \fIobjv\fR array may be abbreviations for
+Some of the values in the \fIobjv\fR array may be abbreviations for
a subcommand. The command
-\fBTcl_GetIndexFromObj\fR will convert the abbreviated string object
+\fBTcl_GetIndexFromObj\fR will convert the abbreviated string value
into an \fIindexObject\fR. If an error occurs in the parsing of the
subcommand we would like to use the full subcommand name rather than
the abbreviation. If the \fBTcl_WrongNumArgs\fR command finds any
\fIindexObjects\fR in the \fIobjv\fR array it will use the full subcommand
name in the error message instead of the abbreviated name that was
originally passed in. Using the above example, let us assume that
-\fIbar\fR is actually an abbreviation for \fIbarfly\fR and the object
-is now an indexObject because it was passed to
+\fIbar\fR is actually an abbreviation for \fIbarfly\fR and the value
+is now an \fIindexObject\fR because it was passed to
\fBTcl_GetIndexFromObj\fR. In this case the error message would be:
.PP
.CS
diff --git a/doc/after.n b/doc/after.n
index 8ccada1..d6181c6 100644
--- a/doc/after.n
+++ b/doc/after.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: after.n,v 1.13 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH after n 7.5 Tcl "Tcl Built-In Commands"
.BS
@@ -51,7 +49,7 @@ The command will be executed at global level (outside the context
of any Tcl procedure).
If an error occurs while executing the delayed command then
the background error will be reported by the command
-registered with \fB interp bgerror\fR.
+registered with \fBinterp bgerror\fR.
The \fBafter\fR command returns an identifier that can be used
to cancel the delayed command using \fBafter cancel\fR.
.TP
@@ -84,7 +82,7 @@ The command returns an identifier that can be used
to cancel the delayed command using \fBafter cancel\fR.
If an error occurs while executing the script then the
background error will be reported by the command
-registered with \fB interp bgerror\fR.
+registered with \fBinterp bgerror\fR.
.TP
\fBafter info \fR?\fIid\fR?
.
diff --git a/doc/append.n b/doc/append.n
index 6217b80..034068d 100644
--- a/doc/append.n
+++ b/doc/append.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: append.n,v 1.12 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH append n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/array.n b/doc/array.n
index 49bc0e6..47f9624 100644
--- a/doc/array.n
+++ b/doc/array.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: array.n,v 1.22 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH array n 8.3 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/bgerror.n b/doc/bgerror.n
index b71ed3d..ac53eca 100644
--- a/doc/bgerror.n
+++ b/doc/bgerror.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: bgerror.n,v 1.15 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH bgerror n 7.5 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/binary.n b/doc/binary.n
index e038fb5..68bf9cc 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: binary.n,v 1.44 2008/12/15 17:11:33 ferrieux Exp $
-'\"
.so man.macros
.TH binary n 8.0 Tcl "Tcl Built-In Commands"
.BS
@@ -15,9 +13,9 @@
binary \- Insert and extract fields from binary strings
.SH SYNOPSIS
.VS 8.6
-\fBbinary decode \fIformat\fR ?\fI-option value ...\fR? \fIdata\fR
+\fBbinary decode \fIformat\fR ?\fI\-option value ...\fR? \fIdata\fR
.br
-\fBbinary encode \fIformat\fR ?\fI-option value ...\fR? \fIdata\fR
+\fBbinary encode \fIformat\fR ?\fI\-option value ...\fR? \fIdata\fR
.br
.VE 8.6
\fBbinary format \fIformatString \fR?\fIarg arg ...\fR?
@@ -94,7 +92,7 @@ Instructs the decoder to throw an error if it encounters whitespace characters.
.
The \fBuuencode\fR binary encoding used to be common for transfer of data
between Unix systems and on USENET, but is less common these days, having been
-largely superceded by the \fBbase64\fR binary encoding.
+largely superseded by the \fBbase64\fR binary encoding.
.RS
.PP
During encoding, the following options are supported:
@@ -137,7 +135,7 @@ is a non-negative decimal integer or \fB*\fR, which normally indicates
that all of the items in the value are to be used. If the number of
arguments does not match the number of fields in the format string
that consume arguments, then an error is generated. The flag character
-is ignored for for \fBbinary format\fR.
+is ignored for \fBbinary format\fR.
.PP
Here is a small example to clarify the relation between the field
specifiers and the arguments:
diff --git a/doc/break.n b/doc/break.n
index 4d758a4..cef37c6 100644
--- a/doc/break.n
+++ b/doc/break.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: break.n,v 1.12 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH break n "" Tcl "Tcl Built-In Commands"
.BS
@@ -20,7 +18,7 @@ break \- Abort looping command
.PP
This command is typically invoked inside the body of a looping command
such as \fBfor\fR or \fBforeach\fR or \fBwhile\fR.
-It returns a \fBTCL_BREAK\fR code, which causes a break exception
+It returns a 3 (\fBTCL_BREAK\fR) result code, which causes a break exception
to occur.
The exception causes the current script to be aborted
out to the innermost containing loop command, which then
diff --git a/doc/case.n b/doc/case.n
index 63ad7e1..0155a61 100644
--- a/doc/case.n
+++ b/doc/case.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: case.n,v 1.3 2000/09/07 14:27:46 poenitz Exp $
-'\"
.so man.macros
.TH case n 7.0 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/catch.n b/doc/catch.n
index 691b0c7..a05ca71 100644
--- a/doc/catch.n
+++ b/doc/catch.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: catch.n,v 1.25 2010/04/07 09:51:31 dkf Exp $
-'\"
.so man.macros
.TH catch n "8.5" Tcl "Tcl Built-In Commands"
.BS
@@ -79,14 +77,14 @@ the corresponding level; or it may be
.QW \fBUP\fR ,
in which case the parameter is
the relative level (as in \fBuplevel\fR) of the previous \fBCALL\fR. The
-salient differences wrt \fB\-errorinfo\fR are that:
-.IP (1)
+salient differences with respect to \fB\-errorinfo\fR are that:
+.IP [1]
it is a machine-readable form that is amenable to processing with
[\fBforeach\fR {tok prm} ...],
-.IP (2)
+.IP [2]
it contains the true (substituted) values passed to the functions, instead of
the static text of the calling sites, and
-.IP (3)
+.IP [3]
it is coarser-grained, with only one element per stack frame (like procs; no
separate elements for \fBforeach\fR constructs for example).
.VE 8.6
diff --git a/doc/cd.n b/doc/cd.n
index 5968446..eb3854c 100644
--- a/doc/cd.n
+++ b/doc/cd.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: cd.n,v 1.10 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH cd n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/chan.n b/doc/chan.n
index 067a408..c518455 100644
--- a/doc/chan.n
+++ b/doc/chan.n
@@ -3,8 +3,6 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
-'\" RCS: @(#) $Id: chan.n,v 1.26 2010/01/20 13:42:17 dkf Exp $
.so man.macros
.TH chan n 8.5 Tcl "Tcl Built-In Commands"
.BS
@@ -59,7 +57,7 @@ closed).
.PP
If the channel is blocking and the channel is ceasing to be writable, the
command does not return until all output is flushed. If the channel is
-nonblocking and there is unflushed output, the channel remains open and the
+non-blocking and there is unflushed output, the channel remains open and the
command returns immediately; output will be flushed in the background and the
channel will be closed when all the flushing is complete.
.PP
@@ -109,8 +107,8 @@ the command sets each of the named options to the corresponding
.PP
The options described below are supported for all channels. In
addition, each channel type may add options that only it supports. See
-the manual entry for the command that creates each type of channels
-for the options that that specific type of channel supports. For
+the manual entry for the command that creates each type of channel
+for the options supported by that specific type of channel. For
example, see the manual entry for the \fBsocket\fR command for additional
options for sockets, and the \fBopen\fR command for additional options for
serial devices.
@@ -120,10 +118,10 @@ serial devices.
The \fB\-blocking\fR option determines whether I/O operations on the
channel can cause the process to block indefinitely. The value of the
option must be a proper boolean value. Channels are normally in
-blocking mode; if a channel is placed into nonblocking mode it will
+blocking mode; if a channel is placed into non-blocking mode it will
affect the operation of the \fBchan gets\fR, \fBchan read\fR, \fBchan
puts\fR, \fBchan flush\fR, and \fBchan close\fR commands; see the
-documentation for those commands for details. For nonblocking mode to
+documentation for those commands for details. For non-blocking mode to
work correctly, the application must be using the Tcl event loop
(e.g. by calling \fBTcl_DoOneEvent\fR or invoking the \fBvwait\fR
command).
@@ -401,7 +399,7 @@ commands.
When a thread or interpreter is deleted, all channels created with
this subcommand and using this thread/interpreter as their computing
base are deleted as well, in all interpreters they have been shared
-with or moved into, and in whatever thread they have been transfered
+with or moved into, and in whatever thread they have been transferred
to. While this pulls the rug out under the other thread(s) and/or
interpreter(s), this cannot be avoided. Trying to use such a channel
will cause the generation of a regular error about unknown channel
@@ -455,7 +453,7 @@ be readable if there is unread data in an input buffer, except in the
special case where the most recent attempt to read from the channel
was a \fBchan gets\fR call that could not find a complete line in the
input buffer. This feature allows a file to be read a line at a time
-in nonblocking mode using events. A channel is also considered to be
+in non-blocking mode using events. A channel is also considered to be
readable if an end of file or error condition is present on the
underlying file or device. It is important for \fIscript\fR to check
for these conditions and handle them appropriately; for example, if
@@ -470,12 +468,12 @@ Note that client sockets opened in asynchronous mode become writable
when they become connected or if the connection fails.
.PP
Event-driven I/O works best for channels that have been placed into
-nonblocking mode with the \fBchan configure\fR command. In blocking
+non-blocking mode with the \fBchan configure\fR command. In blocking
mode, a \fBchan puts\fR command may block if you give it more data
than the underlying file or device can accept, and a \fBchan gets\fR
or \fBchan read\fR command will block if you attempt to read more data
than is ready; no events will be processed while the commands block.
-In nonblocking mode \fBchan puts\fR, \fBchan read\fR, and \fBchan
+In non-blocking mode \fBchan puts\fR, \fBchan read\fR, and \fBchan
gets\fR never block.
.PP
The script for a file event is executed at global level (outside the
@@ -495,7 +493,7 @@ is written.
.PP
If the channel is in blocking mode the command does not return until
all the buffered output has been flushed to the channel. If the
-channel is in nonblocking mode, the command may return before all
+channel is in non-blocking mode, the command may return before all
buffered output has been flushed; the remainder will be flushed in the
background as fast as the underlying file or device is able to absorb
it.
@@ -518,7 +516,7 @@ If an end-of-file occurs while part way through reading a line, the
partial line will be returned (or written into \fIvarName\fR). When
\fIvarName\fR is not specified, the end-of-file case can be
distinguished from an empty line using the \fBchan eof\fR command, and
-the partial-line-but-nonblocking case can be distinguished with the
+the partial-line-but-non-blocking case can be distinguished with the
\fBchan blocked\fR command.
.RE
.TP
@@ -632,16 +630,16 @@ flush\fR command.
.PP
When the output buffer fills up, the \fBchan puts\fR command will
normally block until all the buffered data has been accepted for
-output by the operating system. If \fIchannelId\fR is in nonblocking
+output by the operating system. If \fIchannelId\fR is in non-blocking
mode then the \fBchan puts\fR command will not block even if the
operating system cannot accept the data. Instead, Tcl continues to
buffer the data and writes it in the background as fast as the
underlying file or device can accept it. The application must use the
-Tcl event loop for nonblocking output to work; otherwise Tcl never
+Tcl event loop for non-blocking output to work; otherwise Tcl never
finds out that the file or device is ready for more output data. It
is possible for an arbitrarily large amount of data to be buffered for
-a channel in nonblocking mode, which could consume a large amount of
-memory. To avoid wasting memory, nonblocking I/O should normally be
+a channel in non-blocking mode, which could consume a large amount of
+memory. To avoid wasting memory, non-blocking I/O should normally be
used in an event-driven fashion with the \fBchan event\fR command
(do not invoke \fBchan puts\fR unless you have recently been notified
via a file event that the channel is ready for more output data).
@@ -661,7 +659,7 @@ given to indicate that any trailing newline in the string that has
been read should be trimmed.
.RS
.PP
-If \fIchannelId\fR is in nonblocking mode, \fBchan read\fR may not
+If \fIchannelId\fR is in non-blocking mode, \fBchan read\fR may not
read as many characters as requested: once all available input has
been read, the command will return the data that is available rather
than blocking for more input. If the channel is configured to use a
@@ -677,7 +675,7 @@ channel (see \fBchan configure\fR above for a discussion on the ways
in which \fBchan configure\fR will alter input).
.PP
When reading from a serial port, most applications should configure
-the serial port channel to be nonblocking, like this:
+the serial port channel to be non-blocking, like this:
.PP
.CS
\fBchan configure \fIchannelId \fB\-blocking \fI0\fR.
@@ -730,7 +728,7 @@ position after the end of file.
The \fIorigin\fR argument defaults to \fBstart\fR.
.PP
\fBChan seek\fR flushes all buffered output for the channel before the
-command returns, even if the channel is in nonblocking mode. It also
+command returns, even if the channel is in non-blocking mode. It also
discards any buffered and unread input. This command returns an empty
string. An error occurs if this command is applied to channels whose
underlying file or device does not support seeking.
diff --git a/doc/class.n b/doc/class.n
index 0d29076..88d1b44 100644
--- a/doc/class.n
+++ b/doc/class.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: class.n,v 1.4 2009/11/05 17:56:45 dkf Exp $
-'\"
.so man.macros
.TH class n 0.1 TclOO "TclOO Commands"
.BS
diff --git a/doc/clock.n b/doc/clock.n
index 56a139e..8708029 100644
--- a/doc/clock.n
+++ b/doc/clock.n
@@ -42,12 +42,12 @@ is system-dependent but should be the highest resolution clock available
on the system such as a CPU cycle counter. See \fBHIGH RESOLUTION TIMERS\fR for a full description.
.RS
.PP
-If the \fI\-option\fR argument is \fI\-milliseconds\fR, then the command
+If the \fI\-option\fR argument is \fB\-milliseconds\fR, then the command
is synonymous with \fBclock milliseconds\fR (see below). This
usage is obsolete, and \fBclock milliseconds\fR is to be
considered the preferred way of obtaining a count of milliseconds.
.PP
-If the \fI\-option\fR argument is \fI\-microseconds\fR, then the command
+If the \fI\-option\fR argument is \fB\-microseconds\fR, then the command
is synonymous with \fBclock microseconds\fR (see below). This
usage is obsolete, and \fBclock microseconds\fR is to be
considered the preferred way of obtaining a count of microseconds.
@@ -116,7 +116,7 @@ On \fBclock format\fR, the default format is
%a %b %d %H:%M:%S %z %Y
.CE
.PP
-On \fBclock scan\fR, the lack of a \fI\-format\fR option indicates that a
+On \fBclock scan\fR, the lack of a \fB\-format\fR option indicates that a
.QW "free format scan"
is requested; see \fBFREE FORM SCAN\fR for a description of what happens.
.RE
@@ -904,7 +904,7 @@ or
Note that only these three 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 \fI\-format\fR option to the \fBclock scan\fR command.
+giving an explicit \fB\-format\fR option to the \fBclock scan\fR command.
.TP
\fIrelative time\fR
A specification relative to the current time. The format is \fBnumber
diff --git a/doc/close.n b/doc/close.n
index 60a8b97..2826d82 100644
--- a/doc/close.n
+++ b/doc/close.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: close.n,v 1.16 2009/04/15 12:31:24 dkf Exp $
-'\"
.so man.macros
.TH close n 7.5 Tcl "Tcl Built-In Commands"
.BS
@@ -25,7 +23,8 @@ Tcl standard channel (\fBstdin\fR, \fBstdout\fR, or \fBstderr\fR),
the return value from an invocation of \fBopen\fR or \fBsocket\fR, or
the result of a channel creation command provided by a Tcl extension.
.PP
-The single-argument form is a simple "full-close":
+The single-argument form is a simple
+.QW "full-close" :
all buffered output is flushed to the channel's output device,
any buffered input is discarded, the underlying file or device is closed,
and \fIchannelId\fR becomes unavailable for use.
@@ -49,8 +48,10 @@ When the last interpreter in which the channel is registered invokes
\fBinterp\fR command for a description of channel sharing.
.PP
Channels are automatically closed when an interpreter is destroyed and
-when the process exits. Channels are switched to blocking mode, to ensure
-that all output is correctly flushed before the process exits.
+when the process exits.
+.VS 8.6
+From 8.6 on (TIP#398), nonblocking channels are no longer switched to blocking mode when exiting; this guarantees a timely exit even when the peer or a communication channel is stalled. To ensure proper flushing of stalled nonblocking channels on exit, one must now either (a) actively switch them back to blocking or (b) use the environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT, which when set and not equal to "0" restores the previous behavior.
+.VE 8.6
.PP
The command returns an empty string, and may generate an error if
an error occurs while flushing output. If a command in a command
@@ -58,16 +59,20 @@ pipeline created with \fBopen\fR returns an error, \fBclose\fR
generates an error (similar to the \fBexec\fR command.)
.PP
.VS 8.6
-The two-argument form is a "half-close": given a bidirectional channel like a
+The two-argument form is a
+.QW "half-close" :
+given a bidirectional channel like a
socket or command pipeline and a (possibly abbreviated) direction, it closes
-only the substream going in that direction. This means a shutdown() on a
+only the sub-stream going in that direction. This means a shutdown() on a
socket, and a close() of one end of a pipe for a command pipeline. Then, the
Tcl-level channel data structure is either kept or freed depending on whether
the other direction is still open.
.PP
-A single-argument close on an already half-closed bi-channel is defined to
-just "finish the job. A half-close on an already closed half, or on a
-wrong-sided unidirectional channel, raises an error.
+A single-argument close on an already half-closed bidirectional channel is
+defined to just
+.QW "finish the job" .
+A half-close on an already closed half, or on a wrong-sided unidirectional
+channel, raises an error.
.PP
In the case of a command pipeline, the child-reaping duty falls upon the
shoulders of the last close or half-close, which is thus allowed to report an
diff --git a/doc/concat.n b/doc/concat.n
index 7cda15c..b079b30 100644
--- a/doc/concat.n
+++ b/doc/concat.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: concat.n,v 1.14 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH concat n 8.3 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/continue.n b/doc/continue.n
index beb29b7..de2f07c 100644
--- a/doc/continue.n
+++ b/doc/continue.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: continue.n,v 1.12 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH continue n "" Tcl "Tcl Built-In Commands"
.BS
@@ -20,8 +18,8 @@ continue \- Skip to the next iteration of a loop
.PP
This command is typically invoked inside the body of a looping command
such as \fBfor\fR or \fBforeach\fR or \fBwhile\fR.
-It returns a \fBTCL_CONTINUE\fR code, which causes a continue exception
-to occur.
+It returns a 4 (\fBTCL_CONTINUE\fR) result code, which causes a continue
+exception to occur.
The exception causes the current script to be aborted
out to the innermost containing loop command, which then
continues with the next iteration of the loop.
diff --git a/doc/copy.n b/doc/copy.n
index 018c696..f5002f8 100644
--- a/doc/copy.n
+++ b/doc/copy.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: copy.n,v 1.3 2009/06/07 23:33:23 dkf Exp $
-'\"
.so man.macros
.TH copy n 0.1 TclOO "TclOO Commands"
.BS
@@ -28,10 +26,23 @@ resolved relative to the current namespace if not an absolute qualified name.
If \fItargetObject\fR is omitted, a new name is chosen. The copied object will
be of the same class as the source object, and will have all its per-object
methods copied. If it is a class, it will also have all the class methods in
-the class copied, but it will not have any of its instances copied. The
-contents of the source object's private namespace \fIwill not\fR be copied; it
-is up to the caller to do this. The result of this command will be the
-fully-qualified name of the new object or class.
+the class copied, but it will not have any of its instances copied.
+.PP
+.VS
+After the \fItargetObject\fR has been created and all definitions of its
+configuration (e.g., methods, filters, mixins) copied, the \fB<cloned>\fR
+method of \fItargetObject\fR will be invoked, to allow for customization of
+the created object such as installing related variable traces. The only
+argument given will be \fIsourceObject\fR. The default implementation of this
+method (in \fBoo::object\fR) just copies the procedures and variables in the
+namespace of \fIsourceObject\fR to the namespace of \fItargetObject\fR. If
+this method call does not return a result that is successful (i.e., an error
+or other kind of exception) then the \fItargetObject\fR will be deleted and an
+error returned.
+.VE
+.PP
+The result of the \fBoo::copy\fR command will be the fully-qualified name of
+the new object or class.
.SH EXAMPLES
.PP
This example creates an object, copies it, modifies the source object, and
diff --git a/doc/coroutine.n b/doc/coroutine.n
index 4a7d799..035d58a 100644
--- a/doc/coroutine.n
+++ b/doc/coroutine.n
@@ -4,19 +4,20 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: coroutine.n,v 1.5 2010/01/13 09:10:10 dkf Exp $
-'\"
.so man.macros
.TH coroutine n 8.6 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-coroutine, yield \- Create and produce values from coroutines
+coroutine, yield, yieldto \- Create and produce values from coroutines
.SH SYNOPSIS
.nf
\fBcoroutine \fIname command\fR ?\fIarg...\fR?
\fByield\fR ?\fIvalue\fR?
-\fIname\fR ?\fIvalue\fR?
+.VS TIP396
+\fByieldto\fR \fIcommand\fR ?\fIarg...\fR?
+\fIname\fR ?\fIvalue...\fR?
+.VE TIP396
.fi
.BE
.SH DESCRIPTION
@@ -32,11 +33,37 @@ Within the context, values may be generated as results by using the
When that is called, the context will suspend execution and the
\fBcoroutine\fR command will return the argument to \fByield\fR. The execution
of the context can then be resumed by calling the context command, optionally
-passing in the value to use as the result of the \fByield\fR call that caused
+passing in the \fIsingle\fR value to use as the result of the \fByield\fR call
+that caused
the context to be suspended. If the coroutine context never yields and instead
returns conventionally, the result of the \fBcoroutine\fR command will be the
result of the evaluation of the context.
.PP
+.VS TIP396
+The coroutine may also suspend its execution by use of the \fByieldto\fR
+command, which instead of returning, cedes execution to some command called
+\fIcommand\fR (resolved in the context of the coroutine) and to which \fIany
+number\fR of arguments may be passed. Since every coroutine has a context
+command, \fByieldto\fR can be used to transfer control directly from one
+coroutine to another (this is only advisable if the two coroutines are
+expecting this to happen) but \fIany\fR command may be the target. If a
+coroutine is suspended by this mechanism, the coroutine processing can be
+resumed by calling the context command optionally passing in an arbitrary
+number of arguments. The return value of the \fByieldto\fR call will be the
+list of arguments passed to the context command; it is up to the caller to
+decide what to do with those values.
+.PP
+The recommended way of writing a version of \fByield\fR that allows resumption
+with multiple arguments is by using \fByieldto\fR and the \fBreturn\fR
+command, like this:
+.PP
+.CS
+proc yieldm {value} {
+ \fByieldto\fR return -level 0 $value
+}
+.CE
+.VE TIP396
+.PP
The coroutine can also be deleted by destroying the command \fIname\fR, and
the name of the current coroutine can be retrieved by using
\fBinfo coroutine\fR.
@@ -110,10 +137,31 @@ for {set i 1} {$i <= 20} {incr i} {
puts "prime#$i = [\fIeratosthenes\fR]"
}
.CE
+.PP
+.VS TIP396
+This example shows how a value can be passed around a group of three
+coroutines that yield to each other:
+.PP
+.CS
+proc juggler {name target {value ""}} {
+ if {$value eq ""} {
+ set value [\fByield\fR [info coroutine]]
+ }
+ while {$value ne ""} {
+ puts "$name : $value"
+ set value [string range $value 0 end-1]
+ lassign [\fByieldto\fR $target $value] value
+ }
+}
+\fBcoroutine\fR j1 juggler Larry [
+ \fBcoroutine\fR j2 juggler Curly [
+ \fBcoroutine\fR j3 juggler Moe j1]] "Nyuck!Nyuck!Nyuck!"
+.CE
+.VE TIP396
.SS "DETAILED SEMANTICS"
.PP
This example demonstrates that coroutines start from the global namespace, and
-that\fIcommand\fR resolution happens before the coroutine stack is created.
+that \fIcommand\fR resolution happens before the coroutine stack is created.
.PP
.CS
proc report {where level} {
diff --git a/doc/dde.n b/doc/dde.n
index 7859de1..3fe0f87 100644
--- a/doc/dde.n
+++ b/doc/dde.n
@@ -5,23 +5,23 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: dde.n,v 1.25 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
-.TH dde n 1.3 dde "Tcl Bundled Packages"
+.TH dde n 1.4 dde "Tcl Bundled Packages"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
dde \- Execute a Dynamic Data Exchange command
.SH SYNOPSIS
.sp
-\fBpackage require dde 1.3\fR
+\fBpackage require dde 1.4\fR
.sp
\fBdde servername\fR ?\fB\-force\fR? ?\fB\-handler \fIproc\fR? ?\fB\-\|\-\fR? ?\fItopic\fR?
.sp
-\fBdde execute\fR ?\fB\-async\fR? \fIservice topic data\fR
+.VS 8.6
+\fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR
.sp
-\fBdde poke\fR \fIservice topic item data\fR
+\fBdde poke\fR ?\fB\-binary\fR? \fIservice topic item data\fR
+.VE 8.6
.sp
\fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR
.sp
@@ -71,7 +71,7 @@ procedure is called with all the arguments provided by the remote
call.
.RE
.TP
-\fBdde execute\fR ?\fB\-async\fR? \fIservice topic data\fR
+\fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR
.
\fBdde execute\fR takes the \fIdata\fR and sends it to the server indicated
by \fIservice\fR with the topic indicated by \fItopic\fR. Typically,
@@ -82,8 +82,15 @@ script is run in the application. The \fB\-async\fR option requests
asynchronous invocation. The command returns an error message if the
script did not run, unless the \fB\-async\fR flag was used, in which case
the command returns immediately with no error.
+.VS 8.6
+Without the \fB\-binary\fR option all data will be sent in unicode. For
+dde clients which don't implement the CF_UNICODE clipboard format, this
+will automatically be translated to the system encoding. You can use
+the \fB\-binary\fR option in combination with the result of
+\fBencoding convertto\fR to send data in any other encoding.
+.VE 8.6
.TP
-\fBdde poke \fIservice topic item data\fR
+\fBdde poke\fR ?\fB\-binary\fR? \fIservice topic item data\fR
.
\fBdde poke\fR passes the \fIdata\fR to the server indicated by
\fIservice\fR using the \fItopic\fR and \fIitem\fR specified. Typically,
@@ -92,6 +99,13 @@ specific but can be a command to the server or the name of a file to work
on. The \fIitem\fR is also application specific and is often not used, but
it must always be non-null. The \fIdata\fR field is given to the remote
application.
+.VS 8.6
+Without the \fB\-binary\fR option all data will be sent in unicode. For
+dde clients which don't implement the CF_UNICODE clipboard format, this
+will automatically be translated to the system encoding. You can use
+the \fB\-binary\fR option in combination with the result of
+\fBencoding convertto\fR to send data in any other encoding.
+.VE 8.6
.TP
\fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR
.
@@ -147,7 +161,7 @@ unpredictable results.
.PP
An external application which wishes to run a script in Tcl should have
that script store its result in a variable, run the \fBdde execute\fR
-command, and the run \fBdde request\fR to get the value of the
+command, and then run \fBdde request\fR to get the value of the
variable.
.PP
When using DDE, be careful to ensure that the event queue is flushed
@@ -164,9 +178,12 @@ particularly important website:
.PP
.CS
package require dde
-\fBdde execute\fR iexplore WWW_OpenURL http://www.tcl.tk/
+\fBdde execute\fR -async iexplore WWW_OpenURL http://www.tcl.tk/
.CE
.SH "SEE ALSO"
tk(n), winfo(n), send(n)
.SH KEYWORDS
application, dde, name, remote execution
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/define.n b/doc/define.n
index e3f2e39..1c36ca3 100644
--- a/doc/define.n
+++ b/doc/define.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: define.n,v 1.3 2009/04/11 11:18:51 dkf Exp $
-'\"
.so man.macros
.TH define n 0.3 TclOO "TclOO Commands"
.BS
@@ -83,14 +81,18 @@ class being defined. Note that the methods themselves may be actually defined
by a superclass; subclass exports override superclass visibility, and may in
turn be overridden by instances.
.TP
-\fBfilter\fR ?\fImethodName ...\fR?
-.
-This sets or updates the list of method names that are used to guard whether a
+\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
+.VS
+This slot (see \fBSLOTTED DEFINITIONS\fR below)
+.VE
+sets or updates the list of method names that are used to guard whether
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may
be exposed or not exposed); it is not an error for a non-existent method to be
-named since they may be defined by subclasses. If no \fImethodName\fR
-arguments are present, the list of filter names is set to empty.
+named since they may be defined by subclasses.
+.VS
+By default, this slot works by appending.
+.VE
.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
@@ -116,12 +118,16 @@ exported if \fIname\fR starts with a lower-case letter, and non-exported
otherwise; this behavior can be overridden via \fBexport\fR and
\fBunexport\fR.
.TP
-\fBmixin\fR ?\fIclassName ...\fR?
-.
-This sets or updates the list of additional classes that are to be mixed into
+\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
+.VS
+This slot (see \fBSLOTTED DEFINITIONS\fR below)
+.VE
+sets or updates the list of additional classes that are to be mixed into
all the instances of the class being defined. Each \fIclassName\fR argument
-names a single class that is to be mixed in; if no classes are present, the
-list of mixed-in classes is set to be empty.
+names a single class that is to be mixed in.
+.VS
+By default, this slot works by replacement.
+.VE
.TP
\fBrenamemethod\fI fromName toName\fR
.
@@ -146,12 +152,19 @@ and
operates identically to
.QW "\fBoo::objdefine \fIcls subcommand ...\fR" .
.TP
-\fBsuperclass\fI className \fR?\fIclassName ...\fR?
-.
-This allows the alteration of the superclasses of the class being defined.
+\fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
+.VS
+This slot (see \fBSLOTTED DEFINITIONS\fR below)
+.VE
+allows the alteration of the superclasses of the class being defined.
Each \fIclassName\fR argument names one class that is to be a superclass of
the defined class. Note that objects must not be changed from being classes to
-being non-classes or vice-versa.
+being non-classes or vice-versa, that an empty parent class is equivalent to
+\fBoo::object\fR, and that the parent classes of \fBoo::object\fR and
+\fBoo::class\fR may not be modified.
+.VS
+By default, this slot works by replacement.
+.VE
.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
@@ -162,18 +175,18 @@ context) by the class being defined. Note that the methods themselves may be
actually defined by a superclass; subclass unexports override superclass
visibility, and may be overridden by instance unexports.
.TP
-\fBvariable\fR ?\fIname ...\fR?
+\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
.VS
-This arranges for each of the named variables to be automatically made
+This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
+variables to be automatically made
available in the methods, constructor and destructor declared by the class
-being defined. Note that the list of variable names is the whole list of
-variable names for the class. Each variable name must not have any namespace
+being defined. Each variable name must not have any namespace
separators and must not look like an array access. All variables will be
actually present in the instance object on which the method is executed. Note
that the variable lists declared by a superclass or subclass are completely
disjoint, as are variable lists declared by instances; the list of variable
names is just for methods (and constructors and destructors) declared by this
-class.
+class. By default, this slot works by appending.
.VE
.SS "CONFIGURING OBJECTS"
.PP
@@ -200,15 +213,19 @@ This arranges for each of the named methods, \fIname\fR, to be exported
being defined. Note that the methods themselves may be actually defined by a
class or superclass; object exports override class visibility.
.TP
-\fBfilter\fR ?\fImethodName ...\fR?
-.
-This sets or updates the list of method names that are used to guard whether a
+\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
+.VS
+This slot (see \fBSLOTTED DEFINITIONS\fR below)
+.VE
+sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
-not exposed); it is not an error for a non-existent method to be named. If no
-\fImethodName\fR arguments are present, the list of filter names is set to
-empty. Note that the actual list of filters also depends on the filters set
-upon any classes that the object is an instance of.
+not exposed); it is not an error for a non-existent method to be named. Note
+that the actual list of filters also depends on the filters set upon any
+classes that the object is an instance of.
+.VS
+By default, this slot works by appending.
+.VE
.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
@@ -229,12 +246,16 @@ current namespace of the method will be a namespace that is unique to the
object. The method will be exported if \fIname\fR starts with a lower-case
letter, and non-exported otherwise.
.TP
-\fBmixin\fR ?\fIclassName ...\fR?
-.
-This sets or updates a per-object list of additional classes that are to be
+\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
+.VS
+This slot (see \fBSLOTTED DEFINITIONS\fR below)
+.VE
+sets or updates a per-object list of additional classes that are to be
mixed into the object. Each argument, \fIclassName\fR, names a single class
-that is to be mixed in; if no classes are present, the list of mixed-in
-classes is set to be empty.
+that is to be mixed in.
+.VS
+By default, this slot works by replacement.
+.VE
.TP
\fBrenamemethod\fI fromName toName\fR
.
@@ -252,16 +273,70 @@ just through the \fBmy\fR command visible in the object's context) by the
object being defined. Note that the methods themselves may be actually defined
by a class; instance unexports override class visibility.
.TP
-\fBvariable\fR ?\fIname ...\fR?
+\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
.VS
-This arranges for each of the named variables to be automatically made
-available in the methods declared by the object being defined. Note that the
-list of variable names is the whole list of variable names for the object.
-Each variable name must not have any namespace separators and must not look
-like an array access. All variables will be actually present in the object on
-which the method is executed. Note that the variable lists declared by the
-classes and mixins of which the object is an instance are completely disjoint;
-the list of variable names is just for methods declared by this object.
+This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
+variables to be automatically made available in the methods declared by the
+object being defined. Each variable name must not have any namespace
+separators and must not look like an array access. All variables will be
+actually present in the object on which the method is executed. Note that the
+variable lists declared by the classes and mixins of which the object is an
+instance are completely disjoint; the list of variable names is just for
+methods declared by this object. By default, this slot works by appending.
+.SH "SLOTTED DEFINITIONS"
+Some of the configurable definitions of a class or object are \fIslotted
+definitions\fR. This means that the configuration is implemented by a slot
+object, that is an instance of the class \fBoo::Slot\fR, which manages a list
+of values (class names, variable names, etc.) that comprises the contents of
+the slot. The class defines three operations (as methods) that may be done on
+the slot:
+.VE
+.TP
+\fIslot\fR \fB\-append\fR ?\fImember ...\fR?
+.VS
+This appends the given \fImember\fR elements to the slot definition.
+.VE
+.TP
+\fIslot\fR \fB\-clear\fR
+.VS
+This sets the slot definition to the empty list.
+.VE
+.TP
+\fIslot\fR \fB\-set\fR ?\fImember ...\fR?
+.VS
+This replaces the slot definition with the given \fImember\fR elements.
+.PP
+A consequence of this is that any use of a slot's default operation where the
+first member argument begins with a hyphen will be an error. One of the above
+operations should be used explicitly in those circumstances.
+.SS "SLOT IMPLEMENTATION"
+Internally, slot objects also define a method \fB\-\-default\-operation\fR
+which is forwarded to the default operation of the slot (thus, for the class
+.QW \fBvariable\fR
+slot, this is forwarded to
+.QW "\fBmy \-append\fR" ),
+and these methods which provide the implementation interface:
+.VE
+.TP
+\fIslot\fR \fBGet\fR
+.VS
+Returns a list that is the current contents of the slot. This method must
+always be called from a stack frame created by a call to \fBoo::define\fR or
+\fBoo::objdefine\fR.
+.VE
+.TP
+\fIslot\fR \fBSet \fIelementList\fR
+.VS
+Sets the contents of the slot to the list \fIelementList\fR and returns the
+empty string. This method must always be called from a stack frame created by
+a call to \fBoo::define\fR or \fBoo::objdefine\fR.
+.PP
+The implementation of these methods is slot-dependent (and responsible for
+accessing the correct part of the class or object definition). Slots also have
+an unknown method handler to tie all these pieces together, and they hide
+their \fBdestroy\fR method so that it is not invoked inadvertently. It is
+\fIrecommended\fR that any user changes to the slot mechanism be restricted to
+defining new operations whose names start with a hyphen.
.VE
.SH EXAMPLES
This example demonstrates how to use both forms of the \fBoo::define\fR and
@@ -288,11 +363,41 @@ o Foo Bar \fI\(-> error "unknown method Foo"\fR
\fBoo::objdefine\fR o \fBrenamemethod\fR bar lollipop
o lollipop \fI\(-> prints "hello world"\fR
.CE
+.PP
+This example shows how additional classes can be mixed into an object. It also
+shows how \fBmixin\fR is a slot that supports appending:
+.PP
+.CS
+oo::object create inst
+inst m1 \fI\(-> error "unknown method m1"\fR
+inst m2 \fI\(-> error "unknown method m2"\fR
+
+oo::class create A {
+ \fBmethod\fR m1 {} {
+ puts "red brick"
+ }
+}
+\fBoo::objdefine\fR inst {
+ \fBmixin\fR A
+}
+inst m1 \fI\(-> prints "red brick"\fR
+inst m2 \fI\(-> error "unknown method m2"\fR
+
+oo::class create B {
+ \fBmethod\fR m2 {} {
+ puts "blue brick"
+ }
+}
+\fBoo::objdefine\fR inst {
+ \fBmixin -append\fR B
+}
+inst m1 \fI\(-> prints "red brick"\fR
+inst m2 \fI\(-> prints "blue brick"\fR
+.CE
.SH "SEE ALSO"
next(n), oo::class(n), oo::object(n)
.SH KEYWORDS
-class, definition, method, object
-
+class, definition, method, object, slot
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
diff --git a/doc/dict.n b/doc/dict.n
index 76f37b3..c014448 100644
--- a/doc/dict.n
+++ b/doc/dict.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: dict.n,v 1.24 2010/08/29 15:37:42 dkf Exp $
-'\"
.so man.macros
.TH dict n 8.5 Tcl "Tcl Built-In Commands"
.BS
@@ -69,7 +67,7 @@ dictionary, and a condition of \fBTCL_CONTINUE\fR is equivalent to a false
result. The key/value pairs are tested in the order in which the keys
were inserted into the dictionary.
.TP
-\fBdict filter \fIdictionaryValue \fBvalue \fIglobPattern\fR
+\fBdict filter \fIdictionaryValue \fBvalue \fR?\fIglobPattern ...\fR?
.VS 8.6
The value rule only matches those key/value pairs whose values match any
of the given patterns (in the style of \fBstring match\fR.)
@@ -149,6 +147,31 @@ keys are treated as if they map to an empty list, and it is legal for
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.
.TP
+\fBdict map \fR{\fIkeyVar valueVar\fR} \fIdictionaryValue body\fR
+.
+This command applies a transformation to each element of a dictionary,
+returning a new dictionary. It takes three arguments: the first is a
+two-element list of variable names (for the key and value respectively of each
+mapping in the dictionary), the second the dictionary value to iterate across,
+and the third a script to be evaluated for each mapping with the key and value
+variables set appropriately (in the manner of \fBlmap\fR). In an iteration
+where the evaluated script completes normally (\fBTCL_OK\fR, as opposed to an
+\fBerror\fR, etc.) the result of the script is put into an accumulator
+dictionary using the key that is the current contents of the \fIkeyVar\fR
+variable at that point. The result of the \fBdict map\fR command is the
+accumulator dictionary after all keys have been iterated over.
+.RS
+.PP
+If the evaluation of the body for any particular step generates a \fBbreak\fR,
+no further pairs from the dictionary will be iterated over and the \fBdict
+map\fR command will terminate successfully immediately. If the evaluation of
+the body for a particular step generates a \fBcontinue\fR result, the current
+iteration is aborted and the accumulator dictionary is not modified. The order
+of iteration is the natural order of the dictionary (typically the order in
+which the keys were added to the dictionary; the order is the same as that
+used in \fBdict for\fR).
+.RE
+.TP
\fBdict merge \fR?\fIdictionaryValue ...\fR?
.
Return a dictionary that contains the contents of each of the
@@ -253,6 +276,15 @@ exist after the command finishes (unless explicitly \fBunset\fR).
Note that the mapping of values to variables does not use
traces; changes to the \fIdictionaryVariable\fR's contents only happen
when \fIbody\fR terminates.
+.PP
+If the \fIdictionaryVariable\fR contains a value that is not a dictionary at
+the point when the \fIbody\fR terminates (which can easily happen if the name
+is the same as any of the keys in dictionary) then an error occurs at that
+point. This command is thus not recommended for use when the keys in the
+dictionary are expected to clash with the \fIdictionaryVariable\fR name
+itself. Where the contained key does map to a dictionary, the net effect is to
+combine that inner dictionary into the outer dictionary; see the
+\fBEXAMPLES\fR below for an illustration of this.
.RE
.SH "DICTIONARY VALUES"
.PP
@@ -390,10 +422,20 @@ sumDictionary myDict
puts "dictionary is now \\"$myDict\\""
# prints: \fIdictionary is now "a {total 6} b {total 15}"\fR
.CE
+.PP
+When \fBdict with\fR is used with a key that clashes with the name of the
+dictionary variable:
+.PP
+.CS
+set foo {foo {a b} bar 2 baz 3}
+\fBdict with\fR foo {}
+puts $foo
+# prints: \fIa b foo {a b} bar 2 baz 3\fR
+.CE
.SH "SEE ALSO"
-append(n), array(n), foreach(n), incr(n), list(n), lappend(n), set(n)
+append(n), array(n), foreach(n), mapeach(n), incr(n), list(n), lappend(n), set(n)
.SH KEYWORDS
-dictionary, create, update, lookup, iterate, filter
+dictionary, create, update, lookup, iterate, filter, map
'\" Local Variables:
'\" mode: nroff
'\" End:
diff --git a/doc/encoding.n b/doc/encoding.n
index 4e31bff..5269a18 100644
--- a/doc/encoding.n
+++ b/doc/encoding.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: encoding.n,v 1.18 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH encoding n "8.1" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/eof.n b/doc/eof.n
index bf492bc..017b10e 100644
--- a/doc/eof.n
+++ b/doc/eof.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: eof.n,v 1.10 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH eof n 7.5 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/error.n b/doc/error.n
index d3cf694..d61bd7b 100644
--- a/doc/error.n
+++ b/doc/error.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: error.n,v 1.14 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH error n "" Tcl "Tcl Built-In Commands"
.BS
@@ -41,19 +39,19 @@ to return a stack trace reflecting the original point of occurrence
of the error:
.PP
.CS
-\fBcatch {...} errMsg
+catch {...} errMsg
set savedInfo $::errorInfo
\&...
-error $errMsg $savedInfo\fR
+\fBerror\fR $errMsg $savedInfo
.CE
.PP
When working with Tcl 8.5 or later, the following code
should be used instead:
.PP
.CS
-\fBcatch {...} errMsg options
+catch {...} errMsg options
\&...
-return -options $options $errMsg\fR
+return -options $options $errMsg
.CE
.PP
If the \fIcode\fR argument is present, then its value is stored
@@ -75,3 +73,6 @@ if {1+2 != 3} {
catch(n), return(n)
.SH KEYWORDS
error, exception
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/eval.n b/doc/eval.n
index 1f305f8..da88757 100644
--- a/doc/eval.n
+++ b/doc/eval.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: eval.n,v 1.14 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH eval n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/exec.n b/doc/exec.n
index b84f5ea..5072d61 100644
--- a/doc/exec.n
+++ b/doc/exec.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: exec.n,v 1.27 2010/03/20 21:26:39 dkf Exp $
-'\"
.so man.macros
.TH exec n 8.5 Tcl "Tcl Built-In Commands"
.BS
@@ -241,7 +239,7 @@ names must use the short, cryptic, path format (e.g., using
instead of
.QW applbakery.default ),
which can be obtained with the
-.QW "\fBfile attributes \fIfileName \fB\-shortname\fR"
+.QW "\fBfile attributes\fI fileName \fB\-shortname\fR"
command.
.PP
Two or more forward or backward slashes in a row in a path refer to a
diff --git a/doc/exit.n b/doc/exit.n
index 46728cf..ceb0529 100644
--- a/doc/exit.n
+++ b/doc/exit.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: exit.n,v 1.11 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH exit n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/expr.n b/doc/expr.n
index c9a81bb..8698f5c 100644
--- a/doc/expr.n
+++ b/doc/expr.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: expr.n,v 1.38 2009/05/26 09:08:05 ferrieux Exp $
-'\"
.so man.macros
.TH expr n 8.5 Tcl "Tcl Built-In Commands"
.BS
@@ -30,7 +28,7 @@ Expressions almost always yield numeric results
For example, the expression
.PP
.CS
-\fBexpr 8.2 + 6\fR
+\fBexpr\fR 8.2 + 6
.CE
.PP
evaluates to 14.2.
@@ -41,9 +39,9 @@ additional operators not found in C.
.SS OPERANDS
.PP
A Tcl expression consists of a combination of operands, operators,
-and parentheses.
+parentheses and commas.
White space may be used between the operands and operators and
-parentheses; it is ignored by the expression's instructions.
+parentheses (or commas); it is ignored by the expression's instructions.
Where possible, operands are interpreted as integer values.
Integer values may be specified in decimal (the normal case), in binary
(if the first two characters of the operand are \fB0b\fR), in octal
@@ -70,7 +68,8 @@ Operands may be specified in any of the following ways:
.IP [1]
As a numeric value, either integer or floating-point.
.IP [2]
-As a boolean value, using any form understood by \fBstring is boolean\fR.
+As a boolean value, using any form understood by \fBstring is\fR
+\fBboolean\fR.
.IP [3]
As a Tcl variable, using standard \fB$\fR notation.
The variable's value will be used as the operand.
@@ -135,7 +134,20 @@ Multiply, divide, remainder. None of these operators may be
applied to string operands, and remainder may be applied only
to integers.
The remainder will always have the same sign as the divisor and
-an absolute value smaller than the divisor.
+an absolute value smaller than the absolute value of the divisor.
+.RS
+.PP
+When applied to integers, the division and remainder operators can be
+considered to partition the number line into a sequence of equal-sized
+adjacent non-overlapping pieces where each piece is the size of the divisor;
+the division result identifies which piece the divisor lay within, and the
+remainder result identifies where within that piece the divisor lay. A
+consequence of this is that the result of
+.QW "-57 \fB/\fR 10"
+is always -6, and the result of
+.QW "-57 \fB%\fR 10"
+is always 3.
+.RE
.TP 20
\fB+\0\0\-\fR
.
@@ -227,7 +239,7 @@ just as in C, which means that operands are not evaluated if they are
not needed to determine the outcome. For example, in the command
.PP
.CS
-\fBexpr {$v ? [a] : [b]}\fR
+\fBexpr\fR {$v ? [a] : [b]}
.CE
.PP
only one of
@@ -250,19 +262,19 @@ Tcl function in the \fBtcl::mathfunc\fR namespace. The processing
of an expression such as:
.PP
.CS
-\fBexpr {sin($x+$y)}\fR
+\fBexpr\fR {sin($x+$y)}
.CE
.PP
is the same in every way as the processing of:
.PP
.CS
-\fBexpr {[tcl::mathfunc::sin [expr {$x+$y}]]}\fR
+\fBexpr\fR {[tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]]}
.CE
.PP
which in turn is the same as the processing of:
.PP
.CS
-\fBtcl::mathfunc::sin [expr {$x+$y}]\fR
+tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]
.CE
.PP
The executor will search for \fBtcl::mathfunc::sin\fR using the usual
@@ -271,6 +283,18 @@ rules for resolving functions in namespaces. Either
current]::tcl::mathfunc::sin\fR will satisfy the request, and others
may as well (depending on the current \fBnamespace path\fR setting).
.PP
+Some mathematical functions have several arguments, separated by commas like in C. Thus:
+.PP
+.CS
+\fBexpr\fR {hypot($x,$y)}
+.CE
+.PP
+ends up as
+.PP
+.CS
+tcl::mathfunc::hypot $x $y
+.CE
+.PP
See the \fBmathfunc\fR(n) manual page for the math functions that are
available by default.
.SS "TYPES, OVERFLOW, AND PRECISION"
@@ -327,6 +351,7 @@ returns \fB4.0\fR, not \fB4\fR.
String values may be used as operands of the comparison operators,
although the expression evaluator tries to do comparisons as integer
or floating-point when it can,
+i.e., when all arguments to the operator allow numeric interpretations,
except in the case of the \fBeq\fR and \fBne\fR operators.
If one of the operands of a comparison is a string and the other
has a numeric value, a canonical string representation of the numeric
@@ -337,13 +362,12 @@ is that produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command. For example, the commands
.PP
.CS
-\fBexpr {"0x03" > "2"}\fR
-\fBexpr {"0y" < "0x12"}\fR
+\fBexpr\fR {"0x03" > "2"}
+\fBexpr\fR {"0y" > "0x12"}
.CE
.PP
both return 1. The first comparison is done using integer
-comparison, and the second is done using string comparison after
-the second operand is converted to the string \fB18\fR.
+comparison, and the second is done using string comparison.
Because of Tcl's tendency to treat values as numbers whenever
possible, it is not generally a good idea to use operators like \fB==\fR
when you really want string comparison and the values of the
@@ -360,9 +384,9 @@ once by the Tcl parser and once by the \fBexpr\fR command.
For example, the commands
.PP
.CS
-\fBset a 3\fR
-\fBset b {$a + 2}\fR
-\fBexpr $b*4\fR
+set a 3
+set b {$a + 2}
+\fBexpr\fR $b*4
.CE
.PP
return 11, not a multiple of 4.
@@ -446,3 +470,6 @@ Copyright (c) 1993 The Regents of the University of California.
Copyright (c) 1994-2000 Sun Microsystems Incorporated.
Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
.fi
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/fblocked.n b/doc/fblocked.n
index a426b27..2841aee 100644
--- a/doc/fblocked.n
+++ b/doc/fblocked.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: fblocked.n,v 1.9 2009/02/24 21:04:58 dkf Exp $
-.so man.macros
.TH fblocked n 7.5 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
diff --git a/doc/fconfigure.n b/doc/fconfigure.n
index d2b8ee1..ac0366c 100644
--- a/doc/fconfigure.n
+++ b/doc/fconfigure.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: fconfigure.n,v 1.23 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH fconfigure n 8.3 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/fcopy.n b/doc/fcopy.n
index 1178093..6a4bf1a 100644
--- a/doc/fcopy.n
+++ b/doc/fcopy.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: fcopy.n,v 1.19 2009/01/05 14:04:51 dkf Exp $
-'\"
.so man.macros
.TH fcopy n 8.0 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/file.n b/doc/file.n
index 96d84b5..eef4647 100644
--- a/doc/file.n
+++ b/doc/file.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: file.n,v 1.60 2010/09/18 23:14:19 dkf Exp $
-'\"
.so man.macros
.TH file n 8.3 Tcl "Tcl Built-In Commands"
.BS
@@ -106,7 +104,7 @@ within a single filesystem, \fIfile copy\fR will copy soft links (i.e.
the links themselves are copied, not the things they point to). Trying
to overwrite a non-empty directory, overwrite a directory with a file,
or overwrite a file with a directory will all result in errors even if
-\fI\-force\fR was specified. Arguments are processed in the order
+\fB\-force\fR was specified. Arguments are processed in the order
specified, halting at the first error, if any. A \fB\-\|\-\fR marks
the end of switches; the argument following the \fB\-\|\-\fR will be
treated as a \fIsource\fR even if it starts with a \fB\-\fR.
@@ -140,7 +138,7 @@ returned. For example,
.RS
.PP
.CS
-\fBfile dirname c:/\fR
+\fBfile dirname\fR c:/
.CE
.PP
returns \fBc:/\fR.
@@ -149,13 +147,13 @@ Note that tilde substitution will only be
performed if it is necessary to complete the command. For example,
.PP
.CS
-\fBfile dirname ~/src/foo.c\fR
+\fBfile dirname\fR ~/src/foo.c
.CE
.PP
returns \fB~/src\fR, whereas
.PP
.CS
-\fBfile dirname ~\fR
+\fBfile dirname\fR ~
.CE
.PP
returns \fB/home\fR (or something similar).
@@ -195,7 +193,7 @@ proceed from the current argument. For example,
.RS
.PP
.CS
-\fBfile join a b /foo bar\fR
+\fBfile join\fR a b /foo bar
.CE
.PP
returns \fB/foo/bar\fR.
@@ -229,9 +227,9 @@ If the user wishes to make a link of a specific type only, (and signal an
error if for some reason that is not possible), then the optional
\fI\-linktype\fR argument should be given. Accepted values for
\fI\-linktype\fR are
-.QW \-symbolic
+.QW \fB\-symbolic\fR
and
-.QW \-hard .
+.QW \fB\-hard\fR .
.PP
On Unix, symbolic links can be made to relative paths, and those paths
must be relative to the actual \fIlinkName\fR's location (not to the
@@ -377,12 +375,12 @@ generated.
Returns a list whose elements are the path components in \fIname\fR. The
first element of the list will have the same path type as \fIname\fR.
All other elements will be relative. Path separators will be discarded
-unless they are needed ensure that an element is unambiguously relative.
+unless they are needed to ensure that an element is unambiguously relative.
For example, under Unix
.RS
.PP
.CS
-file split /foo/~bar/baz
+\fBfile split\fR /foo/~bar/baz
.CE
.PP
returns
diff --git a/doc/fileevent.n b/doc/fileevent.n
index 05d68f3..df48d2a 100644
--- a/doc/fileevent.n
+++ b/doc/fileevent.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: fileevent.n,v 1.15 2008/10/15 10:43:37 dkf Exp $
-'\"
.so man.macros
.TH fileevent n 7.5 Tcl "Tcl Built-In Commands"
.BS
@@ -125,7 +123,7 @@ proc GetData {chan} {
}
fconfigure $chan -blocking 0 -encoding binary
-fileevent $chan readable [list GetData $chan]
+\fBfileevent\fR $chan readable [list GetData $chan]
.CE
.PP
The next example demonstrates use of \fBgets\fR to read line-oriented
@@ -142,7 +140,7 @@ proc GetData {chan} {
}
fconfigure $chan -blocking 0 -buffering line -translation crlf
-fileevent $chan readable [list GetData $chan]
+\fBfileevent\fR $chan readable [list GetData $chan]
.CE
.SH CREDITS
.PP
diff --git a/doc/filename.n b/doc/filename.n
index 5b41d76..d481fc9 100644
--- a/doc/filename.n
+++ b/doc/filename.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: filename.n,v 1.20 2007/12/13 15:22:32 dgp Exp $
-'\"
.so man.macros
.TH filename n 7.5 Tcl "Tcl Built-In Commands"
.BS
@@ -40,7 +38,7 @@ type of a given path.
.SH "PATH SYNTAX"
.PP
The rules for native names depend on the value reported in the Tcl
-array element \fBtcl_platform(platform)\fR:
+\fBplatform\fR element of the \fBtcl_platform\fR array:
.TP 10
\fBUnix\fR
On Unix and Apple MacOS X platforms, Tcl uses path names where the
diff --git a/doc/flush.n b/doc/flush.n
index 288b8fc..b8bf3e9 100644
--- a/doc/flush.n
+++ b/doc/flush.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: flush.n,v 1.9 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH flush n 7.5 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/for.n b/doc/for.n
index a7ad4a5..4c65793 100644
--- a/doc/for.n
+++ b/doc/for.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: for.n,v 1.13 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH for n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/foreach.n b/doc/foreach.n
index 37bb455..fb075d3 100644
--- a/doc/foreach.n
+++ b/doc/foreach.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: foreach.n,v 1.12 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH foreach n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/format.n b/doc/format.n
index 242ebfd..23dfe60 100644
--- a/doc/format.n
+++ b/doc/format.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: format.n,v 1.24 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH format n 8.1 Tcl "Tcl Built-In Commands"
.BS
@@ -143,7 +141,8 @@ function of the \fBexpr\fR command (at least a 64-bit range).
If neither \fBh\fR nor \fBl\fR are present, the integer value is
truncated to the same range as that produced by the \fBint()\fR
function of the \fBexpr\fR command (at least a 32-bit range, but
-determined by the value of \fBtcl_platform(wordSize)\fR).
+determined by the value of the \fBwordSize\fR element of the
+\fBtcl_platform\fR array).
.SS "MANDATORY CONVERSION TYPE"
.PP
The last thing in a conversion specifier is an alphabetic character
diff --git a/doc/gets.n b/doc/gets.n
index 5c3a908..fe24058 100644
--- a/doc/gets.n
+++ b/doc/gets.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: gets.n,v 1.8 2005/05/10 18:34:00 kennykb Exp $
-'\"
.so man.macros
.TH gets n 7.5 Tcl "Tcl Built-In Commands"
.BS
@@ -37,12 +35,12 @@ returned.
.PP
If end of file occurs while scanning for an end of
line, the command returns whatever input is available up to the end of file.
-If \fIchannelId\fR is in nonblocking mode and there is not a full
+If \fIchannelId\fR is in non-blocking mode and there is not a full
line of input available, the command returns an empty string and
does not consume any input.
If \fIvarName\fR is specified and an empty string is returned in
\fIvarName\fR because of end-of-file or because of insufficient
-data in nonblocking mode, then the return count is -1.
+data in non-blocking mode, then the return count is -1.
Note that if \fIvarName\fR is not specified then the end-of-file
and no-full-line-available cases can
produce the same results as if there were an input line consisting
@@ -66,4 +64,8 @@ close $chan
file(n), eof(n), fblocked(n), Tcl_StandardChannels(3)
.SH KEYWORDS
-blocking, channel, end of file, end of line, line, nonblocking, read
+blocking, channel, end of file, end of line, line, non-blocking, read
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/glob.n b/doc/glob.n
index 1d53bc9..7b71189 100644
--- a/doc/glob.n
+++ b/doc/glob.n
@@ -4,9 +4,6 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
-'\" RCS: @(#) $Id: glob.n,v 1.26 2010/09/02 19:50:55 andreas_kupries Exp $
-'\"
.so man.macros
.TH glob n 8.3 Tcl "Tcl Built-In Commands"
.BS
@@ -233,9 +230,9 @@ and will not be
interpreted as a wildcard character. One solution to this problem is
to use the Unix style forward slash as a path separator. Windows style
paths can be converted to Unix style paths with the command
-.QW "\fBfile join $path\fR"
+.QW "\fBfile join\fR \fB$path\fR"
or
-.QW "\fBfile normalize $path\fR" .
+.QW "\fBfile normalize\fR \fB$path\fR" .
.SH EXAMPLES
.PP
Find all the Tcl files in the current directory:
diff --git a/doc/global.n b/doc/global.n
index 5ccf587..c17c370 100644
--- a/doc/global.n
+++ b/doc/global.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: global.n,v 1.14 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH global n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/history.n b/doc/history.n
index cd3704f..ba507b4 100644
--- a/doc/history.n
+++ b/doc/history.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: history.n,v 1.8 2007/12/13 15:22:32 dgp Exp $
-'\"
.so man.macros
.TH history n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/http.n b/doc/http.n
index 98a06a4..631a141 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: http.n,v 1.40 2010/07/25 16:08:13 dkf Exp $
-'\"
.so man.macros
.TH "http" n 2.7 http "Tcl Bundled Packages"
.BS
@@ -18,9 +16,9 @@ http \- Client-side implementation of the HTTP/1.1 protocol
\fBpackage require http ?2.7?\fR
.\" See Also -useragent option documentation in body!
.sp
-\fB::http::config ?\fI-option value\fR ...?
+\fB::http::config ?\fI\-option value\fR ...?
.sp
-\fB::http::geturl \fIurl\fR ?\fI-option value\fR ...?
+\fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...?
.sp
\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
.sp
@@ -51,7 +49,8 @@ http \- Client-side implementation of the HTTP/1.1 protocol
.SH DESCRIPTION
.PP
The \fBhttp\fR package provides the client side of the HTTP/1.1
-protocol. The package implements the GET, POST, and HEAD operations
+protocol, as defined in RFC 2616.
+The package implements the GET, POST, and HEAD operations
of HTTP/1.1. It allows configuration of a proxy host to get through
firewalls. The package is compatible with the \fBSafesock\fR security
policy, so it can be used by untrusted applets to do URL fetching from
diff --git a/doc/if.n b/doc/if.n
index dea7610..700f325 100644
--- a/doc/if.n
+++ b/doc/if.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: if.n,v 1.11 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH if n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/incr.n b/doc/incr.n
index 972f78b..595cc27 100644
--- a/doc/incr.n
+++ b/doc/incr.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: incr.n,v 1.8 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH incr n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/info.n b/doc/info.n
index 63ce180..e65a083 100644
--- a/doc/info.n
+++ b/doc/info.n
@@ -3,13 +3,11 @@
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
'\" Copyright (c) 1998-2000 Ajuba Solutions
-'\" Copyright (c) 2007-2008 Donal K. Fellows
+'\" Copyright (c) 2007-2012 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: info.n,v 1.38 2010/04/07 09:51:31 dkf Exp $
-'\"
.so man.macros
.TH info n 8.4 Tcl "Tcl Built-In Commands"
.BS
@@ -81,9 +79,9 @@ lines have been typed to complete the command.
.TP
\fBinfo coroutine\fR
.VS 8.6
-Returns the name of the currently executing coroutine, or the empty string if
-either no coroutine is currently executing, or the current coroutine has been
-deleted (but has not yet returned or yielded since deletion).
+Returns the name of the currently executing \fBcoroutine\fR, or the empty
+string if either no coroutine is currently executing, or the current coroutine
+has been deleted (but has not yet returned or yielded since deletion).
.VE 8.6
.TP
\fBinfo default \fIprocname arg varname\fR
@@ -96,12 +94,30 @@ into variable \fIvarname\fR.
.TP
\fBinfo errorstack \fR?\fIinterp\fR?
.VS 8.6
-Returns a list of lists made of the function names and arguments at each level
-from the call stack of the last error in the given \fIinterp\fR, or in the
-current one if not specified. This information is also present in the
-\fB\-errorstack\fR entry of the options dictionary returned by 3-argument
-\fBcatch\fR; \fBinfo errorstack\fR is a convenient way of retrieving it for
-uncaught errors at toplevel in an interactive tclsh.
+Returns, in a form that is programmatically easy to parse, the function names
+and arguments at each level from the call stack of the last error in the given
+\fIinterp\fR, or in the current one if not specified.
+.RS
+.PP
+This form is an even-sized list alternating tokens and parameters. Tokens are
+currently either \fBCALL\fR, \fBUP\fR, or \fBINNER\fR, but other values may be
+introduced in the future. \fBCALL\fR indicates a procedure call, and its
+parameter is the corresponding \fBinfo level\fR \fB0\fR. \fBUP\fR indicates a
+shift in variable frames generated by \fBuplevel\fR or similar, and applies to
+the previous \fBCALL\fR item. Its parameter is the level offset. \fBINNER\fR
+identifies the
+.QW "inner context" ,
+which is the innermost atomic command or bytecode instruction that raised the
+error, along with its arguments when available. While \fBCALL\fR and \fBUP\fR
+allow to follow complex call paths, \fBINNER\fR homes in on the offending
+operation in the innermost procedure call, even going to sub-expression
+granularity.
+.PP
+This information is also present in the \fB\-errorstack\fR entry of the
+options dictionary returned by 3-argument \fBcatch\fR; \fBinfo errorstack\fR
+is a convenient way of retrieving it for uncaught errors at top-level in an
+interactive \fBtclsh\fR.
+.RE
.VE 8.6
.TP
\fBinfo exists \fIvarName\fR
@@ -164,7 +180,7 @@ means that the command is executed by \fBeval\fR or \fBuplevel\fR.
.TP
\fBprecompiled\fR\0\0\0\0\0\0\0\0
.
-means that the command is found in a precompiled script (loadable by
+means that the command is found in a pre-compiled script (loadable by
the package \fBtbcload\fR), and no further information will be
available.
.RE
@@ -185,9 +201,10 @@ normalized path of the file the command is in.
\fBcmd\fR
.
This entry provides the string representation of the command. This is
-usually the unsubstituted form, however for commands which are a pure
-list executed by eval it is the substituted form as they have no other
-string representation. Care is taken that the pure-List property of
+usually the unsubstituted form, however for commands which are a
+canonically-constructed list (e.g., as produced by the \fBlist\fR command)
+executed by \fBeval\fR it is the substituted form as they have no other
+string representation. Care is taken that the canonicality property of
the latter is not spoiled.
.TP
\fBproc\fR
@@ -214,8 +231,8 @@ locations of commands in their bodies will be reported with type
defined procedures, and literal eval scripts in files or statically
defined procedures.
.PP
-In contrast, a procedure definition or \fBeval\fR within a dynamically
-\fBeval\fRuated environment count linenumbers relative to the start of
+In contrast, procedure definitions and \fBeval\fR within a dynamically
+\fBeval\fRuated environment count line numbers relative to the start of
their script, even if they would be able to count relative to the
start of the outer dynamic script. That type of number usually makes
more sense.
@@ -227,8 +244,8 @@ possible the lines are counted based on the smallest possible
than any dynamic outer scope.
.PP
The syntactic form \fB{*}\fR is handled like \fBeval\fR. I.e. if it
-is given a literal list argument the system tracks the linenumber
-within the list words as well, and otherwise all linenumbers are
+is given a literal list argument the system tracks the line number
+within the list words as well, and otherwise all line numbers are
counted relative to the start of each word (smallest scope)
.RE
.TP
@@ -387,12 +404,35 @@ been set (e.g. a variable declared but not set by \fBvariable\fR).
The following \fIsubcommand\fR values are supported by \fBinfo class\fR:
.VE 8.6
.TP
+\fBinfo class call\fI class method\fR
+.VS
+Returns a description of the method implementations that are used to provide a
+stereotypical instance of \fIclass\fR's implementation of \fImethod\fR
+(stereotypical instances being objects instantiated by a class without having
+any object-specific definitions added). This consists of a list of lists of
+four elements, where each sublist consists of a word that describes the
+general type of method implementation (being one of \fBmethod\fR for an
+ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a
+method that is invoked as part of unknown method handling), a word giving the
+name of the particular method invoked (which is always the same as
+\fImethod\fR for the \fBmethod\fR type, and
+.QW \fBunknown\fR
+for the \fBunknown\fR type), a word giving the fully qualified name of the
+class that defined the method, and a word describing the type of method
+implementation (see \fBinfo class methodtype\fR).
+.RS
+.PP
+Note that there is no inspection of whether the method implementations
+actually use \fBnext\fR to transfer control along the call chain.
+.RE
+.VE 8.6
+.TP
\fBinfo class constructor\fI class\fR
.VS 8.6
This subcommand returns a description of the definition of the constructor of
-class \fIclass\fR. The defintion is described as a two element list; the first
+class \fIclass\fR. The definition is described as a two element list; the first
element is the list of arguments to the constructor in a form suitable for
-passing to another call to \fBproc\fR or a method defintion, and the second
+passing to another call to \fBproc\fR or a method definition, and the second
element is the body of the constructor. If no constructor is present, this
returns the empty list.
.VE 8.6
@@ -400,9 +440,9 @@ returns the empty list.
\fBinfo class definition\fI class method\fR
.VS 8.6
This subcommand returns a description of the definition of the method named
-\fImethod\fR of class \fIclass\fR. The defintion is described as a two element
+\fImethod\fR of class \fIclass\fR. The definition is described as a two element
list; the first element is the list of arguments to the method in a form
-suitable for passing to another call to \fBproc\fR or a method defintion, and
+suitable for passing to another call to \fBproc\fR or a method definition, and
the second element is the body of the method.
.VE 8.6
.TP
@@ -472,8 +512,8 @@ class named \fIclass\fR.
.VS 8.6
This subcommand returns a list of direct subclasses of class \fIclass\fR. If
the optional \fIpattern\fR argument is present, it constrains the list of
-returned classes to those that match it according to the rules of \fBstring
-match\fR.
+returned classes to those that match it according to the rules of
+\fBstring match\fR.
.VE 8.6
.TP
\fBinfo class superclasses\fI class\fR
@@ -492,6 +532,28 @@ class's methods, constructor and destructor).
The following \fIsubcommand\fR values are supported by \fBinfo object\fR:
.VE 8.6
.TP
+\fBinfo object call\fI object method\fR
+.VS 8.6
+Returns a description of the method implementations that are used to provide
+\fIobject\fR's implementation of \fImethod\fR. This consists of a list of
+lists of four elements, where each sublist consists of a word that describes
+the general type of method implementation (being one of \fBmethod\fR for an
+ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a
+method that is invoked as part of unknown method handling), a word giving the
+name of the particular method invoked (which is always the same as
+\fImethod\fR for the \fBmethod\fR type, and
+.QW \fBunknown\fR
+for the \fBunknown\fR type), a word giving what defined the method (the fully
+qualified name of the class, or the literal string \fBobject\fR if the method
+implementation is on an instance), and a word describing the type of method
+implementation (see \fBinfo object methodtype\fR).
+.RS
+.PP
+Note that there is no inspection of whether the method implementations
+actually use \fBnext\fR to transfer control along the call chain.
+.RE
+.VE 8.6
+.TP
\fBinfo object class\fI object\fR ?\fIclassName\fR?
.VS 8.6
If \fIclassName\fR is unspecified, this subcommand returns class of the
@@ -502,9 +564,9 @@ boolean value indicating whether the \fIobject\fR is of that class.
\fBinfo object definition\fI object method\fR
.VS 8.6
This subcommand returns a description of the definition of the method named
-\fImethod\fR of object \fIobject\fR. The defintion is described as a two
+\fImethod\fR of object \fIobject\fR. The definition is described as a two
element list; the first element is the list of arguments to the method in a
-form suitable for passing to another call to \fBproc\fR or a method defintion,
+form suitable for passing to another call to \fBproc\fR or a method definition,
and the second element is the body of the method.
.VE 8.6
.TP
@@ -614,7 +676,7 @@ This subcommand returns a list of all variables in the private namespace of
the object named \fIobject\fR. If the optional \fIpattern\fR argument is
given, it is a filter (in the syntax of a \fBstring match\fR glob pattern)
that constrains the list of variables returned. Note that this is different
-from the lit returned by \fBinfo object variables\fR; that can include
+from the list returned by \fBinfo object variables\fR; that can include
variables that are currently unset, whereas this can include variables that
are not automatically included by any of \fIobject\fR's methods (or those of
its class, superclasses or mixins).
@@ -660,6 +722,28 @@ method and get how it is defined. This procedure illustrates how:
.PP
.CS
proc getDef {obj method} {
+ foreach inf [\fBinfo object call\fR $obj $method] {
+ lassign $inf calltype name locus methodtype
+ # Assume no forwards or filters, and hence no $calltype
+ # or $methodtype checks...
+ if {$locus eq "object"} {
+ return [\fBinfo object definition\fR $obj $name]
+ } else {
+ return [\fBinfo class definition\fR $locus $name]
+ }
+ }
+ error "no definition for $method"
+}
+.CE
+.PP
+This is an alternate way of looking up the definition; it is implemented by
+manually scanning the list of methods up the inheritance tree. This code
+assumes that only single inheritance is in use, and that there is no complex
+use of mixed-in classes (in such cases, using \fBinfo object call\fR as above
+is the simplest way of doing this by far):
+.PP
+.CS
+proc getDef {obj method} {
if {$method in [\fBinfo object methods\fR $obj]} {
# Assume no forwards
return [\fBinfo object definition\fR $obj $method]
@@ -668,7 +752,7 @@ proc getDef {obj method} {
while {$method ni [\fBinfo class methods\fR $cls]} {
# Assume the simple case
set cls [lindex [\fBinfo class superclass\fR $cls] 0]
- if {$cls eq {}} {
+ if {$cls eq ""} {
error "no definition for $method"
}
}
diff --git a/doc/interp.n b/doc/interp.n
index 2d2330b..6ce10ee 100644
--- a/doc/interp.n
+++ b/doc/interp.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: interp.n,v 1.44 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH interp n 8.6 Tcl "Tcl Built-In Commands"
.BS
@@ -63,10 +61,18 @@ on how the alias mechanism works.
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 which they are used. For example, if \fBa\fR is a slave of
-the current interpreter and it has a slave \fBa1\fR, which in turn has a
-slave \fBa11\fR, the qualified name of \fBa11\fR in \fBa\fR is the list
-\fBa1 a11\fR.
+interpreter in which they are used. For example, if
+.QW \fBa\fR
+is a slave of the current interpreter and it has a slave
+.QW \fBa1\fR ,
+which in turn has a slave
+.QW \fBa11\fR ,
+the qualified name of
+.QW \fBa11\fR
+in
+.QW \fBa\fR
+is the list
+.QW "\fBa1 a11\fR" .
.PP
The \fBinterp\fR command, described below, accepts qualified interpreter
names as arguments; the interpreter in which the command is being evaluated
@@ -110,10 +116,12 @@ invoking the command.
interpreter. For example,
.QW "\fBa b\fR"
identifies an interpreter
-\fBb\fR, which is a slave of interpreter \fBa\fR, which is a slave
-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.
+.QW \fBb\fR ,
+which is a slave of interpreter
+.QW \fBa\fR ,
+which is a slave 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
and command, and the \fIarg\fR arguments, if any, specify additional
arguments to \fItargetCmd\fR which are prepended to any arguments specified
@@ -186,6 +194,48 @@ given name already exists in this master.
The initial recursion limit of the slave 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
+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.
+This only effects the output of \fBinfo frame\fR, in that exact
+frame-level information for command invocation at the bytecode level
+is only captured with this setting on.
+.RS
+.PP
+For example, with code like
+.PP
+.CS
+\fBproc\fR mycontrol {... script} {
+ ...
+ \fBuplevel\fR 1 $script
+ ...
+}
+
+\fBproc\fR dosomething {...} {
+ ...
+ mycontrol {
+ somecode
+ }
+}
+.CE
+.PP
+the standard setting will provide a relative line number for the
+command \fBsomecode\fR and the relevant frame will be of type
+\fBeval\fR. With frame-debug active on the other hand the tracking
+extends so far that the system will be able to determine the file and
+absolute line number of this command, and return a frame of type
+\fBsource\fR. This more exact information is paid for with slower
+execution of all commands.
+.PP
+Note that once it is on, this flag cannot be switched back off: such
+attempts are silently ignored. This is needed to maintain the
+consistency of the underlying interpreter's state.
+.RE
+.TP
\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
.
Deletes zero or more interpreters given by the optional \fIpath\fR
@@ -296,7 +346,7 @@ already trusted.
Returns the maximum allowable nesting depth for the interpreter
specified by \fIpath\fR. If \fInewlimit\fR is specified,
the interpreter recursion limit will be set so that nesting
-of more than \fInewlimit\fR calls to \fBTcl_Eval()\fR
+of more than \fInewlimit\fR calls to \fBTcl_Eval\fR
and related procedures in that interpreter will return an error.
The \fInewlimit\fR value is also returned.
The \fInewlimit\fR value must be a positive integer between 1 and the
diff --git a/doc/join.n b/doc/join.n
index e0583ef..1b23667 100644
--- a/doc/join.n
+++ b/doc/join.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: join.n,v 1.10 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH join n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/lappend.n b/doc/lappend.n
index 3a31a57..9bfab72 100644
--- a/doc/lappend.n
+++ b/doc/lappend.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: lappend.n,v 1.17 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH lappend n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/lassign.n b/doc/lassign.n
index f2bfcda..6f5042b 100644
--- a/doc/lassign.n
+++ b/doc/lassign.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: lassign.n,v 1.7 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH lassign n 8.5 Tcl "Tcl Built-In Commands"
.BS
@@ -30,17 +28,17 @@ An illustration of how multiple assignment works, and what happens
when there are either too few or too many elements.
.PP
.CS
-lassign {a b c} x y z ;# Empty return
+\fBlassign\fR {a b c} x y z ;# Empty return
puts $x ;# Prints "a"
puts $y ;# Prints "b"
puts $z ;# Prints "c"
-lassign {d e} x y z ;# Empty return
+\fBlassign\fR {d e} x y z ;# Empty return
puts $x ;# Prints "d"
puts $y ;# Prints "e"
puts $z ;# Prints ""
-lassign {f g h i} x y ;# Returns "h i"
+\fBlassign\fR {f g h i} x y ;# Returns "h i"
puts $x ;# Prints "f"
puts $y ;# Prints "g"
.CE
@@ -51,10 +49,10 @@ the analogue of the
command in many shell languages like this:
.PP
.CS
-set ::argv [lassign $::argv argumentToReadOff]
+set ::argv [\fBlassign\fR $::argv argumentToReadOff]
.CE
.SH "SEE ALSO"
-lindex(n), list(n), lset(n), set(n)
+lindex(n), list(n), lrange(n), lset(n), set(n)
.SH KEYWORDS
assign, element, list, multiple, set, variable
'\"Local Variables:
diff --git a/doc/library.n b/doc/library.n
index 29b3045..2413692 100644
--- a/doc/library.n
+++ b/doc/library.n
@@ -5,7 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: library.n,v 1.27 2010/01/14 11:47:08 dkf Exp $
.so man.macros
.TH library n "8.0" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/lindex.n b/doc/lindex.n
index 4eac53a..bb272a6 100644
--- a/doc/lindex.n
+++ b/doc/lindex.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: lindex.n,v 1.21 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH lindex n 8.4 Tcl "Tcl Built-In Commands"
.BS
@@ -28,13 +26,13 @@ Tcl list and presented as a single argument.
If no indices are presented, the command takes the form:
.PP
.CS
-lindex list
+\fBlindex \fIlist\fR
.CE
.PP
or
.PP
.CS
-lindex list {}
+\fBlindex \fIlist\fR {}
.CE
.PP
In this case, the return value of \fBlindex\fR is simply the value of the
@@ -59,19 +57,19 @@ used in turn to select an element from the previous indexing operation,
allowing the script to select elements from sublists. The command,
.PP
.CS
-lindex $a 1 2 3
+\fBlindex\fR $a 1 2 3
.CE
.PP
or
.PP
.CS
-lindex $a {1 2 3}
+\fBlindex\fR $a {1 2 3}
.CE
.PP
is synonymous with
.PP
.CS
-lindex [lindex [lindex $a 1] 2] 3
+\fBlindex\fR [\fBlindex\fR [\fBlindex\fR $a 1] 2] 3
.CE
.SH EXAMPLES
.PP
diff --git a/doc/linsert.n b/doc/linsert.n
index 9cccab5..c722e4f 100644
--- a/doc/linsert.n
+++ b/doc/linsert.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: linsert.n,v 1.18 2010/08/21 16:58:08 dkf Exp $
-'\"
.so man.macros
.TH linsert n 8.2 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/list.n b/doc/list.n
index cf6fe99..5705254 100644
--- a/doc/list.n
+++ b/doc/list.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: list.n,v 1.14 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH list n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/llength.n b/doc/llength.n
index e050ed9..b0ee4d9 100644
--- a/doc/llength.n
+++ b/doc/llength.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: llength.n,v 1.15 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH llength n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/lmap.n b/doc/lmap.n
new file mode 100644
index 0000000..880b05a
--- /dev/null
+++ b/doc/lmap.n
@@ -0,0 +1,85 @@
+'\"
+'\" Copyright (c) 2012 Trevor Davel
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.so man.macros
+.TH lmap n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+lmap \- Iterate over all elements in one or more lists and collect results
+.SH SYNOPSIS
+\fBlmap \fIvarname list body\fR
+.br
+\fBlmap \fIvarlist1 list1\fR ?\fIvarlist2 list2 ...\fR? \fIbody\fR
+.BE
+.SH DESCRIPTION
+.PP
+The \fBlmap\fR command implements a loop where the loop variable(s) take on
+values from one or more lists, and the loop returns a list of results
+collected from each iteration.
+.PP
+In the simplest case there is one loop variable, \fIvarname\fR, and one list,
+\fIlist\fR, that is a list of values to assign to \fIvarname\fR. The
+\fIbody\fR argument is a Tcl script. For each element of \fIlist\fR (in order
+from first to last), \fBlmap\fR assigns the contents of the element to
+\fIvarname\fR as if the \fBlindex\fR command had been used to extract the
+element, then calls the Tcl interpreter to execute \fIbody\fR. If execution of
+the body completes normally then the result of the body is appended to an
+accumulator list. \fBlmap\fR returns the accumulator list.
+.PP
+In the general case there can be more than one value list (e.g., \fIlist1\fR
+and \fIlist2\fR), and each value list can be associated with a list of loop
+variables (e.g., \fIvarlist1\fR and \fIvarlist2\fR). During each iteration of
+the loop the variables of each \fIvarlist\fR are assigned consecutive values
+from the corresponding \fIlist\fR. Values in each \fIlist\fR are used in order
+from first to last, and each value is used exactly once. The total number of
+loop iterations is large enough to use up all the values from all the value
+lists. If a value list does not contain enough elements for each of its loop
+variables in each iteration, empty values are used for the missing elements.
+.PP
+The \fBbreak\fR and \fBcontinue\fR statements may be invoked inside
+\fIbody\fR, with the same effect as in the \fBfor\fR and \fBforeach\fR
+commands. In these cases the body does not complete normally and the result is
+not appended to the accumulator list.
+.SH EXAMPLES
+.PP
+Zip lists together:
+.PP
+.CS
+set list1 {a b c d}
+set list2 {1 2 3 4}
+set zipped [\fBlmap\fR a $list1 b $list2 {list $a $b}]
+# The value of zipped is "{a 1} {b 2} {c 3} {d 4}"
+.CE
+.PP
+Filter a list to remove odd values:
+.PP
+.CS
+set values {1 2 3 4 5 6 7 8}
+proc isEven {n} {expr {($n % 2) == 0}}
+set goodOnes [\fBlmap\fR x $values {expr {
+ [isEven $x] ? $x : [continue]
+}}]
+# The value of goodOnes is "2 4 6 8"
+.CE
+.PP
+Take a prefix from a list based on the contents of the list:
+.PP
+.CS
+set values {8 7 6 5 4 3 2 1}
+proc isGood {counter} {expr {$n > 3}}
+set prefix [\fBlmap\fR x $values {expr {
+ [isGood $x] ? $x : [break]
+}}]
+# The value of prefix is "8 7 6 5 4"
+.CE
+.SH "SEE ALSO"
+break(n), continue(n), for(n), foreach(n), while(n)
+.SH KEYWORDS
+foreach, iteration, list, loop, map
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/load.n b/doc/load.n
index faba6b5..350a2ae 100644
--- a/doc/load.n
+++ b/doc/load.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: load.n,v 1.26 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH load n 7.5 Tcl "Tcl Built-In Commands"
.BS
@@ -13,11 +11,11 @@
.SH NAME
load \- Load machine code and initialize new commands
.SH SYNOPSIS
-\fBload \fIfileName\fR
+\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName\fR
.br
-\fBload \fIfileName packageName\fR
+\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName\fR
.br
-\fBload \fIfileName packageName interp\fR
+\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName interp\fR
.BE
.SH DESCRIPTION
.PP
@@ -106,6 +104,22 @@ Otherwise, the \fBload\fR command searches for a dynamically loaded
package by that name, and uses it if it is found. If several
different files have been \fBload\fRed with different versions of
the package, Tcl picks the file that was loaded first.
+.PP
+If \fB\-global\fR is specified preceding the filename, all symbols
+found in the shared library are exported for global use by other
+libraries. The option \fB\-lazy\fR delays the actual loading of
+symbols until their first actual use. The options may be abbreviated.
+The option \fB\-\-\fR indicates the end of the options, and should
+be used if you wish to use a filename which starts with \fB\-\fR
+and you provide a packageName to the \fBload\fR command.
+.PP
+On platforms which do not support the \fB\-global\fR or \fB\-lazy\fR
+options, the options still exist but have no effect. Note that use
+of the \fB\-global\fR or \fB\-lazy\fR option may lead to crashes
+in your application later (in case of symbol conflicts resp. missing
+symbols), which cannot be detected during the \fBload\fR. So, only
+use this when you know what you are doing, you will not get a nice
+error message when something is wrong with the loaded library.
.SH "PORTABILITY ISSUES"
.TP
\fBWindows\fR\0\0\0\0\0
diff --git a/doc/lrange.n b/doc/lrange.n
index bf67022..4f4816a 100644
--- a/doc/lrange.n
+++ b/doc/lrange.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: lrange.n,v 1.19 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH lrange n 7.4 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/lrepeat.n b/doc/lrepeat.n
index a8141e0..59a1edf 100644
--- a/doc/lrepeat.n
+++ b/doc/lrepeat.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: lrepeat.n,v 1.7 2008/09/26 21:05:57 dgp Exp $
-'\"
.so man.macros
.TH lrepeat n 8.5 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/lreplace.n b/doc/lreplace.n
index 5509367..6e6c3ea 100644
--- a/doc/lreplace.n
+++ b/doc/lreplace.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: lreplace.n,v 1.21 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH lreplace n 7.4 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/lreverse.n b/doc/lreverse.n
index efda2a5..f52db9b 100644
--- a/doc/lreverse.n
+++ b/doc/lreverse.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: lreverse.n,v 1.7 2008/09/23 13:22:16 dkf Exp $
-'\"
.so man.macros
.TH lreverse n 8.5 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/lsearch.n b/doc/lsearch.n
index 1caf479..7835352 100644
--- a/doc/lsearch.n
+++ b/doc/lsearch.n
@@ -7,8 +7,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: lsearch.n,v 1.37 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH lsearch n 8.6 Tcl "Tcl Built-In Commands"
.BS
@@ -163,7 +161,7 @@ If this option is given, the index result from this command (or every
index result when \fB\-all\fR is also specified) will be a complete
path (suitable for use with \fBlindex\fR or \fBlset\fR) within the
overall list to the term found. This option has no effect unless the
-\fI\-index\fR is also specified, and is just a convenience short-cut.
+\fB\-index\fR is also specified, and is just a convenience short-cut.
.SH EXAMPLES
.PP
Basic searching:
diff --git a/doc/lset.n b/doc/lset.n
index dfc3d2b..805de16 100755
--- a/doc/lset.n
+++ b/doc/lset.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: lset.n,v 1.20 2009/10/21 15:13:15 dkf Exp $
-'\"
.so man.macros
.TH lset n 8.4 Tcl "Tcl Built-In Commands"
.BS
@@ -28,13 +26,13 @@ Finally, it accepts a new value for an element of \fIvarName\fR.
If no indices are presented, the command takes the form:
.PP
.CS
-lset varName newValue
+\fBlset\fR varName newValue
.CE
.PP
or
.PP
.CS
-lset varName {} newValue
+\fBlset\fR varName {} newValue
.CE
.PP
In this case, \fInewValue\fR replaces the old value of the variable
@@ -70,13 +68,13 @@ allowing the script to alter elements in sublists (or append elements
to sublists). The command,
.PP
.CS
-lset a 1 2 newValue
+\fBlset\fR a 1 2 newValue
.CE
.PP
or
.PP
.CS
-lset a {1 2} newValue
+\fBlset\fR a {1 2} newValue
.CE
.PP
replaces element 2 of sublist 1 with \fInewValue\fR.
diff --git a/doc/lsort.n b/doc/lsort.n
index 7b9d6a6..312048e 100644
--- a/doc/lsort.n
+++ b/doc/lsort.n
@@ -7,8 +7,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: lsort.n,v 1.34 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH lsort n 8.5 Tcl "Tcl Built-In Commands"
.BS
@@ -81,7 +79,7 @@ the values themselves.
\fB\-index\0\fIindexList\fR
.
If this option is specified, each of the elements of \fIlist\fR must
-itself be a proper Tcl sublist (unless \fB-stride\fR is used).
+itself be a proper Tcl sublist (unless \fB\-stride\fR is used).
Instead of sorting based on whole sublists, \fBlsort\fR will extract
the \fIindexList\fR'th element from each sublist (as if the overall
element and the \fIindexList\fR were passed to \fBlindex\fR) and sort
@@ -90,7 +88,7 @@ For example,
.RS
.PP
.CS
-lsort -integer -index 1 \e
+\fBlsort\fR -integer -index 1 \e
{{First 24} {Second 18} {Third 30}}
.CE
.PP
@@ -100,7 +98,7 @@ returns \fB{Second 18} {First 24} {Third 30}\fR,
'\" This example is from the test suite!
'\"
.CS
-lsort -index end-1 \e
+\fBlsort\fR -index end-1 \e
{{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
.CE
.PP
@@ -108,7 +106,7 @@ returns \fB{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}\fR,
and
.PP
.CS
-lsort -index {0 1} {
+\fBlsort\fR -index {0 1} {
{{b i g} 12345}
{{d e m o} 34512}
{{c o d e} 54321}
@@ -137,7 +135,7 @@ in turn must be at least 2.
For example,
.PP
.CS
-lsort \-stride 2 {carrot 10 apple 50 banana 25}
+\fBlsort\fR \-stride 2 {carrot 10 apple 50 banana 25}
.CE
.PP
returns
@@ -145,7 +143,7 @@ returns
and
.PP
.CS
-lsort \-stride 2 \-index 1 \-integer {carrot 10 apple 50 banana 25}
+\fBlsort\fR \-stride 2 \-index 1 \-integer {carrot 10 apple 50 banana 25}
.CE
.PP
returns
@@ -163,7 +161,7 @@ effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or
If this option is specified, then only the last set of duplicate
elements found in the list will be retained. Note that duplicates are
determined relative to the comparison used in the sort. Thus if
-\fI\-index 0\fR is used, \fB{1 a}\fR and \fB{1 b}\fR would be
+\fB\-index 0\fR is used, \fB{1 a}\fR and \fB{1 b}\fR would be
considered duplicates and only the second element, \fB{1 b}\fR, would
be retained.
.SH "NOTES"
diff --git a/doc/man.macros b/doc/man.macros
index bd35803..ddd073d 100644
--- a/doc/man.macros
+++ b/doc/man.macros
@@ -67,8 +67,6 @@
.\" Print an open parenthesis, arg1 in quotes, then arg2 normally
.\" (for trailing punctuation) and then a closing parenthesis.
.\"
-.\" RCS: @(#) $Id: man.macros,v 1.9 2008/01/29 15:32:33 dkf Exp $
-.\"
.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
.if t .wh -1.3i ^B
.nr ^l \n(.l
diff --git a/doc/mathfunc.n b/doc/mathfunc.n
index dd89a4c..14b448e 100644
--- a/doc/mathfunc.n
+++ b/doc/mathfunc.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: mathfunc.n,v 1.22 2008/06/29 22:28:24 dkf Exp $
-'\"
.so man.macros
.TH mathfunc n 8.5 Tcl "Tcl Mathematical Functions"
.BS
@@ -197,16 +195,19 @@ Returns the floating-point remainder of the division of \fIx\fR by
.TP
\fBhypot \fIx y\fR
.
-Computes the length of the hypotenuse of a right-angled triangle
-.QW "\fBsqrt\fR [\fBexpr\fR {\fIx\fB*\fIx\fB+\fIy\fB*\fIy\fR}]".
+Computes the length of the hypotenuse of a right-angled triangle,
+approximately
+.QW "\fBsqrt\fR [\fBexpr\fR {\fIx\fB*\fIx\fB+\fIy\fB*\fIy\fR}]"
+except for being more numerically stable when the two arguments have
+substantially different magnitudes.
.TP
\fBint \fIarg\fR
.
The argument may be any numeric value. The integer part of \fIarg\fR
is determined, and then the low order bits of that integer value up
to the machine word size are returned as an integer value. For reference,
-the number of bytes in the machine word are stored in
-\fBtcl_platform(wordSize)\fR.
+the number of bytes in the machine word are stored in the \fBwordSize\fR
+element of the \fBtcl_platform\fR array.
.TP
\fBisqrt \fIarg\fR
.
@@ -298,3 +299,7 @@ Copyright (c) 1993 The Regents of the University of California.
Copyright (c) 1994-2000 Sun Microsystems Incorporated.
Copyright (c) 2005, 2006 by Kevin B. Kenny <kennykb@acm.org>.
.fi
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/mathop.n b/doc/mathop.n
index 6ac7b8e..ac2ebc1 100644
--- a/doc/mathop.n
+++ b/doc/mathop.n
@@ -4,8 +4,6 @@
.\" See the file "license.terms" for information on usage and redistribution
.\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
.\"
-.\" RCS: @(#) $Id: mathop.n,v 1.13 2010/06/30 23:29:26 dkf Exp $
-.\"
.so man.macros
.TH mathop n 8.5 Tcl "Tcl Mathematical Operator Commands"
.BS
@@ -128,14 +126,19 @@ will be an integer.
.TP
\fB%\fR \fInumber number\fR
.
-Returns the integral modulus of the first argument with respect to the second.
-Each \fInumber\fR must have an integral value. Note that Tcl defines this
-operation exactly even for negative numbers, so that the following equality
-holds true:
+Returns the integral modulus (i.e., remainder) of the first argument
+with respect to the second.
+Each \fInumber\fR must have an integral value.
+Also, the sign of the result will be the same as the sign of the second
+\fInumber\fR, which must not be zero.
.RS
.PP
+Note that Tcl defines this operation exactly even for negative numbers, so
+that the following command returns a true value (omitting the namespace for
+clarity):
+.PP
.CS
-(\fIx \fB/ \fIy\fR) \fB* \fIy \fB== \fIx \fB-\fR (\fIx \fB% \fIy\fR)
+\fB==\fR [\fB*\fR [\fB/\fI x y\fR] \fIy\fR] [\fB\-\fI x\fR [\fB%\fI x y\fR]]
.CE
.RE
.TP
diff --git a/doc/memory.n b/doc/memory.n
index b269d7a..f82c5b4 100644
--- a/doc/memory.n
+++ b/doc/memory.n
@@ -3,8 +3,6 @@
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
-'\" RCS: @(#) $Id: memory.n,v 1.14 2009/06/18 09:41:30 dkf Exp $
-'\"
.so man.macros
.TH memory n 8.1 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/msgcat.n b/doc/msgcat.n
index 17cffcb..57fbb78 100644
--- a/doc/msgcat.n
+++ b/doc/msgcat.n
@@ -4,10 +4,8 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" SCCS: @(#) msgcat.n
-'\"
.so man.macros
-.TH "msgcat" n 1.4 msgcat "Tcl Bundled Packages"
+.TH "msgcat" n 1.5 msgcat "Tcl Bundled Packages"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -15,7 +13,7 @@ msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require Tcl 8.5\fR
.sp
-\fBpackage require msgcat 1.4.2\fR
+\fBpackage require msgcat 1.5.0\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
@@ -31,6 +29,12 @@ msgcat \- Tcl message catalog
.sp
\fB::msgcat::mcmset \fIlocale src-trans-list\fR
.sp
+.VS "TIP 404"
+\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?
+.sp
+\fB::msgcat::mcflmset \fIsrc-trans-list\fR
+.VE "TIP 404"
+.sp
\fB::msgcat::mcunknown \fIlocale src-string\fR
.BE
.SH DESCRIPTION
@@ -133,6 +137,26 @@ translate-string ...\fR?} \fB::msgcat::mcmset\fR can be significantly
faster than multiple invocations of \fB::msgcat::mcset\fR. The function
returns the number of translations set.
.TP
+\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?
+.VS "TIP 404"
+Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR in the
+current namespace for the locale implied by the name of the message catalog
+being loaded via \fB::msgcat::mcload\fR. If \fItranslate-string\fR is not
+specified, \fIsrc-string\fR is used for both. The function returns
+\fItranslate-string\fR.
+.VE "TIP 404"
+.TP
+\fB::msgcat::mcflmset \fIsrc-trans-list\fR
+.VS "TIP 404"
+Sets the translation for multiple source strings in \fIsrc-trans-list\fR in
+the current namespace for the locale implied by the name of the message
+catalog being loaded via \fB::msgcat::mcload\fR. \fIsrc-trans-list\fR must
+have an even number of elements and is in the form {\fIsrc-string
+translate-string\fR ?\fIsrc-string translate-string ...\fR?}
+\fB::msgcat::mcflmset\fR can be significantly faster than multiple invocations
+of \fB::msgcat::mcflset\fR. The function returns the number of translations set.
+.VE "TIP 404"
+.TP
\fB::msgcat::mcunknown \fIlocale src-string\fR
.
This routine is called by \fB::msgcat::mc\fR in the case when
@@ -177,11 +201,14 @@ to extract its parts. The initial locale is then set by calling
language[_country][_modifier]
.CE
.PP
-On Windows, if none of those environment variables is set, msgcat will
-attempt to extract locale information from the
-registry. If all these attempts to discover an initial locale
-from the user's environment fail, msgcat defaults to an initial
-locale of
+On Windows and Cygwin, if none of those environment variables is set,
+msgcat will attempt to extract locale information from the registry.
+From Windows Vista on, the RFC4747 locale name "lang-script-country-options"
+is transformed to the locale as "lang_country_script" (Example:
+sr-Latn-CS -> sr_cs_latin). For Windows XP, the language id is
+transformed analoguously (Example: 0c1a -> sr_yu_cyrillic).
+If all these attempts to discover an initial locale from the user's
+environment fail, msgcat defaults to an initial locale of
.QW C .
.PP
When a locale is specified by the user, a
@@ -285,15 +312,15 @@ cause peculiar behavior, such as marking the message file as
.QW hidden
on Unix file systems.
.IP [3]
-The file contains a series of calls to \fBmcset\fR and
-\fBmcmset\fR, setting the necessary translation strings
+The file contains a series of calls to \fBmcflset\fR and
+\fBmcflmset\fR, setting the necessary translation strings
for the language, likely enclosed in a \fBnamespace eval\fR
so that all source strings are tied to the namespace of
the package. For example, a short \fBes.msg\fR might contain:
.PP
.CS
namespace eval ::mypackage {
- \fB::msgcat::mcset\fR es "Free Beer!" "Cerveza Gracias!"
+ \fB::msgcat::mcflset\fR "Free Beer!" "Cerveza Gracias!"
}
.CE
.SH "RECOMMENDED MESSAGE SETUP FOR PACKAGES"
diff --git a/doc/my.n b/doc/my.n
index 2fe0ce7..b5afc67 100644
--- a/doc/my.n
+++ b/doc/my.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: my.n,v 1.3 2009/11/02 10:03:12 dkf Exp $
-'\"
.so man.macros
.TH my n 0.1 TclOO "TclOO Commands"
.BS
@@ -33,7 +31,7 @@ Each object has its own \fBmy\fR command, contained in its instance namespace.
.SH EXAMPLES
.PP
This example shows basic use of \fBmy\fR to use the \fBvariables\fR method of
-the \fBoo::object\fR class, which is not publically visible by default:
+the \fBoo::object\fR class, which is not publicly visible by default:
.PP
.CS
oo::class create c {
diff --git a/doc/namespace.n b/doc/namespace.n
index f89ec91..b06d27a 100644
--- a/doc/namespace.n
+++ b/doc/namespace.n
@@ -7,8 +7,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: namespace.n,v 1.39 2009/12/27 22:06:12 dkf Exp $
-'\"
.so man.macros
.TH namespace n 8.5 Tcl "Tcl Built-In Commands"
.BS
@@ -780,7 +778,10 @@ When non-empty, this option supplies a dictionary that provides a
mapping from subcommand names to a list of prefix words to substitute
in place of the ensemble command and subcommand words (in a manner
similar to an alias created with \fBinterp alias\fR; the words are not
-reparsed after substitution). When this option is empty, the mapping
+reparsed after substitution); if the first word of any target is not
+fully qualified when set, it is assumed to be relative to the
+\fIcurrent\fR namespace and changed to be exactly that (that is, it is
+always fully qualified when read). When this option is empty, the mapping
will be from the local name of the subcommand to its fully-qualified
name. Note that when this option is non-empty and the
\fB\-subcommands\fR option is empty, the ensemble subcommand names
diff --git a/doc/next.n b/doc/next.n
index 1240c1b..0ad752a 100644
--- a/doc/next.n
+++ b/doc/next.n
@@ -4,19 +4,18 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: next.n,v 1.3 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH next n 0.1 TclOO "TclOO Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-next \- invoke superclass method implementations
+next, nextto \- invoke superclass method implementations
.SH SYNOPSIS
.nf
package require TclOO
\fBnext\fR ?\fIarg ...\fR?
+\fBnextto\fI class\fR ?\fIarg ...\fR?
.fi
.BE
@@ -32,6 +31,13 @@ of the next method in the method chain; if there are no further methods in the
method chain, the result of \fBnext\fR will be an error. The arguments,
\fIarg\fR, to \fBnext\fR are the arguments to pass to the next method in the
chain.
+.PP
+The \fBnextto\fR command is the same as the \fBnext\fR command, except that it
+takes an additional \fIclass\fR argument that identifies a class whose
+implementation of the current method chain (see \fBinfo object\fR \fBcall\fR) should
+be used; the method implementation selected will be the one provided by the
+given class, and it must refer to an existing non-filter invocation that lies
+further along the chain than the current implementation.
.SH "THE METHOD CHAIN"
.PP
When a method of an object is invoked, things happen in several stages:
@@ -76,7 +82,7 @@ resulting list of implementations as possible.
.PP
When an object has a list of filter names set upon it, or is an instance of a
class (or has mixed in a class) that has a list of filter names set upon it,
-before every invokation of any method the filters are processed. Filter
+before every invocation of any method the filters are processed. Filter
implementations are found in class traversal order, as are the lists of filter
names (each of which is traversed in natural list order). Explicitly invoking
a method used as a filter will cause that method to be invoked twice, once as
@@ -87,7 +93,7 @@ forward to the proper implementation of the method (which it does by invoking
the \fBnext\fR command as filters are inserted into the front of the method
call chain) and is responsible for returning the result of \fBnext\fR.
.PP
-Filters are not invoked when processing an invokation of the \fBunknown\fR
+Filters are not invoked when processing an invocation of the \fBunknown\fR
method because of a failure to locate a method implementation, or when
invoking either constructors or destructors.
.SH EXAMPLES
@@ -129,7 +135,7 @@ in the superclass, args = pureSynthesis
after chaining from subclass
before chaining from subclass, args =
in the superclass, args = a b
-in the superclassm args = pureSynthesis
+in the superclass, args = pureSynthesis
after chaining from subclass
.CE
.PP
@@ -159,7 +165,7 @@ oo::class create cache {
method flushCache {} {
my variable ValueCache
unset ValueCache
- \fI# Skip the cacheing\fR
+ \fI# Skip the caching\fR
return -level 2 ""
}
}
diff --git a/doc/object.n b/doc/object.n
index 68d642b..6737e7e 100644
--- a/doc/object.n
+++ b/doc/object.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: object.n,v 1.5 2009/11/02 09:54:45 dkf Exp $
-'\"
.so man.macros
.TH object n 0.1 TclOO "TclOO Commands"
.BS
@@ -42,7 +40,7 @@ current namespace whenever a method of the object is invoked (including a
method of the class of the object). When the object is destroyed, its instance
namespace is deleted. The instance namespace contains the object's \fBmy\fR
command, which may be used to invoke non-exported methods of the object or to
-create a reference to the object for the purpose of invokation which persists
+create a reference to the object for the purpose of invocation which persists
across renamings of the object.
.SS CONSTRUCTOR
The \fBoo::object\fR class does not define an explicit constructor.
@@ -67,14 +65,19 @@ This method concatenates the arguments, \fIarg\fR, as if with \fBconcat\fR,
and then evaluates the resulting script in the namespace that is uniquely
associated with \fIobj\fR, returning the result of the evaluation.
.TP
-\fIobj \fBunknown \fImethodName\fR ?\fIarg ...\fR?
+\fIobj \fBunknown ?\fImethodName\fR? ?\fIarg ...\fR?
.
This method is called when an attempt to invoke the method \fImethodName\fR on
object \fIobj\fR fails. The arguments that the user supplied to the method are
-given as \fIarg\fR argments. The default implementation (i.e. the one defined
-by the \fBoo::object\fR class) generates a suitable error, detailing what
-methods the object supports given whether the object was invoked by its public
-name or through the \fBmy\fR command.
+given as \fIarg\fR arguments.
+.VS
+If \fImethodName\fR is absent, the object was invoked with no method name at
+all (or any other arguments).
+.VE
+The default implementation (i.e., the one defined by the \fBoo::object\fR
+class) generates a suitable error, detailing what methods the object supports
+given whether the object was invoked by its public name or through the
+\fBmy\fR command.
.TP
\fIobj \fBvariable \fR?\fIvarName ...\fR?
.
@@ -88,6 +91,16 @@ must not have any namespace separators in it. The result is the empty string.
.
This method returns the globally qualified name of the variable \fIvarName\fR
in the unique namespace for the object \fIobj\fR.
+.TP
+\fIobj \fB<cloned> \fIsourceObjectName\fR
+.VS
+This method is used by the \fBoo::object\fR command to copy the state of one
+object to another. It is responsible for copying the procedures and variables
+of the namespace of the source object (\fIsourceObjectName\fR) to the current
+object. It does not copy any other types of commands or any traces on the
+variables; that can be added if desired by overriding this method in a
+subclass.
+.VE
.SH EXAMPLES
.PP
This example demonstrates basic use of an object.
diff --git a/doc/open.n b/doc/open.n
index 285103b..d4842f2 100644
--- a/doc/open.n
+++ b/doc/open.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: open.n,v 1.36 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH open n 8.3 Tcl "Tcl Built-In Commands"
.BS
@@ -69,8 +67,8 @@ Set the initial access position to the end of the file.
.PP
All of the legal \fIaccess\fR values above may have the character
\fBb\fR added as the second or third character in the value to
-indicate that the opened channel should be configured with the
-\fB\-translation binary\fR option, making the channel suitable for
+indicate that the opened channel should be configured as if with the
+\fBfconfigure\fR \fB\-translation binary\fR option, making the channel suitable for
reading or writing of binary data.
.PP
In the second form, \fIaccess\fR consists of a list of any of the
@@ -133,7 +131,7 @@ conjunction with the process's file mode creation mask.
.SH "COMMAND PIPELINES"
.PP
If the first character of \fIfileName\fR is
-.QW |
+.QW \fB|\fR
then the
remaining characters of \fIfileName\fR are treated as a list of arguments
that describe a command pipeline to invoke, in the same style as the
@@ -141,10 +139,12 @@ arguments for \fBexec\fR.
In this case, the channel identifier returned by \fBopen\fR may be used
to write to the command's input pipe or read from its output pipe,
depending on the value of \fIaccess\fR.
-If write-only access is used (e.g. \fIaccess\fR is \fBw\fR), then
-standard output for the pipeline is directed to the current standard
+If write-only access is used (e.g. \fIaccess\fR is
+.QW \fBw\fR ),
+then standard output for the pipeline is directed to the current standard
output unless overridden by the command.
-If read-only access is used (e.g. \fIaccess\fR is \fBr\fR),
+If read-only access is used (e.g. \fIaccess\fR is
+.QW \fBr\fR ),
standard input for the pipeline is taken from the current standard
input unless overridden by the command.
The id of the spawned process is accessible through the \fBpid\fR
@@ -273,7 +273,7 @@ in the second form both input and output buffers are defined.
(Windows only). This option is query only.
In case of a serial communication error, \fBread\fR or \fBputs\fR
returns a general Tcl file I/O error.
-\fBfconfigure -lasterror\fR can be called to get a list of error details.
+\fBfconfigure\fR \fB\-lasterror\fR can be called to get a list of error details.
See below for an explanation of the various error codes.
.SH "SERIAL PORT SIGNALS"
.PP
@@ -285,29 +285,29 @@ lines and handshaking. Here we are using the terms \fIworkstation\fR for
your computer and \fImodem\fR for the external device, because some signal
names (DCD, RI) come from modems. Of course your external device may use
these signal lines for other purposes.
-.IP \fBTXD(output)\fR
+.IP \fBTXD\fR(output)
\fBTransmitted Data:\fR Outgoing serial data.
-.IP \fBRXD(input)\fR
+.IP \fBRXD\fR(input)
\fBReceived Data:\fRIncoming serial data.
-.IP \fBRTS(output)\fR
+.IP \fBRTS\fR(output)
\fBRequest To Send:\fR This hardware handshake line informs the modem that
your workstation is ready to receive data. Your workstation may
automatically reset this signal to indicate that the input buffer is full.
-.IP \fBCTS(input)\fR
+.IP \fBCTS\fR(input)
\fBClear To Send:\fR The complement to RTS. Indicates that the modem is
ready to receive data.
-.IP \fBDTR(output)\fR
+.IP \fBDTR\fR(output)
\fBData Terminal Ready:\fR This signal tells the modem that the workstation
is ready to establish a link. DTR is often enabled automatically whenever a
serial port is opened.
-.IP \fBDSR(input)\fR
+.IP \fBDSR\fR(input)
\fBData Set Ready:\fR The complement to DTR. Tells the workstation that the
modem is ready to establish a link.
-.IP \fBDCD(input)\fR
+.IP \fBDCD\fR(input)
\fBData Carrier Detect:\fR This line becomes active when a modem detects a
.QW Carrier
signal.
-.IP \fBRI(input)\fR
+.IP \fBRI\fR(input)
\fBRing Indicator:\fR Goes active when the modem detects an incoming call.
.IP \fBBREAK\fR
A BREAK condition is not a hardware signal line, but a logical zero on the
@@ -323,13 +323,13 @@ event polling in background. The external device may have been switched
off, the data lines may be noisy, system buffers may overrun or your mode
settings may be wrong. That is why a reliable software should always
\fBcatch\fR serial read operations. In cases of an error Tcl returns a
-general file I/O error. Then \fBfconfigure -lasterror\fR may help to
+general file I/O error. Then \fBfconfigure\fR \fB\-lasterror\fR may help to
locate the problem. The following error codes may be returned.
.TP 10
\fBRXOVER\fR
.
Windows input buffer overrun. The data comes faster than your scripts reads
-it or your system is overloaded. Use \fBfconfigure -sysbuffer\fR to avoid a
+it or your system is overloaded. Use \fBfconfigure\fR \fB\-sysbuffer\fR to avoid a
temporary bottleneck and/or make your script faster.
.TP 10
\fBTXFULL\fR
@@ -347,13 +347,13 @@ and/or setup a lower(1) interrupt threshold value.
\fBRXPARITY\fR
.
A parity error has been detected by your UART.
-Wrong parity settings with \fBfconfigure -mode\fR or a noisy data line (RXD)
+Wrong parity settings with \fBfconfigure\fR \fB\-mode\fR or a noisy data line (RXD)
may cause this error.
.TP 10
\fBFRAME\fR
.
A stop-bit error has been detected by your UART.
-Wrong mode settings with \fBfconfigure -mode\fR or a noisy data line (RXD)
+Wrong mode settings with \fBfconfigure\fR \fB\-mode\fR or a noisy data line (RXD)
may cause this error.
.TP 10
\fBBREAK\fR
@@ -460,3 +460,6 @@ puts(n), exec(n), pid(n), fopen(3)
.SH KEYWORDS
access mode, append, create, file, non-blocking, open, permissions,
pipeline, process, serial
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/package.n b/doc/package.n
index 034cc18..6cf8991 100644
--- a/doc/package.n
+++ b/doc/package.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: package.n,v 1.25 2010/03/31 20:55:52 dkf Exp $
-'\"
.so man.macros
.TH package n 7.5 Tcl "Tcl Built-In Commands"
.BS
@@ -14,7 +12,7 @@
package \- Facilities for package loading and version control
.SH SYNOPSIS
.nf
-\fBpackage forget ?\fIpackage package ...\fR?
+\fBpackage forget\fR ?\fIpackage package ...\fR?
\fBpackage ifneeded \fIpackage version\fR ?\fIscript\fR?
\fBpackage names\fR
\fBpackage present \fIpackage \fR?\fIrequirement...\fR?
@@ -45,7 +43,7 @@ primarily by system scripts that maintain the package database.
The behavior of the \fBpackage\fR command is determined by its first argument.
The following forms are permitted:
.TP
-\fBpackage forget ?\fIpackage package ...\fR?
+\fBpackage forget\fR ?\fIpackage package ...\fR?
.
Removes all information about each specified package from this interpreter,
including information provided by both \fBpackage ifneeded\fR and
@@ -177,7 +175,7 @@ If \fIcommand\fR is specified as an empty string, then the current
.
Compares the two version numbers given by \fIversion1\fR and \fIversion2\fR.
Returns -1 if \fIversion1\fR is an earlier version than \fIversion2\fR,
-0 if they are equal, and 1 if \fIversion1\fR is later than \fBversion2\fR.
+0 if they are equal, and 1 if \fIversion1\fR is later than \fIversion2\fR.
.TP
\fBpackage versions \fIpackage\fR
.
diff --git a/doc/packagens.n b/doc/packagens.n
index 150dff5..30617a3 100644
--- a/doc/packagens.n
+++ b/doc/packagens.n
@@ -2,8 +2,6 @@
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
-'\" RCS: @(#) $Id: packagens.n,v 1.9 2007/12/13 15:22:33 dgp Exp $
-'\"
.so man.macros
.TH pkg::create n 8.3 Tcl "Tcl Built-In Commands"
.BS
@@ -11,7 +9,7 @@
.SH NAME
pkg::create \- Construct an appropriate 'package ifneeded' command for a given package specification
.SH SYNOPSIS
-\fB::pkg::create \fI\-name packageName\fR \fI\-version packageVersion\fR ?\fI\-load filespec\fR? ... ?\fI\-source filespec\fR? ...
+\fB::pkg::create\fR \fB\-name \fIpackageName \fB\-version \fIpackageVersion\fR ?\fB\-load \fIfilespec\fR? ... ?\fB\-source \fIfilespec\fR? ...
.BE
.SH DESCRIPTION
@@ -24,13 +22,13 @@ command for a given package specification. It can be used to construct a
.SH OPTIONS
The parameters supported are:
.TP
-\fB\-name\fR\0\fIpackageName\fR
+\fB\-name \fIpackageName\fR
This parameter specifies the name of the package. It is required.
.TP
-\fB\-version\fR\0\fIpackageVersion\fR
+\fB\-version \fIpackageVersion\fR
This parameter specifies the version of the package. It is required.
.TP
-\fB\-load\fR\0\fIfilespec\fR
+\fB\-load \fIfilespec\fR
This parameter specifies a binary library that must be loaded with the
\fBload\fR command. \fIfilespec\fR is a list with two elements. The
first element is the name of the file to load. The second, optional
@@ -39,7 +37,7 @@ list of procedures is empty or omitted, \fB::pkg::create\fR will
set up the library for direct loading (see \fBpkg_mkIndex\fR). Any
number of \fB\-load\fR parameters may be specified.
.TP
-\fB\-source\fR\0\fIfilespec\fR
+\fB\-source \fIfilespec\fR
This parameter is similar to the \fB\-load\fR parameter, except that it
specifies a Tcl library that must be loaded with the
\fBsource\fR command. Any number of \fB\-source\fR parameters may be
diff --git a/doc/pid.n b/doc/pid.n
index 69e5347..97a42a7 100644
--- a/doc/pid.n
+++ b/doc/pid.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: pid.n,v 1.9 2007/12/13 15:22:33 dgp Exp $
-'\"
.so man.macros
.TH pid n 7.0 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/pkgMkIndex.n b/doc/pkgMkIndex.n
index 90d87b1..2753208 100644
--- a/doc/pkgMkIndex.n
+++ b/doc/pkgMkIndex.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: pkgMkIndex.n,v 1.24 2009/02/24 21:04:58 dkf Exp $
-'\"
.so man.macros
.TH pkg_mkIndex n 8.3 Tcl "Tcl Built-In Commands"
.BS
@@ -14,7 +12,7 @@
pkg_mkIndex \- Build an index for automatic loading of packages
.SH SYNOPSIS
.nf
-\fBpkg_mkIndex ?\fIoptions...\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
+\fBpkg_mkIndex\fR ?\fIoptions...\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
.fi
.BE
.SH DESCRIPTION
@@ -155,7 +153,7 @@ commands for each version of each available package; these commands
invoke \fBpackage provide\fR commands to announce the
availability of the package, and they setup auto-loader
information to load the files of the package.
-If the \fI\-lazy\fR flag was provided when the \fBpkgIndex.tcl\fR
+If the \fB\-lazy\fR flag was provided when the \fBpkgIndex.tcl\fR
was generated,
a given file of a given version of a given package is not
actually loaded until the first time one of its commands
@@ -170,7 +168,7 @@ commands or those which require special initialization, might select
that their package files be loaded immediately upon \fBpackage require\fR
instead of delaying the actual loading to the first use of one of the
package's command. This is the default mode when generating the package
-index. It can be overridden by specifying the \fI\-lazy\fR argument.
+index. It can be overridden by specifying the \fB\-lazy\fR argument.
.SH "COMPLEX CASES"
Most complex cases of dependencies among scripts
and binary files, and packages being split among scripts and
@@ -230,3 +228,6 @@ the binary file may mask the package defined by the scripts.
package(n)
.SH KEYWORDS
auto-load, index, package, version
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/platform.n b/doc/platform.n
index c73c730..1553698 100644
--- a/doc/platform.n
+++ b/doc/platform.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: platform.n,v 1.6 2009/04/08 19:17:45 andreas_kupries Exp $
-'\"
.so man.macros
.TH "platform" n 1.0.4 platform "Tcl Bundled Packages"
.BS
@@ -14,7 +12,7 @@
platform \- System identification support code and utilities
.SH SYNOPSIS
.nf
-\fBpackage require platform ?1.0.4?\fR
+\fBpackage require platform ?1.0.10?\fR
.sp
\fBplatform::generic\fR
\fBplatform::identify\fR
@@ -47,6 +45,7 @@ architecture a Tcl program is running on.
.SH COMMANDS
.TP
\fBplatform::identify\fR
+.
This command returns an identifier describing the platform the Tcl
core is running on. The returned identifier has the general format
\fIOS\fR-\fICPU\fR. The \fIOS\fR part of the identifier may contain
@@ -55,14 +54,33 @@ may contain dashes as well. The \fICPU\fR part will not contain
dashes, making the preceding dash the last dash in the result.
.TP
\fBplatform::generic\fR
+.
This command returns a simplified identifier describing the platform
the Tcl core is running on. In contrast to \fBplatform::identify\fR it
leaves out details like kernel version, libc version, etc. The
returned identifier has the general format \fIOS\fR-\fICPU\fR.
.TP
-\fBplatform::patterns \fIidentifier\fR
+\fBplatform::patterns \fIidentifier\fR
+.
This command takes an identifier as returned by
\fBplatform::identify\fR and returns a list of identifiers describing
compatible architectures.
+.SH EXAMPLE
+.PP
+This can be used to allow an application to be shipped with multiple builds of
+a shared library, so that the same package works on many versions of an
+operating system. For example:
+.PP
+.CS
+\fBpackage require platform\fR
+# Assume that app script is .../theapp/bin/theapp.tcl
+set binDir [file dirname [file normalize [info script]]]
+set libDir [file join $binDir .. lib]
+set platLibDir [file join $libDir [\fBplatform::identify\fR]]
+load [file join $platLibDir support[info sharedlibextension]]
+.CE
.SH KEYWORDS
operating system, cpu architecture, platform, architecture
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/platform_shell.n b/doc/platform_shell.n
index 16fa364..eef4d4e 100644
--- a/doc/platform_shell.n
+++ b/doc/platform_shell.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: platform_shell.n,v 1.7 2008/11/10 17:57:30 andreas_kupries Exp $
-'\"
.so man.macros
.TH "platform::shell" n 1.1.4 platform::shell "Tcl Bundled Packages"
.BS
diff --git a/doc/prefix.n b/doc/prefix.n
index 0ce3052..eb79996 100644
--- a/doc/prefix.n
+++ b/doc/prefix.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: prefix.n,v 1.5 2010/01/13 09:13:35 dkf Exp $
-'\"
.so man.macros
.TH prefix n 8.6 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/proc.n b/doc/proc.n
index a6432e7..570a37d 100644
--- a/doc/proc.n
+++ b/doc/proc.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: proc.n,v 1.13 2010/01/22 23:38:21 dkf Exp $
-'\"
.so man.macros
.TH proc n "" Tcl "Tcl Built-In Commands"
.BS
@@ -55,7 +53,7 @@ error).
There is one special case to permit procedures with
variable numbers of arguments. If the last formal argument has the name
\fBargs\fR, then a call to the procedure may contain more actual arguments
-than the procedure has formals. In this case, all of the actual arguments
+than the procedure has formal arguments. In this case, all of the actual arguments
starting at the one that would be assigned to \fBargs\fR are combined into
a list (as if the \fBlist\fR command had been used); this combined value
is assigned to the local variable \fBargs\fR.
@@ -68,7 +66,7 @@ Other variables can only be accessed by invoking one of the \fBglobal\fR,
\fBvariable\fR, \fBupvar\fR or \fBnamespace upvar\fR commands.
The current namespace when \fIbody\fR is executed will be the
namespace that the procedure's name exists in, which will be the
-namespace that itwas created in unless it has been changed with
+namespace that it was created in unless it has been changed with
\fBrename\fR.
'\" We may change this! It makes [variable] unstable when renamed and is
'\" frankly pretty crazy, but doing it right is harder than it looks.
diff --git a/doc/puts.n b/doc/puts.n
index 45e67b7..4a53d44 100644
--- a/doc/puts.n
+++ b/doc/puts.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: puts.n,v 1.14 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH puts n 7.5 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/pwd.n b/doc/pwd.n
index 7761aab..65fed84 100644
--- a/doc/pwd.n
+++ b/doc/pwd.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: pwd.n,v 1.8 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH pwd n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/re_syntax.n b/doc/re_syntax.n
index fec37fd..46a180d 100644
--- a/doc/re_syntax.n
+++ b/doc/re_syntax.n
@@ -4,10 +4,10 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
-'\" RCS: @(#) $Id: re_syntax.n,v 1.18 2007/12/13 15:22:33 dgp Exp $
'\"
.so man.macros
+.ie '\w'o''\w'\C'^o''' .ds qo \C'^o'
+.el .ds qo u
.TH re_syntax n "8.1" Tcl "Tcl Built-In Commands"
.BS
.SH NAME
@@ -178,7 +178,7 @@ endpoint, so e.g.
.QW \fBa\-c\-e\fR
is illegal. Ranges in Tcl always use the
Unicode collating sequence, but other programs may use other collating
-sequences and this can be a source of incompatability between programs.
+sequences and this can be a source of incompatibility between programs.
.PP
To include a literal \fB]\fR or \fB\-\fR in the list, the simplest
method is to enclose it in \fB[.\fR and \fB.]\fR to make it a
@@ -223,7 +223,8 @@ A character producing white space in displayed text.
.IP \fBpunct\fR 8
A punctuation character.
.IP \fBgraph\fR 8
-A character with a visible representation (includes both alnum and punct).
+A character with a visible representation (includes both \fBalnum\fR
+and \fBpunct\fR).
.IP \fBcntrl\fR 8
A control character.
.PP
@@ -292,12 +293,12 @@ treatment is as if the enclosing delimiters were
.QW \fB[.\fR \&
and
.QW \fB.]\fR .)
-For example, if \fBo\fR and \fB\N'244'\fR are the members of an
+For example, if \fBo\fR and \fB\*(qo\fR are the members of an
equivalence class, then
.QW \fB[[=o=]]\fR ,
-.QW \fB[[=\N'244'=]]\fR ,
+.QW \fB[[=\*(qo=]]\fR ,
and
-.QW \fB[o\N'244']\fR \&
+.QW \fB[o\*(qo]\fR \&
are all synonymous. An equivalence class may not be an endpoint of a range.
.RS
.PP
@@ -361,39 +362,42 @@ horizontal tab, as in C
.TP
\fB\eu\fIwxyz\fR
.
-(where \fIwxyz\fR is exactly four hexadecimal digits) the Unicode
+(where \fIwxyz\fR is one up to four hexadecimal digits) the Unicode
character \fBU+\fIwxyz\fR in the local byte ordering
.TP
\fB\eU\fIstuvwxyz\fR
.
-(where \fIstuvwxyz\fR is exactly eight hexadecimal digits) reserved
-for a somewhat-hypothetical Unicode extension to 32 bits
+(where \fIstuvwxyz\fR is one up to eight hexadecimal digits) reserved
+for a Unicode extension up to 21 bits. The digits are parsed until the
+first non-hexadecimal character is encountered, the maximun of eight
+hexadecimal digits are reached, or an overflow would occur in the maximum
+value of \fBU+\fI10ffff\fR.
.TP
\fB\ev\fR
.
vertical tab, as in C are all available.
.TP
-\fB\ex\fIhhh\fR
+\fB\ex\fIhh\fR
.
-(where \fIhhh\fR is any sequence of hexadecimal digits) the character
-whose hexadecimal value is \fB0x\fIhhh\fR (a single character no
-matter how many hexadecimal digits are used).
+(where \fIhh\fR is one or two hexadecimal digits) the character
+whose hexadecimal value is \fB0x\fIhh\fR.
.TP
\fB\e0\fR
.
the character whose value is \fB0\fR
.TP
+\fB\e\fIxyz\fR
+.
+(where \fIxyz\fR is exactly three octal digits, and is not a \fIback
+reference\fR (see below)) the character whose octal value is
+\fB0\fIxyz\fR. The first digit must be in the range 0-3, otherwise
+the two-digit form is assumed.
+.TP
\fB\e\fIxy\fR
.
(where \fIxy\fR is exactly two octal digits, and is not a \fIback
reference\fR (see below)) the character whose octal value is
\fB0\fIxy\fR
-.TP
-\fB\e\fIxyz\fR
-.
-(where \fIxyz\fR is exactly three octal digits, and is not a back
-reference (see below)) the character whose octal value is
-\fB0\fIxyz\fR
.RE
.PP
Hexadecimal digits are
diff --git a/doc/read.n b/doc/read.n
index 72db6ed..007c0ac 100644
--- a/doc/read.n
+++ b/doc/read.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: read.n,v 1.16 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH read n 8.1 Tcl "Tcl Built-In Commands"
.BS
@@ -56,7 +54,7 @@ which \fBfconfigure\fR will alter input.
'\" Note: this advice actually applies to many versions of Tcl
.PP
For most applications a channel connected to a serial port should be
-configured to be nonblocking: \fBfconfigure \fIchannelId \fB\-blocking
+configured to be nonblocking: \fBfconfigure\fI channelId \fB\-blocking
\fI0\fR. Then \fBread\fR behaves much like described above. Care
must be taken when using \fBread\fR on blocking serial ports:
.TP
@@ -68,7 +66,7 @@ from the serial port.
\fBread \fIchannelId\fR
.
In this form \fBread\fR blocks until the reception of the end-of-file
-character, see \fBfconfigure -eofchar\fR. If there no end-of-file
+character, see \fBfconfigure\fR \fB\-eofchar\fR. If there no end-of-file
character has been configured for the channel, then \fBread\fR will
block forever.
.SH "EXAMPLE"
@@ -86,3 +84,6 @@ set lines [split $data \en]
file(n), eof(n), fblocked(n), fconfigure(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, channel, end of line, end of file, nonblocking, read, translation, encoding
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/refchan.n b/doc/refchan.n
index 5007a09..a51c3d7 100644
--- a/doc/refchan.n
+++ b/doc/refchan.n
@@ -4,7 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: refchan.n,v 1.20 2010/03/09 21:15:19 andreas_kupries Exp $
.so man.macros
.TH refchan n 8.5 Tcl "Tcl Built-In Commands"
.BS
@@ -18,10 +17,10 @@ refchan \- command handler API of reflected channels
.PP
The Tcl-level handler for a reflected channel has to be a command with
subcommands (termed an \fIensemble\fR, as it is a command such as that
-created by \fBnamespace ensemble create\fR, though the implementation
+created by \fBnamespace ensemble\fR \fBcreate\fR, though the implementation
of handlers for reflected channel \fIis not\fR tied to \fBnamespace
-ensemble\fRs in any way; see \fBEXAMPLE\fR below for how to build a
-\fBclass\fR that supports the API). Note that \fIcmdPrefix\fR is whatever was
+ensemble\fRs in any way; see \fBEXAMPLE\fR below for how to build an
+\fBoo::class\fR that supports the API). Note that \fIcmdPrefix\fR is whatever was
specified in the call to \fBchan create\fR, and may consist of
multiple arguments; this will be expanded to multiple words in place
of the prefix.
diff --git a/doc/regexp.n b/doc/regexp.n
index 4bdf467..5e857f8 100644
--- a/doc/regexp.n
+++ b/doc/regexp.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: regexp.n,v 1.32 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH regexp n 8.3 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/registry.n b/doc/registry.n
index 18e8ae0..2e69b1e 100644
--- a/doc/registry.n
+++ b/doc/registry.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: registry.n,v 1.23 2010/03/31 22:12:26 dkf Exp $
-'\"
.so man.macros
.TH registry n 1.1 registry "Tcl Bundled Packages"
.BS
@@ -105,7 +103,7 @@ data, see \fBSUPPORTED TYPES\fR, below.
If \fIpattern\fR is not specified, returns a list of names of all the
subkeys of \fIkeyName\fR. If \fIpattern\fR is specified, only those
names matching \fIpattern\fR are returned. Matching is determined
-using the same rules as for \fBstring\fR \fBmatch\fR. If the
+using the same rules as for \fBstring match\fR. If the
specified \fIkeyName\fR does not exist, then an error is generated.
.TP
\fBregistry set \fIkeyName\fR ?\fIvalueName data \fR?\fItype\fR??
@@ -129,7 +127,7 @@ Returns the type of the value \fIvalueName\fR in the key
If \fIpattern\fR is not specified, returns a list of names of all the
values of \fIkeyName\fR. If \fIpattern\fR is specified, only those
names matching \fIpattern\fR are returned. Matching is determined
-using the same rules as for \fBstring\fR \fBmatch\fR.
+using the same rules as for \fBstring match\fR.
.SH "SUPPORTED TYPES"
Each value under a key in the registry contains some data of a
particular type in a type-specific representation. The \fBregistry\fR
diff --git a/doc/regsub.n b/doc/regsub.n
index 280692e..fe473d9 100644
--- a/doc/regsub.n
+++ b/doc/regsub.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: regsub.n,v 1.29 2010/09/10 12:59:01 dkf Exp $
-'\"
.so man.macros
.TH regsub n 8.3 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/rename.n b/doc/rename.n
index 7852937..77dc095 100644
--- a/doc/rename.n
+++ b/doc/rename.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: rename.n,v 1.6 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH rename n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/return.n b/doc/return.n
index 9a44ff6..b59a93d 100644
--- a/doc/return.n
+++ b/doc/return.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: return.n,v 1.27 2010/04/07 09:51:31 dkf Exp $
-'\"
.so man.macros
.TH return n 8.5 Tcl "Tcl Built-In Commands"
.BS
@@ -319,7 +317,8 @@ proc myReturn {args} {
}
.CE
.SH "SEE ALSO"
-break(n), catch(n), continue(n), dict(n), error(n), proc(n), source(n), tclvars(n)
+break(n), catch(n), continue(n), dict(n), error(n), proc(n),
+source(n), tclvars(n), throw(n), try(n)
.SH KEYWORDS
break, catch, continue, error, exception, procedure, result, return
.\" Local Variables:
diff --git a/doc/safe.n b/doc/safe.n
index 7ec1cef..ebd9b4d 100644
--- a/doc/safe.n
+++ b/doc/safe.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: safe.n,v 1.14 2010/02/26 10:32:40 rmax Exp $
-'\"
.so man.macros
.TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands"
.BS
@@ -69,7 +67,7 @@ The following commands are provided in the master interpreter:
\fB::safe::interpCreate\fR ?\fIslave\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 \fBoptions\fR.
+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.
@@ -78,7 +76,7 @@ If the \fIslave\fR argument is omitted, a name will be generated.
\fB::safe::interpInit\fR \fIslave\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 \-safe\fR.
+other means, like \fBinterp create\fR \fB\-safe\fR.
.TP
\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
If no \fIoptions\fR are given, returns the settings for all options for the
@@ -295,9 +293,9 @@ executing.
The only valid file names arguments
for the \fBsource\fR and \fBload\fR aliases provided to the slave
are path in the form of
-\fB[file join \fR\fItoken filename\fR\fB]\fR (i.e. when using the
-native file path formats: \fItoken\fR\fB/\fR\fIfilename\fR
-on Unix and \fItoken\fR\fB\e\fIfilename\fR on Windows),
+\fB[file join \fItoken filename\fB]\fR (i.e. when using the
+native file path formats: \fItoken\fB/\fIfilename\fR
+on Unix and \fItoken\fB\e\fIfilename\fR on Windows),
where \fItoken\fR is representing one of the directories
of the \fIaccessPath\fR list and \fIfilename\fR is
one file in that directory (no sub directories access are allowed).
@@ -356,3 +354,6 @@ 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
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/scan.n b/doc/scan.n
index 7f2eb65..cc5ed79 100644
--- a/doc/scan.n
+++ b/doc/scan.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: scan.n,v 1.29 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH scan n 8.4 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/seek.n b/doc/seek.n
index 9bc0923..96d5c4e 100644
--- a/doc/seek.n
+++ b/doc/seek.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: seek.n,v 1.10 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH seek n 8.1 Tcl "Tcl Built-In Commands"
.BS
@@ -51,7 +49,7 @@ position after the end of file.
The \fIorigin\fR argument defaults to \fBstart\fR.
.PP
The command flushes all buffered output for the channel before the command
-returns, even if the channel is in nonblocking mode.
+returns, even if the channel is in non-blocking mode.
It also discards any buffered and unread input.
This command returns an empty string.
An error occurs if this command is applied to channels whose underlying
@@ -88,3 +86,7 @@ close $f
file(n), open(n), close(n), gets(n), tell(n), Tcl_StandardChannels(3)
.SH KEYWORDS
access position, file, seek
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/self.n b/doc/self.n
index a616d30..2a04157 100644
--- a/doc/self.n
+++ b/doc/self.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: self.n,v 1.4 2009/07/24 08:23:00 dkf Exp $
-'\"
.so man.macros
.TH self n 0.1 TclOO "TclOO Commands"
.BS
@@ -27,6 +25,17 @@ takes an argument, \fIsubcommand\fR, that tells it what sort of information is
actually desired; if omitted the result will be the same as if \fBself
object\fR was invoked. The supported subcommands are:
.TP
+\fBself call\fR
+.
+This returns a two-element list describing the method implementations used to
+implement the current call chain. The first element is the same as would be
+reported by \fBinfo object\fR \fBcall\fR for the current method (except that this
+also reports useful values from within constructors and destructors, whose
+names are reported as \fB<constructor>\fR and \fB<destructor>\fR
+respectively), and the second element is an index into the first element's
+list that indicates which actual implementation is currently executing (the
+first implementation to execute is always at index 0).
+.TP
\fBself caller\fR
.
When the method was invoked from inside another object method, this subcommand
@@ -82,7 +91,7 @@ method call chain; the first element is the name of the class or object that
declares the next part of the call chain, and the second element is the name
of the method (with the strings \fB<constructor>\fR and \fB<destructor>\fR
indicating constructors and destructors respectively). If invoked from a
-method that is at the end of a call chain, this subcommand returns the emtpy
+method that is at the end of a call chain, this subcommand returns the empty
string.
.TP
\fBself object\fR
@@ -111,6 +120,28 @@ c create b
a foo \fI\(-> prints "this is the ::a object"\fR
b foo \fI\(-> prints "this is the ::b object"\fR
.CE
+.PP
+This demonstrates what a method call chain looks like, and how traversing
+along it changes the index into it:
+.PP
+.CS
+oo::class create c {
+ method x {} {
+ puts "Cls: [\fBself call\fR]"
+ }
+}
+c create a
+oo::objdefine a {
+ method x {} {
+ puts "Obj: [\fBself call\fR]"
+ next
+ puts "Obj: [\fBself call\fR]"
+ }
+}
+a x \fI\(-> Obj: {{method x object method} {method x ::c method}} 0\fR
+ \fI\(-> Cls: {{method x object method} {method x ::c method}} 1\fR
+ \fI\(-> Obj: {{method x object method} {method x ::c method}} 0\fR
+.CE
.SH "SEE ALSO"
info(n), next(n)
.SH KEYWORDS
diff --git a/doc/set.n b/doc/set.n
index e964425..32a788e 100644
--- a/doc/set.n
+++ b/doc/set.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: set.n,v 1.10 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH set n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/socket.n b/doc/socket.n
index 7596abb..0a60457 100644
--- a/doc/socket.n
+++ b/doc/socket.n
@@ -5,9 +5,8 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: socket.n,v 1.20 2010/02/24 10:11:46 dkf Exp $
.so man.macros
-.TH socket n 8.0 Tcl "Tcl Built-In Commands"
+.TH socket n 8.6 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -20,18 +19,17 @@ socket \- Open a TCP network connection
.BE
.SH DESCRIPTION
.PP
-This command opens a network socket and returns a channel
-identifier that may be used in future invocations of commands like
-\fBread\fR, \fBputs\fR and \fBflush\fR.
-At present only the TCP network protocol is supported; future
-releases may include support for additional protocols.
-The \fBsocket\fR command may be used to open either the client or
-server side of a connection, depending on whether the \fB\-server\fR
-switch is specified.
+This command opens a network socket and returns a channel identifier
+that may be used in future invocations of commands like \fBread\fR,
+\fBputs\fR and \fBflush\fR. At present only the TCP network protocol
+is supported over IPv4 and IPv6; future releases may include support
+for additional protocols. The \fBsocket\fR command may be used to
+open either the client or server side of a connection, depending on
+whether the \fB\-server\fR switch is specified.
.PP
Note that the default encoding for \fIall\fR sockets is the system
encoding, as returned by \fBencoding system\fR. Most of the time, you
-will need to use \fBfconfigure\fR to alter this to something else,
+will need to use \fBchan configure\fR to alter this to something else,
such as \fIutf\-8\fR (ideal for communicating with other Tcl
processes) or \fIiso8859\-1\fR (useful for many network protocols,
especially the older ones).
@@ -46,7 +44,7 @@ this port. \fIPort\fR is an integer port number
(or service name, where supported and understood by the host operating
system) and \fIhost\fR
is either a domain-style name such as \fBwww.tcl.tk\fR or
-a numerical IP address such as \fB127.0.0.1\fR.
+a numerical IPv4 or IPv6 address such as \fB127.0.0.1\fR or \fB2001:DB8::1\fR.
Use \fIlocalhost\fR to refer to the host on which the command is invoked.
.PP
The following options may also be present before \fIhost\fR
@@ -70,51 +68,65 @@ port number will be chosen at random by the system software.
.TP
\fB\-async\fR
.
-The \fB\-async\fR option will cause the client socket to be connected
-asynchronously. This means that the socket will be created immediately but
-may not yet be connected to the server, when the call to \fBsocket\fR
-returns. When a \fBgets\fR or \fBflush\fR is done on the socket before the
-connection attempt succeeds or fails, if the socket is in blocking mode, the
-operation will wait until the connection is completed or fails. If the
-socket is in nonblocking mode and a \fBgets\fR or \fBflush\fR is done on
-the socket before the connection attempt succeeds or fails, the operation
-returns immediately and \fBfblocked\fR on the socket returns 1. Synchronous
-client sockets may be switched (after they have connected) to operating in
-asynchronous mode using:
+This option will cause the client socket to be connected
+asynchronously. This means that the socket will be created immediately
+but may not yet be connected to the server, when the call to
+\fBsocket\fR returns.
.RS
.PP
+When a \fBgets\fR or \fBflush\fR is done on the socket before the
+connection attempt succeeds or fails, if the socket is in blocking
+mode, the operation will wait until the connection is completed or
+fails. If the socket is in nonblocking mode and a \fBgets\fR or
+\fBflush\fR is done on the socket before the connection attempt
+succeeds or fails, the operation returns immediately and
+\fBfblocked\fR on the socket returns 1. Synchronous client sockets may
+be switched (after they have connected) to operating in asynchronous
+mode using:
+.PP
.CS
-\fBfconfigure \fIchan \fB\-blocking 0\fR
+\fBchan configure \fIchan \fB\-blocking 0\fR
.CE
.PP
-See the \fBfconfigure\fR command for more details.
+See the \fBchan configure\fR command for more details.
+.PP
+The Tcl event loop should be running while an asynchronous connection
+is in progress, because it may have to do several connection attempts
+in the background. Running the event loop also allows you to set up a
+writable channel event on the socket to get notified when the
+asynchronous connection has succeeded or failed. See the \fBvwait\fR
+and the \fBchan\fR commands for more details on the event loop and
+channel events.
.RE
.SH "SERVER SOCKETS"
.PP
-If the \fB\-server\fR option is specified then the new socket
-will be a server for the port given by \fIport\fR (either an integer
-or a service name, where supported and understood by the host
-operating system; if \fIport\fR is zero, the operating system will
-allocate a free port to the server socket which may be discovered by
-using \fBfconfigure\fR to read the \fB\-sockname\fR option).
-Tcl will automatically accept connections to the given port.
+If the \fB\-server\fR option is specified then the new socket will be
+a server that listens on the given \fIport\fR (either an integer or a
+service name, where supported and understood by the host operating
+system; if \fIport\fR is zero, the operating system will allocate a
+free port to the server socket which may be discovered by using
+\fBchan configure\fR to read the \fB\-sockname\fR option). If the host
+supports both, IPv4 and IPv6, the socket will listen on both address
+families. Tcl will automatically accept connections to the given port.
For each connection Tcl will create a new channel that may be used to
-communicate with the client. Tcl then invokes \fIcommand\fR
-(properly a command prefix list, see the \fBEXAMPLES\fR below)
-with three additional arguments: the name of the new channel, the
-address, in network address notation, of the client's host, and
-the client's port number.
+communicate with the client. Tcl then invokes \fIcommand\fR (properly
+a command prefix list, see the \fBEXAMPLES\fR below) with three
+additional arguments: the name of the new channel, the address, in
+network address notation, of the client's host, and the client's port
+number.
.PP
The following additional option may also be specified before \fIport\fR:
.TP
\fB\-myaddr\fI addr\fR
.
-\fIAddr\fR gives the domain-style name or numerical IP address of
-the server-side network interface to use for the connection.
-This option may be useful if the server machine has multiple network
-interfaces. If the option is omitted then the server socket is bound
-to the special address INADDR_ANY so that it can accept connections from
-any interface.
+\fIAddr\fR gives the domain-style name or numerical IP address of the
+server-side network interface to use for the connection. This option
+may be useful if the server machine has multiple network interfaces.
+If the option is omitted then the server socket is bound to the
+wildcard address so that it can accept connections from any
+interface. If \fIaddr\fR is a domain name that resolves to multiple IP
+addresses that are available on the local machine, the socket will
+listen on all of them.
.PP
Server channels cannot be used for input or output; their sole use is to
accept new client connections. The channels created for each incoming
@@ -131,11 +143,11 @@ will be accepted.
If \fIport\fR is specified as zero, the operating system will allocate
an unused port for use as a server socket. The port number actually
allocated may be retrieved from the created server socket using the
-\fBfconfigure\fR command to retrieve the \fB\-sockname\fR option as
+\fBchan configure\fR command to retrieve the \fB\-sockname\fR option as
described below.
.SH "CONFIGURATION OPTIONS"
.PP
-The \fBfconfigure\fR command can be used to query several readonly
+The \fBchan configure\fR command can be used to query several readonly
configuration options for socket channels:
.TP
\fB\-error\fR
@@ -144,13 +156,28 @@ This option gets the current error status of the given socket. This
is useful when you need to determine if an asynchronous connect
operation succeeded. If there was an error, the error message is
returned. If there was no error, an empty string is returned.
+.RS
+.PP
+Note that the error status is reset by the read operation; this mimics
+the underlying getsockopt(SO_ERROR) call.
+.RE
.TP
\fB\-sockname\fR
.
-This option returns a list of three elements, the address, the host name
-and the port number for the socket. If the host name cannot be computed,
-the second element is identical to the address, the first element of the
-list.
+For client sockets (including the channels that get created when a
+client connects to a server socket) this option returns a list of
+three elements, the address, the host name and the port number for the
+socket. If the host name cannot be computed, the second element is
+identical to the address, the first element of the list.
+.RS
+.PP
+For server sockets this option returns a list of a multiple of three
+elements each group of which have the same meaning as described
+above. The list contains more than one group when the server socket
+was created without \fB\-myaddr\fR or with the argument to
+\fB\-myaddr\fR being a domain name that resolves multiple IP addresses
+that are local to the invoking host.
+.RE
.TP
\fB\-peername\fR
.
@@ -189,8 +216,10 @@ close $sockChan
puts "The time on $server is $line1"
puts "That is [lindex $line2 0]s since the server started"
.CE
+.SH "HISTORY"
+Support for IPv6 was added in Tcl 8.6.
.SH "SEE ALSO"
-fconfigure(n), flush(n), open(n), read(n)
+chan(n), flush(n), open(n), read(n)
.SH KEYWORDS
asynchronous I/O, bind, channel, connection, domain name, host, network address, socket, tcp
'\" Local Variables:
diff --git a/doc/source.n b/doc/source.n
index d035f72..57a9fa2 100644
--- a/doc/source.n
+++ b/doc/source.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: source.n,v 1.21 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH source n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/split.n b/doc/split.n
index d68aaf3..e3259df 100644
--- a/doc/split.n
+++ b/doc/split.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: split.n,v 1.12 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH split n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/string.n b/doc/string.n
index 50fdeeb..6b3cc59 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -5,8 +5,6 @@
.\" See the file "license.terms" for information on usage and redistribution
.\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
.\"
-.\" RCS: @(#) $Id: string.n,v 1.46 2009/11/08 20:01:18 dkf Exp $
-.\"
.so man.macros
.TH string n 8.1 Tcl "Tcl Built-In Commands"
.BS
@@ -27,11 +25,13 @@ Returns a decimal string giving the number of bytes used to represent
\fIstring\fR in memory. Because UTF\-8 uses one to three bytes to
represent Unicode characters, the byte length will not be the same as
the character length in general. The cases where a script cares about
-the byte length are rare. In almost all cases, you should use the
+the byte length are rare.
+.RS
+.PP
+In almost all cases, you should use the
\fBstring length\fR operation (including determining the length of a
-Tcl ByteArray object). Refer to the \fBTcl_NumUtfChars\fR manual
+Tcl byte array value). Refer to the \fBTcl_NumUtfChars\fR manual
entry for more details on the UTF\-8 representation.
-.RS
.PP
\fICompatibility note:\fR it is likely that this subcommand will be
withdrawn in a future version of Tcl. It is better to use the
@@ -123,6 +123,12 @@ outside of the [0\-9] range.
Any of the valid forms for a double in Tcl, with optional surrounding
whitespace. In case of under/overflow in the value, 0 is returned and
the \fIvarname\fR will contain \-1.
+.IP \fBentier\fR 12
+.VS 8.6
+Any of the valid string formats for an integer value of arbitrary size
+in Tcl, with optional surrounding whitespace. The formats accepted are
+exactly those accepted by the C routine \fBTcl_GetBignumFromObj\fR.
+.VE
.IP \fBfalse\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
false.
@@ -145,7 +151,8 @@ Any Unicode printing character, including space.
.IP \fBpunct\fR 12
Any Unicode punctuation character.
.IP \fBspace\fR 12
-Any Unicode space character.
+Any Unicode whitespace character, zero width space (U+200b),
+word joiner (U+2060) and zero width no-break space (U+feff) (=BOM).
.IP \fBtrue\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
true.
@@ -194,9 +201,9 @@ will return \fB1\fR.
.
Returns a decimal string giving the number of characters in
\fIstring\fR. Note that this is not necessarily the same as the
-number of bytes used to store the string. If the object is a
-ByteArray object (such as those returned from reading a binary encoded
-channel), then this will return the actual byte length of the object.
+number of bytes used to store the string. If the value is a
+byte array value (such as those returned from reading a binary encoded
+channel), then this will return the actual byte length of the value.
.TP
\fBstring map\fR ?\fB\-nocase\fR? \fImapping string\fR
.
@@ -331,22 +338,22 @@ specified using the forms described in \fBSTRING INDICES\fR.
.
Returns a value equal to \fIstring\fR except that any leading or
trailing characters present in the string given by \fIchars\fR are removed. If
-\fIchars\fR is not specified then white space is removed (spaces,
-tabs, newlines, and carriage returns).
+\fIchars\fR is not specified then white space is removed (any character
+for which \fBstring is space\fR returns 1, and "\0").
.TP
\fBstring trimleft \fIstring\fR ?\fIchars\fR?
.
Returns a value equal to \fIstring\fR except that any leading
characters present in the string given by \fIchars\fR are removed. If
-\fIchars\fR is not specified then white space is removed (spaces,
-tabs, newlines, and carriage returns).
+\fIchars\fR is not specified then white space is removed (any character
+for which \fBstring is space\fR returns 1, and "\0").
.TP
\fBstring trimright \fIstring\fR ?\fIchars\fR?
.
Returns a value equal to \fIstring\fR except that any trailing
characters present in the string given by \fIchars\fR are removed. If
-\fIchars\fR is not specified then white space is removed (spaces,
-tabs, newlines, and carriage returns).
+\fIchars\fR is not specified then white space is removed (any character
+for which \fBstring is space\fR returns 1, and "\0").
.TP
\fBstring wordend \fIstring charIndex\fR
.
diff --git a/doc/subst.n b/doc/subst.n
index e4a4f2d..aba2bc9 100644
--- a/doc/subst.n
+++ b/doc/subst.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: subst.n,v 1.18 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH subst n 7.4 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/switch.n b/doc/switch.n
index ea83c0a..acde6cb 100644
--- a/doc/switch.n
+++ b/doc/switch.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: switch.n,v 1.21 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH switch n 8.5 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/tailcall.n b/doc/tailcall.n
index 93af2b5..6a88aca 100644
--- a/doc/tailcall.n
+++ b/doc/tailcall.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: tailcall.n,v 1.2 2010/01/20 09:41:14 dkf Exp $
-'\"
.so man.macros
.TH tailcall n 8.6 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/tclsh.1 b/doc/tclsh.1
index f9f3780..8e7fb9e 100644
--- a/doc/tclsh.1
+++ b/doc/tclsh.1
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: tclsh.1,v 1.18 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH tclsh 1 "" Tcl "Tcl Applications"
.BS
@@ -14,7 +12,7 @@
.SH NAME
tclsh \- Simple shell containing Tcl interpreter
.SH SYNOPSIS
-\fBtclsh\fR ?-encoding \fIname\fR? ?\fIfileName arg arg ...\fR?
+\fBtclsh\fR ?\fB\-encoding \fIname\fR? ?\fIfileName arg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
diff --git a/doc/tcltest.n b/doc/tcltest.n
index ceb05a3..731bed7 100644
--- a/doc/tcltest.n
+++ b/doc/tcltest.n
@@ -8,8 +8,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: tcltest.n,v 1.59 2010/01/14 11:47:09 dkf Exp $
-'\"
.so man.macros
.TH "tcltest" n 2.3 tcltest "Tcl Bundled Packages"
.BS
@@ -34,7 +32,7 @@ tcltest \- Test harness support code and utilities
\fBtcltest::configure\fR
\fBtcltest::configure \fI\-option\fR
-\fBtcltest::configure \fI\-option value\fR ?\fI-option value ...\fR?
+\fBtcltest::configure \fI\-option value\fR ?\fI\-option value ...\fR?
\fBtcltest::customMatch \fImode command\fR
\fBtcltest::testConstraint \fIconstraint\fR ?\fIvalue\fR?
\fBtcltest::outputChannel \fR?\fIchannelID\fR?
@@ -92,7 +90,7 @@ of how to use the commands of \fBtcltest\fR to produce test suites
for your Tcl-enabled code.
.SH COMMANDS
.TP
-\fBtest\fR \fIname description\fR ?\fI-option value ...\fR?
+\fBtest\fR \fIname description\fR ?\fI\-option value ...\fR?
.
Defines and possibly runs a test with the name \fIname\fR and
description \fIdescription\fR. The name and description of a test
diff --git a/doc/tclvars.n b/doc/tclvars.n
index 792d5c8..44a8e11 100644
--- a/doc/tclvars.n
+++ b/doc/tclvars.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: tclvars.n,v 1.42 2010/01/14 11:47:09 dkf Exp $
-'\"
.so man.macros
.TH tclvars n 8.0 Tcl "Tcl Built-In Commands"
.BS
@@ -101,6 +99,23 @@ Tcl format, using
.QW /
as the path separator, regardless of platform.
This variable is only used when initializing the \fBauto_path\fR variable.
+.TP
+\fBenv(TCL_TZ)\fR, \fBenv(TZ)\fR
+.
+These specify the default timezone used for parsing and formatting times and
+dates in the \fBclock\fR command. On many platforms, the TZ environment
+variable is set up by the operating system.
+.TP
+\fBenv(LC_ALL)\fR, \fBenv(LC_MESSAGES)\fR, \fBenv(LANG)\fR
+.
+These environment variables are used by the \fBmsgcat\fR package to
+determine what locale to format messages using.
+.TP
+\fBenv(TCL_INTERP_DEBUG_FRAME)\fR
+.
+If existing, it has the same effect as running \fBinterp debug\fR
+\fB{} -frame 1\fR
+as the very first command of each new Tcl interpreter.
.RE
.TP
\fBerrorCode\fR
@@ -360,22 +375,41 @@ binary number.
.RE
.PP
.RS
-17 digits is
+If \fBtcl_precision\fR is not zero, then when Tcl converts a floating
+point number, it creates a decimal representation of at most
+\fBtcl_precision\fR significant digits; the result may be shorter if
+the shorter result represents the original number exactly. If no
+result of at most \fBtcl_precision\fR digits is an exact representation
+of the original number, the one that is closest to the original
+number is chosen.
+If the original number lies precisely between two equally accurate
+decimal representations, then the one with an even value for the least
+significant digit is chosen; for instance, if \fBtcl_precision\fR is 3, then
+0.3125 will convert to 0.312, not 0.313, while 0.6875 will convert to
+0.688, not 0.687. Any string of trailing zeroes that remains is trimmed.
+.RE
+.PP
+.RS
+a \fBtcl_precision\fR value of 17 digits is
.QW perfect
for IEEE floating-point in that it allows
double-precision values to be converted to strings and back to
-binary with no loss of information. However, using 17 digits prevents
-any rounding, which produces longer, less intuitive results. For example,
-\fBexpr {1.4}\fR returns 1.3999999999999999 with \fBtcl_precision\fR
-set to 17, vs. 1.4 if \fBtcl_precision\fR is 12.
+binary with no loss of information. For this reason, you will often
+see it as a value in legacy code that must run on Tcl versions before
+8.5. It is no longer recommended; as noted above, a zero value is the
+preferred method.
.RE
.PP
.RS
All interpreters in a thread share a single \fBtcl_precision\fR value:
changing it in one interpreter will affect all other interpreters as
-well. However, safe interpreters are not allowed to modify the
+well. Safe interpreters are not allowed to modify the
variable.
.RE
+.PP
+.RS
+Valid values for \fBtcl_precision\fR range from 0 to 17.
+.RE
.TP
\fBtcl_rcFileName\fR
.
@@ -462,6 +496,7 @@ bug fixes that retain backward compatibility.
The value of this variable is returned by the \fBinfo tclversion\fR
command.
.SH "OTHER GLOBAL VARIABLES"
+.PP
The following variables are only guaranteed to exist in \fBtclsh\fR
and \fBwish\fR executables; the Tcl library does not define them
itself but many Tcl environments do.
@@ -485,6 +520,42 @@ was invoked.
Contains 1 if \fBtclsh\fR or \fBwish\fR is running interactively (no
script was specified and standard input is a terminal-like device), 0
otherwise.
+.SH EXAMPLES
+.PP
+To add a directory to the collection of locations searched by
+\fBpackage require\fR, e.g., because of some application-specific
+packages that are used, the \fBauto_path\fR variable needs to be
+updated:
+.PP
+.CS
+lappend ::\fBauto_path\fR [file join [pwd] "theLibDir"]
+.CE
+.PP
+A simple though not very robust way to handle command line arguments
+of the form
+.QW "\-foo 1 \-bar 2"
+is to load them into an array having first loaded in the default settings:
+.CS
+array set arguments {-foo 0 -bar 0 -grill 0}
+array set arguments $::\fBargv\fR
+puts "foo is $arguments(-foo)"
+puts "bar is $arguments(-bar)"
+puts "grill is $arguments(-grill)"
+.CE
+.PP
+The \fBargv0\fR global variable can be used (in conjunction with the
+\fBinfo script\fR command) to determine whether the current script is
+being executed as the main script or loaded as a library. This is
+useful because it allows a single script to be used as both a library
+and a demonstration of that library:
+.PP
+.CS
+if {$::\fBargv0\fR eq [info script]} {
+ # running as: tclsh example.tcl
+} else {
+ package provide Example 1.0
+}
+.CE
.SH "SEE ALSO"
eval(n), library(n), tclsh(1), tkvars(n), wish(1)
.SH KEYWORDS
diff --git a/doc/tell.n b/doc/tell.n
index c62b22a..87e63b0 100644
--- a/doc/tell.n
+++ b/doc/tell.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: tell.n,v 1.10 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH tell n 8.1 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/throw.n b/doc/throw.n
index 2c69df8..d49fb24 100644
--- a/doc/throw.n
+++ b/doc/throw.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: throw.n,v 1.1 2008/12/16 21:29:10 dkf Exp $
-'\"
.so man.macros
.TH throw n 8.6 Tcl "Tcl Built-In Commands"
.BS
@@ -42,7 +40,7 @@ The following produces an error that is identical to that produced by
\fBthrow\fR {ARITH DIVZERO {divide by zero}} {divide by zero}
.CE
.SH "SEE ALSO"
-catch(n), error(n), return(n), try(n)
+catch(n), error(n), return(n), tclvars(n), try(n)
.SH "KEYWORDS"
error, exception
'\" Local Variables:
diff --git a/doc/time.n b/doc/time.n
index 9d7aa5f..52730a1 100644
--- a/doc/time.n
+++ b/doc/time.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: time.n,v 1.10 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH time n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/tm.n b/doc/tm.n
index 09673db..ddfbac2 100644
--- a/doc/tm.n
+++ b/doc/tm.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: tm.n,v 1.20 2010/09/08 16:53:20 andreas_kupries Exp $
-'\"
.so man.macros
.TH tm n 8.5 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/trace.n b/doc/trace.n
index 37e5532..63ed1cb 100644
--- a/doc/trace.n
+++ b/doc/trace.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: trace.n,v 1.27 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH trace n "8.4" Tcl "Tcl Built-In Commands"
.BS
@@ -145,7 +143,7 @@ error will occur.
For \fBleave\fR and \fBleavestep\fR operations:
.PP
.CS
-\fIcommand command-string code result op\fR
+\fIcommandPrefix command-string code result op\fR
.CE
.PP
\fICommand-string\fR gives the complete current command being
diff --git a/doc/transchan.n b/doc/transchan.n
index 0716591..e308e13 100644
--- a/doc/transchan.n
+++ b/doc/transchan.n
@@ -4,7 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: transchan.n,v 1.2 2008/10/07 15:00:10 dkf Exp $
.so man.macros
.TH transchan n 8.6 Tcl "Tcl Built-In Commands"
.BS
@@ -55,7 +54,7 @@ if the interpreter is deleted.
This mandatory subcommand is called first, and then never again (for the given
\fIhandle\fR). Its responsibility is to initialize all parts of the
transformation at the Tcl level. The \fImode\fR is a list containing any of
-\fBread\fR and \fBwrite\fR.
+\fBread \fRand \fBwrite\fR.
.RS
.TP
\fBwrite\fR
@@ -74,7 +73,7 @@ as error thrown by \fBchan push\fR.
.SS "READ-RELATED SUBCOMMANDS"
.PP
These subcommands are used for handling transformations applied to readable
-channels; though strictly \fBread\fR is optional, it must be supported if any
+channels; though strictly \fBread \fRis optional, it must be supported if any
of the others is or the channel will be made non-readable.
.TP
\fIcmdPrefix \fBdrain \fIhandle\fR
diff --git a/doc/try.n b/doc/try.n
index 15e545e..393fe5b 100644
--- a/doc/try.n
+++ b/doc/try.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: try.n,v 1.3 2010/04/15 08:52:55 dkf Exp $
-'\"
.so man.macros
.TH try n 8.6 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/unknown.n b/doc/unknown.n
index 1b13c81..fc2a5a1 100644
--- a/doc/unknown.n
+++ b/doc/unknown.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: unknown.n,v 1.10 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH unknown n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/unload.n b/doc/unload.n
index 965149a..4c0b292 100644
--- a/doc/unload.n
+++ b/doc/unload.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: unload.n,v 1.13 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH unload n 8.5 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/unset.n b/doc/unset.n
index 52d82a5..64b334d 100644
--- a/doc/unset.n
+++ b/doc/unset.n
@@ -6,8 +6,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: unset.n,v 1.15 2010/04/18 11:51:43 dkf Exp $
-'\"
.so man.macros
.TH unset n 8.4 Tcl "Tcl Built-In Commands"
.BS
@@ -15,7 +13,7 @@
.SH NAME
unset \- Delete variables
.SH SYNOPSIS
-\fBunset \fR?\fI\-nocomplain\fR? ?\fI\-\-\fR? ?\fIname name name ...\fR?
+\fBunset \fR?\fB\-nocomplain\fR? ?\fB\-\-\fR? ?\fIname name name ...\fR?
.BE
.SH DESCRIPTION
.PP
@@ -27,9 +25,9 @@ element is removed without affecting the rest of the array.
If a \fIname\fR consists of an array name with no parenthesized
index, then the entire array is deleted.
The \fBunset\fR command returns an empty string as result.
-If \fI\-nocomplain\fR is specified as the first argument, any possible
+If \fB\-nocomplain\fR is specified as the first argument, any possible
errors are suppressed. The option may not be abbreviated, in order to
-disambiguate it from possible variable names. The option \fI\-\-\fR
+disambiguate it from possible variable names. The option \fB\-\-\fR
indicates the end of the options, and should be used if you wish to
remove a variable with the same name as any of the options.
If an error occurs during variable deletion, any variables after the named one
diff --git a/doc/update.n b/doc/update.n
index 64adf34..0c77c5f 100644
--- a/doc/update.n
+++ b/doc/update.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: update.n,v 1.12 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH update n 7.5 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/uplevel.n b/doc/uplevel.n
index 016848b..6c8a957 100644
--- a/doc/uplevel.n
+++ b/doc/uplevel.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: uplevel.n,v 1.12 2010/01/13 12:08:30 dkf Exp $
-'\"
.so man.macros
.TH uplevel n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/upvar.n b/doc/upvar.n
index 02a475d..60e5324 100644
--- a/doc/upvar.n
+++ b/doc/upvar.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: upvar.n,v 1.21 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH upvar n "" Tcl "Tcl Built-In Commands"
.BS
@@ -23,8 +21,7 @@ This command arranges for one or more local variables in the current
procedure to refer to variables in an enclosing procedure call or
to global variables.
\fILevel\fR may have any of the forms permitted for the \fBuplevel\fR
-command, and may be omitted if the first letter of the first \fIotherVar\fR
-is not \fB#\fR or a digit (it defaults to \fB1\fR).
+command, and may be omitted (it defaults to \fB1\fR).
For each \fIotherVar\fR argument, \fBupvar\fR makes the variable
by that name in the procedure frame given by \fIlevel\fR (or at
global level, if \fIlevel\fR is \fB#0\fR) accessible
diff --git a/doc/variable.n b/doc/variable.n
index 5497977..96263b6 100644
--- a/doc/variable.n
+++ b/doc/variable.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: variable.n,v 1.12 2008/10/17 10:22:25 dkf Exp $
-'\"
.so man.macros
.TH variable n 8.0 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/vwait.n b/doc/vwait.n
index d3c62ae..38a8081 100644
--- a/doc/vwait.n
+++ b/doc/vwait.n
@@ -4,8 +4,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: vwait.n,v 1.14 2010/01/20 13:42:17 dkf Exp $
-'\"
.so man.macros
.TH vwait n 8.0 Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/while.n b/doc/while.n
index 03ae3cf..5416e25 100644
--- a/doc/while.n
+++ b/doc/while.n
@@ -5,8 +5,6 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: while.n,v 1.7 2010/01/14 14:52:17 dkf Exp $
-'\"
.so man.macros
.TH while n "" Tcl "Tcl Built-In Commands"
.BS
diff --git a/doc/zlib.n b/doc/zlib.n
index f633cea..951b713 100644
--- a/doc/zlib.n
+++ b/doc/zlib.n
@@ -1,11 +1,9 @@
'\"
-'\" Copyright (c) 2008 Donal K. Fellows
+'\" Copyright (c) 2008-2012 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: zlib.n,v 1.9 2010/02/10 23:17:06 dkf Exp $
-'\"
.so man.macros
.TH zlib n 8.6 Tcl "Tcl Built-In Commands"
.BS
@@ -172,6 +170,13 @@ the
.QW "\fIoptions ...\fR"
to the \fBzlib push\fR command:
.TP
+\fB\-dictionary\fI binData\fR
+.VS "TIP 400"
+Sets the compression dictionary to use when working with compressing or
+decompressing the data to be \fIbinData\fR. Not valid for transformations that
+work with gzip-format data.
+.VE
+.TP
\fB\-header\fI dictionary\fR
.
Passes a description of the gzip header to create, in the same format that
@@ -181,15 +186,33 @@ Passes a description of the gzip header to create, in the same format that
.
How hard to compress the data. Must be an integer from 0 (uncompressed) to 9
(maximally compressed).
-'\".TP
-'\"\fB\-limit\fI readaheadLimit\fR
-'\".
-'\"The maximum number of bytes ahead to read.
-'\"\fITODO: not yet implemented!\fR
+.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.
.PP
Both compressing and decompressing channel transformations add extra
-configuration options that may be accessed through \fBchan configure\fR. Each
-option is either a read-only or a write-only option. The options are:
+configuration options that may be accessed through \fBchan configure\fR. The
+options are:
+.TP
+\fB\-checksum\fI checksum\fR
+.
+This read-only option gets the current checksum for the uncompressed data that
+the compression engine has seen so far. It is valid for both compressing and
+decompressing transforms, but not for the raw inflate and deflate formats. The
+compression algorithm depends on what format is being produced or consumed.
+.TP
+\fB\-dictionary\fI binData\fR
+.VS "TIP 400"
+This read-write options gets or sets the compression dictionary to use when
+working with compressing or decompressing the data to be \fIbinData\fR. It is
+not valid for transformations that work with gzip-format data, and should not
+normally be set on compressing transformations other than at the point where
+the transformation is stacked.
+.VE
.TP
\fB\-flush\fI type\fR
.
@@ -200,62 +223,80 @@ expensive flush respectively. Flushing degrades the compression ratio, but
makes it easier for a decompressor to recover more of the file in the case of
data corruption.
.TP
-\fB\-checksum\fR
-.
-This read-only option, valid for both compressing and decompressing
-transforms, gets the current checksum for the uncompressed data that the
-compression engine has seen so far. The compression algorithm depends on what
-format is being produced or consumed.
-.TP
-\fB\-header\fR
+\fB\-header\fI dictionary\fR
.
This read-only option, only valid for decompressing transforms that are
processing gzip-format data, returns the dictionary describing the header read
off the data stream.
+.TP
+\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.
.RE
.SS "STREAMING SUBCOMMAND"
.TP
-\fBzlib stream\fI mode\fR ?\fIlevel\fR?
+\fBzlib stream\fI mode\fR ?\fIoptions\fR?
.
Creates a streaming compression or decompression command based on the
\fImode\fR, and return the name of the command. For a description of how that
command works, see \fBSTREAMING INSTANCE COMMAND\fR below. The following modes
-are supported:
+and \fIoptions\fR are supported:
.RS
.TP
-\fBzlib stream compress\fR ?\fIlevel\fR?
+\fBzlib stream compress\fR ?\fB\-dictionary \fIbindata\fR? ?\fB\-level \fIlevel\fR?
.
The stream will be a compressing stream that produces zlib-format output,
using compression level \fIlevel\fR (if specified) which will be an integer
-from 0 to 9.
+from 0 to 9,
+.VS "TIP 400"
+and the compression dictionary \fIbindata\fR (if specified).
+.VE
.TP
-\fBzlib stream decompress\fR
+\fBzlib stream decompress\fR ?\fB\-dictionary \fIbindata\fR?
.
The stream will be a decompressing stream that takes zlib-format input and
produces uncompressed output.
+.VS "TIP 400"
+If \fIbindata\fR is supplied, it is a compression dictionary to use if
+required.
+.VE
.TP
-\fBzlib stream deflate\fR ?\fIlevel\fR?
+\fBzlib stream deflate\fR ?\fB\-dictionary \fIbindata\fR? ?\fB\-level \fIlevel\fR?
.
The stream will be a compressing stream that produces raw output, using
compression level \fIlevel\fR (if specified) which will be an integer from 0
-to 9.
+to 9,
+.VS "TIP 400"
+and the compression dictionary \fIbindata\fR (if specified). Note that
+the raw compressed data includes no metadata about what compression
+dictionary was used, if any; that is a feature of the zlib-format data.
+.VE
.TP
\fBzlib stream gunzip\fR
.
The stream will be a decompressing stream that takes gzip-format input and
produces uncompressed output.
.TP
-\fBzlib stream gzip\fR ?\fIlevel\fR?
+\fBzlib stream gzip\fR ?\fB\-header \fIheader\fR? ?\fB\-level \fIlevel\fR?
.
The stream will be a compressing stream that produces gzip-format output,
using compression level \fIlevel\fR (if specified) which will be an integer
-from 0 to 9.
-'\" TODO: Header dictionary!
+from 0 to 9, and the header descriptor dictionary \fIheader\fR (if specified;
+for keys see \fBzlib gzip\fR).
.TP
-\fBzlib stream inflate\fR
+\fBzlib stream inflate\fR ?\fB\-dictionary \fIbindata\fR?
.
The stream will be a decompressing stream that takes raw compressed input and
produces uncompressed output.
+.VS "TIP 400"
+If \fIbindata\fR is supplied, it is a compression dictionary to use. Note that
+there are no checks in place to determine whether the compression dictionary
+is correct.
+.VE
.RE
.SS "CHECKSUMMING SUBCOMMANDS"
.TP
@@ -278,10 +319,10 @@ the transformed data.
The full set of subcommands supported by a streaming instance command,
\fIstream\fR, is as follows:
.TP
-\fIstream \fBadd\fR ?\fIoption\fR? \fIdata\fR
+\fIstream \fBadd\fR ?\fIoption...\fR? \fIdata\fR
.
A short-cut for
-.QW "\fIstream \fBput \fIoption data\fR"
+.QW "\fIstream \fBput \fR?\fIoption...\fR? \fIdata\fR"
followed by
.QW "\fIstream \fBget\fR" .
.TP
@@ -319,15 +360,27 @@ A short-cut for
Return up to \fIcount\fR bytes from \fIstream\fR's internal buffers with the
transformation applied. If \fIcount\fR is omitted, the entire contents of the
buffers are returned.
+.
+\fIstream \fBheader\fR
+.
+Return the gzip header description dictionary extracted from the stream. Only
+supported for streams created with their \fImode\fR parameter set to
+\fBgunzip\fR.
.TP
-\fIstream \fBput\fR ?\fIoption\fR? \fIdata\fR
+\fIstream \fBput\fR ?\fIoption...\fR? \fIdata\fR
.
Append the contents of the binary string \fIdata\fR to \fIstream\fR's internal
-buffers while applying the transformation. If present, \fIoption\fR must be
-one of the following (or an unambiguous prefix) which are used to modify the
+buffers while applying the transformation. The following \fIoption\fRs are
+supported (or an unambiguous prefix of them), which are used to modify the
way in which the transformation is applied:
.RS
.TP
+\fB\-dictionary\fI binData\fR
+.VS "TIP 400"
+Sets the compression dictionary to use when working with compressing or
+decompressing the data to be \fIbinData\fR.
+.VE
+.TP
\fB\-finalize\fR
.
Mark the stream as finished, ensuring that all bytes have been wholly
@@ -335,12 +388,22 @@ compressed or decompressed. For gzip streams, this also ensures that the
footer is written to the stream. The stream will need to be reset before
having more data written to it after this, though data can still be read out
of the stream with the \fBget\fR subcommand.
+.RS
+.PP
+This option is mutually exclusive with the \fB\-flush\fR and \fB\-fullflush\fR
+options.
+.RE
.TP
\fB\-flush\fR
.
Ensure that a decompressor consuming the bytes that the current (compressing)
stream is producing will be able to produce all the bytes that have been
compressed so far, at some performance penalty.
+.RS
+.PP
+This option is mutually exclusive with the \fB\-finalize\fR and
+\fB\-fullflush\fR options.
+.RE
.TP
\fB\-fullflush\fR
.
@@ -348,6 +411,11 @@ Ensure that not only can a decompressor handle all the bytes produced so far
(as with \fB\-flush\fR above) but also that it can restart from this point if
it detects that the stream is partially corrupt. This incurs a substantial
performance penalty.
+.RS
+.PP
+This option is mutually exclusive with the \fB\-finalize\fR and \fB\-flush\fR
+options.
+.RE
.RE
.TP
\fIstream \fBreset\fR
@@ -386,7 +454,7 @@ $\fIstrm \fBclose\fR
.SH "SEE ALSO"
binary(n), chan(n), encoding(n), Tcl_ZlibDeflate(3), RFC1950 \- RFC1952
.SH "KEYWORDS"
-compress, decompress, deflate, gzip, inflate
+compress, decompress, deflate, gzip, inflate, zlib
'\" Local Variables:
'\" mode: nroff
'\" End:
diff --git a/generic/README b/generic/README
index 0faffb9..d1c078e 100644
--- a/generic/README
+++ b/generic/README
@@ -1,5 +1,3 @@
This directory contains Tcl source files that work on all the platforms
where Tcl runs (e.g. UNIX, PCs, and MacOSX). Platform-specific
sources are in the directories ../unix, ../win, and ../macosx.
-
-RCS: @(#) $Id: README,v 1.3 2004/03/17 18:14:12 das Exp $
diff --git a/generic/regc_lex.c b/generic/regc_lex.c
index f3a46da..132e757 100644
--- a/generic/regc_lex.c
+++ b/generic/regc_lex.c
@@ -742,6 +742,7 @@ lexescape(
struct vars *v)
{
chr c;
+ int i;
static const chr alert[] = {
CHR('a'), CHR('l'), CHR('e'), CHR('r'), CHR('t')
};
@@ -818,18 +819,23 @@ lexescape(
RETV(PLAIN, CHR('\t'));
break;
case CHR('u'):
- c = lexdigits(v, 16, 4, 4);
+ c = (uchr) lexdigits(v, 16, 1, 4);
if (ISERR()) {
FAILW(REG_EESCAPE);
}
RETV(PLAIN, c);
break;
case CHR('U'):
- c = lexdigits(v, 16, 8, 8);
+ i = lexdigits(v, 16, 1, 8);
if (ISERR()) {
FAILW(REG_EESCAPE);
}
- RETV(PLAIN, c);
+ if (i > 0xFFFF) {
+ /* TODO: output a Surrogate pair
+ */
+ i = 0xFFFD;
+ }
+ RETV(PLAIN, (uchr) i);
break;
case CHR('v'):
RETV(PLAIN, CHR('\v'));
@@ -844,7 +850,7 @@ lexescape(
break;
case CHR('x'):
NOTE(REG_UUNPORT);
- c = lexdigits(v, 16, 1, 255); /* REs >255 long outside spec */
+ c = (uchr) lexdigits(v, 16, 1, 2);
if (ISERR()) {
FAILW(REG_EESCAPE);
}
@@ -866,7 +872,7 @@ lexescape(
case CHR('9'):
save = v->now;
v->now--; /* put first digit back */
- c = lexdigits(v, 10, 1, 255); /* REs >255 long outside spec */
+ c = (uchr) lexdigits(v, 10, 1, 255); /* REs >255 long outside spec */
if (ISERR()) {
FAILW(REG_EESCAPE);
}
@@ -893,10 +899,15 @@ lexescape(
case CHR('0'):
NOTE(REG_UUNPORT);
v->now--; /* put first digit back */
- c = lexdigits(v, 8, 1, 3);
+ c = (uchr) lexdigits(v, 8, 1, 3);
if (ISERR()) {
FAILW(REG_EESCAPE);
}
+ if (c > 0xff) {
+ /* out of range, so we handled one digit too much */
+ v->now--;
+ c >>= 3;
+ }
RETV(PLAIN, c);
break;
default:
@@ -909,16 +920,16 @@ lexescape(
/*
- lexdigits - slurp up digits and return chr value
- ^ static chr lexdigits(struct vars *, int, int, int);
+ ^ static int lexdigits(struct vars *, int, int, int);
*/
-static chr /* chr value; errors signalled via ERR */
+static int /* chr value; errors signalled via ERR */
lexdigits(
struct vars *v,
int base,
int minlen,
int maxlen)
{
- uchr n; /* unsigned to avoid overflow misbehavior */
+ int n;
int len;
chr c;
int d;
@@ -926,6 +937,10 @@ lexdigits(
n = 0;
for (len = 0; len < maxlen && !ATEOS(); len++) {
+ if (n > 0x10fff) {
+ /* Stop when continuing would otherwise overflow */
+ break;
+ }
c = *v->now++;
switch (c) {
case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
@@ -958,7 +973,7 @@ lexdigits(
ERR(REG_EESCAPE);
}
- return (chr)n;
+ return n;
}
/*
diff --git a/generic/regc_locale.c b/generic/regc_locale.c
index 98df798..f3db471 100644
--- a/generic/regc_locale.c
+++ b/generic/regc_locale.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: regc_locale.c,v 1.21 2008/10/16 22:34:18 nijtmans Exp $
*/
/* ASCII character-name table */
@@ -131,84 +129,172 @@ typedef struct crange {
* and used in generic/regc_locale.c. Do not modify by hand.
*/
-/* Unicode: alphabetic characters */
+/*
+ * Unicode: alphabetic characters.
+ */
static const crange alphaRangeTable[] = {
- {0x0041, 0x005a}, {0x0061, 0x007a}, {0x00c0, 0x00d6}, {0x00d8, 0x00f6},
- {0x00f8, 0x021f}, {0x0222, 0x0233}, {0x0250, 0x02ad}, {0x02b0, 0x02b8},
- {0x02bb, 0x02c1}, {0x02e0, 0x02e4}, {0x0388, 0x038a}, {0x038e, 0x03a1},
- {0x03a3, 0x03ce}, {0x03d0, 0x03d7}, {0x03da, 0x03f5}, {0x0400, 0x0481},
- {0x048c, 0x04c4}, {0x04d0, 0x04f5}, {0x0531, 0x0556}, {0x0561, 0x0587},
- {0x05d0, 0x05ea}, {0x05f0, 0x05f2}, {0x0621, 0x063a}, {0x0640, 0x064a},
- {0x0671, 0x06d3}, {0x06fa, 0x06fc}, {0x0712, 0x072c}, {0x0780, 0x07a5},
- {0x0905, 0x0939}, {0x0958, 0x0961}, {0x0985, 0x098c}, {0x0993, 0x09a8},
- {0x09aa, 0x09b0}, {0x09b6, 0x09b9}, {0x09df, 0x09e1}, {0x0a05, 0x0a0a},
- {0x0a13, 0x0a28}, {0x0a2a, 0x0a30}, {0x0a59, 0x0a5c}, {0x0a72, 0x0a74},
- {0x0a85, 0x0a8b}, {0x0a8f, 0x0a91}, {0x0a93, 0x0aa8}, {0x0aaa, 0x0ab0},
- {0x0ab5, 0x0ab9}, {0x0b05, 0x0b0c}, {0x0b13, 0x0b28}, {0x0b2a, 0x0b30},
- {0x0b36, 0x0b39}, {0x0b5f, 0x0b61}, {0x0b85, 0x0b8a}, {0x0b8e, 0x0b90},
- {0x0b92, 0x0b95}, {0x0ba8, 0x0baa}, {0x0bae, 0x0bb5}, {0x0bb7, 0x0bb9},
- {0x0c05, 0x0c0c}, {0x0c0e, 0x0c10}, {0x0c12, 0x0c28}, {0x0c2a, 0x0c33},
- {0x0c35, 0x0c39}, {0x0c85, 0x0c8c}, {0x0c8e, 0x0c90}, {0x0c92, 0x0ca8},
- {0x0caa, 0x0cb3}, {0x0cb5, 0x0cb9}, {0x0d05, 0x0d0c}, {0x0d0e, 0x0d10},
- {0x0d12, 0x0d28}, {0x0d2a, 0x0d39}, {0x0d85, 0x0d96}, {0x0d9a, 0x0db1},
- {0x0db3, 0x0dbb}, {0x0dc0, 0x0dc6}, {0x0e01, 0x0e30}, {0x0e40, 0x0e46},
- {0x0e94, 0x0e97}, {0x0e99, 0x0e9f}, {0x0ea1, 0x0ea3}, {0x0ead, 0x0eb0},
- {0x0ec0, 0x0ec4}, {0x0f40, 0x0f47}, {0x0f49, 0x0f6a}, {0x0f88, 0x0f8b},
- {0x1000, 0x1021}, {0x1023, 0x1027}, {0x1050, 0x1055}, {0x10a0, 0x10c5},
- {0x10d0, 0x10f6}, {0x1100, 0x1159}, {0x115f, 0x11a2}, {0x11a8, 0x11f9},
- {0x1200, 0x1206}, {0x1208, 0x1246}, {0x124a, 0x124d}, {0x1250, 0x1256},
- {0x125a, 0x125d}, {0x1260, 0x1286}, {0x128a, 0x128d}, {0x1290, 0x12ae},
- {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12ce},
- {0x12d0, 0x12d6}, {0x12d8, 0x12ee}, {0x12f0, 0x130e}, {0x1312, 0x1315},
- {0x1318, 0x131e}, {0x1320, 0x1346}, {0x1348, 0x135a}, {0x13a0, 0x13f4},
- {0x1401, 0x166c}, {0x166f, 0x1676}, {0x1681, 0x169a}, {0x16a0, 0x16ea},
- {0x1780, 0x17b3}, {0x1820, 0x1877}, {0x1880, 0x18a8}, {0x1e00, 0x1e9b},
- {0x1ea0, 0x1ef9}, {0x1f00, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
- {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
- {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3},
- {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc},
- {0x210a, 0x2113}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2131},
- {0x2133, 0x2139}, {0x3031, 0x3035}, {0x3041, 0x3094}, {0x30a1, 0x30fa},
- {0x30fc, 0x30fe}, {0x3105, 0x312c}, {0x3131, 0x318e}, {0x31a0, 0x31b7},
- {0x3400, 0x4db5}, {0x4e00, 0x9fa5}, {0xa000, 0xa48c}, {0xac00, 0xd7a3},
- {0xf900, 0xfa2d}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28},
- {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d},
- {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe72},
- {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a}, {0xff66, 0xffbe},
- {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}
+ {0x41, 0x5a}, {0x61, 0x7a}, {0xc0, 0xd6}, {0xd8, 0xf6},
+ {0xf8, 0x2c1}, {0x2c6, 0x2d1}, {0x2e0, 0x2e4}, {0x370, 0x374},
+ {0x37a, 0x37d}, {0x388, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x3f5},
+ {0x3f7, 0x481}, {0x48a, 0x527}, {0x531, 0x556}, {0x561, 0x587},
+ {0x5d0, 0x5ea}, {0x5f0, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
+ {0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea},
+ {0x800, 0x815}, {0x840, 0x858}, {0x8a2, 0x8ac}, {0x904, 0x939},
+ {0x958, 0x961}, {0x971, 0x977}, {0x979, 0x97f}, {0x985, 0x98c},
+ {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1},
+ {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c},
+ {0xa72, 0xa74}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8},
+ {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28},
+ {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a},
+ {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9},
+ {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc33},
+ {0xc35, 0xc39}, {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8},
+ {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
+ {0xd12, 0xd3a}, {0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1},
+ {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46},
+ {0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb0},
+ {0xec0, 0xec4}, {0xedc, 0xedf}, {0xf40, 0xf47}, {0xf49, 0xf6c},
+ {0xf88, 0xf8c}, {0x1000, 0x102a}, {0x1050, 0x1055}, {0x105a, 0x105d},
+ {0x106e, 0x1070}, {0x1075, 0x1081}, {0x10a0, 0x10c5}, {0x10d0, 0x10fa},
+ {0x10fc, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d},
+ {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5},
+ {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310},
+ {0x1312, 0x1315}, {0x1318, 0x135a}, {0x1380, 0x138f}, {0x13a0, 0x13f4},
+ {0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea},
+ {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751},
+ {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1877},
+ {0x1880, 0x18a8}, {0x18b0, 0x18f5}, {0x1900, 0x191c}, {0x1950, 0x196d},
+ {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19c1, 0x19c7}, {0x1a00, 0x1a16},
+ {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, {0x1b45, 0x1b4b}, {0x1b83, 0x1ba0},
+ {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d},
+ {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15},
+ {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
+ {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4},
+ {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec},
+ {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113},
+ {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f},
+ {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4},
+ {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96},
+ {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe},
+ {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde},
+ {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa},
+ {0x30fc, 0x30ff}, {0x3105, 0x312d}, {0x3131, 0x318e}, {0x31a0, 0x31ba},
+ {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fcc}, {0xa000, 0xa48c},
+ {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e},
+ {0xa67f, 0xa697}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788},
+ {0xa78b, 0xa78e}, {0xa790, 0xa793}, {0xa7a0, 0xa7aa}, {0xa7f8, 0xa801},
+ {0xa803, 0xa805}, {0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873},
+ {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946},
+ {0xa960, 0xa97c}, {0xa984, 0xa9b2}, {0xaa00, 0xaa28}, {0xaa40, 0xaa42},
+ {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa80, 0xaaaf}, {0xaab9, 0xaabd},
+ {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4}, {0xab01, 0xab06},
+ {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
+ {0xabc0, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
+ {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
+ {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1},
+ {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb},
+ {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a},
+ {0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7},
+ {0xffda, 0xffdc}
+#if TCL_UTF_MAX > 4
+ ,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
+ {0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0},
+ {0x10300, 0x1031e}, {0x10330, 0x10340}, {0x10342, 0x10349}, {0x10380, 0x1039d},
+ {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d}, {0x10800, 0x10805},
+ {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10900, 0x10915}, {0x10920, 0x10939},
+ {0x10980, 0x109b7}, {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33},
+ {0x10a60, 0x10a7c}, {0x10b00, 0x10b35}, {0x10b40, 0x10b55}, {0x10b60, 0x10b72},
+ {0x10c00, 0x10c48}, {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8},
+ {0x11103, 0x11126}, {0x11183, 0x111b2}, {0x111c1, 0x111c4}, {0x11680, 0x116aa},
+ {0x12000, 0x1236e}, {0x13000, 0x1342e}, {0x16800, 0x16a38}, {0x16f00, 0x16f44},
+ {0x16f93, 0x16f9f}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
+ {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
+ {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
+ {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0},
+ {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734},
+ {0x1d736, 0x1d74e}, {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8},
+ {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7cb}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f},
+ {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a},
+ {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89},
+ {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb},
+ {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2f800, 0x2fa1d}
+#endif
};
#define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange))
static const chr alphaCharTable[] = {
- 0x00aa, 0x00b5, 0x00ba, 0x02d0, 0x02d1, 0x02ee, 0x037a, 0x0386, 0x038c,
- 0x04c7, 0x04c8, 0x04cb, 0x04cc, 0x04f8, 0x04f9, 0x0559, 0x06d5, 0x06e5,
- 0x06e6, 0x0710, 0x093d, 0x0950, 0x098f, 0x0990, 0x09b2, 0x09dc, 0x09dd,
- 0x09f0, 0x09f1, 0x0a0f, 0x0a10, 0x0a32, 0x0a33, 0x0a35, 0x0a36, 0x0a38,
- 0x0a39, 0x0a5e, 0x0a8d, 0x0ab2, 0x0ab3, 0x0abd, 0x0ad0, 0x0ae0, 0x0b0f,
- 0x0b10, 0x0b32, 0x0b33, 0x0b3d, 0x0b5c, 0x0b5d, 0x0b99, 0x0b9a, 0x0b9c,
- 0x0b9e, 0x0b9f, 0x0ba3, 0x0ba4, 0x0c60, 0x0c61, 0x0cde, 0x0ce0, 0x0ce1,
- 0x0d60, 0x0d61, 0x0dbd, 0x0e32, 0x0e33, 0x0e81, 0x0e82, 0x0e84, 0x0e87,
- 0x0e88, 0x0e8a, 0x0e8d, 0x0ea5, 0x0ea7, 0x0eaa, 0x0eab, 0x0eb2, 0x0eb3,
- 0x0ebd, 0x0ec6, 0x0edc, 0x0edd, 0x0f00, 0x1029, 0x102a, 0x1248, 0x1258,
- 0x1288, 0x12b0, 0x12c0, 0x1310, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x207f,
- 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x3005, 0x3006, 0x309d,
- 0x309e, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfe74, 0xfffe
+ 0xaa, 0xb5, 0xba, 0x2ec, 0x2ee, 0x376, 0x377, 0x386, 0x38c,
+ 0x559, 0x66e, 0x66f, 0x6d5, 0x6e5, 0x6e6, 0x6ee, 0x6ef, 0x6ff,
+ 0x710, 0x7b1, 0x7f4, 0x7f5, 0x7fa, 0x81a, 0x824, 0x828, 0x8a0,
+ 0x93d, 0x950, 0x98f, 0x990, 0x9b2, 0x9bd, 0x9ce, 0x9dc, 0x9dd,
+ 0x9f0, 0x9f1, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38,
+ 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1, 0xb0f,
+ 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71, 0xb83, 0xb99,
+ 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xc3d, 0xc58,
+ 0xc59, 0xc60, 0xc61, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, 0xcf2,
+ 0xd3d, 0xd4e, 0xd60, 0xd61, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82,
+ 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
+ 0xeb2, 0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066,
+ 0x108e, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7,
+ 0x1bae, 0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071,
+ 0x207f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183,
+ 0x2184, 0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006,
+ 0x303b, 0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5,
+ 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
+#if TCL_UTF_MAX > 4
+ ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x109be, 0x109bf, 0x10a00,
+ 0x16f50, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb,
+ 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47,
+ 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d,
+ 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
+#endif
};
#define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr))
/*
- * Unicode: decimal digit characters
+ * Unicode: control characters.
+ */
+
+static const crange controlRangeTable[] = {
+ {0x7f, 0x9f}, {0x600, 0x604}, {0x200b, 0x200f}, {0x202a, 0x202e},
+ {0x2060, 0x2064}, {0x206a, 0x206f}, {0xe000, 0xf8ff}, {0xfff9, 0xfffb}
+#if TCL_UTF_MAX > 4
+ ,{0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd}, {0x100000, 0x10fffd}
+#endif
+};
+
+#define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange))
+
+static const chr controlCharTable[] = {
+ 0xad, 0x6dd, 0x70f, 0xfeff
+#if TCL_UTF_MAX > 4
+ ,0x110bd, 0xe0001
+#endif
+};
+
+#define NUM_CONTROL_CHAR (sizeof(controlCharTable)/sizeof(chr))
+
+/*
+ * Unicode: decimal digit characters.
*/
static const crange digitRangeTable[] = {
- {0x0030, 0x0039}, {0x0660, 0x0669}, {0x06f0, 0x06f9}, {0x0966, 0x096f},
- {0x09e6, 0x09ef}, {0x0a66, 0x0a6f}, {0x0ae6, 0x0aef}, {0x0b66, 0x0b6f},
- {0x0be7, 0x0bef}, {0x0c66, 0x0c6f}, {0x0ce6, 0x0cef}, {0x0d66, 0x0d6f},
- {0x0e50, 0x0e59}, {0x0ed0, 0x0ed9}, {0x0f20, 0x0f29}, {0x1040, 0x1049},
- {0x1369, 0x1371}, {0x17e0, 0x17e9}, {0x1810, 0x1819}, {0xff10, 0xff19}
+ {0x30, 0x39}, {0x660, 0x669}, {0x6f0, 0x6f9}, {0x7c0, 0x7c9},
+ {0x966, 0x96f}, {0x9e6, 0x9ef}, {0xa66, 0xa6f}, {0xae6, 0xaef},
+ {0xb66, 0xb6f}, {0xbe6, 0xbef}, {0xc66, 0xc6f}, {0xce6, 0xcef},
+ {0xd66, 0xd6f}, {0xe50, 0xe59}, {0xed0, 0xed9}, {0xf20, 0xf29},
+ {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17e0, 0x17e9}, {0x1810, 0x1819},
+ {0x1946, 0x194f}, {0x19d0, 0x19d9}, {0x1a80, 0x1a89}, {0x1a90, 0x1a99},
+ {0x1b50, 0x1b59}, {0x1bb0, 0x1bb9}, {0x1c40, 0x1c49}, {0x1c50, 0x1c59},
+ {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909}, {0xa9d0, 0xa9d9},
+ {0xaa50, 0xaa59}, {0xabf0, 0xabf9}, {0xff10, 0xff19}
+#if TCL_UTF_MAX > 4
+ ,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f},
+ {0x111d0, 0x111d9}, {0x116c0, 0x116c9}, {0x1d7ce, 0x1d7ff}
+#endif
};
#define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange))
@@ -222,25 +308,43 @@ static const crange digitRangeTable[] = {
*/
static const crange punctRangeTable[] = {
- {0x0021, 0x0023}, {0x0025, 0x002a}, {0x002c, 0x002f}, {0x005b, 0x005d},
- {0x055a, 0x055f}, {0x066a, 0x066d}, {0x0700, 0x070d}, {0x0f04, 0x0f12},
- {0x0f3a, 0x0f3d}, {0x104a, 0x104f}, {0x1361, 0x1368}, {0x16eb, 0x16ed},
- {0x17d4, 0x17da}, {0x1800, 0x180a}, {0x2010, 0x2027}, {0x2030, 0x2043},
- {0x2048, 0x204d}, {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f},
- {0xfe30, 0xfe44}, {0xfe49, 0xfe52}, {0xfe54, 0xfe61}, {0xff01, 0xff03},
- {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, {0xff61, 0xff65}
+ {0x21, 0x23}, {0x25, 0x2a}, {0x2c, 0x2f}, {0x5b, 0x5d},
+ {0x55a, 0x55f}, {0x66a, 0x66d}, {0x700, 0x70d}, {0x7f7, 0x7f9},
+ {0x830, 0x83e}, {0xf04, 0xf12}, {0xf3a, 0xf3d}, {0xfd0, 0xfd4},
+ {0x104a, 0x104f}, {0x1360, 0x1368}, {0x16eb, 0x16ed}, {0x17d4, 0x17d6},
+ {0x17d8, 0x17da}, {0x1800, 0x180a}, {0x1aa0, 0x1aa6}, {0x1aa8, 0x1aad},
+ {0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7},
+ {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e},
+ {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998}, {0x29d8, 0x29db},
+ {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e3b}, {0x3001, 0x3003},
+ {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f}, {0xa6f2, 0xa6f7},
+ {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd}, {0xaa5c, 0xaa5f},
+ {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61}, {0xff01, 0xff03},
+ {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, {0xff5f, 0xff65}
+#if TCL_UTF_MAX > 4
+ ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10b39, 0x10b3f}, {0x11047, 0x1104d},
+ {0x110be, 0x110c1}, {0x11140, 0x11143}, {0x111c5, 0x111c8}, {0x12470, 0x12473}
+#endif
};
#define NUM_PUNCT_RANGE (sizeof(punctRangeTable)/sizeof(crange))
static const chr punctCharTable[] = {
- 0x003a, 0x003b, 0x003f, 0x0040, 0x005f, 0x007b, 0x007d, 0x00a1, 0x00ab,
- 0x00ad, 0x00b7, 0x00bb, 0x00bf, 0x037e, 0x0387, 0x0589, 0x058a, 0x05be,
- 0x05c0, 0x05c3, 0x05f3, 0x05f4, 0x060c, 0x061b, 0x061f, 0x06d4, 0x0964,
- 0x0965, 0x0970, 0x0df4, 0x0e4f, 0x0e5a, 0x0e5b, 0x0f85, 0x10fb, 0x166d,
- 0x166e, 0x169b, 0x169c, 0x17dc, 0x2045, 0x2046, 0x207d, 0x207e, 0x208d,
- 0x208e, 0x2329, 0x232a, 0x3030, 0x30fb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68,
- 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
+ 0x3a, 0x3b, 0x3f, 0x40, 0x5f, 0x7b, 0x7d, 0xa1, 0xa7,
+ 0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a,
+ 0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c,
+ 0x60d, 0x61b, 0x61e, 0x61f, 0x6d4, 0x85e, 0x964, 0x965, 0x970,
+ 0xaf0, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14, 0xf85, 0xfd9, 0xfda,
+ 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c, 0x1735, 0x1736, 0x1944,
+ 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, 0x207d, 0x207e, 0x208d,
+ 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, 0x29fd, 0x2cfe, 0x2cff,
+ 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, 0xa4ff, 0xa673, 0xa67e,
+ 0xa8ce, 0xa8cf, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df, 0xaade, 0xaadf,
+ 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68, 0xfe6a, 0xfe6b,
+ 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
+#if TCL_UTF_MAX > 4
+ ,0x1039f, 0x103d0, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc
+#endif
};
#define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr))
@@ -250,75 +354,113 @@ static const chr punctCharTable[] = {
*/
static const crange spaceRangeTable[] = {
- {0x0009, 0x000d}, {0x2000, 0x200b}
+ {0x9, 0xd}, {0x2000, 0x200b}
};
#define NUM_SPACE_RANGE (sizeof(spaceRangeTable)/sizeof(crange))
static const chr spaceCharTable[] = {
- 0x0020, 0x00a0, 0x1680, 0x2028, 0x2029, 0x202f, 0x3000
+ 0x20, 0x85, 0xa0, 0x1680, 0x180e, 0x2028, 0x2029, 0x202f, 0x205f,
+ 0x2060, 0x3000, 0xfeff
};
#define NUM_SPACE_CHAR (sizeof(spaceCharTable)/sizeof(chr))
/*
- * Unicode: lowercase characters
+ * Unicode: lowercase characters.
*/
static const crange lowerRangeTable[] = {
- {0x0061, 0x007a}, {0x00df, 0x00f6}, {0x00f8, 0x00ff}, {0x017e, 0x0180},
- {0x0199, 0x019b}, {0x01bd, 0x01bf}, {0x0250, 0x02ad}, {0x03ac, 0x03ce},
- {0x03d5, 0x03d7}, {0x03ef, 0x03f3}, {0x0430, 0x045f}, {0x0561, 0x0587},
- {0x1e95, 0x1e9b}, {0x1f00, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27},
- {0x1f30, 0x1f37}, {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67},
- {0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7},
- {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7},
- {0x1ff2, 0x1ff4}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
+ {0x61, 0x7a}, {0xdf, 0xf6}, {0xf8, 0xff}, {0x17e, 0x180},
+ {0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293},
+ {0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7},
+ {0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x1d00, 0x1d2b},
+ {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, {0x1eff, 0x1f07},
+ {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45},
+ {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87},
+ {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4},
+ {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149},
+ {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731},
+ {0xa771, 0xa778}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
+#if TCL_UTF_MAX > 4
+ ,{0x10428, 0x1044f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467},
+ {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf},
+ {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f},
+ {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f},
+ {0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714},
+ {0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788},
+ {0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}
+#endif
};
#define NUM_LOWER_RANGE (sizeof(lowerRangeTable)/sizeof(crange))
static const chr lowerCharTable[] = {
- 0x00aa, 0x00b5, 0x00ba, 0x0101, 0x0103, 0x0105, 0x0107, 0x0109, 0x010b,
- 0x010d, 0x010f, 0x0111, 0x0113, 0x0115, 0x0117, 0x0119, 0x011b, 0x011d,
- 0x011f, 0x0121, 0x0123, 0x0125, 0x0127, 0x0129, 0x012b, 0x012d, 0x012f,
- 0x0131, 0x0133, 0x0135, 0x0137, 0x0138, 0x013a, 0x013c, 0x013e, 0x0140,
- 0x0142, 0x0144, 0x0146, 0x0148, 0x0149, 0x014b, 0x014d, 0x014f, 0x0151,
- 0x0153, 0x0155, 0x0157, 0x0159, 0x015b, 0x015d, 0x015f, 0x0161, 0x0163,
- 0x0165, 0x0167, 0x0169, 0x016b, 0x016d, 0x016f, 0x0171, 0x0173, 0x0175,
- 0x0177, 0x017a, 0x017c, 0x0183, 0x0185, 0x0188, 0x018c, 0x018d, 0x0192,
- 0x0195, 0x019e, 0x01a1, 0x01a3, 0x01a5, 0x01a8, 0x01aa, 0x01ab, 0x01ad,
- 0x01b0, 0x01b4, 0x01b6, 0x01b9, 0x01ba, 0x01c6, 0x01c9, 0x01cc, 0x01ce,
- 0x01d0, 0x01d2, 0x01d4, 0x01d6, 0x01d8, 0x01da, 0x01dc, 0x01dd, 0x01df,
- 0x01e1, 0x01e3, 0x01e5, 0x01e7, 0x01e9, 0x01eb, 0x01ed, 0x01ef, 0x01f0,
- 0x01f3, 0x01f5, 0x01f9, 0x01fb, 0x01fd, 0x01ff, 0x0201, 0x0203, 0x0205,
- 0x0207, 0x0209, 0x020b, 0x020d, 0x020f, 0x0211, 0x0213, 0x0215, 0x0217,
- 0x0219, 0x021b, 0x021d, 0x021f, 0x0223, 0x0225, 0x0227, 0x0229, 0x022b,
- 0x022d, 0x022f, 0x0231, 0x0233, 0x0390, 0x03d0, 0x03d1, 0x03db, 0x03dd,
- 0x03df, 0x03e1, 0x03e3, 0x03e5, 0x03e7, 0x03e9, 0x03eb, 0x03ed, 0x03f5,
- 0x0461, 0x0463, 0x0465, 0x0467, 0x0469, 0x046b, 0x046d, 0x046f, 0x0471,
- 0x0473, 0x0475, 0x0477, 0x0479, 0x047b, 0x047d, 0x047f, 0x0481, 0x048d,
- 0x048f, 0x0491, 0x0493, 0x0495, 0x0497, 0x0499, 0x049b, 0x049d, 0x049f,
- 0x04a1, 0x04a3, 0x04a5, 0x04a7, 0x04a9, 0x04ab, 0x04ad, 0x04af, 0x04b1,
- 0x04b3, 0x04b5, 0x04b7, 0x04b9, 0x04bb, 0x04bd, 0x04bf, 0x04c2, 0x04c4,
- 0x04c8, 0x04cc, 0x04d1, 0x04d3, 0x04d5, 0x04d7, 0x04d9, 0x04db, 0x04dd,
- 0x04df, 0x04e1, 0x04e3, 0x04e5, 0x04e7, 0x04e9, 0x04eb, 0x04ed, 0x04ef,
- 0x04f1, 0x04f3, 0x04f5, 0x04f9, 0x1e01, 0x1e03, 0x1e05, 0x1e07, 0x1e09,
- 0x1e0b, 0x1e0d, 0x1e0f, 0x1e11, 0x1e13, 0x1e15, 0x1e17, 0x1e19, 0x1e1b,
- 0x1e1d, 0x1e1f, 0x1e21, 0x1e23, 0x1e25, 0x1e27, 0x1e29, 0x1e2b, 0x1e2d,
- 0x1e2f, 0x1e31, 0x1e33, 0x1e35, 0x1e37, 0x1e39, 0x1e3b, 0x1e3d, 0x1e3f,
- 0x1e41, 0x1e43, 0x1e45, 0x1e47, 0x1e49, 0x1e4b, 0x1e4d, 0x1e4f, 0x1e51,
- 0x1e53, 0x1e55, 0x1e57, 0x1e59, 0x1e5b, 0x1e5d, 0x1e5f, 0x1e61, 0x1e63,
- 0x1e65, 0x1e67, 0x1e69, 0x1e6b, 0x1e6d, 0x1e6f, 0x1e71, 0x1e73, 0x1e75,
- 0x1e77, 0x1e79, 0x1e7b, 0x1e7d, 0x1e7f, 0x1e81, 0x1e83, 0x1e85, 0x1e87,
- 0x1e89, 0x1e8b, 0x1e8d, 0x1e8f, 0x1e91, 0x1e93, 0x1ea1, 0x1ea3, 0x1ea5,
- 0x1ea7, 0x1ea9, 0x1eab, 0x1ead, 0x1eaf, 0x1eb1, 0x1eb3, 0x1eb5, 0x1eb7,
- 0x1eb9, 0x1ebb, 0x1ebd, 0x1ebf, 0x1ec1, 0x1ec3, 0x1ec5, 0x1ec7, 0x1ec9,
- 0x1ecb, 0x1ecd, 0x1ecf, 0x1ed1, 0x1ed3, 0x1ed5, 0x1ed7, 0x1ed9, 0x1edb,
- 0x1edd, 0x1edf, 0x1ee1, 0x1ee3, 0x1ee5, 0x1ee7, 0x1ee9, 0x1eeb, 0x1eed,
- 0x1eef, 0x1ef1, 0x1ef3, 0x1ef5, 0x1ef7, 0x1ef9, 0x1fb6, 0x1fb7, 0x1fbe,
- 0x1fc6, 0x1fc7, 0x1fd6, 0x1fd7, 0x1ff6, 0x1ff7, 0x207f, 0x210a, 0x210e,
- 0x210f, 0x2113, 0x212f, 0x2134, 0x2139
+ 0xb5, 0x101, 0x103, 0x105, 0x107, 0x109, 0x10b, 0x10d, 0x10f,
+ 0x111, 0x113, 0x115, 0x117, 0x119, 0x11b, 0x11d, 0x11f, 0x121,
+ 0x123, 0x125, 0x127, 0x129, 0x12b, 0x12d, 0x12f, 0x131, 0x133,
+ 0x135, 0x137, 0x138, 0x13a, 0x13c, 0x13e, 0x140, 0x142, 0x144,
+ 0x146, 0x148, 0x149, 0x14b, 0x14d, 0x14f, 0x151, 0x153, 0x155,
+ 0x157, 0x159, 0x15b, 0x15d, 0x15f, 0x161, 0x163, 0x165, 0x167,
+ 0x169, 0x16b, 0x16d, 0x16f, 0x171, 0x173, 0x175, 0x177, 0x17a,
+ 0x17c, 0x183, 0x185, 0x188, 0x18c, 0x18d, 0x192, 0x195, 0x19e,
+ 0x1a1, 0x1a3, 0x1a5, 0x1a8, 0x1aa, 0x1ab, 0x1ad, 0x1b0, 0x1b4,
+ 0x1b6, 0x1b9, 0x1ba, 0x1c6, 0x1c9, 0x1cc, 0x1ce, 0x1d0, 0x1d2,
+ 0x1d4, 0x1d6, 0x1d8, 0x1da, 0x1dc, 0x1dd, 0x1df, 0x1e1, 0x1e3,
+ 0x1e5, 0x1e7, 0x1e9, 0x1eb, 0x1ed, 0x1ef, 0x1f0, 0x1f3, 0x1f5,
+ 0x1f9, 0x1fb, 0x1fd, 0x1ff, 0x201, 0x203, 0x205, 0x207, 0x209,
+ 0x20b, 0x20d, 0x20f, 0x211, 0x213, 0x215, 0x217, 0x219, 0x21b,
+ 0x21d, 0x21f, 0x221, 0x223, 0x225, 0x227, 0x229, 0x22b, 0x22d,
+ 0x22f, 0x231, 0x23c, 0x23f, 0x240, 0x242, 0x247, 0x249, 0x24b,
+ 0x24d, 0x371, 0x373, 0x377, 0x390, 0x3d0, 0x3d1, 0x3d9, 0x3db,
+ 0x3dd, 0x3df, 0x3e1, 0x3e3, 0x3e5, 0x3e7, 0x3e9, 0x3eb, 0x3ed,
+ 0x3f5, 0x3f8, 0x3fb, 0x3fc, 0x461, 0x463, 0x465, 0x467, 0x469,
+ 0x46b, 0x46d, 0x46f, 0x471, 0x473, 0x475, 0x477, 0x479, 0x47b,
+ 0x47d, 0x47f, 0x481, 0x48b, 0x48d, 0x48f, 0x491, 0x493, 0x495,
+ 0x497, 0x499, 0x49b, 0x49d, 0x49f, 0x4a1, 0x4a3, 0x4a5, 0x4a7,
+ 0x4a9, 0x4ab, 0x4ad, 0x4af, 0x4b1, 0x4b3, 0x4b5, 0x4b7, 0x4b9,
+ 0x4bb, 0x4bd, 0x4bf, 0x4c2, 0x4c4, 0x4c6, 0x4c8, 0x4ca, 0x4cc,
+ 0x4ce, 0x4cf, 0x4d1, 0x4d3, 0x4d5, 0x4d7, 0x4d9, 0x4db, 0x4dd,
+ 0x4df, 0x4e1, 0x4e3, 0x4e5, 0x4e7, 0x4e9, 0x4eb, 0x4ed, 0x4ef,
+ 0x4f1, 0x4f3, 0x4f5, 0x4f7, 0x4f9, 0x4fb, 0x4fd, 0x4ff, 0x501,
+ 0x503, 0x505, 0x507, 0x509, 0x50b, 0x50d, 0x50f, 0x511, 0x513,
+ 0x515, 0x517, 0x519, 0x51b, 0x51d, 0x51f, 0x521, 0x523, 0x525,
+ 0x527, 0x1e01, 0x1e03, 0x1e05, 0x1e07, 0x1e09, 0x1e0b, 0x1e0d, 0x1e0f,
+ 0x1e11, 0x1e13, 0x1e15, 0x1e17, 0x1e19, 0x1e1b, 0x1e1d, 0x1e1f, 0x1e21,
+ 0x1e23, 0x1e25, 0x1e27, 0x1e29, 0x1e2b, 0x1e2d, 0x1e2f, 0x1e31, 0x1e33,
+ 0x1e35, 0x1e37, 0x1e39, 0x1e3b, 0x1e3d, 0x1e3f, 0x1e41, 0x1e43, 0x1e45,
+ 0x1e47, 0x1e49, 0x1e4b, 0x1e4d, 0x1e4f, 0x1e51, 0x1e53, 0x1e55, 0x1e57,
+ 0x1e59, 0x1e5b, 0x1e5d, 0x1e5f, 0x1e61, 0x1e63, 0x1e65, 0x1e67, 0x1e69,
+ 0x1e6b, 0x1e6d, 0x1e6f, 0x1e71, 0x1e73, 0x1e75, 0x1e77, 0x1e79, 0x1e7b,
+ 0x1e7d, 0x1e7f, 0x1e81, 0x1e83, 0x1e85, 0x1e87, 0x1e89, 0x1e8b, 0x1e8d,
+ 0x1e8f, 0x1e91, 0x1e93, 0x1e9f, 0x1ea1, 0x1ea3, 0x1ea5, 0x1ea7, 0x1ea9,
+ 0x1eab, 0x1ead, 0x1eaf, 0x1eb1, 0x1eb3, 0x1eb5, 0x1eb7, 0x1eb9, 0x1ebb,
+ 0x1ebd, 0x1ebf, 0x1ec1, 0x1ec3, 0x1ec5, 0x1ec7, 0x1ec9, 0x1ecb, 0x1ecd,
+ 0x1ecf, 0x1ed1, 0x1ed3, 0x1ed5, 0x1ed7, 0x1ed9, 0x1edb, 0x1edd, 0x1edf,
+ 0x1ee1, 0x1ee3, 0x1ee5, 0x1ee7, 0x1ee9, 0x1eeb, 0x1eed, 0x1eef, 0x1ef1,
+ 0x1ef3, 0x1ef5, 0x1ef7, 0x1ef9, 0x1efb, 0x1efd, 0x1fb6, 0x1fb7, 0x1fbe,
+ 0x1fc6, 0x1fc7, 0x1fd6, 0x1fd7, 0x1ff6, 0x1ff7, 0x210a, 0x210e, 0x210f,
+ 0x2113, 0x212f, 0x2134, 0x2139, 0x213c, 0x213d, 0x214e, 0x2184, 0x2c61,
+ 0x2c65, 0x2c66, 0x2c68, 0x2c6a, 0x2c6c, 0x2c71, 0x2c73, 0x2c74, 0x2c81,
+ 0x2c83, 0x2c85, 0x2c87, 0x2c89, 0x2c8b, 0x2c8d, 0x2c8f, 0x2c91, 0x2c93,
+ 0x2c95, 0x2c97, 0x2c99, 0x2c9b, 0x2c9d, 0x2c9f, 0x2ca1, 0x2ca3, 0x2ca5,
+ 0x2ca7, 0x2ca9, 0x2cab, 0x2cad, 0x2caf, 0x2cb1, 0x2cb3, 0x2cb5, 0x2cb7,
+ 0x2cb9, 0x2cbb, 0x2cbd, 0x2cbf, 0x2cc1, 0x2cc3, 0x2cc5, 0x2cc7, 0x2cc9,
+ 0x2ccb, 0x2ccd, 0x2ccf, 0x2cd1, 0x2cd3, 0x2cd5, 0x2cd7, 0x2cd9, 0x2cdb,
+ 0x2cdd, 0x2cdf, 0x2ce1, 0x2ce3, 0x2ce4, 0x2cec, 0x2cee, 0x2cf3, 0x2d27,
+ 0x2d2d, 0xa641, 0xa643, 0xa645, 0xa647, 0xa649, 0xa64b, 0xa64d, 0xa64f,
+ 0xa651, 0xa653, 0xa655, 0xa657, 0xa659, 0xa65b, 0xa65d, 0xa65f, 0xa661,
+ 0xa663, 0xa665, 0xa667, 0xa669, 0xa66b, 0xa66d, 0xa681, 0xa683, 0xa685,
+ 0xa687, 0xa689, 0xa68b, 0xa68d, 0xa68f, 0xa691, 0xa693, 0xa695, 0xa697,
+ 0xa723, 0xa725, 0xa727, 0xa729, 0xa72b, 0xa72d, 0xa733, 0xa735, 0xa737,
+ 0xa739, 0xa73b, 0xa73d, 0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749,
+ 0xa74b, 0xa74d, 0xa74f, 0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b,
+ 0xa75d, 0xa75f, 0xa761, 0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d,
+ 0xa76f, 0xa77a, 0xa77c, 0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c,
+ 0xa78e, 0xa791, 0xa793, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9, 0xa7fa
+#if TCL_UTF_MAX > 4
+ ,0x1d4bb, 0x1d7cb
+#endif
};
#define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr))
@@ -328,59 +470,95 @@ static const chr lowerCharTable[] = {
*/
static const crange upperRangeTable[] = {
- {0x0041, 0x005a}, {0x00c0, 0x00d6}, {0x00d8, 0x00de}, {0x0189, 0x018b},
- {0x018e, 0x0191}, {0x0196, 0x0198}, {0x01b1, 0x01b3}, {0x01f6, 0x01f8},
- {0x0388, 0x038a}, {0x0391, 0x03a1}, {0x03a3, 0x03ab}, {0x03d2, 0x03d4},
- {0x0400, 0x042f}, {0x0531, 0x0556}, {0x10a0, 0x10c5}, {0x1f08, 0x1f0f},
- {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d},
- {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb},
- {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112},
- {0x2119, 0x211d}, {0x212a, 0x212d}, {0xff21, 0xff3a}
+ {0x41, 0x5a}, {0xc0, 0xd6}, {0xd8, 0xde}, {0x189, 0x18b},
+ {0x18e, 0x191}, {0x196, 0x198}, {0x1b1, 0x1b3}, {0x1f6, 0x1f8},
+ {0x243, 0x246}, {0x388, 0x38a}, {0x391, 0x3a1}, {0x3a3, 0x3ab},
+ {0x3d2, 0x3d4}, {0x3fd, 0x42f}, {0x531, 0x556}, {0x10a0, 0x10c5},
+ {0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f},
+ {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb},
+ {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d},
+ {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133},
+ {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80},
+ {0xff21, 0xff3a}
+#if TCL_UTF_MAX > 4
+ ,{0x10400, 0x10427}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481},
+ {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a},
+ {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
+ {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed},
+ {0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0},
+ {0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}
+#endif
};
#define NUM_UPPER_RANGE (sizeof(upperRangeTable)/sizeof(crange))
static const chr upperCharTable[] = {
- 0x0100, 0x0102, 0x0104, 0x0106, 0x0108, 0x010a, 0x010c, 0x010e, 0x0110,
- 0x0112, 0x0114, 0x0116, 0x0118, 0x011a, 0x011c, 0x011e, 0x0120, 0x0122,
- 0x0124, 0x0126, 0x0128, 0x012a, 0x012c, 0x012e, 0x0130, 0x0132, 0x0134,
- 0x0136, 0x0139, 0x013b, 0x013d, 0x013f, 0x0141, 0x0143, 0x0145, 0x0147,
- 0x014a, 0x014c, 0x014e, 0x0150, 0x0152, 0x0154, 0x0156, 0x0158, 0x015a,
- 0x015c, 0x015e, 0x0160, 0x0162, 0x0164, 0x0166, 0x0168, 0x016a, 0x016c,
- 0x016e, 0x0170, 0x0172, 0x0174, 0x0176, 0x0178, 0x0179, 0x017b, 0x017d,
- 0x0181, 0x0182, 0x0184, 0x0186, 0x0187, 0x0193, 0x0194, 0x019c, 0x019d,
- 0x019f, 0x01a0, 0x01a2, 0x01a4, 0x01a6, 0x01a7, 0x01a9, 0x01ac, 0x01ae,
- 0x01af, 0x01b5, 0x01b7, 0x01b8, 0x01bc, 0x01c4, 0x01c7, 0x01ca, 0x01cd,
- 0x01cf, 0x01d1, 0x01d3, 0x01d5, 0x01d7, 0x01d9, 0x01db, 0x01de, 0x01e0,
- 0x01e2, 0x01e4, 0x01e6, 0x01e8, 0x01ea, 0x01ec, 0x01ee, 0x01f1, 0x01f4,
- 0x01fa, 0x01fc, 0x01fe, 0x0200, 0x0202, 0x0204, 0x0206, 0x0208, 0x020a,
- 0x020c, 0x020e, 0x0210, 0x0212, 0x0214, 0x0216, 0x0218, 0x021a, 0x021c,
- 0x021e, 0x0222, 0x0224, 0x0226, 0x0228, 0x022a, 0x022c, 0x022e, 0x0230,
- 0x0232, 0x0386, 0x038c, 0x038e, 0x038f, 0x03da, 0x03dc, 0x03de, 0x03e0,
- 0x03e2, 0x03e4, 0x03e6, 0x03e8, 0x03ea, 0x03ec, 0x03ee, 0x03f4, 0x0460,
- 0x0462, 0x0464, 0x0466, 0x0468, 0x046a, 0x046c, 0x046e, 0x0470, 0x0472,
- 0x0474, 0x0476, 0x0478, 0x047a, 0x047c, 0x047e, 0x0480, 0x048c, 0x048e,
- 0x0490, 0x0492, 0x0494, 0x0496, 0x0498, 0x049a, 0x049c, 0x049e, 0x04a0,
- 0x04a2, 0x04a4, 0x04a6, 0x04a8, 0x04aa, 0x04ac, 0x04ae, 0x04b0, 0x04b2,
- 0x04b4, 0x04b6, 0x04b8, 0x04ba, 0x04bc, 0x04be, 0x04c0, 0x04c1, 0x04c3,
- 0x04c7, 0x04cb, 0x04d0, 0x04d2, 0x04d4, 0x04d6, 0x04d8, 0x04da, 0x04dc,
- 0x04de, 0x04e0, 0x04e2, 0x04e4, 0x04e6, 0x04e8, 0x04ea, 0x04ec, 0x04ee,
- 0x04f0, 0x04f2, 0x04f4, 0x04f8, 0x1e00, 0x1e02, 0x1e04, 0x1e06, 0x1e08,
- 0x1e0a, 0x1e0c, 0x1e0e, 0x1e10, 0x1e12, 0x1e14, 0x1e16, 0x1e18, 0x1e1a,
- 0x1e1c, 0x1e1e, 0x1e20, 0x1e22, 0x1e24, 0x1e26, 0x1e28, 0x1e2a, 0x1e2c,
- 0x1e2e, 0x1e30, 0x1e32, 0x1e34, 0x1e36, 0x1e38, 0x1e3a, 0x1e3c, 0x1e3e,
- 0x1e40, 0x1e42, 0x1e44, 0x1e46, 0x1e48, 0x1e4a, 0x1e4c, 0x1e4e, 0x1e50,
- 0x1e52, 0x1e54, 0x1e56, 0x1e58, 0x1e5a, 0x1e5c, 0x1e5e, 0x1e60, 0x1e62,
- 0x1e64, 0x1e66, 0x1e68, 0x1e6a, 0x1e6c, 0x1e6e, 0x1e70, 0x1e72, 0x1e74,
- 0x1e76, 0x1e78, 0x1e7a, 0x1e7c, 0x1e7e, 0x1e80, 0x1e82, 0x1e84, 0x1e86,
- 0x1e88, 0x1e8a, 0x1e8c, 0x1e8e, 0x1e90, 0x1e92, 0x1e94, 0x1ea0, 0x1ea2,
- 0x1ea4, 0x1ea6, 0x1ea8, 0x1eaa, 0x1eac, 0x1eae, 0x1eb0, 0x1eb2, 0x1eb4,
- 0x1eb6, 0x1eb8, 0x1eba, 0x1ebc, 0x1ebe, 0x1ec0, 0x1ec2, 0x1ec4, 0x1ec6,
- 0x1ec8, 0x1eca, 0x1ecc, 0x1ece, 0x1ed0, 0x1ed2, 0x1ed4, 0x1ed6, 0x1ed8,
- 0x1eda, 0x1edc, 0x1ede, 0x1ee0, 0x1ee2, 0x1ee4, 0x1ee6, 0x1ee8, 0x1eea,
- 0x1eec, 0x1eee, 0x1ef0, 0x1ef2, 0x1ef4, 0x1ef6, 0x1ef8, 0x1f59, 0x1f5b,
- 0x1f5d, 0x1f5f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x2130,
- 0x2131, 0x2133
+ 0x100, 0x102, 0x104, 0x106, 0x108, 0x10a, 0x10c, 0x10e, 0x110,
+ 0x112, 0x114, 0x116, 0x118, 0x11a, 0x11c, 0x11e, 0x120, 0x122,
+ 0x124, 0x126, 0x128, 0x12a, 0x12c, 0x12e, 0x130, 0x132, 0x134,
+ 0x136, 0x139, 0x13b, 0x13d, 0x13f, 0x141, 0x143, 0x145, 0x147,
+ 0x14a, 0x14c, 0x14e, 0x150, 0x152, 0x154, 0x156, 0x158, 0x15a,
+ 0x15c, 0x15e, 0x160, 0x162, 0x164, 0x166, 0x168, 0x16a, 0x16c,
+ 0x16e, 0x170, 0x172, 0x174, 0x176, 0x178, 0x179, 0x17b, 0x17d,
+ 0x181, 0x182, 0x184, 0x186, 0x187, 0x193, 0x194, 0x19c, 0x19d,
+ 0x19f, 0x1a0, 0x1a2, 0x1a4, 0x1a6, 0x1a7, 0x1a9, 0x1ac, 0x1ae,
+ 0x1af, 0x1b5, 0x1b7, 0x1b8, 0x1bc, 0x1c4, 0x1c7, 0x1ca, 0x1cd,
+ 0x1cf, 0x1d1, 0x1d3, 0x1d5, 0x1d7, 0x1d9, 0x1db, 0x1de, 0x1e0,
+ 0x1e2, 0x1e4, 0x1e6, 0x1e8, 0x1ea, 0x1ec, 0x1ee, 0x1f1, 0x1f4,
+ 0x1fa, 0x1fc, 0x1fe, 0x200, 0x202, 0x204, 0x206, 0x208, 0x20a,
+ 0x20c, 0x20e, 0x210, 0x212, 0x214, 0x216, 0x218, 0x21a, 0x21c,
+ 0x21e, 0x220, 0x222, 0x224, 0x226, 0x228, 0x22a, 0x22c, 0x22e,
+ 0x230, 0x232, 0x23a, 0x23b, 0x23d, 0x23e, 0x241, 0x248, 0x24a,
+ 0x24c, 0x24e, 0x370, 0x372, 0x376, 0x386, 0x38c, 0x38e, 0x38f,
+ 0x3cf, 0x3d8, 0x3da, 0x3dc, 0x3de, 0x3e0, 0x3e2, 0x3e4, 0x3e6,
+ 0x3e8, 0x3ea, 0x3ec, 0x3ee, 0x3f4, 0x3f7, 0x3f9, 0x3fa, 0x460,
+ 0x462, 0x464, 0x466, 0x468, 0x46a, 0x46c, 0x46e, 0x470, 0x472,
+ 0x474, 0x476, 0x478, 0x47a, 0x47c, 0x47e, 0x480, 0x48a, 0x48c,
+ 0x48e, 0x490, 0x492, 0x494, 0x496, 0x498, 0x49a, 0x49c, 0x49e,
+ 0x4a0, 0x4a2, 0x4a4, 0x4a6, 0x4a8, 0x4aa, 0x4ac, 0x4ae, 0x4b0,
+ 0x4b2, 0x4b4, 0x4b6, 0x4b8, 0x4ba, 0x4bc, 0x4be, 0x4c0, 0x4c1,
+ 0x4c3, 0x4c5, 0x4c7, 0x4c9, 0x4cb, 0x4cd, 0x4d0, 0x4d2, 0x4d4,
+ 0x4d6, 0x4d8, 0x4da, 0x4dc, 0x4de, 0x4e0, 0x4e2, 0x4e4, 0x4e6,
+ 0x4e8, 0x4ea, 0x4ec, 0x4ee, 0x4f0, 0x4f2, 0x4f4, 0x4f6, 0x4f8,
+ 0x4fa, 0x4fc, 0x4fe, 0x500, 0x502, 0x504, 0x506, 0x508, 0x50a,
+ 0x50c, 0x50e, 0x510, 0x512, 0x514, 0x516, 0x518, 0x51a, 0x51c,
+ 0x51e, 0x520, 0x522, 0x524, 0x526, 0x10c7, 0x10cd, 0x1e00, 0x1e02,
+ 0x1e04, 0x1e06, 0x1e08, 0x1e0a, 0x1e0c, 0x1e0e, 0x1e10, 0x1e12, 0x1e14,
+ 0x1e16, 0x1e18, 0x1e1a, 0x1e1c, 0x1e1e, 0x1e20, 0x1e22, 0x1e24, 0x1e26,
+ 0x1e28, 0x1e2a, 0x1e2c, 0x1e2e, 0x1e30, 0x1e32, 0x1e34, 0x1e36, 0x1e38,
+ 0x1e3a, 0x1e3c, 0x1e3e, 0x1e40, 0x1e42, 0x1e44, 0x1e46, 0x1e48, 0x1e4a,
+ 0x1e4c, 0x1e4e, 0x1e50, 0x1e52, 0x1e54, 0x1e56, 0x1e58, 0x1e5a, 0x1e5c,
+ 0x1e5e, 0x1e60, 0x1e62, 0x1e64, 0x1e66, 0x1e68, 0x1e6a, 0x1e6c, 0x1e6e,
+ 0x1e70, 0x1e72, 0x1e74, 0x1e76, 0x1e78, 0x1e7a, 0x1e7c, 0x1e7e, 0x1e80,
+ 0x1e82, 0x1e84, 0x1e86, 0x1e88, 0x1e8a, 0x1e8c, 0x1e8e, 0x1e90, 0x1e92,
+ 0x1e94, 0x1e9e, 0x1ea0, 0x1ea2, 0x1ea4, 0x1ea6, 0x1ea8, 0x1eaa, 0x1eac,
+ 0x1eae, 0x1eb0, 0x1eb2, 0x1eb4, 0x1eb6, 0x1eb8, 0x1eba, 0x1ebc, 0x1ebe,
+ 0x1ec0, 0x1ec2, 0x1ec4, 0x1ec6, 0x1ec8, 0x1eca, 0x1ecc, 0x1ece, 0x1ed0,
+ 0x1ed2, 0x1ed4, 0x1ed6, 0x1ed8, 0x1eda, 0x1edc, 0x1ede, 0x1ee0, 0x1ee2,
+ 0x1ee4, 0x1ee6, 0x1ee8, 0x1eea, 0x1eec, 0x1eee, 0x1ef0, 0x1ef2, 0x1ef4,
+ 0x1ef6, 0x1ef8, 0x1efa, 0x1efc, 0x1efe, 0x1f59, 0x1f5b, 0x1f5d, 0x1f5f,
+ 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x213e, 0x213f, 0x2145,
+ 0x2183, 0x2c60, 0x2c67, 0x2c69, 0x2c6b, 0x2c72, 0x2c75, 0x2c82, 0x2c84,
+ 0x2c86, 0x2c88, 0x2c8a, 0x2c8c, 0x2c8e, 0x2c90, 0x2c92, 0x2c94, 0x2c96,
+ 0x2c98, 0x2c9a, 0x2c9c, 0x2c9e, 0x2ca0, 0x2ca2, 0x2ca4, 0x2ca6, 0x2ca8,
+ 0x2caa, 0x2cac, 0x2cae, 0x2cb0, 0x2cb2, 0x2cb4, 0x2cb6, 0x2cb8, 0x2cba,
+ 0x2cbc, 0x2cbe, 0x2cc0, 0x2cc2, 0x2cc4, 0x2cc6, 0x2cc8, 0x2cca, 0x2ccc,
+ 0x2cce, 0x2cd0, 0x2cd2, 0x2cd4, 0x2cd6, 0x2cd8, 0x2cda, 0x2cdc, 0x2cde,
+ 0x2ce0, 0x2ce2, 0x2ceb, 0x2ced, 0x2cf2, 0xa640, 0xa642, 0xa644, 0xa646,
+ 0xa648, 0xa64a, 0xa64c, 0xa64e, 0xa650, 0xa652, 0xa654, 0xa656, 0xa658,
+ 0xa65a, 0xa65c, 0xa65e, 0xa660, 0xa662, 0xa664, 0xa666, 0xa668, 0xa66a,
+ 0xa66c, 0xa680, 0xa682, 0xa684, 0xa686, 0xa688, 0xa68a, 0xa68c, 0xa68e,
+ 0xa690, 0xa692, 0xa694, 0xa696, 0xa722, 0xa724, 0xa726, 0xa728, 0xa72a,
+ 0xa72c, 0xa72e, 0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e,
+ 0xa740, 0xa742, 0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750,
+ 0xa752, 0xa754, 0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762,
+ 0xa764, 0xa766, 0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d,
+ 0xa77e, 0xa780, 0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792,
+ 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7aa
+#if TCL_UTF_MAX > 4
+ ,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538,
+ 0x1d539, 0x1d546, 0x1d7ca
+#endif
};
#define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr))
@@ -390,221 +568,147 @@ static const chr upperCharTable[] = {
*/
static const crange graphRangeTable[] = {
- {0x0021, 0x007e}, {0x00a0, 0x011f}, {0x0121, 0x021f}, {0x0222, 0x0233},
- {0x0250, 0x02ad}, {0x02b0, 0x02ee}, {0x0300, 0x031f}, {0x0321, 0x034e},
- {0x0360, 0x0362}, {0x0384, 0x038a}, {0x038e, 0x03a1}, {0x03a3, 0x03ce},
- {0x03d0, 0x03d7}, {0x03da, 0x03f5}, {0x0400, 0x041f}, {0x0421, 0x0486},
- {0x048c, 0x04c4}, {0x04d0, 0x04f5}, {0x0531, 0x0556}, {0x0559, 0x055f},
- {0x0561, 0x0587}, {0x0591, 0x05a1}, {0x05a3, 0x05b9}, {0x05bb, 0x05c4},
- {0x05d0, 0x05ea}, {0x05f0, 0x05f4}, {0x0621, 0x063a}, {0x0640, 0x0655},
- {0x0660, 0x066d}, {0x0670, 0x06ed}, {0x06f0, 0x06fe}, {0x0700, 0x070d},
- {0x0710, 0x071f}, {0x0721, 0x072c}, {0x0730, 0x074a}, {0x0780, 0x07b0},
- {0x0901, 0x0903}, {0x0905, 0x091f}, {0x0921, 0x0939}, {0x093c, 0x094d},
- {0x0950, 0x0954}, {0x0958, 0x0970}, {0x0981, 0x0983}, {0x0985, 0x098c},
- {0x0993, 0x09a8}, {0x09aa, 0x09b0}, {0x09b6, 0x09b9}, {0x09be, 0x09c4},
- {0x09cb, 0x09cd}, {0x09df, 0x09e3}, {0x09e6, 0x09fa}, {0x0a05, 0x0a0a},
- {0x0a13, 0x0a1f}, {0x0a21, 0x0a28}, {0x0a2a, 0x0a30}, {0x0a3e, 0x0a42},
- {0x0a4b, 0x0a4d}, {0x0a59, 0x0a5c}, {0x0a66, 0x0a74}, {0x0a81, 0x0a83},
- {0x0a85, 0x0a8b}, {0x0a8f, 0x0a91}, {0x0a93, 0x0aa8}, {0x0aaa, 0x0ab0},
- {0x0ab5, 0x0ab9}, {0x0abc, 0x0ac5}, {0x0ac7, 0x0ac9}, {0x0acb, 0x0acd},
- {0x0ae6, 0x0aef}, {0x0b01, 0x0b03}, {0x0b05, 0x0b0c}, {0x0b13, 0x0b1f},
- {0x0b21, 0x0b28}, {0x0b2a, 0x0b30}, {0x0b36, 0x0b39}, {0x0b3c, 0x0b43},
- {0x0b4b, 0x0b4d}, {0x0b5f, 0x0b61}, {0x0b66, 0x0b70}, {0x0b85, 0x0b8a},
- {0x0b8e, 0x0b90}, {0x0b92, 0x0b95}, {0x0ba8, 0x0baa}, {0x0bae, 0x0bb5},
- {0x0bb7, 0x0bb9}, {0x0bbe, 0x0bc2}, {0x0bc6, 0x0bc8}, {0x0bca, 0x0bcd},
- {0x0be7, 0x0bf2}, {0x0c01, 0x0c03}, {0x0c05, 0x0c0c}, {0x0c0e, 0x0c10},
- {0x0c12, 0x0c1f}, {0x0c21, 0x0c28}, {0x0c2a, 0x0c33}, {0x0c35, 0x0c39},
- {0x0c3e, 0x0c44}, {0x0c46, 0x0c48}, {0x0c4a, 0x0c4d}, {0x0c66, 0x0c6f},
- {0x0c85, 0x0c8c}, {0x0c8e, 0x0c90}, {0x0c92, 0x0ca8}, {0x0caa, 0x0cb3},
- {0x0cb5, 0x0cb9}, {0x0cbe, 0x0cc4}, {0x0cc6, 0x0cc8}, {0x0cca, 0x0ccd},
- {0x0ce6, 0x0cef}, {0x0d05, 0x0d0c}, {0x0d0e, 0x0d10}, {0x0d12, 0x0d1f},
- {0x0d21, 0x0d28}, {0x0d2a, 0x0d39}, {0x0d3e, 0x0d43}, {0x0d46, 0x0d48},
- {0x0d4a, 0x0d4d}, {0x0d66, 0x0d6f}, {0x0d85, 0x0d96}, {0x0d9a, 0x0db1},
- {0x0db3, 0x0dbb}, {0x0dc0, 0x0dc6}, {0x0dcf, 0x0dd4}, {0x0dd8, 0x0ddf},
- {0x0df2, 0x0df4}, {0x0e01, 0x0e1f}, {0x0e21, 0x0e3a}, {0x0e3f, 0x0e5b},
- {0x0e94, 0x0e97}, {0x0e99, 0x0e9f}, {0x0ea1, 0x0ea3}, {0x0ead, 0x0eb9},
- {0x0ebb, 0x0ebd}, {0x0ec0, 0x0ec4}, {0x0ec8, 0x0ecd}, {0x0ed0, 0x0ed9},
- {0x0f00, 0x0f1f}, {0x0f21, 0x0f47}, {0x0f49, 0x0f6a}, {0x0f71, 0x0f8b},
- {0x0f90, 0x0f97}, {0x0f99, 0x0fbc}, {0x0fbe, 0x0fcc}, {0x1000, 0x101f},
- {0x1023, 0x1027}, {0x102c, 0x1032}, {0x1036, 0x1039}, {0x1040, 0x1059},
- {0x10a0, 0x10c5}, {0x10d0, 0x10f6}, {0x1100, 0x111f}, {0x1121, 0x1159},
- {0x115f, 0x11a2}, {0x11a8, 0x11f9}, {0x1200, 0x1206}, {0x1208, 0x121f},
- {0x1221, 0x1246}, {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d},
- {0x1260, 0x1286}, {0x128a, 0x128d}, {0x1290, 0x12ae}, {0x12b2, 0x12b5},
- {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12ce}, {0x12d0, 0x12d6},
- {0x12d8, 0x12ee}, {0x12f0, 0x130e}, {0x1312, 0x1315}, {0x1318, 0x131e},
- {0x1321, 0x1346}, {0x1348, 0x135a}, {0x1361, 0x137c}, {0x13a0, 0x13f4},
- {0x1401, 0x141f}, {0x1421, 0x151f}, {0x1521, 0x161f}, {0x1621, 0x1676},
- {0x1680, 0x169c}, {0x16a0, 0x16f0}, {0x1780, 0x17dc}, {0x17e0, 0x17e9},
- {0x1800, 0x180a}, {0x1810, 0x1819}, {0x1821, 0x1877}, {0x1880, 0x18a9},
- {0x1e00, 0x1e1f}, {0x1e21, 0x1e9b}, {0x1ea0, 0x1ef9}, {0x1f00, 0x1f15},
- {0x1f18, 0x1f1d}, {0x1f21, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
- {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3},
- {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe},
- {0x2000, 0x200b}, {0x2010, 0x201f}, {0x2021, 0x2029}, {0x202f, 0x2046},
- {0x2048, 0x204d}, {0x2074, 0x208e}, {0x20a0, 0x20af}, {0x20d0, 0x20e3},
- {0x2100, 0x211f}, {0x2121, 0x213a}, {0x2153, 0x2183}, {0x2190, 0x21f3},
- {0x2200, 0x221f}, {0x2221, 0x22f1}, {0x2300, 0x231f}, {0x2321, 0x237b},
- {0x237d, 0x239a}, {0x2400, 0x241f}, {0x2421, 0x2426}, {0x2440, 0x244a},
- {0x2460, 0x24ea}, {0x2500, 0x251f}, {0x2521, 0x2595}, {0x25a0, 0x25f7},
- {0x2600, 0x2613}, {0x2619, 0x261f}, {0x2621, 0x2671}, {0x2701, 0x2704},
- {0x2706, 0x2709}, {0x270c, 0x271f}, {0x2721, 0x2727}, {0x2729, 0x274b},
- {0x274f, 0x2752}, {0x2758, 0x275e}, {0x2761, 0x2767}, {0x2776, 0x2794},
- {0x2798, 0x27af}, {0x27b1, 0x27be}, {0x2800, 0x281f}, {0x2821, 0x28ff},
- {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2f1f}, {0x2f21, 0x2fd5},
- {0x2ff0, 0x2ffb}, {0x3000, 0x301f}, {0x3021, 0x303a}, {0x3041, 0x3094},
- {0x3099, 0x309e}, {0x30a1, 0x30fe}, {0x3105, 0x311f}, {0x3121, 0x312c},
- {0x3131, 0x318e}, {0x3190, 0x31b7}, {0x3200, 0x321c}, {0x3221, 0x3243},
- {0x3260, 0x327b}, {0x327f, 0x32b0}, {0x32c0, 0x32cb}, {0x32d0, 0x32fe},
- {0x3300, 0x331f}, {0x3321, 0x3376}, {0x337b, 0x33dd}, {0x33e0, 0x33fe},
- {0x3400, 0x341f}, {0x3421, 0x351f}, {0x3521, 0x361f}, {0x3621, 0x371f},
- {0x3721, 0x381f}, {0x3821, 0x391f}, {0x3921, 0x3a1f}, {0x3a21, 0x3b1f},
- {0x3b21, 0x3c1f}, {0x3c21, 0x3d1f}, {0x3d21, 0x3e1f}, {0x3e21, 0x3f1f},
- {0x3f21, 0x401f}, {0x4021, 0x411f}, {0x4121, 0x421f}, {0x4221, 0x431f},
- {0x4321, 0x441f}, {0x4421, 0x451f}, {0x4521, 0x461f}, {0x4621, 0x471f},
- {0x4721, 0x481f}, {0x4821, 0x491f}, {0x4921, 0x4a1f}, {0x4a21, 0x4b1f},
- {0x4b21, 0x4c1f}, {0x4c21, 0x4d1f}, {0x4d21, 0x4db5}, {0x4e00, 0x4e1f},
- {0x4e21, 0x4f1f}, {0x4f21, 0x501f}, {0x5021, 0x511f}, {0x5121, 0x521f},
- {0x5221, 0x531f}, {0x5321, 0x541f}, {0x5421, 0x551f}, {0x5521, 0x561f},
- {0x5621, 0x571f}, {0x5721, 0x581f}, {0x5821, 0x591f}, {0x5921, 0x5a1f},
- {0x5a21, 0x5b1f}, {0x5b21, 0x5c1f}, {0x5c21, 0x5d1f}, {0x5d21, 0x5e1f},
- {0x5e21, 0x5f1f}, {0x5f21, 0x601f}, {0x6021, 0x611f}, {0x6121, 0x621f},
- {0x6221, 0x631f}, {0x6321, 0x641f}, {0x6421, 0x651f}, {0x6521, 0x661f},
- {0x6621, 0x671f}, {0x6721, 0x681f}, {0x6821, 0x691f}, {0x6921, 0x6a1f},
- {0x6a21, 0x6b1f}, {0x6b21, 0x6c1f}, {0x6c21, 0x6d1f}, {0x6d21, 0x6e1f},
- {0x6e21, 0x6f1f}, {0x6f21, 0x701f}, {0x7021, 0x711f}, {0x7121, 0x721f},
- {0x7221, 0x731f}, {0x7321, 0x741f}, {0x7421, 0x751f}, {0x7521, 0x761f},
- {0x7621, 0x771f}, {0x7721, 0x781f}, {0x7821, 0x791f}, {0x7921, 0x7a1f},
- {0x7a21, 0x7b1f}, {0x7b21, 0x7c1f}, {0x7c21, 0x7d1f}, {0x7d21, 0x7e1f},
- {0x7e21, 0x7f1f}, {0x7f21, 0x801f}, {0x8021, 0x811f}, {0x8121, 0x821f},
- {0x8221, 0x831f}, {0x8321, 0x841f}, {0x8421, 0x851f}, {0x8521, 0x861f},
- {0x8621, 0x871f}, {0x8721, 0x881f}, {0x8821, 0x891f}, {0x8921, 0x8a1f},
- {0x8a21, 0x8b1f}, {0x8b21, 0x8c1f}, {0x8c21, 0x8d1f}, {0x8d21, 0x8e1f},
- {0x8e21, 0x8f1f}, {0x8f21, 0x901f}, {0x9021, 0x911f}, {0x9121, 0x921f},
- {0x9221, 0x931f}, {0x9321, 0x941f}, {0x9421, 0x951f}, {0x9521, 0x961f},
- {0x9621, 0x971f}, {0x9721, 0x981f}, {0x9821, 0x991f}, {0x9921, 0x9a1f},
- {0x9a21, 0x9b1f}, {0x9b21, 0x9c1f}, {0x9c21, 0x9d1f}, {0x9d21, 0x9e1f},
- {0x9e21, 0x9f1f}, {0x9f21, 0x9fa5}, {0xa000, 0xa01f}, {0xa021, 0xa11f},
- {0xa121, 0xa21f}, {0xa221, 0xa31f}, {0xa321, 0xa41f}, {0xa421, 0xa48c},
- {0xa490, 0xa4a1}, {0xa4a4, 0xa4b3}, {0xa4b5, 0xa4c0}, {0xa4c2, 0xa4c4},
- {0xac00, 0xac1f}, {0xac21, 0xad1f}, {0xad21, 0xae1f}, {0xae21, 0xaf1f},
- {0xaf21, 0xb01f}, {0xb021, 0xb11f}, {0xb121, 0xb21f}, {0xb221, 0xb31f},
- {0xb321, 0xb41f}, {0xb421, 0xb51f}, {0xb521, 0xb61f}, {0xb621, 0xb71f},
- {0xb721, 0xb81f}, {0xb821, 0xb91f}, {0xb921, 0xba1f}, {0xba21, 0xbb1f},
- {0xbb21, 0xbc1f}, {0xbc21, 0xbd1f}, {0xbd21, 0xbe1f}, {0xbe21, 0xbf1f},
- {0xbf21, 0xc01f}, {0xc021, 0xc11f}, {0xc121, 0xc21f}, {0xc221, 0xc31f},
- {0xc321, 0xc41f}, {0xc421, 0xc51f}, {0xc521, 0xc61f}, {0xc621, 0xc71f},
- {0xc721, 0xc81f}, {0xc821, 0xc91f}, {0xc921, 0xca1f}, {0xca21, 0xcb1f},
- {0xcb21, 0xcc1f}, {0xcc21, 0xcd1f}, {0xcd21, 0xce1f}, {0xce21, 0xcf1f},
- {0xcf21, 0xd01f}, {0xd021, 0xd11f}, {0xd121, 0xd21f}, {0xd221, 0xd31f},
- {0xd321, 0xd41f}, {0xd421, 0xd51f}, {0xd521, 0xd61f}, {0xd621, 0xd71f},
- {0xd721, 0xd7a3}, {0xf900, 0xf91f}, {0xf921, 0xfa1f}, {0xfa21, 0xfa2d},
- {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb1f}, {0xfb21, 0xfb36},
- {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfc1f}, {0xfc21, 0xfd1f},
- {0xfd21, 0xfd3f}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb},
- {0xfe21, 0xfe23}, {0xfe30, 0xfe44}, {0xfe49, 0xfe52}, {0xfe54, 0xfe66},
- {0xfe68, 0xfe6b}, {0xfe70, 0xfe72}, {0xfe76, 0xfefc}, {0xff01, 0xff1f},
- {0xff21, 0xff5e}, {0xff61, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf},
- {0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee},
- {0xfffc, 0xffff}
+ {0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37e},
+ {0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x527}, {0x531, 0x556},
+ {0x559, 0x55f}, {0x561, 0x587}, {0x591, 0x5c7}, {0x5d0, 0x5ea},
+ {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, {0x6de, 0x70d},
+ {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, {0x800, 0x82d},
+ {0x830, 0x83e}, {0x840, 0x85b}, {0x8a2, 0x8ac}, {0x8e4, 0x8fe},
+ {0x900, 0x977}, {0x979, 0x97f}, {0x981, 0x983}, {0x985, 0x98c},
+ {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4},
+ {0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fb}, {0xa01, 0xa03},
+ {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42},
+ {0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa75}, {0xa81, 0xa83},
+ {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
+ {0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd},
+ {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xb01, 0xb03}, {0xb05, 0xb0c},
+ {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb3c, 0xb44},
+ {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77}, {0xb85, 0xb8a},
+ {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9},
+ {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd}, {0xbe6, 0xbfa},
+ {0xc01, 0xc03}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
+ {0xc2a, 0xc33}, {0xc35, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48},
+ {0xc4a, 0xc4d}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc7f},
+ {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3},
+ {0xcb5, 0xcb9}, {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd},
+ {0xce0, 0xce3}, {0xce6, 0xcef}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
+ {0xd12, 0xd3a}, {0xd3d, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4e},
+ {0xd60, 0xd63}, {0xd66, 0xd75}, {0xd79, 0xd7f}, {0xd85, 0xd96},
+ {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xdcf, 0xdd4},
+ {0xdd8, 0xddf}, {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b},
+ {0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb9},
+ {0xebb, 0xebd}, {0xec0, 0xec4}, {0xec8, 0xecd}, {0xed0, 0xed9},
+ {0xedc, 0xedf}, {0xf00, 0xf47}, {0xf49, 0xf6c}, {0xf71, 0xf97},
+ {0xf99, 0xfbc}, {0xfbe, 0xfcc}, {0xfce, 0xfda}, {0x1000, 0x10c5},
+ {0x10d0, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d},
+ {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5},
+ {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310},
+ {0x1312, 0x1315}, {0x1318, 0x135a}, {0x135d, 0x137c}, {0x1380, 0x1399},
+ {0x13a0, 0x13f4}, {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f0},
+ {0x1700, 0x170c}, {0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753},
+ {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9},
+ {0x17f0, 0x17f9}, {0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1877},
+ {0x1880, 0x18aa}, {0x18b0, 0x18f5}, {0x1900, 0x191c}, {0x1920, 0x192b},
+ {0x1930, 0x193b}, {0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
+ {0x19b0, 0x19c9}, {0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e},
+ {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad},
+ {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37},
+ {0x1c3b, 0x1c49}, {0x1c4d, 0x1c7f}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf6},
+ {0x1d00, 0x1de6}, {0x1dfc, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
+ {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
+ {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef},
+ {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e},
+ {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20ba}, {0x20d0, 0x20f0},
+ {0x2100, 0x2189}, {0x2190, 0x23f3}, {0x2400, 0x2426}, {0x2440, 0x244a},
+ {0x2460, 0x26ff}, {0x2701, 0x2b4c}, {0x2b50, 0x2b59}, {0x2c00, 0x2c2e},
+ {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3}, {0x2cf9, 0x2d25}, {0x2d30, 0x2d67},
+ {0x2d7f, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6},
+ {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6},
+ {0x2dd8, 0x2dde}, {0x2de0, 0x2e3b}, {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3},
+ {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb}, {0x3001, 0x303f}, {0x3041, 0x3096},
+ {0x3099, 0x30ff}, {0x3105, 0x312d}, {0x3131, 0x318e}, {0x3190, 0x31ba},
+ {0x31c0, 0x31e3}, {0x31f0, 0x321e}, {0x3220, 0x32fe}, {0x3300, 0x4db5},
+ {0x4dc0, 0x9fcc}, {0xa000, 0xa48c}, {0xa490, 0xa4c6}, {0xa4d0, 0xa62b},
+ {0xa640, 0xa697}, {0xa69f, 0xa6f7}, {0xa700, 0xa78e}, {0xa790, 0xa793},
+ {0xa7a0, 0xa7aa}, {0xa7f8, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
+ {0xa880, 0xa8c4}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fb}, {0xa900, 0xa953},
+ {0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xaa00, 0xaa36},
+ {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaa7b}, {0xaa80, 0xaac2},
+ {0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
+ {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xabc0, 0xabed}, {0xabf0, 0xabf9},
+ {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d},
+ {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36},
+ {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f},
+ {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe26},
+ {0xfe30, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74},
+ {0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf},
+ {0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee}
+#if TCL_UTF_MAX > 4
+ ,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
+ {0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133},
+ {0x10137, 0x1018a}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
+ {0x102a0, 0x102d0}, {0x10300, 0x1031e}, {0x10320, 0x10323}, {0x10330, 0x1034a},
+ {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5}, {0x10400, 0x1049d},
+ {0x104a0, 0x104a9}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
+ {0x10857, 0x1085f}, {0x10900, 0x1091b}, {0x1091f, 0x10939}, {0x10980, 0x109b7},
+ {0x10a00, 0x10a03}, {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33},
+ {0x10a38, 0x10a3a}, {0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a7f},
+ {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72}, {0x10b78, 0x10b7f},
+ {0x10c00, 0x10c48}, {0x10e60, 0x10e7e}, {0x11000, 0x1104d}, {0x11052, 0x1106f},
+ {0x11080, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8}, {0x110f0, 0x110f9},
+ {0x11100, 0x11134}, {0x11136, 0x11143}, {0x11180, 0x111c8}, {0x111d0, 0x111d9},
+ {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x12000, 0x1236e}, {0x12400, 0x12462},
+ {0x12470, 0x12473}, {0x13000, 0x1342e}, {0x16800, 0x16a38}, {0x16f00, 0x16f44},
+ {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126},
+ {0x1d129, 0x1d172}, {0x1d17b, 0x1d1dd}, {0x1d200, 0x1d245}, {0x1d300, 0x1d356},
+ {0x1d360, 0x1d371}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
+ {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
+ {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
+ {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb},
+ {0x1d7ce, 0x1d7ff}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32},
+ {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72},
+ {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b},
+ {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b},
+ {0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0be}, {0x1f0c1, 0x1f0cf},
+ {0x1f0d1, 0x1f0df}, {0x1f100, 0x1f10a}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b},
+ {0x1f170, 0x1f19a}, {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23a}, {0x1f240, 0x1f248},
+ {0x1f300, 0x1f320}, {0x1f330, 0x1f335}, {0x1f337, 0x1f37c}, {0x1f380, 0x1f393},
+ {0x1f3a0, 0x1f3c4}, {0x1f3c6, 0x1f3ca}, {0x1f3e0, 0x1f3f0}, {0x1f400, 0x1f43e},
+ {0x1f442, 0x1f4f7}, {0x1f4f9, 0x1f4fc}, {0x1f500, 0x1f53d}, {0x1f540, 0x1f543},
+ {0x1f550, 0x1f567}, {0x1f5fb, 0x1f640}, {0x1f645, 0x1f64f}, {0x1f680, 0x1f6c5},
+ {0x1f700, 0x1f773}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
+ {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
+#endif
};
#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
static const chr graphCharTable[] = {
- 0x0374, 0x0375, 0x037a, 0x037e, 0x038c, 0x0488, 0x0489, 0x04c7, 0x04c8,
- 0x04cb, 0x04cc, 0x04f8, 0x04f9, 0x0589, 0x058a, 0x060c, 0x061b, 0x061f,
- 0x098f, 0x0990, 0x09b2, 0x09bc, 0x09c7, 0x09c8, 0x09d7, 0x09dc, 0x09dd,
- 0x0a02, 0x0a0f, 0x0a10, 0x0a32, 0x0a33, 0x0a35, 0x0a36, 0x0a38, 0x0a39,
- 0x0a3c, 0x0a47, 0x0a48, 0x0a5e, 0x0a8d, 0x0ab2, 0x0ab3, 0x0ad0, 0x0ae0,
- 0x0b0f, 0x0b10, 0x0b32, 0x0b33, 0x0b47, 0x0b48, 0x0b56, 0x0b57, 0x0b5c,
- 0x0b5d, 0x0b82, 0x0b83, 0x0b99, 0x0b9a, 0x0b9c, 0x0b9e, 0x0b9f, 0x0ba3,
- 0x0ba4, 0x0bd7, 0x0c55, 0x0c56, 0x0c60, 0x0c61, 0x0c82, 0x0c83, 0x0cd5,
- 0x0cd6, 0x0cde, 0x0ce0, 0x0ce1, 0x0d02, 0x0d03, 0x0d57, 0x0d60, 0x0d61,
- 0x0d82, 0x0d83, 0x0dbd, 0x0dca, 0x0dd6, 0x0e81, 0x0e82, 0x0e84, 0x0e87,
- 0x0e88, 0x0e8a, 0x0e8d, 0x0ea5, 0x0ea7, 0x0eaa, 0x0eab, 0x0ec6, 0x0edc,
- 0x0edd, 0x0fcf, 0x1021, 0x1029, 0x102a, 0x10fb, 0x1248, 0x1258, 0x1288,
- 0x12b0, 0x12c0, 0x1310, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x274d, 0x2756,
- 0x303e, 0x303f, 0xa4c6, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfe74
+ 0x38c, 0x589, 0x58a, 0x58f, 0x85e, 0x8a0, 0x98f, 0x990, 0x9b2,
+ 0x9c7, 0x9c8, 0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33,
+ 0xa35, 0xa36, 0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e,
+ 0xab2, 0xab3, 0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48,
+ 0xb56, 0xb57, 0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c,
+ 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xc58,
+ 0xc59, 0xc82, 0xc83, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2, 0xd02,
+ 0xd03, 0xd57, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82,
+ 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
+ 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59,
+ 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xa9de,
+ 0xa9df, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
+#if TCL_UTF_MAX > 4
+ ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x1093f, 0x109be, 0x109bf,
+ 0x10a05, 0x10a06, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6,
+ 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42,
+ 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b,
+ 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250,
+ 0x1f251, 0x1f440
+#endif
};
#define NUM_GRAPH_CHAR (sizeof(graphCharTable)/sizeof(chr))
/*
- * Unicode: unicode print characters including space, i.e. all Letters (class
- * L*), Numbers (N*), Punctuation (P*), Symbols (S*) and Spaces (Zs).
- */
-
-static const crange printRangeTable[] = {
- {0x0020, 0x007E}, {0x00A0, 0x01F5}, {0x01FA, 0x0217}, {0x0250, 0x02A8},
- {0x02B0, 0x02DE}, {0x02E0, 0x02E9}, {0x0374, 0x0375}, {0x0384, 0x038A},
- {0x038E, 0x03A1}, {0x03A3, 0x03CE}, {0x03D0, 0x03D6}, {0x03E2, 0x03F3},
- {0x0401, 0x040C}, {0x040E, 0x044F}, {0x0451, 0x045C}, {0x045E, 0x0482},
- {0x0490, 0x04C4}, {0x04C7, 0x04C8}, {0x04CB, 0x04CC}, {0x04D0, 0x04EB},
- {0x04EE, 0x04F5}, {0x04F8, 0x04F9}, {0x0531, 0x0556}, {0x0559, 0x055F},
- {0x0561, 0x0587}, {0x05D0, 0x05EA}, {0x05F0, 0x05F4}, {0x0621, 0x063A},
- {0x0640, 0x064A}, {0x0660, 0x066D}, {0x0671, 0x06B7}, {0x06BA, 0x06BE},
- {0x06C0, 0x06CE}, {0x06D0, 0x06D5}, {0x06E5, 0x06E6}, {0x06F0, 0x06F9},
- {0x0905, 0x0939}, {0x0958, 0x0961}, {0x0964, 0x0970}, {0x0985, 0x098C},
- {0x098F, 0x0990}, {0x0993, 0x09A8}, {0x09AA, 0x09B0}, {0x09B6, 0x09B9},
- {0x09DC, 0x09DD}, {0x09DF, 0x09E1}, {0x09E6, 0x09FA}, {0x0A05, 0x0A0A},
- {0x0A0F, 0x0A10}, {0x0A13, 0x0A28}, {0x0A2A, 0x0A30}, {0x0A32, 0x0A33},
- {0x0A35, 0x0A36}, {0x0A38, 0x0A39}, {0x0A59, 0x0A5C}, {0x0A66, 0x0A6F},
- {0x0A72, 0x0A74}, {0x0A85, 0x0A8B}, {0x0A8F, 0x0A91}, {0x0A93, 0x0AA8},
- {0x0AAA, 0x0AB0}, {0x0AB2, 0x0AB3}, {0x0AB5, 0x0AB9}, {0x0AE6, 0x0AEF},
- {0x0B05, 0x0B0C}, {0x0B0F, 0x0B10}, {0x0B13, 0x0B28}, {0x0B2A, 0x0B30},
- {0x0B32, 0x0B33}, {0x0B36, 0x0B39}, {0x0B5C, 0x0B5D}, {0x0B5F, 0x0B61},
- {0x0B66, 0x0B70}, {0x0B85, 0x0B8A}, {0x0B8E, 0x0B90}, {0x0B92, 0x0B95},
- {0x0B99, 0x0B9A}, {0x0B9E, 0x0B9F}, {0x0BA3, 0x0BA4}, {0x0BA8, 0x0BAA},
- {0x0BAE, 0x0BB5}, {0x0BB7, 0x0BB9}, {0x0BE7, 0x0BF2}, {0x0C05, 0x0C0C},
- {0x0C0E, 0x0C10}, {0x0C12, 0x0C28}, {0x0C2A, 0x0C33}, {0x0C35, 0x0C39},
- {0x0C60, 0x0C61}, {0x0C66, 0x0C6F}, {0x0C85, 0x0C8C}, {0x0C8E, 0x0C90},
- {0x0C92, 0x0CA8}, {0x0CAA, 0x0CB3}, {0x0CB5, 0x0CB9}, {0x0CE0, 0x0CE1},
- {0x0CE6, 0x0CEF}, {0x0D05, 0x0D0C}, {0x0D0E, 0x0D10}, {0x0D12, 0x0D28},
- {0x0D2A, 0x0D39}, {0x0D60, 0x0D61}, {0x0D66, 0x0D6F}, {0x0E3F, 0x0E46},
- {0x0E4F, 0x0E5B}, {0x0E99, 0x0E9F}, {0x0EA1, 0x0EA3}, {0x0EAA, 0x0EAB},
- {0x0EAD, 0x0EB0}, {0x0EB2, 0x0EB3}, {0x0EC0, 0x0EC4}, {0x0ED0, 0x0ED9},
- {0x0EDC, 0x0EDD}, {0x0F00, 0x0F17}, {0x0F1A, 0x0F34}, {0x0F3A, 0x0F3D},
- {0x0F40, 0x0F47}, {0x0F49, 0x0F69}, {0x0F88, 0x0F8B}, {0x10A0, 0x10C5},
- {0x10D0, 0x10F6}, {0x1100, 0x1159}, {0x115F, 0x11A2}, {0x11A8, 0x11F9},
- {0x1E00, 0x1E9B}, {0x1EA0, 0x1EF9}, {0x1F00, 0x1F15}, {0x1F18, 0x1F1D},
- {0x1F20, 0x1F45}, {0x1F48, 0x1F4D}, {0x1F50, 0x1F57}, {0x1F5F, 0x1F7D},
- {0x1F80, 0x1FB4}, {0x1FB6, 0x1FC4}, {0x1FC6, 0x1FD3}, {0x1FD6, 0x1FDB},
- {0x1FDD, 0x1FEF}, {0x1FF2, 0x1FF4}, {0x1FF6, 0x1FFE}, {0x2000, 0x200B},
- {0x2010, 0x2027}, {0x2030, 0x2046}, {0x2074, 0x208E}, {0x20A0, 0x20AC},
- {0x2100, 0x2138}, {0x2153, 0x2182}, {0x2190, 0x21EA}, {0x2200, 0x22F1},
- {0x2302, 0x237A}, {0x2400, 0x2424}, {0x2440, 0x244A}, {0x2460, 0x24EA},
- {0x2500, 0x2595}, {0x25A0, 0x25EF}, {0x2600, 0x2613}, {0x261A, 0x266F},
- {0x2701, 0x2704}, {0x2706, 0x2709}, {0x270C, 0x2727}, {0x2729, 0x274B},
- {0x274F, 0x2752}, {0x2758, 0x275E}, {0x2761, 0x2767}, {0x2776, 0x2794},
- {0x2798, 0x27AF}, {0x27B1, 0x27BE}, {0x3000, 0x3029}, {0x3030, 0x3037},
- {0x3041, 0x3094}, {0x309B, 0x309E}, {0x30A1, 0x30FE}, {0x3105, 0x312C},
- {0x3131, 0x318E}, {0x3190, 0x319F}, {0x3200, 0x321C}, {0x3220, 0x3243},
- {0x3260, 0x327B}, {0x327F, 0x32B0}, {0x32C0, 0x32CB}, {0x32D0, 0x32FE},
- {0x3300, 0x3376}, {0x337B, 0x33DD}, {0x33E0, 0x33FE}, {0x4E00, 0x9FA5},
- {0xAC00, 0xD7A3}, {0xF900, 0xFA2D}, {0xFB00, 0xFB06}, {0xFB13, 0xFB17},
- {0xFB1F, 0xFB36}, {0xFB38, 0xFB3C}, {0xFB40, 0xFB41}, {0xFB43, 0xFB44},
- {0xFB46, 0xFBB1}, {0xFBD3, 0xFD3F}, {0xFD50, 0xFD8F}, {0xFD92, 0xFDC7},
- {0xFDF0, 0xFDFB}, {0xFE30, 0xFE44}, {0xFE49, 0xFE52}, {0xFE54, 0xFE66},
- {0xFE68, 0xFE6B}, {0xFE70, 0xFE72}, {0xFE76, 0xFEFC}, {0xFF01, 0xFF5E},
- {0xFF61, 0xFFBE}, {0xFFC2, 0xFFC7}, {0xFFCA, 0xFFCF}, {0xFFD2, 0xFFD7},
- {0xFFDA, 0xFFDC}, {0xFFE0, 0xFFE6}, {0xFFE8, 0xFFEE}, {0xFFFC, 0xFFFD}
-};
-
-#define NUM_PRINT_RANGE (sizeof(printRangeTable)/sizeof(crange))
-
-static const chr printCharTable[] = {
- 0x037A, 0x037E, 0x038C, 0x03DA, 0x03DC, 0x03DE, 0x03E0, 0x0589, 0x05BE,
- 0x05C0, 0x05C3, 0x060C, 0x061B, 0x061F, 0x06E9, 0x093D, 0x0950, 0x09B2,
- 0x0A5E, 0x0A8D, 0x0ABD, 0x0AD0, 0x0AE0, 0x0B3D, 0x0B9C, 0x0CDE, 0x0E01,
- 0x0E32, 0x0E81, 0x0E84, 0x0E87, 0x0E8A, 0x0E8D, 0x0E94, 0x0EA5, 0x0EA7,
- 0x0EBD, 0x0EC6, 0x0F36, 0x0F38, 0x0F85, 0x10FB, 0x1F59, 0x1F5B, 0x1F5D,
- 0x2070, 0x2300, 0x274D, 0x2756, 0x303F, 0xFB3E, 0xFE74
-};
-
-#define NUM_PRINT_CHAR (sizeof(printCharTable)/sizeof(chr))
-
-/*
* End of auto-generated Unicode character ranges declarations.
*/
@@ -817,15 +921,6 @@ cclass(
np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);
/*
- * Remap lower and upper to alpha if the match is case insensitive.
- */
-
- if (cases && len == 5 && (strncmp("lower", np, 5) == 0
- || strncmp("upper", np, 5) == 0)) {
- np = "alpha";
- }
-
- /*
* Map the name to the corresponding enumerated value.
*/
@@ -843,22 +938,18 @@ cclass(
}
/*
+ * Remap lower and upper to alpha if the match is case insensitive.
+ */
+
+ if (cases && ((index == CC_LOWER) || (index == CC_UPPER))) {
+ index = CC_ALNUM;
+ }
+
+ /*
* Now compute the character class contents.
*/
switch((enum classes) index) {
- case CC_PRINT:
- cv = getcvec(v, NUM_PRINT_CHAR, NUM_PRINT_RANGE);
- if (cv) {
- for (i=0 ; (size_t)i<NUM_PRINT_CHAR ; i++) {
- addchr(cv, printCharTable[i]);
- }
- for (i=0 ; (size_t)i<NUM_PRINT_RANGE ; i++) {
- addrange(cv, printRangeTable[i].start,
- printRangeTable[i].end);
- }
- }
- break;
case CC_ALNUM:
cv = getcvec(v, NUM_ALPHA_CHAR, NUM_DIGIT_RANGE + NUM_ALPHA_RANGE);
if (cv) {
@@ -899,9 +990,16 @@ cclass(
addchr(cv, ' ');
break;
case CC_CNTRL:
- cv = getcvec(v, 0, 2);
- addrange(cv, 0x0, 0x1f);
- addrange(cv, 0x7f, 0x9f);
+ cv = getcvec(v, NUM_CONTROL_CHAR, NUM_CONTROL_RANGE);
+ if (cv) {
+ for (i=0 ; (size_t)i<NUM_CONTROL_RANGE ; i++) {
+ addrange(cv, controlRangeTable[i].start,
+ controlRangeTable[i].end);
+ }
+ for (i=0 ; (size_t)i<NUM_CONTROL_CHAR ; i++) {
+ addchr(cv, controlCharTable[i]);
+ }
+ }
break;
case CC_DIGIT:
cv = getcvec(v, 0, NUM_DIGIT_RANGE);
@@ -977,6 +1075,25 @@ cclass(
}
}
break;
+ case CC_PRINT:
+ cv = getcvec(v, NUM_SPACE_CHAR + NUM_GRAPH_CHAR, NUM_SPACE_RANGE + NUM_GRAPH_RANGE - 1);
+ if (cv) {
+ for (i=1 ; (size_t)i<NUM_SPACE_RANGE ; i++) {
+ addrange(cv, spaceRangeTable[i].start,
+ spaceRangeTable[i].end);
+ }
+ for (i=0 ; (size_t)i<NUM_SPACE_CHAR ; i++) {
+ addchr(cv, spaceCharTable[i]);
+ }
+ for (i=0 ; (size_t)i<NUM_GRAPH_RANGE ; i++) {
+ addrange(cv, graphRangeTable[i].start,
+ graphRangeTable[i].end);
+ }
+ for (i=0 ; (size_t)i<NUM_GRAPH_CHAR ; i++) {
+ addchr(cv, graphCharTable[i]);
+ }
+ }
+ break;
case CC_GRAPH:
cv = getcvec(v, NUM_GRAPH_CHAR, NUM_GRAPH_RANGE);
if (cv) {
diff --git a/generic/regcomp.c b/generic/regcomp.c
index 9753ca4..65555aa 100644
--- a/generic/regcomp.c
+++ b/generic/regcomp.c
@@ -79,7 +79,7 @@ static void lexnest(struct vars *, const chr *, const chr *);
static void lexword(struct vars *);
static int next(struct vars *);
static int lexescape(struct vars *);
-static chr lexdigits(struct vars *, int, int, int);
+static int lexdigits(struct vars *, int, int, int);
static int brenext(struct vars *, pchr);
static void skip(struct vars *);
static chr newline(NOPARMS);
@@ -2131,7 +2131,7 @@ stdump(
/*
- stid - identify a subtree node for dumping
- ^ static char *stid(struct subre *, char *, size_t);
+ ^ static const char *stid(struct subre *, char *, size_t);
*/
static const char * /* points to buf or constant string */
stid(
diff --git a/generic/regcustom.h b/generic/regcustom.h
index bc8c28c..1c970ea 100644
--- a/generic/regcustom.h
+++ b/generic/regcustom.h
@@ -97,7 +97,7 @@ typedef int celt; /* Type to hold chr, or NOCELT */
#define NOCELT (-1) /* Celt value which is not valid chr */
#define CHR(c) (UCHAR(c)) /* Turn char literal into chr literal */
#define DIGITVAL(c) ((c)-'0') /* Turn chr digit into its value */
-#if TCL_UTF_MAX > 3
+#if TCL_UTF_MAX > 4
#define CHRBITS 32 /* Bits in a chr; must not use sizeof */
#define CHR_MIN 0x00000000 /* Smallest and largest chr; the value */
#define CHR_MAX 0xffffffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */
diff --git a/generic/tcl.decls b/generic/tcl.decls
index f7c5d4f..1829249 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -11,8 +11,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: tcl.decls,v 1.181 2010/09/15 07:33:54 nijtmans Exp $
library tcl
@@ -62,7 +60,7 @@ declare 8 {
}
# Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix,
-# but they are part of the old interface, so we include them here for
+# but they are part of the old generic interface, so we include them here for
# compatibility reasons.
declare 9 unix {
@@ -598,7 +596,7 @@ declare 166 {
}
# Tcl_GetOpenFile is only available on unix, but it is a part of the old
-# interface, so we inlcude it here for compatibility reasons.
+# generic interface, so we inlcude it here for compatibility reasons.
declare 167 unix {
int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting,
@@ -777,10 +775,10 @@ declare 217 {
void Tcl_ResetResult(Tcl_Interp *interp)
}
declare 218 {
- int Tcl_ScanElement(const char *str, int *flagPtr)
+ int Tcl_ScanElement(const char *src, int *flagPtr)
}
declare 219 {
- int Tcl_ScanCountedElement(const char *str, int length, int *flagPtr)
+ int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
# Obsolete
declare 220 {
@@ -2313,13 +2311,19 @@ declare 627 {
Tcl_LoadHandle *handlePtr)
}
declare 628 {
- void* Tcl_FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle handle,
+ void *Tcl_FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle handle,
const char *symbol)
}
declare 629 {
int Tcl_FSUnloadFile(Tcl_Interp *interp, Tcl_LoadHandle handlePtr)
}
+# TIP #400
+declare 630 {
+ void Tcl_ZlibStreamSetCompressionDictionary(Tcl_ZlibStream zhandle,
+ Tcl_Obj *compressionDictionaryObj)
+}
+
# ----- BASELINE -- FOR -- 8.6.0 ----- #
##############################################################################
@@ -2367,6 +2371,14 @@ export {
void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
}
export {
+ const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
+ int exact)
+}
+export {
+ const char *TclTomMathInitializeStubs(Tcl_Interp* interp,
+ const char* version, int epoch, int revision)
+}
+export {
const char *Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version,
int exact)
}
diff --git a/generic/tcl.h b/generic/tcl.h
index 76e7c86..3003abf 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -12,8 +12,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tcl.h,v 1.308 2010/08/14 20:58:30 nijtmans Exp $
*/
#ifndef _TCL
@@ -53,17 +51,15 @@ extern "C" {
* win/README (not patchlevel) (sections 0 and 2)
* unix/tcl.spec (1 LOC patch)
* tools/tcl.hpj.in (not patchlevel, for windows installer)
- * tools/tcl.wse.in (for windows installer)
- * tools/tclSplash.bmp (not patchlevel)
*/
#define TCL_MAJOR_VERSION 8
#define TCL_MINOR_VERSION 6
-#define TCL_RELEASE_LEVEL TCL_BETA_RELEASE
-#define TCL_RELEASE_SERIAL 1
+#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
+#define TCL_RELEASE_SERIAL 0
#define TCL_VERSION "8.6"
-#define TCL_PATCH_LEVEL "8.6b1.2"
+#define TCL_PATCH_LEVEL "8.6.0"
/*
*----------------------------------------------------------------------------
@@ -158,6 +154,28 @@ extern "C" {
# define TCL_VARARGS_DEF(type, name) (type name, ...)
# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
#endif
+#if defined(__GNUC__) && (__GNUC__ > 2)
+# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
+#else
+# define TCL_FORMAT_PRINTF(a,b)
+#endif
+
+/*
+ * Allow a part of Tcl's API to be explicitly marked as deprecated.
+ *
+ * Used to make TIP 330/336 generate moans even if people use the
+ * compatibility macros. Change your code, guys! We won't support you forever.
+ */
+
+#if defined(__GNUC__) && ((__GNUC__ >= 4) || ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 1)))
+# if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC__MINOR__ >= 5))
+# define TCL_DEPRECATED_API(msg) __attribute__ ((__deprecated__ (msg)))
+# else
+# define TCL_DEPRECATED_API(msg) __attribute__ ((__deprecated__))
+# endif
+#else
+# define TCL_DEPRECATED_API(msg) /* nothing portable */
+#endif
/*
*----------------------------------------------------------------------------
@@ -370,28 +388,17 @@ typedef long LONG;
*/
#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
-# if defined(__GNUC__)
-# define TCL_WIDE_INT_TYPE long long
-# if defined(__WIN32__) && !defined(__CYGWIN__)
-# define TCL_LL_MODIFIER "I64"
-# else
-# define TCL_LL_MODIFIER "ll"
-# endif
-typedef struct stat Tcl_StatBuf;
-# elif defined(__WIN32__)
+# if defined(__WIN32__)
# define TCL_WIDE_INT_TYPE __int64
# ifdef __BORLANDC__
-typedef struct stati64 Tcl_StatBuf;
# define TCL_LL_MODIFIER "L"
# else /* __BORLANDC__ */
-# if _MSC_VER < 1400 || !defined(_M_IX86)
-typedef struct _stati64 Tcl_StatBuf;
-# else
-typedef struct _stat64 Tcl_StatBuf;
-# endif /* _MSC_VER < 1400 */
# define TCL_LL_MODIFIER "I64"
# endif /* __BORLANDC__ */
-# else /* __WIN32__ */
+# elif defined(__GNUC__)
+# define TCL_WIDE_INT_TYPE long long
+# define TCL_LL_MODIFIER "ll"
+# else /* ! __WIN32__ && ! __GNUC__ */
/*
* Don't know what platform it is and configure hasn't discovered what is
* going on for us. Try to guess...
@@ -417,7 +424,6 @@ typedef TCL_WIDE_INT_TYPE Tcl_WideInt;
typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
#ifdef TCL_WIDE_INT_IS_LONG
-typedef struct stat Tcl_StatBuf;
# define Tcl_WideAsLong(val) ((long)(val))
# define Tcl_LongAsWide(val) ((long)(val))
# define Tcl_WideAsDouble(val) ((double)((long)(val)))
@@ -431,11 +437,6 @@ typedef struct stat Tcl_StatBuf;
* or some other strange platform.
*/
# ifndef TCL_LL_MODIFIER
-# ifdef HAVE_STRUCT_STAT64
-typedef struct stat64 Tcl_StatBuf;
-# else
-typedef struct stat Tcl_StatBuf;
-# endif /* HAVE_STRUCT_STAT64 */
# define TCL_LL_MODIFIER "ll"
# endif /* !TCL_LL_MODIFIER */
# define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val)))
@@ -443,6 +444,39 @@ typedef struct stat Tcl_StatBuf;
# define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val)))
# define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
#endif /* TCL_WIDE_INT_IS_LONG */
+
+#if defined(__WIN32__)
+# ifdef __BORLANDC__
+ typedef struct stati64 Tcl_StatBuf;
+# elif defined(_WIN64)
+ typedef struct __stat64 Tcl_StatBuf;
+# elif (defined(_MSC_VER) && (_MSC_VER < 1400)) || defined(_USE_32BIT_TIME_T)
+ typedef struct _stati64 Tcl_StatBuf;
+# else
+ typedef struct _stat32i64 Tcl_StatBuf;
+# endif /* _MSC_VER < 1400 */
+#elif defined(__CYGWIN__)
+ typedef struct _stat32i64 {
+ dev_t st_dev;
+ unsigned short st_ino;
+ unsigned short st_mode;
+ short st_nlink;
+ short st_uid;
+ short st_gid;
+ /* Here is a 2-byte gap */
+ dev_t st_rdev;
+ /* Here is a 4-byte gap */
+ long long st_size;
+ struct {long tv_sec;} st_atim;
+ struct {long tv_sec;} st_mtim;
+ struct {long tv_sec;} st_ctim;
+ /* Here is a 4-byte gap */
+ } Tcl_StatBuf;
+#elif defined(HAVE_STRUCT_STAT64)
+ typedef struct stat64 Tcl_StatBuf;
+#else
+ typedef struct stat Tcl_StatBuf;
+#endif
/*
*----------------------------------------------------------------------------
@@ -464,13 +498,17 @@ typedef struct stat Tcl_StatBuf;
* accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
*/
-typedef struct Tcl_Interp {
+typedef struct Tcl_Interp
+#ifndef TCL_NO_DEPRECATED
+{
/* TIP #330: Strongly discourage extensions from using the string
* result. */
#ifdef USE_INTERP_RESULT
- char *result; /* If the last command returned a string
+ char *result TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult");
+ /* If the last command returned a string
* result, this points to it. */
- void (*freeProc) (char *blockPtr);
+ void (*freeProc) (char *blockPtr)
+ TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult");
/* Zero means the string result is statically
* allocated. TCL_DYNAMIC means it was
* allocated with ckalloc and should be freed
@@ -479,17 +517,20 @@ typedef struct Tcl_Interp {
* Tcl_Eval must free it before executing next
* command. */
#else
- char *unused3;
- void (*unused4) (char *);
+ char *resultDontUse; /* Don't use in extensions! */
+ void (*freeProcDontUse) (char *); /* Don't use in extensions! */
#endif
#ifdef USE_INTERP_ERRORLINE
- int errorLine; /* When TCL_ERROR is returned, this gives the
+ int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine");
+ /* When TCL_ERROR is returned, this gives the
* line number within the command where the
* error occurred (1 if first line). */
#else
- int unused5;
+ int errorLineDontUse; /* Don't use in extensions! */
#endif
-} Tcl_Interp;
+}
+#endif /* TCL_NO_DEPRECATED */
+Tcl_Interp;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
@@ -796,11 +837,14 @@ typedef struct Tcl_Obj {
void *ptr1;
void *ptr2;
} twoPtrValue;
- struct { /* - internal rep as a wide int, tightly
- * packed fields. */
- void *ptr; /* Pointer to digits. */
- unsigned long value;/* Alloc, used, and signum packed into a
- * single word. */
+ struct { /* - internal rep as a pointer and a long,
+ * the main use of which is a bignum's
+ * tightly packed fields, where the alloc,
+ * used and signum flags are packed into a
+ * single word with everything else hung
+ * off the pointer. */
+ void *ptr;
+ unsigned long value;
} ptrAndLongRep;
} internalRep;
} Tcl_Obj;
@@ -810,10 +854,7 @@ typedef struct Tcl_Obj {
* whether an object is shared (i.e. has reference count > 1). Note: clients
* should use Tcl_DecrRefCount() when they are finished using an object, and
* should never call TclFreeObj() directly. TclFreeObj() is only defined and
- * made public in tcl.h to support Tcl_DecrRefCount's macro definition. Note
- * also that Tcl_DecrRefCount() refers to the parameter "obj" twice. This
- * means that you should avoid calling it with an expression that is expensive
- * to compute or has side effects.
+ * made public in tcl.h to support Tcl_DecrRefCount's macro definition.
*/
void Tcl_IncrRefCount(Tcl_Obj *objPtr);
@@ -987,8 +1028,6 @@ typedef struct Tcl_DString {
* is safe to leave the hash unquoted when the element is not the first
* element of a list, and this flag can be used by the caller to indicate
* that condition.
- * (Careful! If you change these flag values be sure to change the definitions
- * at the front of tclUtil.c).
*/
#define TCL_DONT_USE_BRACES 1
@@ -1165,7 +1204,7 @@ struct Tcl_HashEntry {
int words[1]; /* Multiple integer words for key. The actual
* size will be as large as necessary for this
* table's keys. */
- char string[4]; /* String for key. The actual size will be as
+ char string[1]; /* String for key. The actual size will be as
* large as needed to hold the key. */
} key; /* MUST BE LAST FIELD IN RECORD!! */
};
@@ -2147,12 +2186,12 @@ typedef struct Tcl_EncodingType {
/*
* The maximum number of bytes that are necessary to represent a single
- * Unicode character in UTF-8. The valid values should be 3 or 6 (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 6, then Tcl_UniChar must
- * be 4-bytes in size (UCS-4). At this time UCS-2 mode is the default and
- * recommended mode. UCS-4 is experimental and not recommended. It works for
- * the core, but most extensions expect UCS-2.
+ * Unicode character in UTF-8. The valid values should be 3, 4 or 6
+ * (or perhaps 1 if we want to support a non-unicode enabled core). If 3 or
+ * 4, then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6,
+ * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UCS-2 mode
+ * is the default and recommended mode. UCS-4 is experimental and not
+ * recommended. It works for the core, but most extensions expect UCS-2.
*/
#ifndef TCL_UTF_MAX
@@ -2164,7 +2203,7 @@ typedef struct Tcl_EncodingType {
* reflected in regcustom.h.
*/
-#if TCL_UTF_MAX > 3
+#if TCL_UTF_MAX > 4
/*
* unsigned int isn't 100% accurate as it should be a strict 4-byte value
* (perhaps wchar_t). 64-bit systems may have troubles. The size of this
@@ -2270,12 +2309,12 @@ typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
#define TCL_ARGV_AUTO_HELP \
{TCL_ARGV_HELP, "-help", NULL, NULL, \
- "Print summary of command-line options and abort"}
+ "Print summary of command-line options and abort", NULL}
#define TCL_ARGV_AUTO_REST \
{TCL_ARGV_REST, "--", NULL, NULL, \
- "Marks the end of the options"}
+ "Marks the end of the options", NULL}
#define TCL_ARGV_TABLE_END \
- {TCL_ARGV_END}
+ {TCL_ARGV_END, NULL, NULL, NULL, NULL, NULL}
/*
*----------------------------------------------------------------------------
@@ -2320,6 +2359,14 @@ typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
/*
*----------------------------------------------------------------------------
+ * Definitions needed for the Tcl_LoadFile function. [TIP #416]
+ */
+
+#define TCL_LOAD_GLOBAL 1
+#define TCL_LOAD_LAZY 2
+
+/*
+ *----------------------------------------------------------------------------
* Single public declaration for NRE.
*/
@@ -2367,8 +2414,10 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
* Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
*/
-EXTERN void Tcl_Main(int argc, char **argv,
- Tcl_AppInitProc *appInitProc);
+#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
+ (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
+EXTERN void Tcl_MainEx(int argc, char **argv,
+ Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
const char *version, int exact);
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
@@ -2399,11 +2448,16 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
#ifdef TCL_MEM_DEBUG
-# define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
-# define ckfree(x) Tcl_DbCkfree(x, __FILE__, __LINE__)
-# define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
-# define attemptckalloc(x) Tcl_AttemptDbCkalloc(x, __FILE__, __LINE__)
-# define attemptckrealloc(x,y) Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__)
+# define ckalloc(x) \
+ ((VOID *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__))
+# define ckfree(x) \
+ Tcl_DbCkfree((char *)(x), __FILE__, __LINE__)
+# define ckrealloc(x,y) \
+ ((VOID *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__))
+# define attemptckalloc(x) \
+ ((VOID *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__))
+# define attemptckrealloc(x,y) \
+ ((VOID *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__))
#else /* !TCL_MEM_DEBUG */
@@ -2413,11 +2467,16 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
* memory allocator both inside and outside of the Tcl library.
*/
-# define ckalloc(x) Tcl_Alloc(x)
-# define ckfree(x) Tcl_Free(x)
-# define ckrealloc(x,y) Tcl_Realloc(x,y)
-# define attemptckalloc(x) Tcl_AttemptAlloc(x)
-# define attemptckrealloc(x,y) Tcl_AttemptRealloc(x,y)
+# define ckalloc(x) \
+ ((VOID *) Tcl_Alloc((unsigned)(x)))
+# define ckfree(x) \
+ Tcl_Free((char *)(x))
+# define ckrealloc(x,y) \
+ ((VOID *) Tcl_Realloc((char *)(x), (unsigned)(y)))
+# define attemptckalloc(x) \
+ ((VOID *) Tcl_AttemptAlloc((unsigned)(x)))
+# define attemptckrealloc(x,y) \
+ ((VOID *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y)))
# undef Tcl_InitMemory
# define Tcl_InitMemory(x)
# undef Tcl_DumpActiveMemory
@@ -2442,7 +2501,12 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
* http://c2.com/cgi/wiki?TrivialDoWhileLoop
*/
# define Tcl_DecrRefCount(objPtr) \
- do { if (--(objPtr)->refCount <= 0) TclFreeObj(objPtr); } while(0)
+ do { \
+ Tcl_Obj *_objPtr = (objPtr); \
+ if (--(_objPtr)->refCount <= 0) { \
+ TclFreeObj(_objPtr); \
+ } \
+ } while(0)
# define Tcl_IsShared(objPtr) \
((objPtr)->refCount > 1)
#endif
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index ebb6898..ae61e85 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -14,8 +14,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclAlloc.c,v 1.30 2010/04/28 11:50:54 nijtmans Exp $
*/
/*
@@ -28,12 +26,6 @@
#if USE_TCLALLOC
-#ifdef TCL_DEBUG
-# define DEBUG
-/* #define MSTATS */
-# define RCHECK
-#endif
-
/*
* We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait
* until Tcl uses config.h properly.
@@ -62,7 +54,7 @@ union overhead {
unsigned char index; /* bucket # */
unsigned char unused; /* unused */
unsigned char magic1; /* other magic number */
-#ifdef RCHECK
+#ifndef NDEBUG
unsigned short rmagic; /* range magic number */
unsigned long size; /* actual block size */
unsigned short unused2; /* padding to 8-byte align */
@@ -79,7 +71,7 @@ union overhead {
#define MAGIC 0xef /* magic # on accounting info */
#define RMAGIC 0x5555 /* magic # on range info */
-#ifdef RCHECK
+#ifndef NDEBUG
#define RSLOP sizeof(unsigned short)
#else
#define RSLOP 0
@@ -144,7 +136,7 @@ static int allocInit = 0;
static unsigned int numMallocs[NBUCKETS+1];
#endif
-#if defined(DEBUG) || defined(RCHECK)
+#if !defined(NDEBUG)
#define ASSERT(p) if (!(p)) Tcl_Panic(# p)
#define RANGE_ASSERT(p) if (!(p)) Tcl_Panic(# p)
#else
@@ -301,7 +293,7 @@ TclpAlloc(
numMallocs[NBUCKETS]++;
#endif
-#ifdef RCHECK
+#ifndef NDEBUG
/*
* Record allocated size of block and bound space with magic numbers.
*/
@@ -359,7 +351,7 @@ TclpAlloc(
numMallocs[bucket]++;
#endif
-#ifdef RCHECK
+#ifndef NDEBUG
/*
* Record allocated size of block and bound space with magic numbers.
*/
@@ -579,7 +571,7 @@ TclpRealloc(
numMallocs[NBUCKETS]++;
#endif
-#ifdef RCHECK
+#ifndef NDEBUG
/*
* Record allocated size of block and update magic number bounds.
*/
@@ -621,7 +613,7 @@ TclpRealloc(
* Ok, we don't have to copy, it fits as-is
*/
-#ifdef RCHECK
+#ifndef NDEBUG
overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
BLOCK_END(overPtr) = RMAGIC;
#endif
@@ -704,7 +696,7 @@ char *
TclpAlloc(
unsigned int numBytes) /* Number of bytes to allocate. */
{
- return (char*) malloc(numBytes);
+ return (char *) malloc(numBytes);
}
/*
@@ -752,7 +744,7 @@ TclpRealloc(
char *oldPtr, /* Pointer to alloced block. */
unsigned int numBytes) /* New size of memory. */
{
- return (char*) realloc(oldPtr, numBytes);
+ return (char *) realloc(oldPtr, numBytes);
}
#endif /* !USE_TCLALLOC */
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
new file mode 100644
index 0000000..7833105
--- /dev/null
+++ b/generic/tclAssembly.c
@@ -0,0 +1,4357 @@
+/*
+ * tclAssembly.c --
+ *
+ * Assembler for Tcl bytecodes.
+ *
+ * This file contains the procedures that convert Tcl Assembly Language (TAL)
+ * to a sequence of bytecode instructions for the Tcl execution engine.
+ *
+ * Copyright (c) 2010 by Ozgur Dogan Ugurlu.
+ * Copyright (c) 2010 by Kevin B. Kenny.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+/*-
+ *- THINGS TO DO:
+ *- More instructions:
+ *- done - alternate exit point (affects stack and exception range checking)
+ *- break and continue - if exception ranges can be sorted out.
+ *- foreach_start4, foreach_step4
+ *- returnImm, returnStk
+ *- expandStart, expandStkTop, invokeExpanded
+ *- dictFirst, dictNext, dictDone
+ *- dictUpdateStart, dictUpdateEnd
+ *- jumpTable testing
+ *- syntax (?)
+ *- returnCodeBranch
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+#include "tclOOInt.h"
+
+/*
+ * Structure that represents a range of instructions in the bytecode.
+ */
+
+typedef struct CodeRange {
+ int startOffset; /* Start offset in the bytecode array */
+ int endOffset; /* End offset in the bytecode array */
+} CodeRange;
+
+/*
+ * State identified for a basic block's catch context.
+ */
+
+typedef enum BasicBlockCatchState {
+ BBCS_UNKNOWN = 0, /* Catch context has not yet been identified */
+ BBCS_NONE, /* Block is outside of any catch */
+ BBCS_INCATCH, /* Block is within a catch context */
+ BBCS_CAUGHT, /* Block is within a catch context and
+ * may be executed after an exception fires */
+} BasicBlockCatchState;
+
+/*
+ * Structure that defines a basic block - a linear sequence of bytecode
+ * instructions with no jumps in or out (including not changing the
+ * state of any exception range).
+ */
+
+typedef struct BasicBlock {
+ int originalStartOffset; /* Instruction offset before JUMP1s were
+ * substituted with JUMP4's */
+ int startOffset; /* Instruction offset of the start of the
+ * block */
+ int startLine; /* Line number in the input script of the
+ * instruction at the start of the block */
+ int jumpOffset; /* Bytecode offset of the 'jump' instruction
+ * that ends the block, or -1 if there is no
+ * jump. */
+ int jumpLine; /* Line number in the input script of the
+ * 'jump' instruction that ends the block, or
+ * -1 if there is no jump */
+ struct BasicBlock* prevPtr; /* Immediate predecessor of this block */
+ struct BasicBlock* predecessor;
+ /* Predecessor of this block in the spanning
+ * tree */
+ struct BasicBlock* successor1;
+ /* BasicBlock structure of the following
+ * block: NULL at the end of the bytecode
+ * sequence. */
+ Tcl_Obj* jumpTarget; /* Jump target label if the jump target is
+ * unresolved */
+ int initialStackDepth; /* Absolute stack depth on entry */
+ int minStackDepth; /* Low-water relative stack depth */
+ int maxStackDepth; /* High-water relative stack depth */
+ int finalStackDepth; /* Relative stack depth on exit */
+ enum BasicBlockCatchState catchState;
+ /* State of the block for 'catch' analysis */
+ int catchDepth; /* Number of nested catches in which the basic
+ * block appears */
+ struct BasicBlock* enclosingCatch;
+ /* BasicBlock structure of the last startCatch
+ * executed on a path to this block, or NULL
+ * if there is no enclosing catch */
+ int foreignExceptionBase; /* Base index of foreign exceptions */
+ int foreignExceptionCount; /* Count of foreign exceptions */
+ ExceptionRange* foreignExceptions;
+ /* ExceptionRange structures for exception
+ * ranges belonging to embedded scripts and
+ * expressions in this block */
+ JumptableInfo* jtPtr; /* Jump table at the end of this basic block */
+ int flags; /* Boolean flags */
+} BasicBlock;
+
+/*
+ * Flags that pertain to a basic block.
+ */
+
+enum BasicBlockFlags {
+ BB_VISITED = (1 << 0), /* Block has been visited in the current
+ * traversal */
+ BB_FALLTHRU = (1 << 1), /* Control may pass from this block to a
+ * successor */
+ BB_JUMP1 = (1 << 2), /* Basic block ends with a 1-byte-offset jump
+ * and may need expansion */
+ BB_JUMPTABLE = (1 << 3), /* Basic block ends with a jump table */
+ BB_BEGINCATCH = (1 << 4), /* Block ends with a 'beginCatch' instruction,
+ * marking it as the start of a 'catch'
+ * sequence. The 'jumpTarget' is the exception
+ * exit from the catch block. */
+ BB_ENDCATCH = (1 << 5), /* Block ends with an 'endCatch' instruction,
+ * unwinding the catch from the exception
+ * stack. */
+};
+
+/*
+ * Source instruction type recognized by the assembler.
+ */
+
+typedef enum TalInstType {
+ ASSEM_1BYTE, /* Fixed arity, 1-byte instruction */
+ ASSEM_BEGIN_CATCH, /* Begin catch: one 4-byte jump offset to be
+ * converted to appropriate exception
+ * ranges */
+ ASSEM_BOOL, /* One Boolean operand */
+ ASSEM_BOOL_LVT4, /* One Boolean, one 4-byte LVT ref. */
+ ASSEM_CONCAT1, /* 1-byte unsigned-integer operand count, must
+ * be strictly positive, consumes N, produces
+ * 1 */
+ ASSEM_DICT_GET, /* 'dict get' and related - consumes N+1
+ * operands, produces 1, N > 0 */
+ ASSEM_DICT_SET, /* specifies key count and LVT index, consumes
+ * N+1 operands, produces 1, N > 0 */
+ ASSEM_DICT_UNSET, /* specifies key count and LVT index, consumes
+ * N operands, produces 1, N > 0 */
+ ASSEM_END_CATCH, /* End catch. No args. Exception range popped
+ * from stack and stack pointer restored. */
+ ASSEM_EVAL, /* 'eval' - evaluate a constant script (by
+ * compiling it in line with the assembly
+ * code! I love Tcl!) */
+ ASSEM_INDEX, /* 4 byte operand, integer or end-integer */
+ ASSEM_INVOKE, /* 1- or 4-byte operand count, must be
+ * strictly positive, consumes N, produces
+ * 1. */
+ ASSEM_JUMP, /* Jump instructions */
+ ASSEM_JUMP4, /* Jump instructions forcing a 4-byte offset */
+ ASSEM_JUMPTABLE, /* Jumptable (switch -exact) */
+ ASSEM_LABEL, /* The assembly directive that defines a
+ * label */
+ ASSEM_LINDEX_MULTI, /* 4-byte operand count, must be strictly
+ * positive, consumes N, produces 1 */
+ ASSEM_LIST, /* 4-byte operand count, must be nonnegative,
+ * consumses N, produces 1 */
+ ASSEM_LSET_FLAT, /* 4-byte operand count, must be >= 3,
+ * consumes N, produces 1 */
+ ASSEM_LVT, /* One operand that references a local
+ * variable */
+ ASSEM_LVT1, /* One 1-byte operand that references a local
+ * variable */
+ ASSEM_LVT1_SINT1, /* One 1-byte operand that references a local
+ * variable, one signed-integer 1-byte
+ * operand */
+ ASSEM_LVT4, /* One 4-byte operand that references a local
+ * variable */
+ ASSEM_OVER, /* OVER: 4-byte operand count, consumes N+1,
+ * produces N+2 */
+ ASSEM_PUSH, /* one literal operand */
+ ASSEM_REGEXP, /* One Boolean operand, but weird mapping to
+ * call flags */
+ ASSEM_REVERSE, /* REVERSE: 4-byte operand count, consumes N,
+ * produces N */
+ ASSEM_SINT1, /* One 1-byte signed-integer operand
+ * (INCR_STK_IMM) */
+ ASSEM_SINT4_LVT4, /* Signed 4-byte integer operand followed by
+ * LVT entry. Fixed arity */
+} TalInstType;
+
+/*
+ * Description of an instruction recognized by the assembler.
+ */
+
+typedef struct TalInstDesc {
+ const char *name; /* Name of instruction. */
+ TalInstType instType; /* The type of instruction */
+ int tclInstCode; /* Instruction code. For instructions having
+ * 1- and 4-byte variables, tclInstCode is
+ * ((1byte)<<8) || (4byte) */
+ int operandsConsumed; /* Number of operands consumed by the
+ * operation, or INT_MIN if the operation is
+ * variadic */
+ int operandsProduced; /* Number of operands produced by the
+ * operation. If negative, the operation has a
+ * net stack effect of -1-operandsProduced */
+} TalInstDesc;
+
+/*
+ * Structure that holds the state of the assembler while generating code.
+ */
+
+typedef struct AssemblyEnv {
+ CompileEnv* envPtr; /* Compilation environment being used for code
+ * generation */
+ Tcl_Parse* parsePtr; /* Parse of the current line of source */
+ Tcl_HashTable labelHash; /* Hash table whose keys are labels and whose
+ * values are 'label' objects storing the code
+ * offsets of the labels. */
+ int cmdLine; /* Current line number within the assembly
+ * code */
+ int* clNext; /* Invisible continuation line for
+ * [info frame] */
+ BasicBlock* head_bb; /* First basic block in the code */
+ BasicBlock* curr_bb; /* Current basic block */
+ int maxDepth; /* Maximum stack depth encountered */
+ int curCatchDepth; /* Current depth of catches */
+ int maxCatchDepth; /* Maximum depth of catches encountered */
+ int flags; /* Compilation flags (TCL_EVAL_DIRECT) */
+} AssemblyEnv;
+
+/*
+ * Static functions defined in this file.
+ */
+
+static void AddBasicBlockRangeToErrorInfo(AssemblyEnv*,
+ BasicBlock*);
+static BasicBlock * AllocBB(AssemblyEnv*);
+static int AssembleOneLine(AssemblyEnv* envPtr);
+static void BBAdjustStackDepth(BasicBlock* bbPtr, int consumed,
+ int produced);
+static void BBUpdateStackReqs(BasicBlock* bbPtr, int tblIdx,
+ int count);
+static void BBEmitInstInt1(AssemblyEnv* assemEnvPtr, int tblIdx,
+ int opnd, int count);
+static void BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx,
+ int opnd, int count);
+static void BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
+ int param, int count);
+static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx,
+ int count);
+static int BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
+static int CalculateJumpRelocations(AssemblyEnv*, int*);
+static int CheckForUnclosedCatches(AssemblyEnv*);
+static int CheckForThrowInWrongContext(AssemblyEnv*);
+static int CheckNonThrowingBlock(AssemblyEnv*, BasicBlock*);
+static int BytecodeMightThrow(unsigned char);
+static int CheckJumpTableLabels(AssemblyEnv*, BasicBlock*);
+static int CheckNamespaceQualifiers(Tcl_Interp*, const char*,
+ int);
+static int CheckNonNegative(Tcl_Interp*, int);
+static int CheckOneByte(Tcl_Interp*, int);
+static int CheckSignedOneByte(Tcl_Interp*, int);
+static int CheckStack(AssemblyEnv*);
+static int CheckStrictlyPositive(Tcl_Interp*, int);
+static ByteCode * CompileAssembleObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
+ const TalInstDesc*);
+static int DefineLabel(AssemblyEnv* envPtr, const char* label);
+static void DeleteMirrorJumpTable(JumptableInfo* jtPtr);
+static void DupAssembleCodeInternalRep(Tcl_Obj* src,
+ Tcl_Obj* dest);
+static void FillInJumpOffsets(AssemblyEnv*);
+static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
+ Tcl_Obj* jumpTable);
+static int FindLocalVar(AssemblyEnv* envPtr,
+ Tcl_Token** tokenPtrPtr);
+static int FinishAssembly(AssemblyEnv*);
+static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
+static void FreeAssemblyEnv(AssemblyEnv*);
+static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
+static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
+static int GetIntegerOperand(AssemblyEnv*, Tcl_Token**, int*);
+static int GetNextOperand(AssemblyEnv*, Tcl_Token**, Tcl_Obj**);
+static void LookForFreshCatches(BasicBlock*, BasicBlock**);
+static void MoveCodeForJumps(AssemblyEnv*, int);
+static void MoveExceptionRangesToBasicBlock(AssemblyEnv*, int,
+ int);
+static AssemblyEnv* NewAssemblyEnv(CompileEnv*, int);
+static int ProcessCatches(AssemblyEnv*);
+static int ProcessCatchesInBasicBlock(AssemblyEnv*, BasicBlock*,
+ BasicBlock*, enum BasicBlockCatchState, int);
+static void ResetVisitedBasicBlocks(AssemblyEnv*);
+static void ResolveJumpTableTargets(AssemblyEnv*, BasicBlock*);
+static void ReportUndefinedLabel(AssemblyEnv*, BasicBlock*,
+ Tcl_Obj*);
+static void RestoreEmbeddedExceptionRanges(AssemblyEnv*);
+static int StackCheckBasicBlock(AssemblyEnv*, BasicBlock *,
+ BasicBlock *, int);
+static BasicBlock* StartBasicBlock(AssemblyEnv*, int fallthrough,
+ Tcl_Obj* jumpLabel);
+/* static int AdvanceIp(const unsigned char *pc); */
+static int StackCheckBasicBlock(AssemblyEnv*, BasicBlock *,
+ BasicBlock *, int);
+static int StackCheckExit(AssemblyEnv*);
+static void StackFreshCatches(AssemblyEnv*, BasicBlock*, int,
+ BasicBlock**, int*);
+static void SyncStackDepth(AssemblyEnv*);
+static int TclAssembleCode(CompileEnv* envPtr, const char* code,
+ int codeLen, int flags);
+static void UnstackExpiredCatches(CompileEnv*, BasicBlock*, int,
+ BasicBlock**, int*);
+
+/*
+ * Tcl_ObjType that describes bytecode emitted by the assembler.
+ */
+
+static const Tcl_ObjType assembleCodeType = {
+ "assemblecode",
+ FreeAssembleCodeInternalRep, /* freeIntRepProc */
+ DupAssembleCodeInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+/*
+ * TIP #280: Remember the per-word line information of the current command. An
+ * index is used instead of a pointer as recursive compilation may reallocate,
+ * i.e. move, the array. This is also the reason to save the nuloc now, it may
+ * change during the course of the function.
+ *
+ * Macro to encapsulate the variable definition and setup.
+ */
+
+#define DefineLineInformation \
+ ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \
+ int eclIndex = mapPtr->nuloc - 1
+
+#define SetLineInformation(word) \
+ envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \
+ envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
+
+/*
+ * Flags bits used by PushVarName.
+ */
+
+#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */
+
+/*
+ * Source instructions recognized in the Tcl Assembly Language (TAL)
+ */
+
+static const TalInstDesc TalInstructionTable[] = {
+ /* PUSH must be first, see the code near the end of TclAssembleCode */
+ {"push", ASSEM_PUSH, (INST_PUSH1<<8
+ | INST_PUSH4), 0, 1},
+
+ {"add", ASSEM_1BYTE, INST_ADD, 2, 1},
+ {"append", ASSEM_LVT, (INST_APPEND_SCALAR1<<8
+ | INST_APPEND_SCALAR4),1, 1},
+ {"appendArray", ASSEM_LVT, (INST_APPEND_ARRAY1<<8
+ | INST_APPEND_ARRAY4), 2, 1},
+ {"appendArrayStk", ASSEM_1BYTE, INST_APPEND_ARRAY_STK, 3, 1},
+ {"appendStk", ASSEM_1BYTE, INST_APPEND_STK, 2, 1},
+ {"arrayExistsImm", ASSEM_LVT4, INST_ARRAY_EXISTS_IMM, 0, 1},
+ {"arrayExistsStk", ASSEM_1BYTE, INST_ARRAY_EXISTS_STK, 1, 1},
+ {"arrayMakeImm", ASSEM_LVT4, INST_ARRAY_MAKE_IMM, 0, 0},
+ {"arrayMakeStk", ASSEM_1BYTE, INST_ARRAY_MAKE_STK, 1, 0},
+ {"beginCatch", ASSEM_BEGIN_CATCH,
+ INST_BEGIN_CATCH4, 0, 0},
+ {"bitand", ASSEM_1BYTE, INST_BITAND, 2, 1},
+ {"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1},
+ {"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1},
+ {"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1},
+ {"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1},
+ {"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1},
+ {"currentNamespace",ASSEM_1BYTE, INST_NS_CURRENT, 0, 1},
+ {"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1},
+ {"dictExists", ASSEM_DICT_GET, INST_DICT_EXISTS, INT_MIN,1},
+ {"dictExpand", ASSEM_1BYTE, INST_DICT_EXPAND, 3, 1},
+ {"dictGet", ASSEM_DICT_GET, INST_DICT_GET, INT_MIN,1},
+ {"dictIncrImm", ASSEM_SINT4_LVT4,
+ INST_DICT_INCR_IMM, 1, 1},
+ {"dictLappend", ASSEM_LVT4, INST_DICT_LAPPEND, 2, 1},
+ {"dictRecombineStk",ASSEM_1BYTE, INST_DICT_RECOMBINE_STK,3, 0},
+ {"dictRecombineImm",ASSEM_LVT4, INST_DICT_RECOMBINE_IMM,2, 0},
+ {"dictSet", ASSEM_DICT_SET, INST_DICT_SET, INT_MIN,1},
+ {"dictUnset", ASSEM_DICT_UNSET,
+ INST_DICT_UNSET, INT_MIN,1},
+ {"div", ASSEM_1BYTE, INST_DIV, 2, 1},
+ {"dup", ASSEM_1BYTE, INST_DUP, 1, 2},
+ {"endCatch", ASSEM_END_CATCH,INST_END_CATCH, 0, 0},
+ {"eq", ASSEM_1BYTE, INST_EQ, 2, 1},
+ {"eval", ASSEM_EVAL, INST_EVAL_STK, 1, 1},
+ {"evalStk", ASSEM_1BYTE, INST_EVAL_STK, 1, 1},
+ {"exist", ASSEM_LVT4, INST_EXIST_SCALAR, 0, 1},
+ {"existArray", ASSEM_LVT4, INST_EXIST_ARRAY, 1, 1},
+ {"existArrayStk", ASSEM_1BYTE, INST_EXIST_ARRAY_STK, 2, 1},
+ {"existStk", ASSEM_1BYTE, INST_EXIST_STK, 1, 1},
+ {"expon", ASSEM_1BYTE, INST_EXPON, 2, 1},
+ {"expr", ASSEM_EVAL, INST_EXPR_STK, 1, 1},
+ {"exprStk", ASSEM_1BYTE, INST_EXPR_STK, 1, 1},
+ {"ge", ASSEM_1BYTE, INST_GE, 2, 1},
+ {"gt", ASSEM_1BYTE, INST_GT, 2, 1},
+ {"incr", ASSEM_LVT1, INST_INCR_SCALAR1, 1, 1},
+ {"incrArray", ASSEM_LVT1, INST_INCR_ARRAY1, 2, 1},
+ {"incrArrayImm", ASSEM_LVT1_SINT1,
+ INST_INCR_ARRAY1_IMM, 1, 1},
+ {"incrArrayStk", ASSEM_1BYTE, INST_INCR_ARRAY_STK, 3, 1},
+ {"incrArrayStkImm", ASSEM_SINT1, INST_INCR_ARRAY_STK_IMM,2, 1},
+ {"incrImm", ASSEM_LVT1_SINT1,
+ INST_INCR_SCALAR1_IMM, 0, 1},
+ {"incrStk", ASSEM_1BYTE, INST_INCR_SCALAR_STK, 2, 1},
+ {"incrStkImm", ASSEM_SINT1, INST_INCR_SCALAR_STK_IMM,
+ 1, 1},
+ {"infoLevelArgs", ASSEM_1BYTE, INST_INFO_LEVEL_ARGS, 1, 1},
+ {"infoLevelNumber", ASSEM_1BYTE, INST_INFO_LEVEL_NUM, 0, 1},
+ {"invokeStk", ASSEM_INVOKE, (INST_INVOKE_STK1 << 8
+ | INST_INVOKE_STK4), INT_MIN,1},
+ {"jump", ASSEM_JUMP, INST_JUMP1, 0, 0},
+ {"jump4", ASSEM_JUMP4, INST_JUMP4, 0, 0},
+ {"jumpFalse", ASSEM_JUMP, INST_JUMP_FALSE1, 1, 0},
+ {"jumpFalse4", ASSEM_JUMP4, INST_JUMP_FALSE4, 1, 0},
+ {"jumpTable", ASSEM_JUMPTABLE,INST_JUMP_TABLE, 1, 0},
+ {"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE1, 1, 0},
+ {"jumpTrue4", ASSEM_JUMP4, INST_JUMP_TRUE4, 1, 0},
+ {"label", ASSEM_LABEL, 0, 0, 0},
+ {"land", ASSEM_1BYTE, INST_LAND, 2, 1},
+ {"lappend", ASSEM_LVT, (INST_LAPPEND_SCALAR1<<8
+ | INST_LAPPEND_SCALAR4),
+ 1, 1},
+ {"lappendArray", ASSEM_LVT, (INST_LAPPEND_ARRAY1<<8
+ | INST_LAPPEND_ARRAY4),2, 1},
+ {"lappendArrayStk", ASSEM_1BYTE, INST_LAPPEND_ARRAY_STK, 3, 1},
+ {"lappendStk", ASSEM_1BYTE, INST_LAPPEND_STK, 2, 1},
+ {"le", ASSEM_1BYTE, INST_LE, 2, 1},
+ {"lindexMulti", ASSEM_LINDEX_MULTI,
+ INST_LIST_INDEX_MULTI, INT_MIN,1},
+ {"list", ASSEM_LIST, INST_LIST, INT_MIN,1},
+ {"listIn", ASSEM_1BYTE, INST_LIST_IN, 2, 1},
+ {"listIndex", ASSEM_1BYTE, INST_LIST_INDEX, 2, 1},
+ {"listIndexImm", ASSEM_INDEX, INST_LIST_INDEX_IMM, 1, 1},
+ {"listLength", ASSEM_1BYTE, INST_LIST_LENGTH, 1, 1},
+ {"listNotIn", ASSEM_1BYTE, INST_LIST_NOT_IN, 2, 1},
+ {"load", ASSEM_LVT, (INST_LOAD_SCALAR1 << 8
+ | INST_LOAD_SCALAR4), 0, 1},
+ {"loadArray", ASSEM_LVT, (INST_LOAD_ARRAY1<<8
+ | INST_LOAD_ARRAY4), 1, 1},
+ {"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1},
+ {"loadStk", ASSEM_1BYTE, INST_LOAD_SCALAR_STK, 1, 1},
+ {"lor", ASSEM_1BYTE, INST_LOR, 2, 1},
+ {"lsetFlat", ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1},
+ {"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1},
+ {"lshift", ASSEM_1BYTE, INST_LSHIFT, 2, 1},
+ {"lt", ASSEM_1BYTE, INST_LT, 2, 1},
+ {"mod", ASSEM_1BYTE, INST_MOD, 2, 1},
+ {"mult", ASSEM_1BYTE, INST_MULT, 2, 1},
+ {"neq", ASSEM_1BYTE, INST_NEQ, 2, 1},
+ {"nop", ASSEM_1BYTE, INST_NOP, 0, 0},
+ {"not", ASSEM_1BYTE, INST_LNOT, 1, 1},
+ {"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1},
+ {"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1},
+ {"pop", ASSEM_1BYTE, INST_POP, 1, 0},
+ {"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1},
+ {"pushReturnOpts", ASSEM_1BYTE, INST_PUSH_RETURN_OPTIONS,
+ 0, 1},
+ {"pushResult", ASSEM_1BYTE, INST_PUSH_RESULT, 0, 1},
+ {"regexp", ASSEM_REGEXP, INST_REGEXP, 2, 1},
+ {"resolveCmd", ASSEM_1BYTE, INST_RESOLVE_COMMAND, 1, 1},
+ {"reverse", ASSEM_REVERSE, INST_REVERSE, INT_MIN,-1-0},
+ {"rshift", ASSEM_1BYTE, INST_RSHIFT, 2, 1},
+ {"store", ASSEM_LVT, (INST_STORE_SCALAR1<<8
+ | INST_STORE_SCALAR4), 1, 1},
+ {"storeArray", ASSEM_LVT, (INST_STORE_ARRAY1<<8
+ | INST_STORE_ARRAY4), 2, 1},
+ {"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1},
+ {"storeStk", ASSEM_1BYTE, INST_STORE_SCALAR_STK, 2, 1},
+ {"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1},
+ {"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1},
+ {"strfind", ASSEM_1BYTE, INST_STR_FIND, 2, 1},
+ {"strindex", ASSEM_1BYTE, INST_STR_INDEX, 2, 1},
+ {"strlen", ASSEM_1BYTE, INST_STR_LEN, 1, 1},
+ {"strmap", ASSEM_1BYTE, INST_STR_MAP, 3, 1},
+ {"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1},
+ {"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1},
+ {"strrange", ASSEM_1BYTE, INST_STR_RANGE, 3, 1},
+ {"strrfind", ASSEM_1BYTE, INST_STR_FIND_LAST, 2, 1},
+ {"sub", ASSEM_1BYTE, INST_SUB, 2, 1},
+ {"tclooClass", ASSEM_1BYTE, INST_TCLOO_CLASS, 1, 1},
+ {"tclooIsObject", ASSEM_1BYTE, INST_TCLOO_IS_OBJECT, 1, 1},
+ {"tclooNamespace", ASSEM_1BYTE, INST_TCLOO_NS, 1, 1},
+ {"tclooSelf", ASSEM_1BYTE, INST_TCLOO_SELF, 0, 1},
+ {"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1},
+ {"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1},
+ {"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0},
+ {"unsetArray", ASSEM_BOOL_LVT4,INST_UNSET_ARRAY, 1, 0},
+ {"unsetArrayStk", ASSEM_BOOL, INST_UNSET_ARRAY_STK, 2, 0},
+ {"unsetStk", ASSEM_BOOL, INST_UNSET_STK, 1, 0},
+ {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1},
+ {"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1},
+ {"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0},
+ {"verifyDict", ASSEM_1BYTE, INST_DICT_VERIFY, 1, 0},
+ {"yield", ASSEM_1BYTE, INST_YIELD, 1, 1},
+ {NULL, 0, 0, 0, 0}
+};
+
+/*
+ * List of instructions that cannot throw an exception under any
+ * circumstances. These instructions are the ones that are permissible after
+ * an exception is caught but before the corresponding exception range is
+ * popped from the stack.
+ * The instructions must be in ascending order by numeric operation code.
+ */
+
+static const unsigned char NonThrowingByteCodes[] = {
+ INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */
+ INST_JUMP1, INST_JUMP4, /* 34-35 */
+ INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */
+ INST_OVER, /* 95 */
+ INST_PUSH_RETURN_OPTIONS, /* 108 */
+ INST_REVERSE, /* 126 */
+ INST_NOP, /* 132 */
+ INST_STR_MAP, /* 143 */
+ INST_STR_FIND, /* 144 */
+ INST_COROUTINE_NAME, /* 149 */
+ INST_NS_CURRENT, /* 151 */
+ INST_INFO_LEVEL_NUM, /* 152 */
+ INST_RESOLVE_COMMAND /* 154 */
+};
+
+/*
+ * Helper macros.
+ */
+
+#if defined(TCL_DEBUG_ASSEMBLY) && defined(__GNUC__) && __GNUC__ > 2
+#define DEBUG_PRINT(...) fprintf(stderr, ##__VA_ARGS__);fflush(stderr)
+#elif defined(__GNUC__) && __GNUC__ > 2
+#define DEBUG_PRINT(...) /* nothing */
+#else
+#define DEBUG_PRINT /* nothing */
+#endif
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BBAdjustStackDepth --
+ *
+ * When an opcode is emitted, adjusts the stack information in the basic
+ * block to reflect the number of operands produced and consumed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Updates minimum, maximum and final stack requirements in the basic
+ * block.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+BBAdjustStackDepth(
+ BasicBlock *bbPtr, /* Structure describing the basic block */
+ int consumed, /* Count of operands consumed by the
+ * operation */
+ int produced) /* Count of operands produced by the
+ * operation */
+{
+ int depth = bbPtr->finalStackDepth;
+
+ depth -= consumed;
+ if (depth < bbPtr->minStackDepth) {
+ bbPtr->minStackDepth = depth;
+ }
+ depth += produced;
+ if (depth > bbPtr->maxStackDepth) {
+ bbPtr->maxStackDepth = depth;
+ }
+ bbPtr->finalStackDepth = depth;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BBUpdateStackReqs --
+ *
+ * Updates the stack requirements of a basic block, given the opcode
+ * being emitted and an operand count.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Updates min, max and final stack requirements in the basic block.
+ *
+ * Notes:
+ * This function must not be called for instructions such as REVERSE and
+ * OVER that are variadic but do not consume all their operands. Instead,
+ * BBAdjustStackDepth should be called directly.
+ *
+ * count should be provided only for variadic operations. For operations
+ * with known arity, count should be 0.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+BBUpdateStackReqs(
+ BasicBlock* bbPtr, /* Structure describing the basic block */
+ int tblIdx, /* Index in TalInstructionTable of the
+ * operation being assembled */
+ int count) /* Count of operands for variadic insts */
+{
+ int consumed = TalInstructionTable[tblIdx].operandsConsumed;
+ int produced = TalInstructionTable[tblIdx].operandsProduced;
+
+ if (consumed == INT_MIN) {
+ /*
+ * The instruction is variadic; it consumes 'count' operands.
+ */
+
+ consumed = count;
+ }
+ if (produced < 0) {
+ /*
+ * The instruction leaves some of its variadic operands on the stack,
+ * with net stack effect of '-1-produced'
+ */
+
+ produced = consumed - produced - 1;
+ }
+ BBAdjustStackDepth(bbPtr, consumed, produced);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BBEmitOpcode, BBEmitInstInt1, BBEmitInstInt4 --
+ *
+ * Emit the opcode part of an instruction, or the entirety of an
+ * instruction with a 1- or 4-byte operand, and adjust stack
+ * requirements.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Stores instruction and operand in the operand stream, and adjusts the
+ * stack.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+BBEmitOpcode(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int tblIdx, /* Table index in TalInstructionTable of op */
+ int count) /* Operand count for variadic ops */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ BasicBlock* bbPtr = assemEnvPtr->curr_bb;
+ /* Current basic block */
+ int op = TalInstructionTable[tblIdx].tclInstCode & 0xff;
+
+ /*
+ * If this is the first instruction in a basic block, record its line
+ * number.
+ */
+
+ if (bbPtr->startOffset == envPtr->codeNext - envPtr->codeStart) {
+ bbPtr->startLine = assemEnvPtr->cmdLine;
+ }
+
+ TclEmitInt1(op, envPtr);
+ envPtr->atCmdStart = ((op) == INST_START_CMD);
+ BBUpdateStackReqs(bbPtr, tblIdx, count);
+}
+
+static void
+BBEmitInstInt1(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int tblIdx, /* Index in TalInstructionTable of op */
+ int opnd, /* 1-byte operand */
+ int count) /* Operand count for variadic ops */
+{
+ BBEmitOpcode(assemEnvPtr, tblIdx, count);
+ TclEmitInt1(opnd, assemEnvPtr->envPtr);
+}
+
+static void
+BBEmitInstInt4(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int tblIdx, /* Index in TalInstructionTable of op */
+ int opnd, /* 4-byte operand */
+ int count) /* Operand count for variadic ops */
+{
+ BBEmitOpcode(assemEnvPtr, tblIdx, count);
+ TclEmitInt4(opnd, assemEnvPtr->envPtr);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BBEmitInst1or4 --
+ *
+ * Emits a 1- or 4-byte operation according to the magnitude of the
+ * operand
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+BBEmitInst1or4(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int tblIdx, /* Index in TalInstructionTable of op */
+ int param, /* Variable-length parameter */
+ int count) /* Arity if variadic */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ BasicBlock* bbPtr = assemEnvPtr->curr_bb;
+ /* Current basic block */
+ int op = TalInstructionTable[tblIdx].tclInstCode;
+
+ if (param <= 0xff) {
+ op >>= 8;
+ } else {
+ op &= 0xff;
+ }
+ TclEmitInt1(op, envPtr);
+ if (param <= 0xff) {
+ TclEmitInt1(param, envPtr);
+ } else {
+ TclEmitInt4(param, envPtr);
+ }
+ envPtr->atCmdStart = ((op) == INST_START_CMD);
+ BBUpdateStackReqs(bbPtr, tblIdx, count);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Tcl_AssembleObjCmd, TclNRAssembleObjCmd --
+ *
+ * Direct evaluation path for tcl::unsupported::assemble
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Assembles the code in objv[1], and executes it, so side effects
+ * include whatever the code does.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int
+Tcl_AssembleObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ /*
+ * Boilerplate - make sure that there is an NRE trampoline on the C stack
+ * because there needs to be one in place to execute bytecode.
+ */
+
+ return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRAssembleObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ ByteCode *codePtr; /* Pointer to the bytecode to execute */
+ Tcl_Obj* backtrace; /* Object where extra error information is
+ * constructed. */
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "bytecodeList");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Assemble the source to bytecode.
+ */
+
+ codePtr = CompileAssembleObj(interp, objv[1]);
+
+ /*
+ * On failure, report error line.
+ */
+
+ if (codePtr == NULL) {
+ Tcl_AddErrorInfo(interp, "\n (\"");
+ Tcl_AddErrorInfo(interp, Tcl_GetString(objv[0]));
+ Tcl_AddErrorInfo(interp, "\" body, line ");
+ backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp));
+ Tcl_IncrRefCount(backtrace);
+ Tcl_AddErrorInfo(interp, Tcl_GetString(backtrace));
+ Tcl_DecrRefCount(backtrace);
+ Tcl_AddErrorInfo(interp, ")");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Use NRE to evaluate the bytecode from the trampoline.
+ */
+
+ return TclNRExecuteByteCode(interp, codePtr);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CompileAssembleObj --
+ *
+ * Sets up and assembles Tcl bytecode for the direct-execution path in
+ * the Tcl bytecode assembler.
+ *
+ * Results:
+ * Returns a pointer to the assembled code. Returns NULL if the assembly
+ * fails for any reason, with an appropriate error message in the
+ * interpreter.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static ByteCode *
+CompileAssembleObj(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *objPtr) /* Source code to assemble */
+{
+ Interp *iPtr = (Interp *) interp;
+ /* Internals of the interpreter */
+ CompileEnv compEnv; /* Compilation environment structure */
+ register ByteCode *codePtr = NULL;
+ /* Bytecode resulting from the assembly */
+ register const AuxData * auxDataPtr;
+ /* Pointer to an auxiliary data element
+ * in a compilation environment being
+ * destroyed. */
+ Namespace* namespacePtr; /* Namespace in which variable and command
+ * names in the bytecode resolve */
+ int status; /* Status return from Tcl_AssembleCode */
+ const char* source; /* String representation of the source code */
+ int sourceLen; /* Length of the source code in bytes */
+ int i;
+
+
+ /*
+ * Get the expression ByteCode from the object. If it exists, make sure it
+ * is valid in the current context.
+ */
+
+ if (objPtr->typePtr == &assembleCodeType) {
+ namespacePtr = iPtr->varFramePtr->nsPtr;
+ codePtr = objPtr->internalRep.otherValuePtr;
+ if (((Interp *) *codePtr->interpHandle == iPtr)
+ && (codePtr->compileEpoch == iPtr->compileEpoch)
+ && (codePtr->nsPtr == namespacePtr)
+ && (codePtr->nsEpoch == namespacePtr->resolverEpoch)
+ && (codePtr->localCachePtr
+ == iPtr->varFramePtr->localCachePtr)) {
+ return codePtr;
+ }
+
+ /*
+ * Not valid, so free it and regenerate.
+ */
+
+ FreeAssembleCodeInternalRep(objPtr);
+ }
+
+ /*
+ * Set up the compilation environment, and assemble the code.
+ */
+
+ source = TclGetStringFromObj(objPtr, &sourceLen);
+ TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0);
+ status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT);
+ if (status != TCL_OK) {
+ /*
+ * Assembly failed. Clean up and report the error.
+ */
+
+ /*
+ * Free any literals that were constructed for the assembly.
+ */
+ for (i = 0; i < compEnv.literalArrayNext; i++) {
+ TclReleaseLiteral(interp, compEnv.literalArrayPtr[i].objPtr);
+ }
+
+ /*
+ * Free any auxiliary data that was attached to the bytecode
+ * under construction.
+ */
+
+ for (i = 0; i < compEnv.auxDataArrayNext; i++) {
+ auxDataPtr = compEnv.auxDataArrayPtr + i;
+ if (auxDataPtr->type->freeProc != NULL) {
+ (auxDataPtr->type->freeProc)(auxDataPtr->clientData);
+ }
+ }
+
+ /*
+ * TIP 280. If there is extended command line information,
+ * we need to clean it up.
+ */
+
+ if (compEnv.extCmdMapPtr != NULL) {
+ if (compEnv.extCmdMapPtr->type == TCL_LOCATION_SOURCE) {
+ Tcl_DecrRefCount(compEnv.extCmdMapPtr->path);
+ }
+ for (i = 0; i < compEnv.extCmdMapPtr->nuloc; ++i) {
+ ckfree(compEnv.extCmdMapPtr->loc[i].line);
+ }
+ if (compEnv.extCmdMapPtr->loc != NULL) {
+ ckfree(compEnv.extCmdMapPtr->loc);
+ }
+ Tcl_DeleteHashTable(&(compEnv.extCmdMapPtr->litInfo));
+ }
+
+ TclFreeCompileEnv(&compEnv);
+ return NULL;
+ }
+
+ /*
+ * Add a "done" instruction as the last instruction and change the object
+ * into a ByteCode object. Ownership of the literal objects and aux data
+ * items is given to the ByteCode object.
+ */
+
+ TclEmitOpcode(INST_DONE, &compEnv);
+ TclInitByteCodeObj(objPtr, &compEnv);
+ objPtr->typePtr = &assembleCodeType;
+ TclFreeCompileEnv(&compEnv);
+
+ /*
+ * Record the local variable context to which the bytecode pertains
+ */
+
+ codePtr = objPtr->internalRep.otherValuePtr;
+ if (iPtr->varFramePtr->localCachePtr) {
+ codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
+ codePtr->localCachePtr->refCount++;
+ }
+
+ /*
+ * Report on what the assembler did.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceCompile >= 2) {
+ TclPrintByteCodeObj(interp, objPtr);
+ fflush(stdout);
+ }
+#endif /* TCL_COMPILE_DEBUG */
+
+ return codePtr;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclCompileAssembleCmd --
+ *
+ * Compilation procedure for the '::tcl::unsupported::assemble' command.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Puts the result of assembling the code into the bytecode stream in
+ * 'compileEnv'.
+ *
+ * This procedure makes sure that the command has a single arg, which is
+ * constant. If that condition is met, the procedure calls TclAssembleCode to
+ * produce bytecode for the given assembly code, and returns any error
+ * resulting from the assembly.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int
+TclCompileAssembleCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokenPtr; /* Token in the input script */
+
+ /*
+ * Make sure that the command has a single arg that is a simple word.
+ */
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compile the code and return any error from the compilation.
+ */
+
+ return TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclAssembleCode --
+ *
+ * Take a list of instructions in a Tcl_Obj, and assemble them to Tcl
+ * bytecodes
+ *
+ * Results:
+ * Returns TCL_OK on success, TCL_ERROR on failure. If 'flags' includes
+ * TCL_EVAL_DIRECT, places an error message in the interpreter result.
+ *
+ * Side effects:
+ * Adds byte codes to the compile environment, and updates the
+ * environment's stack depth.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+TclAssembleCode(
+ CompileEnv *envPtr, /* Compilation environment that is to receive
+ * the generated bytecode */
+ const char* codePtr, /* Assembly-language code to be processed */
+ int codeLen, /* Length of the code */
+ int flags) /* OR'ed combination of flags */
+{
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ /*
+ * Walk through the assembly script using the Tcl parser. Each 'command'
+ * will be an instruction or assembly directive.
+ */
+
+ const char* instPtr = codePtr;
+ /* Where to start looking for a line of code */
+ int instLen; /* Length in bytes of the current line of
+ * code */
+ const char* nextPtr; /* Pointer to the end of the line of code */
+ int bytesLeft = codeLen; /* Number of bytes of source code remaining to
+ * be parsed */
+ int status; /* Tcl status return */
+ AssemblyEnv* assemEnvPtr = NewAssemblyEnv(envPtr, flags);
+ Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
+
+ do {
+ /*
+ * Parse out one command line from the assembly script.
+ */
+
+ status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr);
+ instLen = parsePtr->commandSize;
+ if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
+ --instLen;
+ }
+
+ /*
+ * Report errors in the parse.
+ */
+
+ if (status != TCL_OK) {
+ if (flags & TCL_EVAL_DIRECT) {
+ Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart,
+ instLen);
+ }
+ FreeAssemblyEnv(assemEnvPtr);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Advance the pointers around any leading commentary.
+ */
+
+ TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr,
+ parsePtr->commandStart);
+ TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
+ parsePtr->commandStart - envPtr->source);
+
+ /*
+ * Process the line of code.
+ */
+
+ if (parsePtr->numWords > 0) {
+ /*
+ * If tracing, show each line assembled as it happens.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+ if ((tclTraceCompile >= 2) && (envPtr->procPtr == NULL)) {
+ printf(" %4ld Assembling: ",
+ (long)(envPtr->codeNext - envPtr->codeStart));
+ TclPrintSource(stdout, parsePtr->commandStart,
+ TclMin(instLen, 55));
+ printf("\n");
+ }
+#endif
+ if (AssembleOneLine(assemEnvPtr) != TCL_OK) {
+ if (flags & TCL_EVAL_DIRECT) {
+ Tcl_LogCommandInfo(interp, codePtr,
+ parsePtr->commandStart, instLen);
+ }
+ Tcl_FreeParse(parsePtr);
+ FreeAssemblyEnv(assemEnvPtr);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Advance to the next line of code.
+ */
+
+ nextPtr = parsePtr->commandStart + parsePtr->commandSize;
+ bytesLeft -= (nextPtr - instPtr);
+ instPtr = nextPtr;
+ TclAdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart,
+ instPtr);
+ TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
+ instPtr - envPtr->source);
+ Tcl_FreeParse(parsePtr);
+ } while (bytesLeft > 0);
+
+ /*
+ * Done with parsing the code.
+ */
+
+ status = FinishAssembly(assemEnvPtr);
+ FreeAssemblyEnv(assemEnvPtr);
+ return status;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * NewAssemblyEnv --
+ *
+ * Creates an environment for the assembler to run in.
+ *
+ * Results:
+ * Allocates, initialises and returns an assembler environment
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static AssemblyEnv*
+NewAssemblyEnv(
+ CompileEnv* envPtr, /* Compilation environment being used for code
+ * generation*/
+ int flags) /* Compilation flags (TCL_EVAL_DIRECT) */
+{
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ AssemblyEnv* assemEnvPtr = TclStackAlloc(interp, sizeof(AssemblyEnv));
+ /* Assembler environment under construction */
+ Tcl_Parse* parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+ /* Parse of one line of assembly code */
+
+ assemEnvPtr->envPtr = envPtr;
+ assemEnvPtr->parsePtr = parsePtr;
+ assemEnvPtr->cmdLine = envPtr->line;
+ assemEnvPtr->clNext = envPtr->clNext;
+
+ /*
+ * Make the hashtables that store symbol resolution.
+ */
+
+ Tcl_InitHashTable(&assemEnvPtr->labelHash, TCL_STRING_KEYS);
+
+ /*
+ * Start the first basic block.
+ */
+
+ assemEnvPtr->curr_bb = NULL;
+ assemEnvPtr->head_bb = AllocBB(assemEnvPtr);
+ assemEnvPtr->curr_bb = assemEnvPtr->head_bb;
+ assemEnvPtr->head_bb->startLine = 1;
+
+ /*
+ * Stash compilation flags.
+ */
+
+ assemEnvPtr->flags = flags;
+ return assemEnvPtr;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FreeAssemblyEnv --
+ *
+ * Cleans up the assembler environment when assembly is complete.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+FreeAssemblyEnv(
+ AssemblyEnv* assemEnvPtr) /* Environment to free */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment being used for code
+ * generation */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ BasicBlock* thisBB; /* Pointer to a basic block being deleted */
+ BasicBlock* nextBB; /* Pointer to a deleted basic block's
+ * successor */
+
+ /*
+ * Free all the basic block structures.
+ */
+
+ for (thisBB = assemEnvPtr->head_bb; thisBB != NULL; thisBB = nextBB) {
+ if (thisBB->jumpTarget != NULL) {
+ Tcl_DecrRefCount(thisBB->jumpTarget);
+ }
+ if (thisBB->foreignExceptions != NULL) {
+ ckfree(thisBB->foreignExceptions);
+ }
+ nextBB = thisBB->successor1;
+ if (thisBB->jtPtr != NULL) {
+ DeleteMirrorJumpTable(thisBB->jtPtr);
+ thisBB->jtPtr = NULL;
+ }
+ ckfree(thisBB);
+ }
+
+ /*
+ * Dispose what's left.
+ */
+
+ Tcl_DeleteHashTable(&assemEnvPtr->labelHash);
+ TclStackFree(interp, assemEnvPtr->parsePtr);
+ TclStackFree(interp, assemEnvPtr);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * AssembleOneLine --
+ *
+ * Assembles a single command from an assembly language source.
+ *
+ * Results:
+ * Returns TCL_ERROR with an appropriate error message if the assembly
+ * fails. Returns TCL_OK if the assembly succeeds. Updates the assembly
+ * environment with the state of the assembly.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+AssembleOneLine(
+ AssemblyEnv* assemEnvPtr) /* State of the assembly */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment being used for code
+ * gen */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
+ /* Parse of the line of code */
+ Tcl_Token* tokenPtr; /* Current token within the line of code */
+ Tcl_Obj* instNameObj; /* Name of the instruction */
+ int tblIdx; /* Index in TalInstructionTable of the
+ * instruction */
+ enum TalInstType instType; /* Type of the instruction */
+ Tcl_Obj* operand1Obj = NULL;
+ /* First operand to the instruction */
+ const char* operand1; /* String rep of the operand */
+ int operand1Len; /* String length of the operand */
+ int opnd; /* Integer representation of an operand */
+ int litIndex; /* Literal pool index of a constant */
+ int localVar; /* LVT index of a local variable */
+ int flags; /* Flags for a basic block */
+ JumptableInfo* jtPtr; /* Pointer to a jumptable */
+ int infoIndex; /* Index of the jumptable in auxdata */
+ int status = TCL_ERROR; /* Return value from this function */
+
+ /*
+ * Make sure that the instruction name is known at compile time.
+ */
+
+ tokenPtr = parsePtr->tokenPtr;
+ if (GetNextOperand(assemEnvPtr, &tokenPtr, &instNameObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the instruction name.
+ */
+
+ if (Tcl_GetIndexFromObjStruct(interp, instNameObj,
+ &TalInstructionTable[0].name, sizeof(TalInstDesc), "instruction",
+ TCL_EXACT, &tblIdx) != TCL_OK) {
+ goto cleanup;
+ }
+
+ /*
+ * Vector on the type of instruction being processed.
+ */
+
+ instType = TalInstructionTable[tblIdx].instType;
+ switch (instType) {
+
+ case ASSEM_PUSH:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "value");
+ goto cleanup;
+ }
+ if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
+ goto cleanup;
+ }
+ operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
+ litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
+ BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0);
+ break;
+
+ case ASSEM_1BYTE:
+ if (parsePtr->numWords != 1) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
+ goto cleanup;
+ }
+ BBEmitOpcode(assemEnvPtr, tblIdx, 0);
+ break;
+
+ case ASSEM_BEGIN_CATCH:
+ /*
+ * Emit the BEGIN_CATCH instruction with the code offset of the
+ * exception branch target instead of the exception range index. The
+ * correct index will be generated and inserted later, when catches
+ * are being resolved.
+ */
+
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
+ goto cleanup;
+ }
+ if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
+ goto cleanup;
+ }
+ assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
+ assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
+ BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0);
+ assemEnvPtr->curr_bb->flags |= BB_BEGINCATCH;
+ StartBasicBlock(assemEnvPtr, BB_FALLTHRU, operand1Obj);
+ break;
+
+ case ASSEM_BOOL:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean");
+ goto cleanup;
+ }
+ if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
+ break;
+
+ case ASSEM_BOOL_LVT4:
+ if (parsePtr->numWords != 3) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName");
+ goto cleanup;
+ }
+ if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
+ goto cleanup;
+ }
+ BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
+ TclEmitInt4(localVar, envPtr);
+ break;
+
+ case ASSEM_CONCAT1:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckOneByte(interp, opnd) != TCL_OK
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd);
+ break;
+
+ case ASSEM_DICT_GET:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
+ break;
+
+ case ASSEM_DICT_SET:
+ if (parsePtr->numWords != 3) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
+ TclEmitInt4(localVar, envPtr);
+ break;
+
+ case ASSEM_DICT_UNSET:
+ if (parsePtr->numWords != 3) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
+ TclEmitInt4(localVar, envPtr);
+ break;
+
+ case ASSEM_END_CATCH:
+ if (parsePtr->numWords != 1) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
+ goto cleanup;
+ }
+ assemEnvPtr->curr_bb->flags |= BB_ENDCATCH;
+ BBEmitOpcode(assemEnvPtr, tblIdx, 0);
+ StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
+ break;
+
+ case ASSEM_EVAL:
+ /* TODO - Refactor this stuff into a subroutine that takes the inst
+ * code, the message ("script" or "expression") and an evaluator
+ * callback that calls TclCompileScript or TclCompileExpr. */
+
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj,
+ ((TalInstructionTable[tblIdx].tclInstCode
+ == INST_EVAL_STK) ? "script" : "expression"));
+ goto cleanup;
+ }
+ if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ CompileEmbeddedScript(assemEnvPtr, tokenPtr+1,
+ TalInstructionTable+tblIdx);
+ } else if (GetNextOperand(assemEnvPtr, &tokenPtr,
+ &operand1Obj) != TCL_OK) {
+ goto cleanup;
+ } else {
+ operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
+ litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
+
+ /*
+ * Assumes that PUSH is the first slot!
+ */
+
+ BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
+ BBEmitOpcode(assemEnvPtr, tblIdx, 0);
+ }
+ break;
+
+ case ASSEM_INVOKE:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+
+ BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd);
+ break;
+
+ case ASSEM_JUMP:
+ case ASSEM_JUMP4:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
+ goto cleanup;
+ }
+ if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
+ goto cleanup;
+ }
+ assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
+ if (instType == ASSEM_JUMP) {
+ flags = BB_JUMP1;
+ BBEmitInstInt1(assemEnvPtr, tblIdx, 0, 0);
+ } else {
+ flags = 0;
+ BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0);
+ }
+
+ /*
+ * Start a new basic block at the instruction following the jump.
+ */
+
+ assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
+ if (TalInstructionTable[tblIdx].operandsConsumed != 0) {
+ flags |= BB_FALLTHRU;
+ }
+ StartBasicBlock(assemEnvPtr, flags, operand1Obj);
+ break;
+
+ case ASSEM_JUMPTABLE:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "table");
+ goto cleanup;
+ }
+ if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
+ goto cleanup;
+ }
+
+ jtPtr = ckalloc(sizeof(JumptableInfo));
+
+ Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
+ assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
+ assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
+ DEBUG_PRINT("bb %p jumpLine %d jumpOffset %d\n",
+ assemEnvPtr->curr_bb, assemEnvPtr->cmdLine,
+ envPtr->codeNext - envPtr->codeStart);
+
+ infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
+ DEBUG_PRINT("auxdata index=%d\n", infoIndex);
+
+ BBEmitInstInt4(assemEnvPtr, tblIdx, infoIndex, 0);
+ if (CreateMirrorJumpTable(assemEnvPtr, operand1Obj) != TCL_OK) {
+ goto cleanup;
+ }
+ StartBasicBlock(assemEnvPtr, BB_JUMPTABLE|BB_FALLTHRU, NULL);
+ break;
+
+ case ASSEM_LABEL:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "name");
+ goto cleanup;
+ }
+ if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
+ goto cleanup;
+ }
+
+ /*
+ * Add the (label_name, address) pair to the hash table.
+ */
+
+ if (DefineLabel(assemEnvPtr, Tcl_GetString(operand1Obj)) != TCL_OK) {
+ goto cleanup;
+ }
+ break;
+
+ case ASSEM_LINDEX_MULTI:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
+ break;
+
+ case ASSEM_LIST:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckNonNegative(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
+ break;
+
+ case ASSEM_INDEX:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+ goto cleanup;
+ }
+ if (GetListIndexOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
+ break;
+
+ case ASSEM_LSET_FLAT:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ if (opnd < 2) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("operand must be >=2", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL);
+ }
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
+ break;
+
+ case ASSEM_LVT:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
+ goto cleanup;
+ }
+ BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0);
+ break;
+
+ case ASSEM_LVT1:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0 || CheckOneByte(interp, localVar)) {
+ goto cleanup;
+ }
+ BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
+ break;
+
+ case ASSEM_LVT1_SINT1:
+ if (parsePtr->numWords != 3) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8");
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0 || CheckOneByte(interp, localVar)
+ || GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckSignedOneByte(interp, opnd)) {
+ goto cleanup;
+ }
+ BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
+ TclEmitInt1(opnd, envPtr);
+ break;
+
+ case ASSEM_LVT4:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0);
+ break;
+
+ case ASSEM_OVER:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckNonNegative(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
+ break;
+
+ case ASSEM_REGEXP:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean");
+ goto cleanup;
+ }
+ if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ {
+ int flags = TCL_REG_ADVANCED | (opnd ? TCL_REG_NOCASE : 0);
+
+ BBEmitInstInt1(assemEnvPtr, tblIdx, flags, 0);
+ }
+ break;
+
+ case ASSEM_REVERSE:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckNonNegative(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
+ break;
+
+ case ASSEM_SINT1:
+ if (parsePtr->numWords != 2) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckSignedOneByte(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
+ break;
+
+ case ASSEM_SINT4_LVT4:
+ if (parsePtr->numWords != 3) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0);
+ TclEmitInt4(localVar, envPtr);
+ break;
+
+ default:
+ Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n",
+ Tcl_GetString(instNameObj));
+ }
+
+ status = TCL_OK;
+ cleanup:
+ Tcl_DecrRefCount(instNameObj);
+ if (operand1Obj) {
+ Tcl_DecrRefCount(operand1Obj);
+ }
+ return status;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CompileEmbeddedScript --
+ *
+ * Compile an embedded 'eval' or 'expr' that appears in assembly code.
+ *
+ * This procedure is called when the 'eval' or 'expr' assembly directive is
+ * encountered, and the argument to the directive is a simple word that
+ * requires no substitution. The appropriate compiler (TclCompileScript or
+ * TclCompileExpr) is invoked recursively, and emits bytecode.
+ *
+ * Before the compiler is invoked, the compilation environment's stack
+ * consumption is reset to zero. Upon return from the compilation, the net
+ * stack effect of the compilation is in the compiler env, and this stack
+ * effect is posted to the assembler environment. The compile environment's
+ * stack consumption is then restored to what it was before (which is actually
+ * the state of the stack on entry to the block of assembly code).
+ *
+ * Any exception ranges pushed by the compilation are copied to the basic
+ * block and removed from the compiler environment. They will be rebuilt at
+ * the end of assembly, when the exception stack depth is actually known.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+CompileEmbeddedScript(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Token* tokenPtr, /* Tcl_Token containing the script */
+ const TalInstDesc* instPtr) /* Instruction that determines whether
+ * the script is 'expr' or 'eval' */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+
+ /*
+ * The expression or script is not only known at compile time, but
+ * actually a "simple word". It can be compiled inline by invoking the
+ * compiler recursively.
+ *
+ * Save away the stack depth and reset it before compiling the script.
+ * We'll record the stack usage of the script in the BasicBlock, and
+ * accumulate it together with the stack usage of the enclosing assembly
+ * code.
+ */
+
+ int savedStackDepth = envPtr->currStackDepth;
+ int savedMaxStackDepth = envPtr->maxStackDepth;
+ int savedCodeIndex = envPtr->codeNext - envPtr->codeStart;
+ int savedExceptArrayNext = envPtr->exceptArrayNext;
+
+ envPtr->currStackDepth = 0;
+ envPtr->maxStackDepth = 0;
+
+ StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
+ switch(instPtr->tclInstCode) {
+ case INST_EVAL_STK:
+ TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr);
+ break;
+ case INST_EXPR_STK:
+ TclCompileExpr(interp, tokenPtr->start, tokenPtr->size, envPtr, 1);
+ break;
+ default:
+ Tcl_Panic("no ASSEM_EVAL case for %s (%d), can't happen",
+ instPtr->name, instPtr->tclInstCode);
+ }
+
+ /*
+ * Roll up the stack usage of the embedded block into the assembler
+ * environment.
+ */
+
+ SyncStackDepth(assemEnvPtr);
+ envPtr->currStackDepth = savedStackDepth;
+ envPtr->maxStackDepth = savedMaxStackDepth;
+
+ /*
+ * Save any exception ranges that were pushed by the compiler; they will
+ * need to be fixed up once the stack depth is known.
+ */
+
+ MoveExceptionRangesToBasicBlock(assemEnvPtr, savedCodeIndex,
+ savedExceptArrayNext);
+
+ /*
+ * Flush the current basic block.
+ */
+
+ StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * SyncStackDepth --
+ *
+ * Copies the stack depth from the compile environment to a basic block.
+ *
+ * Side effects:
+ * Current and max stack depth in the current basic block are adjusted.
+ *
+ * This procedure is called on return from invoking the compiler for the
+ * 'eval' and 'expr' operations. It adjusts the stack depth of the current
+ * basic block to reflect the stack required by the just-compiled code.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+SyncStackDepth(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ BasicBlock* curr_bb = assemEnvPtr->curr_bb;
+ /* Current basic block */
+ int maxStackDepth = curr_bb->finalStackDepth + envPtr->maxStackDepth;
+ /* Max stack depth in the basic block */
+
+ if (maxStackDepth > curr_bb->maxStackDepth) {
+ curr_bb->maxStackDepth = maxStackDepth;
+ }
+ curr_bb->finalStackDepth += envPtr->currStackDepth;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * MoveExceptionRangesToBasicBlock --
+ *
+ * Removes exception ranges that were created by compiling an embedded
+ * script from the CompileEnv, and stores them in the BasicBlock. They
+ * will be reinstalled, at the correct stack depth, after control flow
+ * analysis is complete on the assembly code.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+MoveExceptionRangesToBasicBlock(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int savedCodeIndex, /* Start of the embedded code */
+ int savedExceptArrayNext) /* Saved index of the end of the exception
+ * range array */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ BasicBlock* curr_bb = assemEnvPtr->curr_bb;
+ /* Current basic block */
+ int exceptionCount = envPtr->exceptArrayNext - savedExceptArrayNext;
+ /* Number of ranges that must be moved */
+ int i;
+
+ if (exceptionCount == 0) {
+ /* Nothing to do */
+ return;
+ }
+
+ /*
+ * Save the exception ranges in the basic block. They will be re-added at
+ * the conclusion of assembly; at this time, the INST_BEGIN_CATCH
+ * instructions in the block will be adjusted from whatever range indices
+ * they have [savedExceptArrayNext .. envPtr->exceptArrayNext) to the
+ * indices that the exceptions acquire. The saved exception ranges are
+ * converted to a relative nesting depth. The depth will be recomputed
+ * once flow analysis has determined the actual stack depth of the block.
+ */
+
+ DEBUG_PRINT("basic block %p has %d exceptions starting at %d\n",
+ curr_bb, exceptionCount, savedExceptArrayNext);
+ curr_bb->foreignExceptionBase = savedExceptArrayNext;
+ curr_bb->foreignExceptionCount = exceptionCount;
+ curr_bb->foreignExceptions =
+ ckalloc(exceptionCount * sizeof(ExceptionRange));
+ memcpy(curr_bb->foreignExceptions,
+ envPtr->exceptArrayPtr + savedExceptArrayNext,
+ exceptionCount * sizeof(ExceptionRange));
+ for (i = 0; i < exceptionCount; ++i) {
+ curr_bb->foreignExceptions[i].nestingLevel -= envPtr->exceptDepth;
+ }
+ envPtr->exceptArrayNext = savedExceptArrayNext;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CreateMirrorJumpTable --
+ *
+ * Makes a jump table with comparison values and assembly code labels.
+ *
+ * Results:
+ * Returns a standard Tcl status, with an error message in the
+ * interpreter on error.
+ *
+ * Side effects:
+ * Initializes the jump table pointer in the current basic block to a
+ * JumptableInfo. The keys in the JumptableInfo are the comparison
+ * strings. The values, instead of being jump displacements, are
+ * Tcl_Obj's with the code labels.
+ */
+
+static int
+CreateMirrorJumpTable(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Obj* jumps) /* List of alternating keywords and labels */
+{
+ int objc; /* Number of elements in the 'jumps' list */
+ Tcl_Obj** objv; /* Pointers to the elements in the list */
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ BasicBlock* bbPtr = assemEnvPtr->curr_bb;
+ /* Current basic block */
+ JumptableInfo* jtPtr;
+ Tcl_HashTable* jtHashPtr; /* Hashtable in the JumptableInfo */
+ Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */
+ int isNew; /* Flag==1 if the key is not yet in the
+ * table. */
+ int i;
+
+ if (Tcl_ListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc % 2 != 0) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "jump table must have an even number of list elements",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Allocate the jumptable.
+ */
+
+ jtPtr = ckalloc(sizeof(JumptableInfo));
+ jtHashPtr = &jtPtr->hashTable;
+ Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS);
+
+ /*
+ * Fill the keys and labels into the table.
+ */
+
+ DEBUG_PRINT("jump table {\n");
+ for (i = 0; i < objc; i+=2) {
+ DEBUG_PRINT(" %s -> %s\n", Tcl_GetString(objv[i]),
+ Tcl_GetString(objv[i+1]));
+ hashEntry = Tcl_CreateHashEntry(jtHashPtr, Tcl_GetString(objv[i]),
+ &isNew);
+ if (!isNew) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "duplicate entry in jump table for \"%s\"",
+ Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY");
+ DeleteMirrorJumpTable(jtPtr);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_SetHashValue(hashEntry, objv[i+1]);
+ Tcl_IncrRefCount(objv[i+1]);
+ }
+ DEBUG_PRINT("}\n");
+
+ /*
+ * Put the mirror jumptable in the basic block struct.
+ */
+
+ bbPtr->jtPtr = jtPtr;
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * DeleteMirrorJumpTable --
+ *
+ * Cleans up a jump table when the basic block is deleted.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+DeleteMirrorJumpTable(
+ JumptableInfo* jtPtr)
+{
+ Tcl_HashTable* jtHashPtr = &jtPtr->hashTable;
+ /* Hash table pointer */
+ Tcl_HashSearch search; /* Hash search control */
+ Tcl_HashEntry* entry; /* Hash table entry containing a jump label */
+ Tcl_Obj* label; /* Jump label from the hash table */
+
+ for (entry = Tcl_FirstHashEntry(jtHashPtr, &search);
+ entry != NULL;
+ entry = Tcl_NextHashEntry(&search)) {
+ label = Tcl_GetHashValue(entry);
+ Tcl_DecrRefCount(label);
+ Tcl_SetHashValue(entry, NULL);
+ }
+ Tcl_DeleteHashTable(jtHashPtr);
+ ckfree(jtPtr);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GetNextOperand --
+ *
+ * Retrieves the next operand in sequence from an assembly instruction,
+ * and makes sure that its value is known at compile time.
+ *
+ * Results:
+ * If successful, returns TCL_OK and leaves a Tcl_Obj with the operand
+ * text in *operandObjPtr. In case of failure, returns TCL_ERROR and
+ * leaves *operandObjPtr untouched.
+ *
+ * Side effects:
+ * Advances *tokenPtrPtr around the token just processed.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+GetNextOperand(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Token** tokenPtrPtr, /* INPUT/OUTPUT: Pointer to the token holding
+ * the operand */
+ Tcl_Obj** operandObjPtr) /* OUTPUT: Tcl object holding the operand text
+ * with \-substitutions done. */
+{
+ Tcl_Interp* interp = (Tcl_Interp*) assemEnvPtr->envPtr->iPtr;
+ Tcl_Obj* operandObj = Tcl_NewObj();
+
+ if (!TclWordKnownAtCompileTime(*tokenPtrPtr, operandObj)) {
+ Tcl_DecrRefCount(operandObj);
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "assembly code may not contain substitutions", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", NULL);
+ }
+ return TCL_ERROR;
+ }
+ *tokenPtrPtr = TokenAfter(*tokenPtrPtr);
+ Tcl_IncrRefCount(operandObj);
+ *operandObjPtr = operandObj;
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GetBooleanOperand --
+ *
+ * Retrieves a Boolean operand from the input stream and advances
+ * the token pointer.
+ *
+ * Results:
+ * Returns a standard Tcl result (with an error message in the
+ * interpreter on failure).
+ *
+ * Side effects:
+ * Stores the Boolean value in (*result) and advances (*tokenPtrPtr)
+ * to the next token.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+GetBooleanOperand(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Token** tokenPtrPtr, /* Current token from the parser */
+ int* result) /* OUTPUT: Integer extracted from the token */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ Tcl_Token* tokenPtr = *tokenPtrPtr;
+ /* INOUT: Pointer to the next token in the
+ * source code */
+ Tcl_Obj* intObj; /* Integer from the source code */
+ int status; /* Tcl status return */
+
+ /*
+ * Extract the next token as a string.
+ */
+
+ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Convert to an integer, advance to the next token and return.
+ */
+
+ status = Tcl_GetBooleanFromObj(interp, intObj, result);
+ Tcl_DecrRefCount(intObj);
+ *tokenPtrPtr = TokenAfter(tokenPtr);
+ return status;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GetIntegerOperand --
+ *
+ * Retrieves an integer operand from the input stream and advances the
+ * token pointer.
+ *
+ * Results:
+ * Returns a standard Tcl result (with an error message in the
+ * interpreter on failure).
+ *
+ * Side effects:
+ * Stores the integer value in (*result) and advances (*tokenPtrPtr) to
+ * the next token.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+GetIntegerOperand(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Token** tokenPtrPtr, /* Current token from the parser */
+ int* result) /* OUTPUT: Integer extracted from the token */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ Tcl_Token* tokenPtr = *tokenPtrPtr;
+ /* INOUT: Pointer to the next token in the
+ * source code */
+ Tcl_Obj* intObj; /* Integer from the source code */
+ int status; /* Tcl status return */
+
+ /*
+ * Extract the next token as a string.
+ */
+
+ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Convert to an integer, advance to the next token and return.
+ */
+
+ status = Tcl_GetIntFromObj(interp, intObj, result);
+ Tcl_DecrRefCount(intObj);
+ *tokenPtrPtr = TokenAfter(tokenPtr);
+ return status;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GetListIndexOperand --
+ *
+ * Gets the value of an operand intended to serve as a list index.
+ *
+ * Results:
+ * Returns a standard Tcl result: TCL_OK if the parse is successful and
+ * TCL_ERROR (with an appropriate error message) if the parse fails.
+ *
+ * Side effects:
+ * Stores the list index at '*index'. Values between -1 and 0x7fffffff
+ * have their natural meaning; values between -2 and -0x80000000
+ * represent 'end-2-N'.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+GetListIndexOperand(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Token** tokenPtrPtr, /* Current token from the parser */
+ int* result) /* OUTPUT: Integer extracted from the token */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ Tcl_Token* tokenPtr = *tokenPtrPtr;
+ /* INOUT: Pointer to the next token in the
+ * source code */
+ Tcl_Obj* intObj; /* Integer from the source code */
+ int status; /* Tcl status return */
+
+ /*
+ * Extract the next token as a string.
+ */
+
+ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Convert to an integer, advance to the next token and return.
+ */
+
+ status = TclGetIntForIndex(interp, intObj, -2, result);
+ Tcl_DecrRefCount(intObj);
+ *tokenPtrPtr = TokenAfter(tokenPtr);
+ return status;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FindLocalVar --
+ *
+ * Gets the name of a local variable from the input stream and advances
+ * the token pointer.
+ *
+ * Results:
+ * Returns the LVT index of the local variable. Returns -1 if the
+ * variable is non-local, not known at compile time, or cannot be
+ * installed in the LVT (leaving an error message in the interpreter
+ * result if necessary).
+ *
+ * Side effects:
+ * Advances the token pointer. May define a new LVT slot if the variable
+ * has not yet been seen and the execution context allows for it.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+FindLocalVar(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Token** tokenPtrPtr)
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ Tcl_Token* tokenPtr = *tokenPtrPtr;
+ /* INOUT: Pointer to the next token in the
+ * source code. */
+ Tcl_Obj* varNameObj; /* Name of the variable */
+ const char* varNameStr;
+ int varNameLen;
+ int localVar; /* Index of the variable in the LVT */
+
+ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
+ return -1;
+ }
+ varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
+ if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
+ Tcl_DecrRefCount(varNameObj);
+ return -1;
+ }
+ localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
+ Tcl_DecrRefCount(varNameObj);
+ if (localVar == -1) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot use this instruction to create a variable"
+ " in a non-proc context", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
+ }
+ return -1;
+ }
+ *tokenPtrPtr = TokenAfter(tokenPtr);
+ return localVar;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckNamespaceQualifiers --
+ *
+ * Verify that a variable name has no namespace qualifiers before
+ * attempting to install it in the LVT.
+ *
+ * Results:
+ * On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
+ * an error message in the interpreter result.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckNamespaceQualifiers(
+ Tcl_Interp* interp, /* Tcl interpreter for error reporting */
+ const char* name, /* Variable name to check */
+ int nameLen) /* Length of the variable */
+{
+ const char* p;
+
+ for (p = name; p+2 < name+nameLen; p++) {
+ if ((*p == ':') && (p[1] == ':')) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "variable \"%s\" is not local", name));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL);
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckOneByte --
+ *
+ * Verify that a constant fits in a single byte in the instruction
+ * stream.
+ *
+ * Results:
+ * On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
+ * an error message in the interpreter result.
+ *
+ * This code is here primarily to verify that instructions like INCR_SCALAR1
+ * are possible on a given local variable. The fact that there is no
+ * INCR_SCALAR4 is puzzling.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckOneByte(
+ Tcl_Interp* interp, /* Tcl interpreter for error reporting */
+ int value) /* Value to check */
+{
+ Tcl_Obj* result; /* Error message */
+
+ if (value < 0 || value > 0xff) {
+ result = Tcl_NewStringObj("operand does not fit in one byte", -1);
+ Tcl_SetObjResult(interp, result);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckSignedOneByte --
+ *
+ * Verify that a constant fits in a single signed byte in the instruction
+ * stream.
+ *
+ * Results:
+ * On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
+ * an error message in the interpreter result.
+ *
+ * This code is here primarily to verify that instructions like INCR_SCALAR1
+ * are possible on a given local variable. The fact that there is no
+ * INCR_SCALAR4 is puzzling.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckSignedOneByte(
+ Tcl_Interp* interp, /* Tcl interpreter for error reporting */
+ int value) /* Value to check */
+{
+ Tcl_Obj* result; /* Error message */
+
+ if (value > 0x7f || value < -0x80) {
+ result = Tcl_NewStringObj("operand does not fit in one byte", -1);
+ Tcl_SetObjResult(interp, result);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckNonNegative --
+ *
+ * Verify that a constant is nonnegative
+ *
+ * Results:
+ * On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
+ * an error message in the interpreter result.
+ *
+ * This code is here primarily to verify that instructions like INCR_INVOKE
+ * are consuming a positive number of operands
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckNonNegative(
+ Tcl_Interp* interp, /* Tcl interpreter for error reporting */
+ int value) /* Value to check */
+{
+ Tcl_Obj* result; /* Error message */
+
+ if (value < 0) {
+ result = Tcl_NewStringObj("operand must be nonnegative", -1);
+ Tcl_SetObjResult(interp, result);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckStrictlyPositive --
+ *
+ * Verify that a constant is positive
+ *
+ * Results:
+ * On success, returns TCL_OK. On failure, returns TCL_ERROR and
+ * stores an error message in the interpreter result.
+ *
+ * This code is here primarily to verify that instructions like INCR_INVOKE
+ * are consuming a positive number of operands
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckStrictlyPositive(
+ Tcl_Interp* interp, /* Tcl interpreter for error reporting */
+ int value) /* Value to check */
+{
+ Tcl_Obj* result; /* Error message */
+
+ if (value <= 0) {
+ result = Tcl_NewStringObj("operand must be positive", -1);
+ Tcl_SetObjResult(interp, result);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * DefineLabel --
+ *
+ * Defines a label appearing in the assembly sequence.
+ *
+ * Results:
+ * Returns a standard Tcl result. Returns TCL_OK and an empty result if
+ * the definition succeeds; returns TCL_ERROR and an appropriate message
+ * if a duplicate definition is found.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+DefineLabel(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ const char* labelName) /* Label being defined */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ Tcl_HashEntry* entry; /* Label's entry in the symbol table */
+ int isNew; /* Flag == 1 iff the label was previously
+ * undefined */
+
+ /* TODO - This can now be simplified! */
+
+ StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
+
+ /*
+ * Look up the newly-defined label in the symbol table.
+ */
+
+ entry = Tcl_CreateHashEntry(&assemEnvPtr->labelHash, labelName, &isNew);
+ if (!isNew) {
+ /*
+ * This is a duplicate label.
+ */
+
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "duplicate definition of label \"%s\"", labelName));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName,
+ NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * This is the first appearance of the label in the code.
+ */
+
+ Tcl_SetHashValue(entry, assemEnvPtr->curr_bb);
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * StartBasicBlock --
+ *
+ * Starts a new basic block when a label or jump is encountered.
+ *
+ * Results:
+ * Returns a pointer to the BasicBlock structure of the new
+ * basic block.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static BasicBlock*
+StartBasicBlock(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int flags, /* Flags to apply to the basic block being
+ * closed, if there is one. */
+ Tcl_Obj* jumpLabel) /* Label of the location that the block jumps
+ * to, or NULL if the block does not jump */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ BasicBlock* newBB; /* BasicBlock structure for the new block */
+ BasicBlock* currBB = assemEnvPtr->curr_bb;
+
+ /*
+ * Coalesce zero-length blocks.
+ */
+
+ if (currBB->startOffset == envPtr->codeNext - envPtr->codeStart) {
+ currBB->startLine = assemEnvPtr->cmdLine;
+ return currBB;
+ }
+
+ /*
+ * Make the new basic block.
+ */
+
+ newBB = AllocBB(assemEnvPtr);
+
+ /*
+ * Record the jump target if there is one.
+ */
+
+ currBB->jumpTarget = jumpLabel;
+ if (jumpLabel != NULL) {
+ Tcl_IncrRefCount(currBB->jumpTarget);
+ }
+
+ /*
+ * Record the fallthrough if there is one.
+ */
+
+ currBB->flags |= flags;
+
+ /*
+ * Record the successor block.
+ */
+
+ currBB->successor1 = newBB;
+ assemEnvPtr->curr_bb = newBB;
+ return newBB;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * AllocBB --
+ *
+ * Allocates a new basic block
+ *
+ * Results:
+ * Returns a pointer to the newly allocated block, which is initialized
+ * to contain no code and begin at the current instruction pointer.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static BasicBlock *
+AllocBB(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ BasicBlock *bb = ckalloc(sizeof(BasicBlock));
+
+ bb->originalStartOffset =
+ bb->startOffset = envPtr->codeNext - envPtr->codeStart;
+ bb->startLine = assemEnvPtr->cmdLine + 1;
+ bb->jumpOffset = -1;
+ bb->jumpLine = -1;
+ bb->prevPtr = assemEnvPtr->curr_bb;
+ bb->predecessor = NULL;
+ bb->successor1 = NULL;
+ bb->jumpTarget = NULL;
+ bb->initialStackDepth = 0;
+ bb->minStackDepth = 0;
+ bb->maxStackDepth = 0;
+ bb->finalStackDepth = 0;
+ bb->enclosingCatch = NULL;
+ bb->foreignExceptionBase = -1;
+ bb->foreignExceptionCount = 0;
+ bb->foreignExceptions = NULL;
+ bb->jtPtr = NULL;
+ bb->flags = 0;
+
+ return bb;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FinishAssembly --
+ *
+ * Postprocessing after all bytecode has been generated for a block of
+ * assembly code.
+ *
+ * Results:
+ * Returns a standard Tcl result, with an error message left in the
+ * interpreter if appropriate.
+ *
+ * Side effects:
+ * The program is checked to see if any undefined labels remain. The
+ * initial stack depth of all the basic blocks in the flow graph is
+ * calculated and saved. The stack balance on exit is computed, checked
+ * and saved.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+FinishAssembly(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
+{
+ int mustMove; /* Amount by which the code needs to be grown
+ * because of expanding jumps */
+
+ /*
+ * Resolve the targets of all jumps and determine whether code needs to be
+ * moved around.
+ */
+
+ if (CalculateJumpRelocations(assemEnvPtr, &mustMove)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Move the code if necessary.
+ */
+
+ if (mustMove) {
+ MoveCodeForJumps(assemEnvPtr, mustMove);
+ }
+
+ /*
+ * Resolve jump target labels to bytecode offsets.
+ */
+
+ FillInJumpOffsets(assemEnvPtr);
+
+ /*
+ * Label each basic block with its catch context. Quit on inconsistency.
+ */
+
+ if (ProcessCatches(assemEnvPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that no block accessible from a catch's error exit that hasn't
+ * popped the exception stack can throw an exception.
+ */
+
+ if (CheckForThrowInWrongContext(assemEnvPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compute stack balance throughout the program.
+ */
+
+ if (CheckStack(assemEnvPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * TODO - Check for unreachable code. Or maybe not; unreachable code is
+ * Mostly Harmless.
+ */
+
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CalculateJumpRelocations --
+ *
+ * Calculate any movement that has to be done in the assembly code to
+ * expand JUMP1 instructions to JUMP4 (because they jump more than a
+ * 1-byte range).
+ *
+ * Results:
+ * Returns a standard Tcl result, with an appropriate error message if
+ * anything fails.
+ *
+ * Side effects:
+ * Sets the 'startOffset' pointer in every basic block to the new origin
+ * of the block, and turns off JUMP1 flags on instructions that must be
+ * expanded (and adjusts them to the corresponding JUMP4's). Does *not*
+ * store the jump offsets at this point.
+ *
+ * Sets *mustMove to 1 if and only if at least one instruction changed
+ * size so the code must be moved.
+ *
+ * As a side effect, also checks for undefined labels and reports them.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CalculateJumpRelocations(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int* mustMove) /* OUTPUT: Number of bytes that have been
+ * added to the code */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ BasicBlock* bbPtr; /* Pointer to a basic block being checked */
+ Tcl_HashEntry* entry; /* Exit label's entry in the symbol table */
+ BasicBlock* jumpTarget; /* Basic block where the jump goes */
+ int motion; /* Amount by which the code has expanded */
+ int offset; /* Offset in the bytecode from a jump
+ * instruction to its target */
+ unsigned opcode; /* Opcode in the bytecode being adjusted */
+
+ /*
+ * Iterate through basic blocks as long as a change results in code
+ * expansion.
+ */
+
+ *mustMove = 0;
+ do {
+ motion = 0;
+ for (bbPtr = assemEnvPtr->head_bb;
+ bbPtr != NULL;
+ bbPtr = bbPtr->successor1) {
+ /*
+ * Advance the basic block start offset by however many bytes we
+ * have inserted in the code up to this point
+ */
+
+ bbPtr->startOffset += motion;
+
+ /*
+ * If the basic block references a label (and hence performs a
+ * jump), find the location of the label. Report an error if the
+ * label is missing.
+ */
+
+ if (bbPtr->jumpTarget != NULL) {
+ entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(bbPtr->jumpTarget));
+ if (entry == NULL) {
+ ReportUndefinedLabel(assemEnvPtr, bbPtr,
+ bbPtr->jumpTarget);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the instruction is a JUMP1, turn it into a JUMP4 if its
+ * target is out of range.
+ */
+
+ jumpTarget = Tcl_GetHashValue(entry);
+ if (bbPtr->flags & BB_JUMP1) {
+ offset = jumpTarget->startOffset
+ - (bbPtr->jumpOffset + motion);
+ if (offset < -0x80 || offset > 0x7f) {
+ opcode = TclGetUInt1AtPtr(envPtr->codeStart
+ + bbPtr->jumpOffset);
+ ++opcode;
+ TclStoreInt1AtPtr(opcode,
+ envPtr->codeStart + bbPtr->jumpOffset);
+ motion += 3;
+ bbPtr->flags &= ~BB_JUMP1;
+ }
+ }
+ }
+
+ /*
+ * If the basic block references a jump table, that doesn't affect
+ * the code locations, but resolve the labels now, and store basic
+ * block pointers in the jumptable hash.
+ */
+
+ if (bbPtr->flags & BB_JUMPTABLE) {
+ if (CheckJumpTableLabels(assemEnvPtr, bbPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ *mustMove += motion;
+ } while (motion != 0);
+
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckJumpTableLabels --
+ *
+ * Make sure that all the labels in a jump table are defined.
+ *
+ * Results:
+ * Returns TCL_OK if they are, TCL_ERROR if they aren't.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckJumpTableLabels(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* bbPtr) /* Basic block that ends in a jump table */
+{
+ Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable;
+ /* Hash table with the symbols */
+ Tcl_HashSearch search; /* Hash table iterator */
+ Tcl_HashEntry* symEntryPtr; /* Hash entry for the symbols */
+ Tcl_Obj* symbolObj; /* Jump target */
+ Tcl_HashEntry* valEntryPtr; /* Hash entry for the resolutions */
+
+ /*
+ * Look up every jump target in the jump hash.
+ */
+
+ DEBUG_PRINT("check jump table labels %p {\n", bbPtr);
+ for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search);
+ symEntryPtr != NULL;
+ symEntryPtr = Tcl_NextHashEntry(&search)) {
+ symbolObj = Tcl_GetHashValue(symEntryPtr);
+ valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(symbolObj));
+ DEBUG_PRINT(" %s -> %s (%d)\n",
+ (char*) Tcl_GetHashKey(symHash, symEntryPtr),
+ Tcl_GetString(symbolObj), (valEntryPtr != NULL));
+ if (valEntryPtr == NULL) {
+ ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj);
+ return TCL_ERROR;
+ }
+ }
+ DEBUG_PRINT("}\n");
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ReportUndefinedLabel --
+ *
+ * Report that a basic block refers to an undefined jump label
+ *
+ * Side effects:
+ * Stores an error message, error code, and line number information in
+ * the assembler's Tcl interpreter.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+ReportUndefinedLabel(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* bbPtr, /* Basic block that contains the undefined
+ * label */
+ Tcl_Obj* jumpTarget) /* Label of a jump target */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "undefined label \"%s\"", Tcl_GetString(jumpTarget)));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
+ Tcl_GetString(jumpTarget), NULL);
+ Tcl_SetErrorLine(interp, bbPtr->jumpLine);
+ }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * MoveCodeForJumps --
+ *
+ * Move bytecodes in memory to accommodate JUMP1 instructions that have
+ * expanded to become JUMP4's.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+MoveCodeForJumps(
+ AssemblyEnv* assemEnvPtr, /* Assembler environment */
+ int mustMove) /* Number of bytes of added code */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ BasicBlock* bbPtr; /* Pointer to a basic block being checked */
+ int topOffset; /* Bytecode offset of the following basic
+ * block before code motion */
+
+ /*
+ * Make sure that there is enough space in the bytecode array to
+ * accommodate the expanded code.
+ */
+
+ while (envPtr->codeEnd < envPtr->codeNext + mustMove) {
+ TclExpandCodeArray(envPtr);
+ }
+
+ /*
+ * Iterate through the bytecodes in reverse order, and move them upward to
+ * their new homes.
+ */
+
+ topOffset = envPtr->codeNext - envPtr->codeStart;
+ for (bbPtr = assemEnvPtr->curr_bb; bbPtr != NULL; bbPtr = bbPtr->prevPtr) {
+ DEBUG_PRINT("move code from %d to %d\n",
+ bbPtr->originalStartOffset, bbPtr->startOffset);
+ memmove(envPtr->codeStart + bbPtr->startOffset,
+ envPtr->codeStart + bbPtr->originalStartOffset,
+ topOffset - bbPtr->originalStartOffset);
+ topOffset = bbPtr->originalStartOffset;
+ bbPtr->jumpOffset += (bbPtr->startOffset - bbPtr->originalStartOffset);
+ }
+ envPtr->codeNext += mustMove;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FillInJumpOffsets --
+ *
+ * Fill in the final offsets of all jump instructions once bytecode
+ * locations have been completely determined.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+FillInJumpOffsets(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ BasicBlock* bbPtr; /* Pointer to a basic block being checked */
+ Tcl_HashEntry* entry; /* Hashtable entry for a jump target label */
+ BasicBlock* jumpTarget; /* Basic block where a jump goes */
+ int fromOffset; /* Bytecode location of a jump instruction */
+ int targetOffset; /* Bytecode location of a jump instruction's
+ * target */
+
+ for (bbPtr = assemEnvPtr->head_bb;
+ bbPtr != NULL;
+ bbPtr = bbPtr->successor1) {
+ if (bbPtr->jumpTarget != NULL) {
+ entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(bbPtr->jumpTarget));
+ jumpTarget = Tcl_GetHashValue(entry);
+ fromOffset = bbPtr->jumpOffset;
+ targetOffset = jumpTarget->startOffset;
+ if (bbPtr->flags & BB_JUMP1) {
+ TclStoreInt1AtPtr(targetOffset - fromOffset,
+ envPtr->codeStart + fromOffset + 1);
+ } else {
+ TclStoreInt4AtPtr(targetOffset - fromOffset,
+ envPtr->codeStart + fromOffset + 1);
+ }
+ }
+ if (bbPtr->flags & BB_JUMPTABLE) {
+ ResolveJumpTableTargets(assemEnvPtr, bbPtr);
+ }
+ }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ResolveJumpTableTargets --
+ *
+ * Puts bytecode addresses for the targets of a jumptable into the
+ * table
+ *
+ * Results:
+ * Returns TCL_OK if they are, TCL_ERROR if they aren't.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+ResolveJumpTableTargets(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* bbPtr) /* Basic block that ends in a jump table */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable;
+ /* Hash table with the symbols */
+ Tcl_HashSearch search; /* Hash table iterator */
+ Tcl_HashEntry* symEntryPtr; /* Hash entry for the symbols */
+ Tcl_Obj* symbolObj; /* Jump target */
+ Tcl_HashEntry* valEntryPtr; /* Hash entry for the resolutions */
+ int auxDataIndex; /* Index of the auxdata */
+ JumptableInfo* realJumpTablePtr;
+ /* Jump table in the actual code */
+ Tcl_HashTable* realJumpHashPtr;
+ /* Jump table hash in the actual code */
+ Tcl_HashEntry* realJumpEntryPtr;
+ /* Entry in the jump table hash in
+ * the actual code */
+ BasicBlock* jumpTargetBBPtr;
+ /* Basic block that the jump proceeds to */
+ int junk;
+
+ auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
+ DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
+ bbPtr, bbPtr->jumpOffset, auxDataIndex);
+ realJumpTablePtr = envPtr->auxDataArrayPtr[auxDataIndex].clientData;
+ realJumpHashPtr = &realJumpTablePtr->hashTable;
+
+ /*
+ * Look up every jump target in the jump hash.
+ */
+
+ DEBUG_PRINT("resolve jump table {\n");
+ for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search);
+ symEntryPtr != NULL;
+ symEntryPtr = Tcl_NextHashEntry(&search)) {
+ symbolObj = Tcl_GetHashValue(symEntryPtr);
+ DEBUG_PRINT(" symbol %s\n", Tcl_GetString(symbolObj));
+
+ valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(symbolObj));
+ jumpTargetBBPtr = Tcl_GetHashValue(valEntryPtr);
+
+ realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr,
+ Tcl_GetHashKey(symHash, symEntryPtr), &junk);
+ DEBUG_PRINT(" %s -> %s -> bb %p (pc %d) hash entry %p\n",
+ (char*) Tcl_GetHashKey(symHash, symEntryPtr),
+ Tcl_GetString(symbolObj), jumpTargetBBPtr,
+ jumpTargetBBPtr->startOffset, realJumpEntryPtr);
+
+ Tcl_SetHashValue(realJumpEntryPtr,
+ INT2PTR(jumpTargetBBPtr->startOffset - bbPtr->jumpOffset));
+ }
+ DEBUG_PRINT("}\n");
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckForThrowInWrongContext --
+ *
+ * Verify that no beginCatch/endCatch sequence can throw an exception
+ * after an original exception is caught and before its exception context
+ * is removed from the stack.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Stores an appropriate error message in the interpreter as needed.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckForThrowInWrongContext(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
+{
+ BasicBlock* blockPtr; /* Current basic block */
+
+ /*
+ * Walk through the basic blocks in turn, checking all the ones that have
+ * caught an exception and not disposed of it properly.
+ */
+
+ for (blockPtr = assemEnvPtr->head_bb;
+ blockPtr != NULL;
+ blockPtr = blockPtr->successor1) {
+ if (blockPtr->catchState == BBCS_CAUGHT) {
+ /*
+ * Walk through the instructions in the basic block.
+ */
+
+ if (CheckNonThrowingBlock(assemEnvPtr, blockPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckNonThrowingBlock --
+ *
+ * Check that a basic block cannot throw an exception.
+ *
+ * Results:
+ * Returns TCL_ERROR if the block cannot be proven to be nonthrowing.
+ *
+ * Side effects:
+ * Stashes an error message in the interpreter result.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckNonThrowingBlock(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* blockPtr) /* Basic block where exceptions are not
+ * allowed */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ BasicBlock* nextPtr; /* Pointer to the succeeding basic block */
+ int offset; /* Bytecode offset of the current
+ * instruction */
+ int bound; /* Bytecode offset following the last
+ * instruction of the block. */
+ unsigned char opcode; /* Current bytecode instruction */
+
+ /*
+ * Determine where in the code array the basic block ends.
+ */
+
+ nextPtr = blockPtr->successor1;
+ if (nextPtr == NULL) {
+ bound = envPtr->codeNext - envPtr->codeStart;
+ } else {
+ bound = nextPtr->startOffset;
+ }
+
+ /*
+ * Walk through the instructions of the block.
+ */
+
+ offset = blockPtr->startOffset;
+ while (offset < bound) {
+ /*
+ * Determine whether an instruction is nonthrowing.
+ */
+
+ opcode = (envPtr->codeStart)[offset];
+ if (BytecodeMightThrow(opcode)) {
+ /*
+ * Report an error for a throw in the wrong context.
+ */
+
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" instruction may not appear in "
+ "a context where an exception has been "
+ "caught and not disposed of.",
+ tclInstructionTable[opcode].name));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL);
+ AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
+ }
+ return TCL_ERROR;
+ }
+ offset += tclInstructionTable[opcode].numBytes;
+ }
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BytecodeMightThrow --
+ *
+ * Tests if a given bytecode instruction might throw an exception.
+ *
+ * Results:
+ * Returns 1 if the bytecode might throw an exception, 0 if the
+ * instruction is known never to throw.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+BytecodeMightThrow(
+ unsigned char opcode)
+{
+ /*
+ * Binary search on the non-throwing bytecode list.
+ */
+
+ int min = 0;
+ int max = sizeof(NonThrowingByteCodes) - 1;
+ int mid;
+ unsigned char c;
+
+ while (max >= min) {
+ mid = (min + max) / 2;
+ c = NonThrowingByteCodes[mid];
+ if (opcode < c) {
+ max = mid-1;
+ } else if (opcode > c) {
+ min = mid+1;
+ } else {
+ /*
+ * Opcode is nonthrowing.
+ */
+
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckStack --
+ *
+ * Audit stack usage in a block of assembly code.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Updates stack depth on entry for all basic blocks in the flowgraph.
+ * Calculates the max stack depth used in the program, and updates the
+ * compilation environment to reflect it.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckStack(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ int maxDepth; /* Maximum stack depth overall */
+
+ /*
+ * Checking the head block will check all the other blocks recursively.
+ */
+
+ assemEnvPtr->maxDepth = 0;
+ if (StackCheckBasicBlock(assemEnvPtr, assemEnvPtr->head_bb, NULL,
+ 0) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Post the max stack depth back to the compilation environment.
+ */
+
+ maxDepth = assemEnvPtr->maxDepth + envPtr->currStackDepth;
+ if (maxDepth > envPtr->maxStackDepth) {
+ envPtr->maxStackDepth = maxDepth;
+ }
+
+ /*
+ * If the exit is reachable, make sure that the program exits with 1
+ * operand on the stack.
+ */
+
+ if (StackCheckExit(assemEnvPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Reset the visited state on all basic blocks.
+ */
+
+ ResetVisitedBasicBlocks(assemEnvPtr);
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * StackCheckBasicBlock --
+ *
+ * Checks stack consumption for a basic block (and recursively for its
+ * successors).
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Updates initial stack depth for the basic block and its successors.
+ * (Final and maximum stack depth are relative to initial, and are not
+ * touched).
+ *
+ * This procedure eventually checks, for the entire flow graph, whether stack
+ * balance is consistent. It is an error for a given basic block to be
+ * reachable along multiple flow paths with different stack depths.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+StackCheckBasicBlock(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* blockPtr, /* Pointer to the basic block being checked */
+ BasicBlock* predecessor, /* Pointer to the block that passed control to
+ * this one. */
+ int initialStackDepth) /* Stack depth on entry to the block */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ BasicBlock* jumpTarget; /* Basic block where a jump goes */
+ int stackDepth; /* Current stack depth */
+ int maxDepth; /* Maximum stack depth so far */
+ int result; /* Tcl status return */
+ Tcl_HashSearch jtSearch; /* Search structure for the jump table */
+ Tcl_HashEntry* jtEntry; /* Hash entry in the jump table */
+ Tcl_Obj* targetLabel; /* Target label from the jump table */
+ Tcl_HashEntry* entry; /* Hash entry in the label table */
+
+ if (blockPtr->flags & BB_VISITED) {
+ /*
+ * If the block is already visited, check stack depth for consistency
+ * among the paths that reach it.
+ */
+
+ if (blockPtr->initialStackDepth == initialStackDepth) {
+ return TCL_OK;
+ }
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "inconsistent stack depths on two execution paths", -1));
+
+ /*
+ * TODO - add execution trace of both paths
+ */
+
+ Tcl_SetErrorLine(interp, blockPtr->startLine);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the block is not already visited, set the 'predecessor' link to
+ * indicate how control got to it. Set the initial stack depth to the
+ * current stack depth in the flow of control.
+ */
+
+ blockPtr->flags |= BB_VISITED;
+ blockPtr->predecessor = predecessor;
+ blockPtr->initialStackDepth = initialStackDepth;
+
+ /*
+ * Calculate minimum stack depth, and flag an error if the block
+ * underflows the stack.
+ */
+
+ if (initialStackDepth + blockPtr->minStackDepth < 0) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("stack underflow", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
+ Tcl_SetErrorLine(interp, blockPtr->startLine);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that the block doesn't try to pop below the stack level of an
+ * enclosing catch.
+ */
+
+ if (blockPtr->enclosingCatch != 0 &&
+ initialStackDepth + blockPtr->minStackDepth
+ < (blockPtr->enclosingCatch->initialStackDepth
+ + blockPtr->enclosingCatch->finalStackDepth)) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "code pops stack below level of enclosing catch", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", -1);
+ AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
+ Tcl_SetErrorLine(interp, blockPtr->startLine);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Update maximum stgack depth.
+ */
+
+ maxDepth = initialStackDepth + blockPtr->maxStackDepth;
+ if (maxDepth > assemEnvPtr->maxDepth) {
+ assemEnvPtr->maxDepth = maxDepth;
+ }
+
+ /*
+ * Calculate stack depth on exit from the block, and invoke this procedure
+ * recursively to check successor blocks.
+ */
+
+ stackDepth = initialStackDepth + blockPtr->finalStackDepth;
+ result = TCL_OK;
+ if (blockPtr->flags & BB_FALLTHRU) {
+ result = StackCheckBasicBlock(assemEnvPtr, blockPtr->successor1,
+ blockPtr, stackDepth);
+ }
+
+ if (result == TCL_OK && blockPtr->jumpTarget != NULL) {
+ entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(blockPtr->jumpTarget));
+ jumpTarget = Tcl_GetHashValue(entry);
+ result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr,
+ stackDepth);
+ }
+
+ /*
+ * All blocks referenced in a jump table are successors.
+ */
+
+ if (blockPtr->flags & BB_JUMPTABLE) {
+ for (jtEntry = Tcl_FirstHashEntry(&blockPtr->jtPtr->hashTable,
+ &jtSearch);
+ result == TCL_OK && jtEntry != NULL;
+ jtEntry = Tcl_NextHashEntry(&jtSearch)) {
+ targetLabel = Tcl_GetHashValue(jtEntry);
+ entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(targetLabel));
+ jumpTarget = Tcl_GetHashValue(entry);
+ result = StackCheckBasicBlock(assemEnvPtr, jumpTarget,
+ blockPtr, stackDepth);
+ }
+ }
+
+ return result;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * StackCheckExit --
+ *
+ * Makes sure that the net stack effect of an entire assembly language
+ * script is to push 1 result.
+ *
+ * Results:
+ * Returns a standard Tcl result, with an error message in the
+ * interpreter result if the stack is wrong.
+ *
+ * Side effects:
+ * If the assembly code had a net stack effect of zero, emits code to the
+ * concluding block to push a null result. In any case, updates the stack
+ * depth in the compile environment to reflect the net effect of the
+ * assembly code.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+StackCheckExit(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ int depth; /* Net stack effect */
+ int litIndex; /* Index in the literal pool of the empty
+ * string */
+ BasicBlock* curr_bb = assemEnvPtr->curr_bb;
+ /* Final basic block in the assembly */
+
+ /*
+ * Don't perform these checks if execution doesn't reach the exit (either
+ * because of an infinite loop or because the only return is from the
+ * middle.
+ */
+
+ if (curr_bb->flags & BB_VISITED) {
+ /*
+ * Exit with no operands; push an empty one.
+ */
+
+ depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
+ if (depth == 0) {
+ /*
+ * Emit a 'push' of the empty literal.
+ */
+
+ litIndex = TclRegisterNewLiteral(envPtr, "", 0);
+
+ /*
+ * Assumes that 'push' is at slot 0 in TalInstructionTable.
+ */
+
+ BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
+ ++depth;
+ }
+
+ /*
+ * Exit with unbalanced stack.
+ */
+
+ if (depth != 1) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "stack is unbalanced on exit from the code (depth=%d)",
+ depth));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Record stack usage.
+ */
+
+ envPtr->currStackDepth += depth;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ProcessCatches --
+ *
+ * First pass of 'catch' processing.
+ *
+ * Results:
+ * Returns a standard Tcl result, with an appropriate error message if
+ * the result is TCL_ERROR.
+ *
+ * Side effects:
+ * Labels all basic blocks with their enclosing catches.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+ProcessCatches(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
+{
+ BasicBlock* blockPtr; /* Pointer to a basic block */
+
+ /*
+ * Clear the catch state of all basic blocks.
+ */
+
+ for (blockPtr = assemEnvPtr->head_bb;
+ blockPtr != NULL;
+ blockPtr = blockPtr->successor1) {
+ blockPtr->catchState = BBCS_UNKNOWN;
+ blockPtr->enclosingCatch = NULL;
+ }
+
+ /*
+ * Start the check recursively from the first basic block, which is
+ * outside any exception context
+ */
+
+ if (ProcessCatchesInBasicBlock(assemEnvPtr, assemEnvPtr->head_bb,
+ NULL, BBCS_NONE, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check for unclosed catch on exit.
+ */
+
+ if (CheckForUnclosedCatches(assemEnvPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now there's enough information to build the exception ranges.
+ */
+
+ if (BuildExceptionRanges(assemEnvPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Finally, restore any exception ranges from embedded scripts.
+ */
+
+ RestoreEmbeddedExceptionRanges(assemEnvPtr);
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ProcessCatchesInBasicBlock --
+ *
+ * First-pass catch processing for one basic block.
+ *
+ * Results:
+ * Returns a standard Tcl result, with error message in the interpreter
+ * result if an error occurs.
+ *
+ * This procedure checks consistency of the exception context through the
+ * assembler program, and records the enclosing 'catch' for every basic block.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+ProcessCatchesInBasicBlock(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* bbPtr, /* Basic block being processed */
+ BasicBlock* enclosing, /* Start basic block of the enclosing catch */
+ enum BasicBlockCatchState state,
+ /* BBCS_NONE, BBCS_INCATCH, or BBCS_CAUGHT */
+ int catchDepth) /* Depth of nesting of catches */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ int result; /* Return value from this procedure */
+ BasicBlock* fallThruEnclosing;
+ /* Enclosing catch if execution falls thru */
+ enum BasicBlockCatchState fallThruState;
+ /* Catch state of the successor block */
+ BasicBlock* jumpEnclosing; /* Enclosing catch if execution goes to jump
+ * target */
+ enum BasicBlockCatchState jumpState;
+ /* Catch state of the jump target */
+ int changed = 0; /* Flag == 1 iff successor blocks need to be
+ * checked because the state of this block has
+ * changed. */
+ BasicBlock* jumpTarget; /* Basic block where a jump goes */
+ Tcl_HashSearch jtSearch; /* Hash search control for a jumptable */
+ Tcl_HashEntry* jtEntry; /* Entry in a jumptable */
+ Tcl_Obj* targetLabel; /* Target label from a jumptable */
+ Tcl_HashEntry* entry; /* Entry from the label table */
+
+ /*
+ * Update the state of the current block, checking for consistency. Set
+ * 'changed' to 1 if the state changes and successor blocks need to be
+ * rechecked.
+ */
+
+ if (bbPtr->catchState == BBCS_UNKNOWN) {
+ bbPtr->enclosingCatch = enclosing;
+ } else if (bbPtr->enclosingCatch != enclosing) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "execution reaches an instruction in inconsistent "
+ "exception contexts", -1));
+ Tcl_SetErrorLine(interp, bbPtr->startLine);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (state > bbPtr->catchState) {
+ bbPtr->catchState = state;
+ changed = 1;
+ }
+
+ /*
+ * If this block has been visited before, and its state hasn't changed,
+ * we're done with it for now.
+ */
+
+ if (!changed) {
+ return TCL_OK;
+ }
+ bbPtr->catchDepth = catchDepth;
+
+ /*
+ * Determine enclosing catch and 'caught' state for the fallthrough and
+ * the jump target. Default for both is the state of the current block.
+ */
+
+ fallThruEnclosing = enclosing;
+ fallThruState = state;
+ jumpEnclosing = enclosing;
+ jumpState = state;
+
+ /*
+ * TODO: Make sure that the test cases include validating that a natural
+ * loop can't include 'beginCatch' or 'endCatch'
+ */
+
+ if (bbPtr->flags & BB_BEGINCATCH) {
+ /*
+ * If the block begins a catch, the state for the successor is 'in
+ * catch'. The jump target is the exception exit, and the state of the
+ * jump target is 'caught.'
+ */
+
+ fallThruEnclosing = bbPtr;
+ fallThruState = BBCS_INCATCH;
+ jumpEnclosing = bbPtr;
+ jumpState = BBCS_CAUGHT;
+ ++catchDepth;
+ }
+
+ if (bbPtr->flags & BB_ENDCATCH) {
+ /*
+ * If the block ends a catch, the state for the successor is whatever
+ * the state was on entry to the catch.
+ */
+
+ if (enclosing == NULL) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "endCatch without a corresponding beginCatch", -1));
+ Tcl_SetErrorLine(interp, bbPtr->startLine);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL);
+ }
+ return TCL_ERROR;
+ }
+ fallThruEnclosing = enclosing->enclosingCatch;
+ fallThruState = enclosing->catchState;
+ --catchDepth;
+ }
+
+ /*
+ * Visit any successor blocks with the appropriate exception context
+ */
+
+ result = TCL_OK;
+ if (bbPtr->flags & BB_FALLTHRU) {
+ result = ProcessCatchesInBasicBlock(assemEnvPtr, bbPtr->successor1,
+ fallThruEnclosing, fallThruState, catchDepth);
+ }
+ if (result == TCL_OK && bbPtr->jumpTarget != NULL) {
+ entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(bbPtr->jumpTarget));
+ jumpTarget = Tcl_GetHashValue(entry);
+ result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
+ jumpEnclosing, jumpState, catchDepth);
+ }
+
+ /*
+ * All blocks referenced in a jump table are successors.
+ */
+
+ if (bbPtr->flags & BB_JUMPTABLE) {
+ for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable,&jtSearch);
+ result == TCL_OK && jtEntry != NULL;
+ jtEntry = Tcl_NextHashEntry(&jtSearch)) {
+ targetLabel = Tcl_GetHashValue(jtEntry);
+ entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(targetLabel));
+ jumpTarget = Tcl_GetHashValue(entry);
+ result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
+ jumpEnclosing, jumpState, catchDepth);
+ }
+ }
+
+ return result;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckForUnclosedCatches --
+ *
+ * Checks that a sequence of assembly code has no unclosed catches on
+ * exit.
+ *
+ * Results:
+ * Returns a standard Tcl result, with an error message for unclosed
+ * catches.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckForUnclosedCatches(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+
+ if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "catch still active on exit from assembly code", -1));
+ Tcl_SetErrorLine(interp,
+ assemEnvPtr->curr_bb->enclosingCatch->startLine);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL);
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BuildExceptionRanges --
+ *
+ * Walks through the assembly code and builds exception ranges for the
+ * catches embedded therein.
+ *
+ * Results:
+ * Returns a standard Tcl result with an error message in the interpreter
+ * if anything is unsuccessful.
+ *
+ * Side effects:
+ * Each contiguous block of code with a given catch exit is assigned an
+ * exception range at the appropriate level.
+ * Exception ranges in embedded blocks have their levels corrected and
+ * collated into the table.
+ * Blocks that end with 'beginCatch' are associated with the innermost
+ * exception range of the following block.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+BuildExceptionRanges(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ BasicBlock* bbPtr; /* Current basic block */
+ BasicBlock* prevPtr = NULL; /* Previous basic block */
+ int catchDepth = 0; /* Current catch depth */
+ int maxCatchDepth = 0; /* Maximum catch depth in the program */
+ BasicBlock** catches; /* Stack of catches in progress */
+ int* catchIndices; /* Indices of the exception ranges of catches
+ * in progress */
+ int i;
+
+ /*
+ * Determine the max catch depth for the entire assembly script
+ * (excluding embedded eval's and expr's, which will be handled later).
+ */
+
+ for (bbPtr=assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
+ if (bbPtr->catchDepth > maxCatchDepth) {
+ maxCatchDepth = bbPtr->catchDepth;
+ }
+ }
+
+ /*
+ * Allocate memory for a stack of active catches.
+ */
+
+ catches = ckalloc(maxCatchDepth * sizeof(BasicBlock*));
+ catchIndices = ckalloc(maxCatchDepth * sizeof(int));
+ for (i = 0; i < maxCatchDepth; ++i) {
+ catches[i] = NULL;
+ catchIndices[i] = -1;
+ }
+
+ /*
+ * Walk through the basic blocks and manage exception ranges.
+ */
+
+ for (bbPtr=assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
+ UnstackExpiredCatches(envPtr, bbPtr, catchDepth, catches,
+ catchIndices);
+ LookForFreshCatches(bbPtr, catches);
+ StackFreshCatches(assemEnvPtr, bbPtr, catchDepth, catches,
+ catchIndices);
+
+ /*
+ * If the last block was a 'begin catch', fill in the exception range.
+ */
+
+ catchDepth = bbPtr->catchDepth;
+ if (prevPtr != NULL && (prevPtr->flags & BB_BEGINCATCH)) {
+ TclStoreInt4AtPtr(catchIndices[catchDepth-1],
+ envPtr->codeStart + bbPtr->startOffset - 4);
+ }
+
+ prevPtr = bbPtr;
+ }
+
+ /* Make sure that all catches are closed */
+
+ if (catchDepth != 0) {
+ Tcl_Panic("unclosed catch at end of code in "
+ "tclAssembly.c:BuildExceptionRanges, can't happen");
+ }
+
+ /* Free temp storage */
+
+ ckfree(catchIndices);
+ ckfree(catches);
+
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * UnstackExpiredCatches --
+ *
+ * Unstacks and closes the exception ranges for any catch contexts that
+ * were active in the previous basic block but are inactive in the
+ * current one.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+UnstackExpiredCatches(
+ CompileEnv* envPtr, /* Compilation environment */
+ BasicBlock* bbPtr, /* Basic block being processed */
+ int catchDepth, /* Depth of nesting of catches prior to entry
+ * to this block */
+ BasicBlock** catches, /* Array of catch contexts */
+ int* catchIndices) /* Indices of the exception ranges
+ * corresponding to the catch contexts */
+{
+ ExceptionRange* range; /* Exception range for a specific catch */
+ BasicBlock* catch; /* Catch block being examined */
+ BasicBlockCatchState catchState;
+ /* State of the code relative to the catch
+ * block being examined ("in catch" or
+ * "caught"). */
+
+ /*
+ * Unstack any catches that are deeper than the nesting level of the basic
+ * block being entered.
+ */
+
+ while (catchDepth > bbPtr->catchDepth) {
+ --catchDepth;
+ range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
+ range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
+ catches[catchDepth] = NULL;
+ catchIndices[catchDepth] = -1;
+ }
+
+ /*
+ * Unstack any catches that don't match the basic block being entered,
+ * either because they are no longer part of the context, or because the
+ * context has changed from INCATCH to CAUGHT.
+ */
+
+ catchState = bbPtr->catchState;
+ catch = bbPtr->enclosingCatch;
+ while (catchDepth > 0) {
+ --catchDepth;
+ if (catches[catchDepth] != NULL) {
+ if (catches[catchDepth] != catch || catchState >= BBCS_CAUGHT) {
+ range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
+ range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
+ catches[catchDepth] = NULL;
+ catchIndices[catchDepth] = -1;
+ }
+ catchState = catch->catchState;
+ catch = catch->enclosingCatch;
+ }
+ }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * LookForFreshCatches --
+ *
+ * Determines whether a basic block being entered needs any exception
+ * ranges that are not already stacked.
+ *
+ * Does not create the ranges: this procedure iterates from the innermost
+ * catch outward, but exception ranges must be created from the outermost
+ * catch inward.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+LookForFreshCatches(
+ BasicBlock* bbPtr, /* Basic block being entered */
+ BasicBlock** catches) /* Array of catch contexts that are already
+ * entered */
+{
+ BasicBlockCatchState catchState;
+ /* State ("in catch" or "caught") of the
+ * current catch. */
+ BasicBlock* catch; /* Current enclosing catch */
+ int catchDepth; /* Nesting depth of the current catch */
+
+ catchState = bbPtr->catchState;
+ catch = bbPtr->enclosingCatch;
+ catchDepth = bbPtr->catchDepth;
+ while (catchDepth > 0) {
+ --catchDepth;
+ if (catches[catchDepth] != catch && catchState < BBCS_CAUGHT) {
+ catches[catchDepth] = catch;
+ }
+ catchState = catch->catchState;
+ catch = catch->enclosingCatch;
+ }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * StackFreshCatches --
+ *
+ * Make ExceptionRange records for any catches that are in the basic
+ * block being entered and were not in the previous basic block.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+StackFreshCatches(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* bbPtr, /* Basic block being processed */
+ int catchDepth, /* Depth of nesting of catches prior to entry
+ * to this block */
+ BasicBlock** catches, /* Array of catch contexts */
+ int* catchIndices) /* Indices of the exception ranges
+ * corresponding to the catch contexts */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ ExceptionRange* range; /* Exception range for a specific catch */
+ BasicBlock* catch; /* Catch block being examined */
+ BasicBlock* errorExit; /* Error exit from the catch block */
+ Tcl_HashEntry* entryPtr;
+
+ catchDepth = 0;
+
+ /*
+ * Iterate through the enclosing catch blocks from the outside in,
+ * looking for ones that don't have exception ranges (and are uncaught)
+ */
+
+ for (catchDepth = 0; catchDepth < bbPtr->catchDepth; ++catchDepth) {
+ if (catchIndices[catchDepth] == -1 && catches[catchDepth] != NULL) {
+ /*
+ * Create an exception range for a block that needs one.
+ */
+
+ catch = catches[catchDepth];
+ catchIndices[catchDepth] =
+ TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
+ range->nestingLevel = envPtr->exceptDepth + catchDepth;
+ envPtr->maxExceptDepth =
+ TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth);
+ range->codeOffset = bbPtr->startOffset;
+
+ entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(catch->jumpTarget));
+ if (entryPtr == NULL) {
+ Tcl_Panic("undefined label in tclAssembly.c:"
+ "BuildExceptionRanges, can't happen");
+ }
+
+ errorExit = Tcl_GetHashValue(entryPtr);
+ range->catchOffset = errorExit->startOffset;
+ }
+ }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * RestoreEmbeddedExceptionRanges --
+ *
+ * Processes an assembly script, replacing any exception ranges that
+ * were present in embedded code.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+RestoreEmbeddedExceptionRanges(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ BasicBlock* bbPtr; /* Current basic block */
+ int rangeBase; /* Base of the foreign exception ranges when
+ * they are reinstalled */
+ int rangeIndex; /* Index of the current foreign exception
+ * range as reinstalled */
+ ExceptionRange* range; /* Current foreign exception range */
+ unsigned char opcode; /* Current instruction's opcode */
+ int catchIndex; /* Index of the exception range to which the
+ * current instruction refers */
+ int i;
+
+ /*
+ * Walk the basic blocks looking for exceptions in embedded scripts.
+ */
+
+ for (bbPtr = assemEnvPtr->head_bb;
+ bbPtr != NULL;
+ bbPtr = bbPtr->successor1) {
+ if (bbPtr->foreignExceptionCount != 0) {
+ /*
+ * Reinstall the embedded exceptions and track their nesting level
+ */
+
+ rangeBase = envPtr->exceptArrayNext;
+ for (i = 0; i < bbPtr->foreignExceptionCount; ++i) {
+ range = bbPtr->foreignExceptions + i;
+ rangeIndex = TclCreateExceptRange(range->type, envPtr);
+ range->nestingLevel += envPtr->exceptDepth + bbPtr->catchDepth;
+ memcpy(envPtr->exceptArrayPtr + rangeIndex, range,
+ sizeof(ExceptionRange));
+ if (range->nestingLevel >= envPtr->maxExceptDepth) {
+ envPtr->maxExceptDepth = range->nestingLevel + 1;
+ }
+ }
+
+ /*
+ * Walk through the bytecode of the basic block, and relocate
+ * INST_BEGIN_CATCH4 instructions to the new locations
+ */
+
+ i = bbPtr->startOffset;
+ while (i < bbPtr->successor1->startOffset) {
+ opcode = envPtr->codeStart[i];
+ if (opcode == INST_BEGIN_CATCH4) {
+ catchIndex = TclGetUInt4AtPtr(envPtr->codeStart + i + 1);
+ if (catchIndex >= bbPtr->foreignExceptionBase
+ && catchIndex < (bbPtr->foreignExceptionBase +
+ bbPtr->foreignExceptionCount)) {
+ catchIndex -= bbPtr->foreignExceptionBase;
+ catchIndex += rangeBase;
+ TclStoreInt4AtPtr(catchIndex, envPtr->codeStart+i+1);
+ }
+ }
+ i += tclInstructionTable[opcode].numBytes;
+ }
+ }
+ }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ResetVisitedBasicBlocks --
+ *
+ * Turns off the 'visited' flag in all basic blocks at the conclusion
+ * of a pass.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+ResetVisitedBasicBlocks(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
+{
+ BasicBlock* block;
+
+ for (block = assemEnvPtr->head_bb; block != NULL;
+ block = block->successor1) {
+ block->flags &= ~BB_VISITED;
+ }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * AddBasicBlockRangeToErrorInfo --
+ *
+ * Updates the error info of the Tcl interpreter to show a given basic
+ * block in the code.
+ *
+ * This procedure is used to label the callstack with source location
+ * information when reporting an error in stack checking.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+AddBasicBlockRangeToErrorInfo(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* bbPtr) /* Basic block in which the error is found */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ Tcl_Obj* lineNo; /* Line number in the source */
+
+ Tcl_AddErrorInfo(interp, "\n in assembly code between lines ");
+ lineNo = Tcl_NewIntObj(bbPtr->startLine);
+ Tcl_IncrRefCount(lineNo);
+ Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
+ Tcl_AddErrorInfo(interp, " and ");
+ if (bbPtr->successor1 != NULL) {
+ Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine);
+ Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
+ } else {
+ Tcl_AddErrorInfo(interp, "end of assembly code");
+ }
+ Tcl_DecrRefCount(lineNo);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * DupAssembleCodeInternalRep --
+ *
+ * Part of the Tcl object type implementation for Tcl assembly language
+ * bytecode. We do not copy the bytecode intrep. Instead, we return
+ * without setting copyPtr->typePtr, so the copy is a plain string copy
+ * of the assembly source, and if it is to be used as a compiled
+ * expression, it will need to be reprocessed.
+ *
+ * This makes sense, because with Tcl's copy-on-write practices, the
+ * usual (only?) time Tcl_DuplicateObj() will be called is when the copy
+ * is about to be modified, which would invalidate any copied bytecode
+ * anyway. The only reason it might make sense to copy the bytecode is if
+ * we had some modifying routines that operated directly on the intrep,
+ * as we do for lists and dicts.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+DupAssembleCodeInternalRep(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr)
+{
+ return;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FreeAssembleCodeInternalRep --
+ *
+ * Part of the Tcl object type implementation for Tcl expression
+ * bytecode. Frees the storage allocated to hold the internal rep, unless
+ * ref counts indicate bytecode execution is still in progress.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May free allocated memory. Leaves objPtr untyped.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+FreeAssembleCodeInternalRep(
+ Tcl_Obj *objPtr)
+{
+ ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
+
+ codePtr->refCount--;
+ if (codePtr->refCount <= 0) {
+ TclCleanupByteCode(codePtr);
+ }
+ objPtr->typePtr = NULL;
+ objPtr->internalRep.otherValuePtr = NULL;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclAsync.c b/generic/tclAsync.c
index faf012f..14804e4 100644
--- a/generic/tclAsync.c
+++ b/generic/tclAsync.c
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclAsync.c,v 1.19 2009/11/18 21:59:51 nijtmans Exp $
*/
#include "tclInt.h"
@@ -120,7 +118,7 @@ Tcl_AsyncCreate(
AsyncHandler *asyncPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- asyncPtr = (AsyncHandler *) ckalloc(sizeof(AsyncHandler));
+ asyncPtr = ckalloc(sizeof(AsyncHandler));
asyncPtr->ready = 0;
asyncPtr->nextPtr = NULL;
asyncPtr->proc = proc;
@@ -312,7 +310,7 @@ Tcl_AsyncDelete(
}
}
Tcl_MutexUnlock(&tsdPtr->asyncMutex);
- ckfree((char *) asyncPtr);
+ ckfree(asyncPtr);
}
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e426178..562cca6 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -15,8 +15,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclBasic.c,v 1.466 2010/09/27 19:42:37 msofer Exp $
*/
#include "tclInt.h"
@@ -83,8 +81,6 @@ TCL_DECLARE_MUTEX(cancelLock)
* are used to save the evaluation state between NR calls to each coro.
*/
-static const CorContext NULL_CONTEXT = {NULL, NULL, NULL, NULL};
-
#define SAVE_CONTEXT(context) \
(context).framePtr = iPtr->framePtr; \
(context).varFramePtr = iPtr->varFramePtr; \
@@ -135,11 +131,11 @@ static Tcl_Obj * GetCommandSource(Interp *iPtr, int objc,
Tcl_Obj *const objv[], int lookup);
static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
int actual, Tcl_Obj *const *objv);
-static Tcl_NRPostProc NRCoroutineActivateCallback;
static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
+static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);
+
static Tcl_NRPostProc NRRunObjProc;
-static Tcl_NRPostProc NRTailcallEval;
static Tcl_ObjCmdProc OldMathFuncProc;
static void OldMathFuncDeleteProc(ClientData clientData);
static void ProcessUnexpectedResult(Tcl_Interp *interp,
@@ -167,7 +163,8 @@ static Tcl_NRPostProc TEOV_RunLeaveTraces;
static Tcl_NRPostProc YieldToCallback;
static void ClearTailcall(Tcl_Interp *interp,
- struct TEOV_callback *tailcallPtr);
+ struct NRE_callback *tailcallPtr);
+static Tcl_ObjCmdProc NRCoroInjectObjCmd;
MODULE_SCOPE const TclStubs tclStubs;
@@ -216,11 +213,11 @@ static const CmdInfo builtInCmds[] = {
{"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, 1},
{"coroutine", NULL, NULL, TclNRCoroutineObjCmd, 1},
{"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, 1},
- {"eval", Tcl_EvalObjCmd, NULL, NULL, 1},
+ {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, 1},
{"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, 1},
{"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, 1},
{"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, 1},
- {"format", Tcl_FormatObjCmd, NULL, NULL, 1},
+ {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, 1},
{"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, 1},
{"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, 1},
{"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, 1},
@@ -231,18 +228,18 @@ static const CmdInfo builtInCmds[] = {
{"linsert", Tcl_LinsertObjCmd, NULL, NULL, 1},
{"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, 1},
{"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, 1},
- {"lrange", Tcl_LrangeObjCmd, NULL, NULL, 1},
+ {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, 1},
+ {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, 1},
{"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, 1},
- {"lreplace", Tcl_LreplaceObjCmd, NULL, NULL, 1},
+ {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, 1},
{"lreverse", Tcl_LreverseObjCmd, NULL, NULL, 1},
{"lsearch", Tcl_LsearchObjCmd, NULL, NULL, 1},
{"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, 1},
{"lsort", Tcl_LsortObjCmd, NULL, NULL, 1},
- {"namespace", Tcl_NamespaceObjCmd, TclCompileNamespaceCmd, TclNRNamespaceObjCmd, 1},
{"package", Tcl_PackageObjCmd, NULL, NULL, 1},
{"proc", Tcl_ProcObjCmd, NULL, NULL, 1},
{"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, 1},
- {"regsub", Tcl_RegsubObjCmd, NULL, NULL, 1},
+ {"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, 1},
{"rename", Tcl_RenameObjCmd, NULL, NULL, 1},
{"return", Tcl_ReturnObjCmd, TclCompileReturnCmd, NULL, 1},
{"scan", Tcl_ScanObjCmd, NULL, NULL, 1},
@@ -250,7 +247,7 @@ static const CmdInfo builtInCmds[] = {
{"split", Tcl_SplitObjCmd, NULL, NULL, 1},
{"subst", Tcl_SubstObjCmd, TclCompileSubstCmd, TclNRSubstObjCmd, 1},
{"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, TclNRSwitchObjCmd, 1},
- {"tailcall", NULL, NULL, TclNRTailcallObjCmd, 1},
+ {"tailcall", NULL, TclCompileTailcallCmd, TclNRTailcallObjCmd, 1},
{"throw", Tcl_ThrowObjCmd, TclCompileThrowCmd, NULL, 1},
{"trace", Tcl_TraceObjCmd, NULL, NULL, 1},
{"try", Tcl_TryObjCmd, TclCompileTryCmd, TclNRTryObjCmd, 1},
@@ -259,7 +256,8 @@ static const CmdInfo builtInCmds[] = {
{"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, 1},
{"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, 1},
{"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, 1},
- {"yield", NULL, NULL, TclNRYieldObjCmd, 1},
+ {"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, 1},
+ {"yieldto", NULL, NULL, TclNRYieldToObjCmd, 1},
/*
* Commands in the OS-interface. Note that many of these are unsafe.
@@ -275,7 +273,6 @@ static const CmdInfo builtInCmds[] = {
{"fblocked", Tcl_FblockedObjCmd, NULL, NULL, 1},
{"fconfigure", Tcl_FconfigureObjCmd, NULL, NULL, 0},
{"fcopy", Tcl_FcopyObjCmd, NULL, NULL, 1},
- {"file", Tcl_FileObjCmd, NULL, NULL, 0},
{"fileevent", Tcl_FileEventObjCmd, NULL, NULL, 1},
{"flush", Tcl_FlushObjCmd, NULL, NULL, 1},
{"gets", Tcl_GetsObjCmd, NULL, NULL, 1},
@@ -502,7 +499,7 @@ Tcl_CreateInterp(void)
* object type table and other object management code.
*/
- iPtr = (Interp *) ckalloc(sizeof(Interp));
+ iPtr = ckalloc(sizeof(Interp));
interp = (Tcl_Interp *) iPtr;
iPtr->result = iPtr->resultSpace;
@@ -526,10 +523,10 @@ Tcl_CreateInterp(void)
*/
iPtr->cmdFramePtr = NULL;
- iPtr->linePBodyPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
- iPtr->lineBCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
- iPtr->lineLAPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
- iPtr->lineLABCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ iPtr->linePBodyPtr = ckalloc(sizeof(Tcl_HashTable));
+ iPtr->lineBCPtr = ckalloc(sizeof(Tcl_HashTable));
+ iPtr->lineLAPtr = ckalloc(sizeof(Tcl_HashTable));
+ iPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS);
@@ -549,6 +546,10 @@ Tcl_CreateInterp(void)
Tcl_IncrRefCount(iPtr->upLiteral);
TclNewLiteralStringObj(iPtr->callLiteral,"CALL");
Tcl_IncrRefCount(iPtr->callLiteral);
+ TclNewLiteralStringObj(iPtr->innerLiteral,"INNER");
+ Tcl_IncrRefCount(iPtr->innerLiteral);
+ iPtr->innerContext = Tcl_NewListObj(0, NULL);
+ Tcl_IncrRefCount(iPtr->innerContext);
iPtr->errorCode = NULL;
TclNewLiteralStringObj(iPtr->ecVar, "::errorCode");
Tcl_IncrRefCount(iPtr->ecVar);
@@ -592,6 +593,15 @@ Tcl_CreateInterp(void)
iPtr->resultSpace[0] = 0;
iPtr->threadId = Tcl_GetCurrentThread();
+ /* TIP #378 */
+#ifdef TCL_INTERP_DEBUG_FRAME
+ iPtr->flags |= INTERP_DEBUG_FRAME;
+#else
+ if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {
+ iPtr->flags |= INTERP_DEBUG_FRAME;
+ }
+#endif
+
/*
* Initialise the tables for variable traces and searches *before*
* creating the global ns - so that the trace on errorInfo can be
@@ -614,7 +624,7 @@ Tcl_CreateInterp(void)
*/
/* This is needed to satisfy GCC 3.3's strict aliasing rules */
- framePtr = (CallFrame *) ckalloc(sizeof(CallFrame));
+ framePtr = ckalloc(sizeof(CallFrame));
result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
(Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
if (result != TCL_OK) {
@@ -647,7 +657,7 @@ Tcl_CreateInterp(void)
iPtr->asyncCancelMsg = Tcl_NewObj();
- cancelInfo = (CancelInfo *) ckalloc(sizeof(CancelInfo));
+ cancelInfo = ckalloc(sizeof(CancelInfo));
cancelInfo->interp = interp;
iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo);
@@ -748,7 +758,7 @@ Tcl_CreateInterp(void)
hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
cmdInfoPtr->name, &isNew);
if (isNew) {
- cmdPtr = (Command *) ckalloc(sizeof(Command));
+ cmdPtr = ckalloc(sizeof(Command));
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = iPtr->globalNsPtr;
cmdPtr->refCount = 1;
@@ -769,16 +779,19 @@ Tcl_CreateInterp(void)
}
/*
- * Create the "array", "binary", "chan", "dict", "info" and "string"
- * ensembles. Note that all these commands (and their subcommands that are
- * not present in the global namespace) are wholly safe.
+ * Create the "array", "binary", "chan", "dict", "file", "info",
+ * "namespace" and "string" ensembles. Note that all these commands (and
+ * their subcommands that are not present in the global namespace) are
+ * wholly safe *except* for "file".
*/
TclInitArrayCmd(interp);
TclInitBinaryCmd(interp);
TclInitChanCmd(interp);
TclInitDictCmd(interp);
+ TclInitFileCmd(interp);
TclInitInfoCmd(interp);
+ TclInitNamespaceCmd(interp);
TclInitStringCmd(interp);
TclInitPrefixCmd(interp);
@@ -811,10 +824,14 @@ Tcl_CreateInterp(void)
Tcl_CreateObjCommand(interp, "::tcl::unsupported::representation",
Tcl_RepresentationCmd, NULL, NULL);
- Tcl_NRCreateCommand(interp, "::tcl::unsupported::yieldTo", NULL,
- TclNRYieldToObjCmd, NULL, NULL);
- Tcl_NRCreateCommand(interp, "::tcl::unsupported::yieldm", NULL,
- TclNRYieldObjCmd, INT2PTR(CORO_ACTIVATE_YIELDM), NULL);
+ /* Adding the bytecode assembler command */
+ cmdPtr = (Command *) Tcl_NRCreateCommand(interp,
+ "::tcl::unsupported::assemble", Tcl_AssembleObjCmd,
+ TclNRAssembleObjCmd, NULL, NULL);
+ cmdPtr->compileProc = &TclCompileAssembleCmd;
+
+ Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
+ NRCoroInjectObjCmd, NULL, NULL);
#ifdef USE_DTRACE
/*
@@ -832,8 +849,8 @@ Tcl_CreateInterp(void)
if (mathfuncNSPtr == NULL) {
Tcl_Panic("Can't create math function namespace");
}
- strcpy(mathFuncName, "::tcl::mathfunc::");
#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
+ memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN);
for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
builtinFuncPtr++) {
strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
@@ -847,15 +864,14 @@ Tcl_CreateInterp(void)
*/
mathopNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
-#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
if (mathopNSPtr == NULL) {
Tcl_Panic("can't create math operator namespace");
}
Tcl_Export(interp, mathopNSPtr, "*", 1);
- strcpy(mathFuncName, "::tcl::mathop::");
+#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
+ memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
- TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)
- ckalloc(sizeof(TclOpCmdClientData));
+ TclOpCmdClientData *occdPtr = ckalloc(sizeof(TclOpCmdClientData));
occdPtr->op = opcmdInfoPtr->name;
occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
@@ -930,11 +946,11 @@ Tcl_CreateInterp(void)
Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
if (TclTommath_Init(interp) != TCL_OK) {
- Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
+ Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
}
if (TclOOInit(interp) != TCL_OK) {
- Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
+ Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
}
/*
@@ -944,7 +960,7 @@ Tcl_CreateInterp(void)
#ifdef HAVE_ZLIB
if (TclZlibInit(interp) != TCL_OK) {
- Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
+ Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
}
#endif
@@ -958,7 +974,7 @@ DeleteOpCmdClientData(
{
TclOpCmdClientData *occdPtr = clientData;
- ckfree((char *) occdPtr);
+ ckfree(occdPtr);
}
/*
@@ -991,6 +1007,7 @@ TclHideUnsafeCommands(
Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
}
}
+ TclMakeFileCommandSafe(interp); /* Ugh! */
return TCL_OK;
}
@@ -1028,14 +1045,14 @@ Tcl_CallWhenDeleted(
Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int));
int isNew;
char buffer[32 + TCL_INTEGER_SPACE];
- AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData));
+ AssocData *dPtr = ckalloc(sizeof(AssocData));
Tcl_HashEntry *hPtr;
sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr);
(*assocDataCounterPtr)++;
if (iPtr->assocData == NULL) {
- iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ iPtr->assocData = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
}
hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
@@ -1084,7 +1101,7 @@ Tcl_DontCallWhenDeleted(
hPtr = Tcl_NextHashEntry(&hSearch)) {
dPtr = Tcl_GetHashValue(hPtr);
if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
- ckfree((char *) dPtr);
+ ckfree(dPtr);
Tcl_DeleteHashEntry(hPtr);
return;
}
@@ -1124,14 +1141,14 @@ Tcl_SetAssocData(
int isNew;
if (iPtr->assocData == NULL) {
- iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ iPtr->assocData = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
}
hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew);
if (isNew == 0) {
dPtr = Tcl_GetHashValue(hPtr);
} else {
- dPtr = (AssocData *) ckalloc(sizeof(AssocData));
+ dPtr = ckalloc(sizeof(AssocData));
}
dPtr->proc = proc;
dPtr->clientData = clientData;
@@ -1176,7 +1193,7 @@ Tcl_DeleteAssocData(
if (dPtr->proc != NULL) {
dPtr->proc(dPtr->clientData, interp);
}
- ckfree((char *) dPtr);
+ ckfree(dPtr);
Tcl_DeleteHashEntry(hPtr);
}
@@ -1334,10 +1351,11 @@ DeleteInterpProc(
int i;
/*
- * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
+ * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup,
+ * unless we are exiting.
*/
- if (iPtr->numLevels > 0) {
+ if ((iPtr->numLevels > 0) && !TclInExit()) {
Tcl_Panic("DeleteInterpProc called with active evals");
}
@@ -1371,9 +1389,9 @@ DeleteInterpProc(
if (cancelInfo != NULL) {
if (cancelInfo->result != NULL) {
- ckfree((char *) cancelInfo->result);
+ ckfree(cancelInfo->result);
}
- ckfree((char *) cancelInfo);
+ ckfree(cancelInfo);
}
Tcl_DeleteHashEntry(hPtr);
@@ -1407,7 +1425,6 @@ DeleteInterpProc(
* table, as it will be freed later in this function without further use.
*/
- TclCleanupLiteralTable(interp, &iPtr->literalTable);
TclHandleFree(iPtr->handle);
TclTeardownNamespace(iPtr->globalNsPtr);
@@ -1429,7 +1446,7 @@ DeleteInterpProc(
Tcl_DeleteCommandFromToken(interp, Tcl_GetHashValue(hPtr));
}
Tcl_DeleteHashTable(hTablePtr);
- ckfree((char *) hTablePtr);
+ ckfree(hTablePtr);
}
/*
@@ -1450,10 +1467,10 @@ DeleteInterpProc(
if (dPtr->proc != NULL) {
dPtr->proc(dPtr->clientData, interp);
}
- ckfree((char *) dPtr);
+ ckfree(dPtr);
}
Tcl_DeleteHashTable(hTablePtr);
- ckfree((char *) hTablePtr);
+ ckfree(hTablePtr);
}
/*
@@ -1461,11 +1478,11 @@ DeleteInterpProc(
* namespace. The order is important [Bug 1658572].
*/
- if (iPtr->framePtr != iPtr->rootFramePtr) {
+ if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
}
Tcl_PopCallFrame(interp);
- ckfree((char *) iPtr->rootFramePtr);
+ ckfree(iPtr->rootFramePtr);
iPtr->rootFramePtr = NULL;
Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);
@@ -1492,6 +1509,8 @@ DeleteInterpProc(
iPtr->errorStack = NULL;
Tcl_DecrRefCount(iPtr->upLiteral);
Tcl_DecrRefCount(iPtr->callLiteral);
+ Tcl_DecrRefCount(iPtr->innerLiteral);
+ Tcl_DecrRefCount(iPtr->innerContext);
if (iPtr->returnOpts) {
Tcl_DecrRefCount(iPtr->returnOpts);
}
@@ -1506,6 +1525,10 @@ DeleteInterpProc(
if (iPtr->execEnvPtr != NULL) {
TclDeleteExecEnv(iPtr->execEnvPtr);
}
+ if (iPtr->scriptFile) {
+ Tcl_DecrRefCount(iPtr->scriptFile);
+ iPtr->scriptFile = NULL;
+ }
Tcl_DecrRefCount(iPtr->emptyObjPtr);
iPtr->emptyObjPtr = NULL;
@@ -1513,7 +1536,7 @@ DeleteInterpProc(
while (resPtr) {
nextResPtr = resPtr->nextPtr;
ckfree(resPtr->name);
- ckfree((char *) resPtr);
+ ckfree(resPtr);
resPtr = nextResPtr;
}
@@ -1533,16 +1556,20 @@ DeleteInterpProc(
hPtr != NULL;
hPtr = Tcl_NextHashEntry(&search)) {
CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
+ Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);
- if (cfPtr->type == TCL_LOCATION_SOURCE) {
- Tcl_DecrRefCount(cfPtr->data.eval.path);
+ procPtr->iPtr = NULL;
+ if (cfPtr) {
+ if (cfPtr->type == TCL_LOCATION_SOURCE) {
+ Tcl_DecrRefCount(cfPtr->data.eval.path);
+ }
+ ckfree(cfPtr->line);
+ ckfree(cfPtr);
}
- ckfree((char *) cfPtr->line);
- ckfree((char *) cfPtr);
Tcl_DeleteHashEntry(hPtr);
}
Tcl_DeleteHashTable(iPtr->linePBodyPtr);
- ckfree((char *) iPtr->linePBodyPtr);
+ ckfree(iPtr->linePBodyPtr);
iPtr->linePBodyPtr = NULL;
/*
@@ -1558,20 +1585,20 @@ DeleteInterpProc(
Tcl_DecrRefCount(eclPtr->path);
}
for (i=0; i< eclPtr->nuloc; i++) {
- ckfree((char *) eclPtr->loc[i].line);
+ ckfree(eclPtr->loc[i].line);
}
if (eclPtr->loc != NULL) {
- ckfree((char *) eclPtr->loc);
+ ckfree(eclPtr->loc);
}
Tcl_DeleteHashTable(&eclPtr->litInfo);
- ckfree((char *) eclPtr);
+ ckfree(eclPtr);
Tcl_DeleteHashEntry(hPtr);
}
Tcl_DeleteHashTable(iPtr->lineBCPtr);
- ckfree((char *) iPtr->lineBCPtr);
+ ckfree(iPtr->lineBCPtr);
iPtr->lineBCPtr = NULL;
/*
@@ -1580,7 +1607,7 @@ DeleteInterpProc(
* know which arguments will be used as scripts and which will not.
*/
- if (iPtr->lineLAPtr->numEntries) {
+ if (iPtr->lineLAPtr->numEntries && !TclInExit()) {
/*
* When the interp goes away we have nothing on the stack, so there
* are no arguments, so this table has to be empty.
@@ -1593,7 +1620,7 @@ DeleteInterpProc(
ckfree((char *) iPtr->lineLAPtr);
iPtr->lineLAPtr = NULL;
- if (iPtr->lineLABCPtr->numEntries) {
+ if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
/*
* When the interp goes away we have nothing on the stack, so there
* are no arguments, so this table has to be empty.
@@ -1603,7 +1630,7 @@ DeleteInterpProc(
}
Tcl_DeleteHashTable(iPtr->lineLABCPtr);
- ckfree((char *) iPtr->lineLABCPtr);
+ ckfree(iPtr->lineLABCPtr);
iPtr->lineLABCPtr = NULL;
/*
@@ -1614,7 +1641,7 @@ DeleteInterpProc(
Tcl_DeleteHashTable(&iPtr->varTraces);
Tcl_DeleteHashTable(&iPtr->varSearches);
- ckfree((char *) iPtr);
+ ckfree(iPtr);
}
/*
@@ -1680,9 +1707,9 @@ Tcl_HideCommand(
*/
if (strstr(hiddenCmdToken, "::") != NULL) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot use namespace qualifiers in hidden command"
- " token (rename)", NULL);
+ " token (rename)", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL);
return TCL_ERROR;
}
@@ -1705,8 +1732,9 @@ Tcl_HideCommand(
*/
if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
- Tcl_AppendResult(interp, "can only hide global namespace commands"
- " (use rename then hide)", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only hide global namespace commands (use rename then hide)",
+ -1));
Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", NULL);
return TCL_ERROR;
}
@@ -1717,8 +1745,7 @@ Tcl_HideCommand(
hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
if (hiddenCmdTablePtr == NULL) {
- hiddenCmdTablePtr = (Tcl_HashTable *)
- ckalloc((unsigned) sizeof(Tcl_HashTable));
+ hiddenCmdTablePtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS);
iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr;
}
@@ -1731,8 +1758,9 @@ Tcl_HideCommand(
hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
if (!isNew) {
- Tcl_AppendResult(interp, "hidden command named \"", hiddenCmdToken,
- "\" already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "hidden command named \"%s\" already exists",
+ hiddenCmdToken));
Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", NULL);
return TCL_ERROR;
}
@@ -1834,8 +1862,9 @@ Tcl_ExposeCommand(
*/
if (strstr(cmdName, "::") != NULL) {
- Tcl_AppendResult(interp, "cannot expose to a namespace "
- "(use expose to toplevel, then rename)", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot expose to a namespace (use expose to toplevel, then rename)",
+ -1));
Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", NULL);
return TCL_ERROR;
}
@@ -1850,8 +1879,8 @@ Tcl_ExposeCommand(
hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
}
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "unknown hidden command \"", hiddenCmdToken,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown hidden command \"%s\"", hiddenCmdToken));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
hiddenCmdToken, NULL);
return TCL_ERROR;
@@ -1870,9 +1899,9 @@ Tcl_ExposeCommand(
* than 'nicely' erroring out ?
*/
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"trying to expose a non-global command namespace command",
- NULL);
+ -1));
return TCL_ERROR;
}
@@ -1889,13 +1918,24 @@ Tcl_ExposeCommand(
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
if (!isNew) {
- Tcl_AppendResult(interp, "exposed command \"", cmdName,
- "\" already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "exposed command \"%s\" already exists", cmdName));
Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", NULL);
return TCL_ERROR;
}
/*
+ * Command resolvers (per-interp, per-namespace) might have resolved to a
+ * command for the given namespace scope with this command not being
+ * registered with the namespace's command table. During BC compilation,
+ * the so-resolved command turns into a CmdName literal. Without
+ * invalidating a possible CmdName literal here explicitly, such literals
+ * keep being reused while pointing to overhauled commands.
+ */
+
+ TclInvalidateCmdLiteral(interp, cmdName, nsPtr);
+
+ /*
* The list of command 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.
@@ -2043,6 +2083,18 @@ Tcl_CreateCommand(
}
} else {
/*
+ * Command resolvers (per-interp, per-namespace) might have resolved
+ * to a command for the given namespace scope with this command not
+ * being registered with the namespace's command table. During BC
+ * compilation, the so-resolved command turns into a CmdName literal.
+ * Without invalidating a possible CmdName literal here explicitly,
+ * such literals keep being reused while pointing to overhauled
+ * commands.
+ */
+
+ TclInvalidateCmdLiteral(interp, tail, nsPtr);
+
+ /*
* The list of command 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.
@@ -2051,7 +2103,7 @@ Tcl_CreateCommand(
TclInvalidateNsCmdLookup(nsPtr);
TclInvalidateNsPath(nsPtr);
}
- cmdPtr = (Command *) ckalloc(sizeof(Command));
+ cmdPtr = ckalloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = nsPtr;
@@ -2216,6 +2268,18 @@ Tcl_CreateObjCommand(
}
} else {
/*
+ * Command resolvers (per-interp, per-namespace) might have resolved
+ * to a command for the given namespace scope with this command not
+ * being registered with the namespace's command table. During BC
+ * compilation, the so-resolved command turns into a CmdName literal.
+ * Without invalidating a possible CmdName literal here explicitly,
+ * such literals keep being reused while pointing to overhauled
+ * commands.
+ */
+
+ TclInvalidateCmdLiteral(interp, tail, nsPtr);
+
+ /*
* The list of command 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.
@@ -2223,7 +2287,7 @@ Tcl_CreateObjCommand(
TclInvalidateNsCmdLookup(nsPtr);
}
- cmdPtr = (Command *) ckalloc(sizeof(Command));
+ cmdPtr = ckalloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = nsPtr;
@@ -2435,9 +2499,10 @@ TclRenameCommand(
cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0);
cmdPtr = (Command *) cmd;
if (cmdPtr == NULL) {
- Tcl_AppendResult(interp, "can't ",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't %s \"%s\": command doesn't exist",
((newName == NULL)||(*newName == '\0'))? "delete":"rename",
- " \"", oldName, "\": command doesn't exist", NULL);
+ oldName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL);
return TCL_ERROR;
}
@@ -2467,16 +2532,17 @@ TclRenameCommand(
TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);
if ((newNsPtr == NULL) || (newTail == NULL)) {
- Tcl_AppendResult(interp, "can't rename to \"", newName,
- "\": bad command name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't rename to \"%s\": bad command name", newName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
result = TCL_ERROR;
goto done;
}
if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
- Tcl_AppendResult(interp, "can't rename to \"", newName,
- "\": command already exists", NULL);
- Tcl_SetErrorCode(interp, "TCL", "RENAME", "TARGET_EXISTS", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't rename to \"%s\": command already exists", newName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
+ "TARGET_EXISTS", NULL);
result = TCL_ERROR;
goto done;
}
@@ -2524,6 +2590,17 @@ TclRenameCommand(
TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
/*
+ * Command resolvers (per-interp, per-namespace) might have resolved to a
+ * command for the given namespace scope with this command not being
+ * registered with the namespace's command table. During BC compilation,
+ * the so-resolved command turns into a CmdName literal. Without
+ * invalidating a possible CmdName literal here explicitly, such literals
+ * keep being reused while pointing to overhauled commands.
+ */
+
+ TclInvalidateCmdLiteral(interp, newTail, cmdPtr->nsPtr);
+
+ /*
* Script for rename traces can delete the command "oldName". Therefore
* increment the reference count for cmdPtr so that it's Command structure
* is freed only towards the end of this function by calling
@@ -2538,7 +2615,7 @@ TclRenameCommand(
Tcl_DStringInit(&newFullName);
Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1);
if (newNsPtr != iPtr->globalNsPtr) {
- Tcl_DStringAppend(&newFullName, "::", 2);
+ TclDStringAppendLiteral(&newFullName, "::");
}
Tcl_DStringAppend(&newFullName, newTail, -1);
cmdPtr->refCount++;
@@ -2966,8 +3043,9 @@ Tcl_DeleteCommandFromToken(
tracePtr = cmdPtr->tracePtr;
while (tracePtr != NULL) {
CommandTrace *nextPtr = tracePtr->nextPtr;
+
if ((--tracePtr->refCount) <= 0) {
- ckfree((char *) tracePtr);
+ ckfree(tracePtr);
}
tracePtr = nextPtr;
}
@@ -3053,8 +3131,8 @@ Tcl_DeleteCommandFromToken(
* from a CmdName Tcl object in some ByteCode code sequence. In that case,
* delay the cleanup until all references are either discarded (when a
* ByteCode is freed) or replaced by a new reference (when a cached
- * CmdName Command reference is found to be invalid and TclNRExecuteByteCode
- * looks up the command in the command hashtable).
+ * CmdName Command reference is found to be invalid and
+ * TclNRExecuteByteCode looks up the command in the command hashtable).
*/
TclCleanupCommandMacro(cmdPtr);
@@ -3152,7 +3230,7 @@ CallCommandTraces(
oldName, newName, flags);
cmdPtr->flags &= ~tracePtr->flags;
if ((--tracePtr->refCount) <= 0) {
- ckfree((char *) tracePtr);
+ ckfree(tracePtr);
}
}
@@ -3215,28 +3293,29 @@ CancelEvalProc(
if (iPtr != NULL) {
/*
- * Setting this flag will cause the script in progress to be
- * canceled as soon as possible. The core honors this flag at all
- * the necessary places to ensure script cancellation is
+ * Setting the CANCELED flag will cause the script in progress to
+ * be canceled as soon as possible. The core honors this flag at
+ * all the necessary places to ensure script cancellation is
* responsive. Extensions can check for this flag by calling
* Tcl_Canceled and checking if TCL_ERROR is returned or they can
* choose to ignore the script cancellation flag and the
- * associated functionality altogether.
+ * associated functionality altogether. Currently, the only other
+ * flag we care about here is the TCL_CANCEL_UNWIND flag (from
+ * Tcl_CancelEval). We do not want to simply combine all the flags
+ * from original Tcl_CancelEval call with the interp flags here
+ * just in case the caller passed flags that might cause behaviour
+ * unrelated to script cancellation.
*/
- iPtr->flags |= CANCELED;
+ TclSetCancelFlags(iPtr, cancelInfo->flags | CANCELED);
/*
- * Currently, we only care about the TCL_CANCEL_UNWIND flag from
- * Tcl_CancelEval. We do not want to simply combine all the flags
- * from original Tcl_CancelEval call with the interp flags here
- * just in case the caller passed flags that might cause behaviour
- * unrelated to script cancellation.
+ * Now, we must set the script cancellation flags on all the slave
+ * interpreters belonging to this one.
*/
- if (cancelInfo->flags & TCL_CANCEL_UNWIND) {
- iPtr->flags |= TCL_CANCEL_UNWIND;
- }
+ TclSetSlaveCancelFlags((Tcl_Interp *) iPtr,
+ cancelInfo->flags | CANCELED, 0);
/*
* Create the result object now so that Tcl_Canceled can avoid
@@ -3344,7 +3423,7 @@ TclCleanupCommand(
{
cmdPtr->refCount--;
if (cmdPtr->refCount <= 0) {
- ckfree((char *) cmdPtr);
+ ckfree(cmdPtr);
}
}
@@ -3385,18 +3464,16 @@ Tcl_CreateMathFunc(
* function. */
{
Tcl_DString bigName;
- OldMathFuncData *data = (OldMathFuncData *)
- ckalloc(sizeof(OldMathFuncData));
+ OldMathFuncData *data = ckalloc(sizeof(OldMathFuncData));
data->proc = proc;
data->numArgs = numArgs;
- data->argTypes = (Tcl_ValueType *)
- ckalloc(numArgs * sizeof(Tcl_ValueType));
+ data->argTypes = ckalloc(numArgs * sizeof(Tcl_ValueType));
memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
data->clientData = clientData;
Tcl_DStringInit(&bigName);
- Tcl_DStringAppend(&bigName, "::tcl::mathfunc::", -1);
+ TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::");
Tcl_DStringAppend(&bigName, name, -1);
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
@@ -3448,7 +3525,7 @@ OldMathFuncProc(
* Convert arguments from Tcl_Obj's to Tcl_Value's.
*/
- args = (Tcl_Value *) ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
+ args = ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
for (j = 1, k = 0; j < objc; ++j, ++k) {
/* TODO: Convert to TclGetNumberFromObj? */
valuePtr = objv[j];
@@ -3464,11 +3541,11 @@ OldMathFuncProc(
* We have a non-numeric argument.
*/
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument to math function didn't have numeric value",
- TCL_STATIC);
+ -1));
TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
- ckfree((char *) args);
+ ckfree(args);
return TCL_ERROR;
}
@@ -3500,7 +3577,7 @@ OldMathFuncProc(
break;
case TCL_INT:
if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) {
- ckfree((char *) args);
+ ckfree(args);
return TCL_ERROR;
}
valuePtr = Tcl_GetObjResult(interp);
@@ -3509,7 +3586,7 @@ OldMathFuncProc(
break;
case TCL_WIDE_INT:
if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) {
- ckfree((char *) args);
+ ckfree(args);
return TCL_ERROR;
}
valuePtr = Tcl_GetObjResult(interp);
@@ -3525,7 +3602,7 @@ OldMathFuncProc(
errno = 0;
result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult);
- ckfree((char *) args);
+ ckfree(args);
if (result != TCL_OK) {
return result;
}
@@ -3568,8 +3645,8 @@ OldMathFuncDeleteProc(
{
OldMathFuncData *dataPtr = clientData;
- ckfree((char *) dataPtr->argTypes);
- ckfree((char *) dataPtr);
+ ckfree(dataPtr->argTypes);
+ ckfree(dataPtr);
}
/*
@@ -3623,12 +3700,8 @@ Tcl_GetMathFuncInfo(
*/
if (cmdPtr == NULL) {
- Tcl_Obj *message;
-
- TclNewLiteralStringObj(message, "unknown math function \"");
- Tcl_AppendToObj(message, name, -1);
- Tcl_AppendToObj(message, "\"", 1);
- Tcl_SetObjResult(interp, message);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown math function \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL);
*numArgsPtr = -1;
*argTypesPtr = NULL;
@@ -3683,41 +3756,28 @@ Tcl_ListMathFuncs(
Tcl_Interp *interp,
const char *pattern)
{
- Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
- Namespace *nsPtr;
- Namespace *dummy1NsPtr;
- Namespace *dummy2NsPtr;
- const char *dummyNamePtr;
- Tcl_Obj *result = Tcl_NewObj();
-
- TclGetNamespaceForQualName(interp, "::tcl::mathfunc",
- globalNsPtr, TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY,
- &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &dummyNamePtr);
- if (nsPtr == NULL) {
- return result;
+ Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1);
+ Tcl_Obj *result;
+ Tcl_InterpState state;
+
+ if (pattern) {
+ Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1);
+ Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj);
+
+ Tcl_AppendObjToObj(script, arg);
+ Tcl_DecrRefCount(arg); /* Should tear down patternObj too */
}
- if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
- if (Tcl_FindHashEntry(&nsPtr->cmdTable, pattern) != NULL) {
- Tcl_ListObjAppendElement(NULL, result,
- Tcl_NewStringObj(pattern, -1));
- }
+ state = Tcl_SaveInterpState(interp, TCL_OK);
+ Tcl_IncrRefCount(script);
+ if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) {
+ result = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
} else {
- Tcl_HashSearch cmdHashSearch;
- Tcl_HashEntry *cmdHashEntry =
- Tcl_FirstHashEntry(&nsPtr->cmdTable,&cmdHashSearch);
-
- for (; cmdHashEntry != NULL;
- cmdHashEntry = Tcl_NextHashEntry(&cmdHashSearch)) {
- const char *cmdNamePtr =
- Tcl_GetHashKey(&nsPtr->cmdTable, cmdHashEntry);
-
- if (pattern == NULL || Tcl_StringMatch(cmdNamePtr, pattern)) {
- Tcl_ListObjAppendElement(NULL, result,
- Tcl_NewStringObj(cmdNamePtr, -1));
- }
- }
+ result = Tcl_NewObj();
}
+ Tcl_DecrRefCount(script);
+ Tcl_RestoreInterpState(interp, state);
+
return result;
}
@@ -3757,15 +3817,22 @@ TclInterpReady(
*/
if (iPtr->flags & DELETED) {
- /* JJM - Superfluous Tcl_ResetResult call removed. */
- Tcl_AppendResult(interp,
- "attempt to call eval in deleted interpreter", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to call eval in deleted interpreter", -1));
Tcl_SetErrorCode(interp, "TCL", "IDELETE",
"attempt to call eval in deleted interpreter", NULL);
return TCL_ERROR;
}
- if (iPtr->execEnvPtr->rewind ||
+ if (iPtr->execEnvPtr->rewind) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure the script being evaluated (if any) has not been canceled.
+ */
+
+ if (TclCanceled(iPtr) &&
(TCL_OK != Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG))) {
return TCL_ERROR;
}
@@ -3779,8 +3846,8 @@ TclInterpReady(
return TCL_OK;
}
- Tcl_AppendResult(interp,
- "too many nested evaluations (infinite loop?)", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "too many nested evaluations (infinite loop?)", -1));
Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
return TCL_ERROR;
}
@@ -3815,7 +3882,7 @@ TclResetCancellation(
}
if (force || (iPtr->numLevels == 0)) {
- iPtr->flags &= (~(CANCELED | TCL_CANCEL_UNWIND));
+ TclUnsetCancelFlags(iPtr);
}
return TCL_OK;
}
@@ -3853,105 +3920,78 @@ Tcl_Canceled(
register Interp *iPtr = (Interp *) interp;
/*
- * Traverse up the to the top-level interp, checking for the CANCELED flag
- * along the way. If any of the intervening interps have the CANCELED flag
- * set, the current script in progress is considered to be canceled and we
- * stop checking. Otherwise, if any interp has the DELETED flag set we
- * stop checking.
+ * Has the current script in progress for this interpreter been canceled
+ * or is the stack being unwound due to the previous script cancellation?
*/
- for (; iPtr!=NULL; iPtr = (Interp *) Tcl_GetMaster((Tcl_Interp *) iPtr)) {
- /*
- * Has the current script in progress for this interpreter been
- * canceled or is the stack being unwound due to the previous script
- * cancellation?
- */
-
- if ((iPtr->flags & CANCELED) || (iPtr->flags & TCL_CANCEL_UNWIND)) {
- /*
- * The CANCELED flag is a one-shot flag that is reset immediately
- * upon being detected; however, if the TCL_CANCEL_UNWIND flag is
- * set we will continue to report that the script in progress has
- * been canceled thereby allowing the evaluation stack for the
- * interp to be fully unwound.
- */
+ if (!TclCanceled(iPtr)) {
+ return TCL_OK;
+ }
- iPtr->flags &= ~CANCELED;
+ /*
+ * The CANCELED flag is a one-shot flag that is reset immediately upon
+ * being detected; however, if the TCL_CANCEL_UNWIND flag is set we will
+ * continue to report that the script in progress has been canceled
+ * thereby allowing the evaluation stack for the interp to be fully
+ * unwound.
+ */
- /*
- * The CANCELED flag was detected and reset; however, if the
- * caller specified the TCL_CANCEL_UNWIND flag, we only return
- * TCL_ERROR (indicating that the script in progress has been
- * canceled) if the evaluation stack for the interp is being fully
- * unwound.
- */
+ iPtr->flags &= ~CANCELED;
- if (!(flags & TCL_CANCEL_UNWIND)
- || (iPtr->flags & TCL_CANCEL_UNWIND)) {
- /*
- * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error
- * in the interp's result; otherwise, we leave it alone.
- */
+ /*
+ * The CANCELED flag was detected and reset; however, if the caller
+ * specified the TCL_CANCEL_UNWIND flag, we only return TCL_ERROR
+ * (indicating that the script in progress has been canceled) if the
+ * evaluation stack for the interp is being fully unwound.
+ */
- if (flags & TCL_LEAVE_ERR_MSG) {
- const char *id, *message = NULL;
- int length;
+ if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) {
+ return TCL_OK;
+ }
- /*
- * Setup errorCode variables so that we can differentiate
- * between being canceled and unwound.
- */
+ /*
+ * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the
+ * interp's result; otherwise, we leave it alone.
+ */
- if (iPtr->asyncCancelMsg != NULL) {
- message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg,
- &length);
- } else {
- length = 0;
- }
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ const char *id, *message = NULL;
+ int length;
- if (iPtr->flags & TCL_CANCEL_UNWIND) {
- id = "IUNWIND";
- if (length == 0) {
- message = "eval unwound";
- }
- } else {
- id = "ICANCEL";
- if (length == 0) {
- message = "eval canceled";
- }
- }
-
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, message, NULL);
- Tcl_SetErrorCode(interp, "TCL", id, message, NULL);
- }
+ /*
+ * Setup errorCode variables so that we can differentiate between
+ * being canceled and unwound.
+ */
- /*
- * Return TCL_ERROR to the caller (not necessarily just the
- * Tcl core itself) that indicates further processing of the
- * script or command in progress should halt gracefully and as
- * soon as possible.
- */
+ if (iPtr->asyncCancelMsg != NULL) {
+ message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length);
+ } else {
+ length = 0;
+ }
- return TCL_ERROR;
- }
- } else {
- /*
- * FIXME: If this interpreter is being deleted we cannot continue
- * to traverse up the interp chain due to an issue with
- * Tcl_GetMaster (really the slave interp bookkeeping) that causes
- * us to run off into a freed interp struct. Ideally, this check
- * would not be necessary because Tcl_GetMaster would return NULL
- * instead of a pointer to invalid (freed) memory.
- */
+ if (iPtr->flags & TCL_CANCEL_UNWIND) {
+ id = "IUNWIND";
+ if (length == 0) {
+ message = "eval unwound";
+ }
+ } else {
+ id = "ICANCEL";
+ if (length == 0) {
+ message = "eval canceled";
+ }
+ }
- if (iPtr->flags & DELETED) {
- break;
- }
- }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1));
+ Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL);
}
- return TCL_OK;
+ /*
+ * Return TCL_ERROR to the caller (not necessarily just the Tcl core
+ * itself) that indicates further processing of the script or command in
+ * progress should halt gracefully and as soon as possible.
+ */
+
+ return TCL_ERROR;
}
/*
@@ -4096,7 +4136,7 @@ Tcl_EvalObjv(
* TCL_EVAL_NOERR are currently supported. */
{
int result;
- TEOV_callback *rootPtr = TOP_CB(interp);
+ NRE_callback *rootPtr = TOP_CB(interp);
result = TclNREvalObjv(interp, objc, objv, flags, NULL);
return TclNRRunCallbacks(interp, result, rootPtr);
@@ -4120,8 +4160,6 @@ TclNREvalObjv(
Interp *iPtr = (Interp *) interp;
int result;
Namespace *lookupNsPtr = iPtr->lookupNsPtr;
- Tcl_ObjCmdProc *objProc;
- ClientData objClientData;
Command **cmdPtrPtr;
iPtr->lookupNsPtr = NULL;
@@ -4137,10 +4175,10 @@ TclNREvalObjv(
*/
if (iPtr->evalFlags & TCL_EVAL_REDIRECT) {
- TclNRAddCallback(interp, NRCommand, NULL, INT2PTR(1), NULL, NULL);
+ TclNRAddCallback(interp, NRCommand, NULL, INT2PTR(1), INT2PTR(objc), objv);
iPtr->evalFlags &= ~TCL_EVAL_REDIRECT;
} else {
- TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
+ TclNRAddCallback(interp, NRCommand, NULL, NULL, INT2PTR(objc), objv);
}
cmdPtrPtr = (Command **) &(TOP_CB(interp)->data[0]);
@@ -4221,6 +4259,8 @@ TclNREvalObjv(
}
}
+
+#ifdef USE_DTRACE
if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
const char *a[10];
int i = 0;
@@ -4246,7 +4286,7 @@ TclNREvalObjv(
TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
(Tcl_Obj **)(objv + 1));
}
-
+#endif /* USE_DTRACE */
/*
* Fix the original callback to point to the now known cmdPtr. Insure that
* the Command struct lives until the command returns.
@@ -4260,15 +4300,13 @@ TclNREvalObjv(
* a callback to do the actual running.
*/
- objProc = cmdPtr->nreProc;
- if (!objProc) {
- objProc = cmdPtr->objProc;
+ if (cmdPtr->nreProc) {
+ TclNRAddCallback(interp, NRRunObjProc, cmdPtr,
+ INT2PTR(objc), (ClientData) objv, NULL);
+ return TCL_OK;
+ } else {
+ return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
}
- objClientData = cmdPtr->objClientData;
-
- TclNRAddCallback(interp, NRRunObjProc, objProc, objClientData,
- INT2PTR(objc), (ClientData) objv);
- return TCL_OK;
}
void
@@ -4283,12 +4321,12 @@ int
TclNRRunCallbacks(
Tcl_Interp *interp,
int result,
- struct TEOV_callback *rootPtr)
+ struct NRE_callback *rootPtr)
/* All callbacks down to rootPtr not inclusive
* are to be run. */
{
Interp *iPtr = (Interp *) interp;
- TEOV_callback *callbackPtr;
+ NRE_callback *callbackPtr;
Tcl_NRPostProc *procPtr;
/*
@@ -4315,7 +4353,7 @@ TclNRRunCallbacks(
return result;
}
-int
+static int
NRCommand(
ClientData data[],
Tcl_Interp *interp,
@@ -4338,7 +4376,7 @@ NRCommand(
if (TclAsyncReady(iPtr)) {
result = Tcl_AsyncInvoke(interp, result);
}
- if (result == TCL_OK) {
+ if ((result == TCL_OK) && TclCanceled(iPtr)) {
result = Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG);
}
if (result == TCL_OK && TclLimitReady(iPtr->limit)) {
@@ -4356,15 +4394,11 @@ NRRunObjProc(
{
/* OPT: do not call? */
- Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0];
- ClientData objClientData = data[1];
- int objc = PTR2INT(data[2]);
- Tcl_Obj **objv = data[3];
+ Command* cmdPtr = data[0];
+ int objc = PTR2INT(data[1]);
+ Tcl_Obj **objv = data[2];
- if (result == TCL_OK) {
- return objProc(objClientData, interp, objc, objv);
- }
- return result;
+ return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv);
}
@@ -4467,7 +4501,7 @@ TEOV_Exception(
* here directly.
*/
- iPtr->flags &= (~(CANCELED | TCL_CANCEL_UNWIND));
+ TclUnsetCancelFlags(iPtr);
return result;
}
@@ -4570,8 +4604,8 @@ TEOV_NotFound(
cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
if (cmdPtr == NULL) {
- Tcl_AppendResult(interp, "invalid command name \"",
- TclGetString(objv[0]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid command name \"%s\"", TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
TclGetString(objv[0]), NULL);
@@ -4886,7 +4920,7 @@ TclEvalEx(
int line, /* The line the script starts on. */
int *clNextOuter, /* Information about an outer context for */
const char *outerScript) /* continuation line data. This is set only in
- * EvalTokensStandard(), to properly handle
+ * TclSubstTokens(), to properly handle
* [...]-nested commands. The 'outerScript'
* refers to the most-outer script containing
* the embedded command, which is refered to
@@ -5066,10 +5100,9 @@ TclEvalEx(
*/
if (numWords > minObjs) {
- expand = (int *) ckalloc(numWords * sizeof(int));
- objvSpace = (Tcl_Obj **)
- ckalloc(numWords * sizeof(Tcl_Obj *));
- lineSpace = (int *) ckalloc(numWords * sizeof(int));
+ expand = ckalloc(numWords * sizeof(int));
+ objvSpace = ckalloc(numWords * sizeof(Tcl_Obj *));
+ lineSpace = ckalloc(numWords * sizeof(int));
}
expandRequested = 0;
objv = objvSpace;
@@ -5154,10 +5187,9 @@ TclEvalEx(
int objIdx = objectsNeeded - 1;
if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
- objv = objvSpace = (Tcl_Obj **)
+ objv = objvSpace =
ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
- lines = lineSpace = (int *)
- ckalloc(objectsNeeded * sizeof(int));
+ lines = lineSpace = ckalloc(objectsNeeded * sizeof(int));
}
objectsUsed = 0;
@@ -5184,10 +5216,10 @@ TclEvalEx(
objv += objIdx+1;
if (copy != stackObjArray) {
- ckfree((char *) copy);
+ ckfree(copy);
}
if (lcopy != linesStack) {
- ckfree((char *) lcopy);
+ ckfree(lcopy);
}
}
@@ -5227,9 +5259,9 @@ TclEvalEx(
}
objectsUsed = 0;
if (objvSpace != stackObjArray) {
- ckfree((char *) objvSpace);
+ ckfree(objvSpace);
objvSpace = stackObjArray;
- ckfree((char *) lineSpace);
+ ckfree(lineSpace);
lineSpace = linesStack;
}
@@ -5239,7 +5271,7 @@ TclEvalEx(
*/
if (expand != expandStack) {
- ckfree((char *) expand);
+ ckfree(expand);
expand = expandStack;
}
}
@@ -5304,11 +5336,11 @@ TclEvalEx(
Tcl_FreeParse(parsePtr);
}
if (objvSpace != stackObjArray) {
- ckfree((char *) objvSpace);
- ckfree((char *) lineSpace);
+ ckfree(objvSpace);
+ ckfree(lineSpace);
}
if (expand != expandStack) {
- ckfree((char *) expand);
+ ckfree(expand);
}
iPtr->varFramePtr = savedVarFramePtr;
@@ -5392,7 +5424,7 @@ TclAdvanceContinuations(
/*
* Track the invisible continuation lines embedded in a script, if any.
* Here they are just spaces (already). They were removed by
- * EvalTokensStandard via Tcl_UtfBackslash.
+ * TclSubstTokens via TclParseBackslash.
*
* *clNextPtrPtr <=> We have continuation lines to track.
* **clNextPtrPtr >= 0 <=> We are not beyond the last possible location.
@@ -5472,7 +5504,7 @@ TclArgumentEnter(
* and initialize references.
*/
- cfwPtr = (CFWord *) ckalloc(sizeof(CFWord));
+ cfwPtr = ckalloc(sizeof(CFWord));
cfwPtr->framePtr = cfPtr;
cfwPtr->word = i;
cfwPtr->refCount = 1;
@@ -5533,7 +5565,7 @@ TclArgumentRelease(
continue;
}
- ckfree((char *) cfwPtr);
+ ckfree(cfwPtr);
Tcl_DeleteHashEntry(hPtr);
}
}
@@ -5593,13 +5625,16 @@ TclArgumentBCEnter(
* have to save them at compile time.
*/
+ if (ePtr->nline != objc) {
+ Tcl_Panic ("TIP 280 data structure inconsistency");
+ }
+
for (word = 1; word < objc; word++) {
if (ePtr->line[word] >= 0) {
int isnew;
- Tcl_HashEntry *hPtr =
- Tcl_CreateHashEntry(iPtr->lineLABCPtr,
- objv[word], &isnew);
- CFWordBC *cfwPtr = (CFWordBC *) ckalloc(sizeof(CFWordBC));
+ Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr,
+ objv[word], &isnew);
+ CFWordBC *cfwPtr = ckalloc(sizeof(CFWordBC));
cfwPtr->framePtr = cfPtr;
cfwPtr->obj = objv[word];
@@ -5678,7 +5713,7 @@ TclArgumentBCRelease(
Tcl_DeleteHashEntry(hPtr);
}
- ckfree((char *) cfwPtr);
+ ckfree(cfwPtr);
cfwPtr = nextPtr;
}
@@ -5721,8 +5756,7 @@ TclArgumentGet(
* up by the caller. It knows better than us.
*/
- if ((!obj->bytes) || ((obj->typePtr == &tclListType) &&
- ((List *) obj->internalRep.twoPtrValue.ptr1)->canonicalFlag)) {
+ if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) {
return;
}
@@ -5881,7 +5915,7 @@ TclEvalObjEx(
int word) /* Index of the word which is in objPtr. */
{
int result = TCL_OK;
- TEOV_callback *rootPtr = TOP_CB(interp);
+ NRE_callback *rootPtr = TOP_CB(interp);
result = TclNREvalObjEx(interp, objPtr, flags, invoker, word);
return TclNRRunCallbacks(interp, result, rootPtr);
@@ -5901,17 +5935,14 @@ TclNREvalObjEx(
{
Interp *iPtr = (Interp *) interp;
int result;
- List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
/*
* This function consists of three independent blocks for: direct
- * evaluation of canonical lists, compileation and bytecode execution and
+ * evaluation of canonical lists, compilation and bytecode execution and
* finally direct evaluation. Precisely one of these blocks will be run.
*/
- if ((objPtr->typePtr == &tclListType) && /* is a list */
- ((objPtr->bytes == NULL || /* no string rep */
- listRepPtr->canonicalFlag))) { /* or is canonical */
+ if (TclListObjIsCanonical(objPtr)) {
Tcl_Obj *listPtr = objPtr;
CmdFrame *eoFramePtr = NULL;
int objc;
@@ -6002,6 +6033,9 @@ TclNREvalObjEx(
* iPtr->varFramePtr in case
* TCL_EVAL_GLOBAL was set. */
+ if (TclInterpReady(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
if (flags & TCL_EVAL_GLOBAL) {
savedVarFramePtr = iPtr->varFramePtr;
iPtr->varFramePtr = iPtr->rootFramePtr;
@@ -6170,7 +6204,7 @@ TEOEx_ByteCodeCallback(
* Let us just unset the flags inline.
*/
- iPtr->flags &= (~(CANCELED | TCL_CANCEL_UNWIND));
+ TclUnsetCancelFlags(iPtr);
}
iPtr->evalFlags = 0;
@@ -6239,11 +6273,11 @@ ProcessUnexpectedResult(
Tcl_ResetResult(interp);
if (returnCode == TCL_BREAK) {
- Tcl_AppendResult(interp,
- "invoked \"break\" outside of a loop", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invoked \"break\" outside of a loop", -1));
} else if (returnCode == TCL_CONTINUE) {
- Tcl_AppendResult(interp,
- "invoked \"continue\" outside of a loop", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invoked \"continue\" outside of a loop", -1));
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"command returned bad code: %d", returnCode));
@@ -6578,7 +6612,8 @@ TclObjInvoke(
}
if ((objc < 1) || (objv == NULL)) {
- Tcl_AppendResult(interp, "illegal argument vector", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal argument vector", -1));
return TCL_ERROR;
}
@@ -6596,8 +6631,8 @@ TclObjInvoke(
hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
}
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "invalid hidden command name \"",
- cmdName, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid hidden command name \"%s\"", cmdName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
NULL);
return TCL_ERROR;
@@ -7223,7 +7258,8 @@ ExprIsqrtFunc(
return TCL_OK;
negarg:
- Tcl_SetResult(interp, "square root of negative argument", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "square root of negative argument", -1));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range", NULL);
return TCL_ERROR;
@@ -7402,21 +7438,16 @@ ExprAbsFunc(
goto unChanged;
} else if (l == (long)0) {
const char *string = objv[1]->bytes;
-
- if (!string) {
- /*
- * There is no string representation, so internal one is
- * correct.
- */
-
- goto unChanged;
- }
- while (isspace(UCHAR(*string))) {
- string++;
- }
- if (*string != '-') {
- goto unChanged;
+ if (string) {
+ while (*string != '0') {
+ if (*string == '-') {
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
+ return TCL_OK;
+ }
+ string++;
+ }
}
+ goto unChanged;
} else if (l == LONG_MIN) {
TclBNInitBignumFromLong(&big, l);
goto tooLarge;
@@ -7684,7 +7715,7 @@ ExprRandFunc(
* to insure different seeds in different threads (bug #416643)
*/
- iPtr->randSeed = TclpGetClicks() + ((long)Tcl_GetCurrentThread()<<12);
+ iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12);
/*
* Make sure 1 <= randSeed <= (2^31) - 2. See below.
@@ -8086,8 +8117,9 @@ Tcl_NRCallObjProc(
Tcl_Obj *const objv[])
{
int result = TCL_OK;
- TEOV_callback *rootPtr = TOP_CB(interp);
+ NRE_callback *rootPtr = TOP_CB(interp);
+#ifdef USE_DTRACE
if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
const char *a[10];
int i = 0;
@@ -8114,6 +8146,7 @@ Tcl_NRCallObjProc(
TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
(Tcl_Obj **)(objv + 1));
}
+#endif /* USE_DTRACE */
result = objProc(clientData, interp, objc, objv);
return TclNRRunCallbacks(interp, result, rootPtr);
}
@@ -8238,7 +8271,7 @@ Tcl_NRCmdSwap(
void
TclSpliceTailcall(
Tcl_Interp *interp,
- TEOV_callback *tailcallPtr)
+ NRE_callback *tailcallPtr)
{
/*
* Find the splicing spot: right before the NRCommand of the thing
@@ -8246,7 +8279,7 @@ TclSpliceTailcall(
* (used by command redirectors).
*/
- TEOV_callback *runPtr;
+ NRE_callback *runPtr;
for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
@@ -8275,10 +8308,9 @@ TclNRTailcallObjCmd(
return TCL_ERROR;
}
- if (!iPtr->varFramePtr->isProcCallFrame) { /* or is upleveled */
- Tcl_SetResult(interp,
- "tailcall can only be called from a proc or lambda",
- TCL_STATIC);
+ if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { /* or is upleveled */
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "tailcall can only be called from a proc or lambda", -1));
Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
return TCL_ERROR;
}
@@ -8304,8 +8336,8 @@ TclNRTailcallObjCmd(
Tcl_Obj *listPtr, *nsObjPtr;
Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
Tcl_Namespace *ns1Ptr;
- TEOV_callback *tailcallPtr;
-
+ NRE_callback *tailcallPtr;
+
listPtr = Tcl_NewListObj(objc-1, objv+1);
Tcl_IncrRefCount(listPtr);
@@ -8316,7 +8348,8 @@ TclNRTailcallObjCmd(
}
Tcl_IncrRefCount(nsObjPtr);
- TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL);
+ TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr,
+ NULL, NULL);
tailcallPtr = TOP_CB(interp);
TOP_CB(interp) = tailcallPtr->nextPtr;
iPtr->varFramePtr->tailcallPtr = tailcallPtr;
@@ -8325,7 +8358,7 @@ TclNRTailcallObjCmd(
}
int
-NRTailcallEval(
+TclNRTailcallEval(
ClientData data[],
Tcl_Interp *interp,
int result)
@@ -8346,7 +8379,7 @@ NRTailcallEval(
* Tailcall execution was preempted, eg by an intervening catch or by
* a now-gone namespace: cleanup and return.
*/
-
+
TailcallCleanup(data, interp, result);
return result;
}
@@ -8375,7 +8408,7 @@ TailcallCleanup(
static void
ClearTailcall(
Tcl_Interp *interp,
- TEOV_callback *tailcallPtr)
+ NRE_callback *tailcallPtr)
{
TailcallCleanup(tailcallPtr->data, interp, TCL_OK);
TCLNR_FREE(interp, tailcallPtr);
@@ -8429,14 +8462,15 @@ TclNRYieldObjCmd(
Tcl_Obj *const objv[])
{
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?");
return TCL_ERROR;
}
if (!corPtr) {
- Tcl_SetResult(interp, "yield can only be called in a coroutine",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yield can only be called in a coroutine", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
return TCL_ERROR;
}
@@ -8446,7 +8480,7 @@ TclNRYieldObjCmd(
}
NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
- TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
clientData, NULL, NULL);
return TCL_OK;
}
@@ -8469,8 +8503,8 @@ TclNRYieldToObjCmd(
}
if (!corPtr) {
- Tcl_SetResult(interp, "yieldTo can only be called in a coroutine",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yieldto can only be called in a coroutine", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
return TCL_ERROR;
}
@@ -8487,7 +8521,7 @@ TclNRYieldToObjCmd(
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
|| (nsPtr != ns1Ptr)) {
- Tcl_Panic("yieldTo failed to find the proper namespace");
+ Tcl_Panic("yieldto failed to find the proper namespace");
}
Tcl_IncrRefCount(nsObjPtr);
@@ -8500,7 +8534,7 @@ TclNRYieldToObjCmd(
NULL);
iPtr->execEnvPtr = corPtr->eePtr;
- return TclNRYieldObjCmd(clientData, interp, 1, objv);
+ return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
}
static int
@@ -8512,13 +8546,13 @@ YieldToCallback(
/* CoroutineData *corPtr = data[0];*/
Tcl_Obj *listPtr = data[1];
ClientData nsPtr = data[2];
- TEOV_callback *cbPtr;
+ NRE_callback *cbPtr;
/*
* yieldTo: invoke the command using tailcall tech.
*/
- TclNRAddCallback(interp, NRTailcallEval, listPtr, nsPtr, NULL, NULL);
+ TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsPtr, NULL, NULL);
cbPtr = TOP_CB(interp);
TOP_CB(interp) = cbPtr->nextPtr;
@@ -8550,7 +8584,7 @@ RewindCoroutine(
corPtr->eePtr->rewind = 1;
TclNRAddCallback(interp, RewindCoroutineCallback, state,
NULL, NULL, NULL);
- return NRInterpCoroutine(corPtr, interp, 0, NULL);
+ return TclNRInterpCoroutine(corPtr, interp, 0, NULL);
}
static void
@@ -8559,7 +8593,7 @@ DeleteCoroutine(
{
CoroutineData *corPtr = clientData;
Tcl_Interp *interp = corPtr->eePtr->interp;
- TEOV_callback *rootPtr = TOP_CB(interp);
+ NRE_callback *rootPtr = TOP_CB(interp);
if (COR_IS_SUSPENDED(corPtr)) {
TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr);
@@ -8591,14 +8625,14 @@ NRCoroutineCallerCallback(
NRE_ASSERT(iPtr->varFramePtr == corPtr->caller.varFramePtr);
NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr);
NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr);
- ckfree((char *) corPtr);
+ ckfree(corPtr);
return result;
}
NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
SAVE_CONTEXT(corPtr->running);
RESTORE_CONTEXT(corPtr->caller);
-
+
if (cmdPtr->flags & CMD_IS_DELETED) {
/*
* The command was deleted while it was running: wind down the
@@ -8650,7 +8684,7 @@ NRCoroutineExitCallback(
*/
Tcl_DeleteHashTable(corPtr->lineLABCPtr);
- ckfree((char *) corPtr->lineLABCPtr);
+ ckfree(corPtr->lineLABCPtr);
corPtr->lineLABCPtr = NULL;
RESTORE_CONTEXT(corPtr->caller);
@@ -8660,20 +8694,25 @@ NRCoroutineExitCallback(
return result;
}
-
/*
- * NRCoroutineActivateCallback --
+ *----------------------------------------------------------------------
+ *
+ * TclNRCoroutineActivateCallback --
+ *
+ * This is the workhorse for coroutines: it implements both yield and
+ * resume.
*
- * This is the workhorse for coroutines: it implements both yield and resume.
+ * It is important that both be implemented in the same callback: the
+ * detection of the impossibility to suspend due to a busy C-stack relies
+ * on the precise position of a local variable in the stack. We do not
+ * want the compiler to play tricks on us, either by moving things around
+ * or inlining.
*
- * It is important that both be implemented in the same callback: the
- * detection of the impossibility to suspend due to a busy C-stack relies on
- * the precise position of a local variable in the stack. We do not want the
- * compiler to play tricks on us, either by moving things around or inlining.
+ *----------------------------------------------------------------------
*/
-static int
-NRCoroutineActivateCallback(
+int
+TclNRCoroutineActivateCallback(
ClientData data[],
Tcl_Interp *interp,
int result)
@@ -8686,18 +8725,18 @@ NRCoroutineActivateCallback(
if (!corPtr->stackLevel) {
/*
* -- Coroutine is suspended --
- * Push the callback to restore the caller's context on yield or return
+ * Push the callback to restore the caller's context on yield or
+ * return.
*/
- TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, NULL, NULL,
- NULL);
+ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr,
+ NULL, NULL, NULL);
/*
* Record the stackLevel at which the resume is happening, then swap
- * the interp's environment to make it suitable to run this
- * coroutine.
+ * the interp's environment to make it suitable to run this coroutine.
*/
-
+
corPtr->stackLevel = stackLevel;
numLevels = corPtr->auxNumLevels;
corPtr->auxNumLevels = iPtr->numLevels;
@@ -8707,29 +8746,27 @@ NRCoroutineActivateCallback(
RESTORE_CONTEXT(corPtr->running);
iPtr->execEnvPtr = corPtr->eePtr;
iPtr->numLevels += numLevels;
-
- return TCL_OK;
} else {
/*
* Coroutine is active: yield
*/
if (corPtr->stackLevel != stackLevel) {
- Tcl_SetResult(interp, "cannot yield: C stack busy",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot yield: C stack busy", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
NULL);
return TCL_ERROR;
}
-
- if (type == CORO_ACTIVATE_YIELD) {
+
+ if (type == CORO_ACTIVATE_YIELD) {
corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
} else if (type == CORO_ACTIVATE_YIELDM) {
corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY;
} else {
Tcl_Panic("Yield received an option which is not implemented");
}
-
+
corPtr->stackLevel = NULL;
numLevels = iPtr->numLevels;
@@ -8737,12 +8774,73 @@ NRCoroutineActivateCallback(
corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
iPtr->execEnvPtr = corPtr->callerEEPtr;
- return TCL_OK;
}
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NRCoroInjectObjCmd --
+ *
+ * Implementation of [::tcl::unsupported::inject] command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NRCoroInjectObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Command *cmdPtr;
+ CoroutineData *corPtr;
+ ExecEnv *savedEEPtr = iPtr->execEnvPtr;
+
+ /*
+ * Usage more or less like tailcall:
+ * inject coroName cmd ?arg1 arg2 ...?
+ */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
+ return TCL_ERROR;
+ }
+
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
+ if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only inject a command into a coroutine", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
+ TclGetString(objv[1]), NULL);
+ return TCL_ERROR;
+ }
+
+ corPtr = cmdPtr->objClientData;
+ if (!COR_IS_SUSPENDED(corPtr)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only inject a command into a suspended coroutine", -1));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Add the callback to the coro's execEnv, so that it is the first thing
+ * to happen when the coro is resumed.
+ */
+
+ iPtr->execEnvPtr = corPtr->eePtr;
+ TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN);
+ iPtr->execEnvPtr = savedEEPtr;
+
+ return TCL_OK;
}
int
-NRInterpCoroutine(
+TclNRInterpCoroutine(
ClientData clientData,
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
@@ -8751,9 +8849,9 @@ NRInterpCoroutine(
CoroutineData *corPtr = clientData;
if (!COR_IS_SUSPENDED(corPtr)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "coroutine \"", Tcl_GetString(objv[0]),
- "\" is already running", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "coroutine \"%s\" is already running",
+ Tcl_GetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
return TCL_ERROR;
}
@@ -8789,11 +8887,22 @@ NRInterpCoroutine(
break;
}
- TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
NULL, NULL, NULL);
return TCL_OK;
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRCoroutineObjCmd --
+ *
+ * Implementation of [coroutine] command; see documentation for
+ * description of what this does.
+ *
+ *----------------------------------------------------------------------
+ */
+
int
TclNRCoroutineObjCmd(
ClientData dummy, /* Not used. */
@@ -8806,7 +8915,8 @@ TclNRCoroutineObjCmd(
const char *fullName, *procName;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
Tcl_DString ds;
-
+ Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr;
+
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
return TCL_ERROR;
@@ -8822,22 +8932,24 @@ TclNRCoroutineObjCmd(
&nsPtr, &altNsPtr, &cxtNsPtr, &procName);
if (nsPtr == NULL) {
- Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": unknown namespace", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\": unknown namespace",
+ fullName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL);
return TCL_ERROR;
}
if (procName == NULL) {
- Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": bad procedure name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\": bad procedure name",
+ fullName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
return TCL_ERROR;
}
if ((nsPtr != iPtr->globalNsPtr)
&& (procName != NULL) && (procName[0] == ':')) {
- Tcl_AppendResult(interp, "can't create procedure \"", procName,
- "\" in non-global namespace with name starting with \":\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\" in non-global namespace with"
+ " name starting with \":\"", procName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
return TCL_ERROR;
}
@@ -8847,17 +8959,17 @@ TclNRCoroutineObjCmd(
* struct and create the corresponding command.
*/
- corPtr = (CoroutineData *) ckalloc(sizeof(CoroutineData));
+ corPtr = ckalloc(sizeof(CoroutineData));
Tcl_DStringInit(&ds);
if (nsPtr != iPtr->globalNsPtr) {
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
- Tcl_DStringAppend(&ds, "::", 2);
+ TclDStringAppendLiteral(&ds, "::");
}
Tcl_DStringAppend(&ds, procName, -1);
cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
- /*objProc*/ NULL, NRInterpCoroutine, corPtr, DeleteCoroutine);
+ /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine);
Tcl_DStringFree(&ds);
corPtr->cmdPtr = cmdPtr;
@@ -8876,8 +8988,7 @@ TclNRCoroutineObjCmd(
Tcl_HashSearch hSearch;
Tcl_HashEntry *hePtr;
- corPtr->lineLABCPtr = (Tcl_HashTable *)
- ckalloc(sizeof(Tcl_HashTable));
+ corPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
@@ -8893,7 +9004,7 @@ TclNRCoroutineObjCmd(
}
/*
- * Save the base context.
+ * Create the base context.
*/
corPtr->running.framePtr = iPtr->rootFramePtr;
@@ -8902,32 +9013,38 @@ TclNRCoroutineObjCmd(
corPtr->running.lineLABCPtr = corPtr->lineLABCPtr;
corPtr->stackLevel = NULL;
corPtr->auxNumLevels = 0;
- iPtr->numLevels--;
-
+
/*
* Create the coro's execEnv, switch to it to push the exit and coro
- * command callbacks, then switch back.
+ * command callbacks, then switch back.
*/
corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE);
corPtr->callerEEPtr = iPtr->execEnvPtr;
corPtr->eePtr->corPtr = corPtr;
-
+
+ SAVE_CONTEXT(corPtr->caller);
+ corPtr->callerEEPtr = iPtr->execEnvPtr;
+ RESTORE_CONTEXT(corPtr->running);
iPtr->execEnvPtr = corPtr->eePtr;
TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
NULL, NULL, NULL);
- iPtr->lookupNsPtr = iPtr->varFramePtr->nsPtr;
+ /* insure that the command is looked up in the correct namespace */
+ iPtr->lookupNsPtr = lookupNsPtr;
Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
+ iPtr->numLevels--;
+
+ SAVE_CONTEXT(corPtr->running);
+ RESTORE_CONTEXT(corPtr->caller);
iPtr->execEnvPtr = corPtr->callerEEPtr;
-
+
/*
- * Now just resume the coroutine. Take care to insure that the command is
- * looked up in the correct namespace.
+ * Now just resume the coroutine.
*/
- TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
NULL, NULL, NULL);
return TCL_OK;
}
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index de2d319..5c33308 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclBinary.c,v 1.66 2010/09/15 22:12:00 dkf Exp $
*/
#include "tclInt.h"
@@ -174,13 +172,13 @@ typedef struct ByteArray {
* array. */
int allocated; /* The amount of space actually allocated
* minus 1 byte. */
- unsigned char bytes[4]; /* The array of bytes. The actual size of this
+ unsigned char bytes[1]; /* The array of bytes. The actual size of this
* field depends on the 'allocated' field
* above. */
} ByteArray;
#define BYTEARRAY_SIZE(len) \
- ((unsigned) (sizeof(ByteArray) - 4 + (len)))
+ ((unsigned) (TclOffset(ByteArray, bytes) + (len)))
#define GET_BYTEARRAY(objPtr) \
((ByteArray *) (objPtr)->internalRep.otherValuePtr)
#define SET_BYTEARRAY(objPtr, baPtr) \
@@ -305,15 +303,16 @@ Tcl_SetByteArrayObj(
TclFreeIntRep(objPtr);
Tcl_InvalidateStringRep(objPtr);
- length = (length < 0) ? 0 : length;
- byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
- memset(byteArrayPtr, 0, BYTEARRAY_SIZE(length));
+ if (length < 0) {
+ length = 0;
+ }
+ byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
byteArrayPtr->used = length;
byteArrayPtr->allocated = length;
- if (bytes && length) {
+
+ if ((bytes != NULL) && (length > 0)) {
memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
}
-
objPtr->typePtr = &tclByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
@@ -393,8 +392,7 @@ Tcl_SetByteArrayLength(
byteArrayPtr = GET_BYTEARRAY(objPtr);
if (length > byteArrayPtr->allocated) {
- byteArrayPtr = (ByteArray *)
- ckrealloc((char *) byteArrayPtr, BYTEARRAY_SIZE(length));
+ byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
byteArrayPtr->allocated = length;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
@@ -434,7 +432,7 @@ SetByteArrayFromAny(
src = TclGetStringFromObj(objPtr, &length);
srcEnd = src + length;
- byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+ byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
src += Tcl_UtfToUniChar(src, &ch);
*dst++ = UCHAR(ch);
@@ -471,7 +469,7 @@ static void
FreeByteArrayInternalRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
- ckfree((char *) GET_BYTEARRAY(objPtr));
+ ckfree(GET_BYTEARRAY(objPtr));
objPtr->typePtr = NULL;
}
@@ -503,7 +501,7 @@ DupByteArrayInternalRep(
srcArrayPtr = GET_BYTEARRAY(srcPtr);
length = srcArrayPtr->used;
- copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+ copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
copyArrayPtr->used = length;
copyArrayPtr->allocated = length;
memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
@@ -562,7 +560,7 @@ UpdateStringOfByteArray(
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
- dst = (char *) ckalloc((unsigned) (size + 1));
+ dst = ckalloc(size + 1);
objPtr->bytes = dst;
objPtr->length = size;
@@ -643,9 +641,8 @@ TclAppendBytesToByteArray(
}
if (BYTEARRAY_SIZE(attempt) > BYTEARRAY_SIZE(used)) {
- tmpByteArrayPtr = (ByteArray *)
- attemptckrealloc((char *) byteArrayPtr,
- BYTEARRAY_SIZE(attempt));
+ tmpByteArrayPtr = attemptckrealloc(byteArrayPtr,
+ BYTEARRAY_SIZE(attempt));
}
if (tmpByteArrayPtr == NULL) {
@@ -653,7 +650,7 @@ TclAppendBytesToByteArray(
if (BYTEARRAY_SIZE(attempt) < BYTEARRAY_SIZE(used)) {
Tcl_Panic("attempt to allocate a bigger buffer than we can handle");
}
- tmpByteArrayPtr = (ByteArray *) ckrealloc((char *) byteArrayPtr,
+ tmpByteArrayPtr = ckrealloc(byteArrayPtr,
BYTEARRAY_SIZE(attempt));
}
@@ -691,29 +688,30 @@ TclAppendBytesToByteArray(
*----------------------------------------------------------------------
*/
+static const EnsembleImplMap binaryMap[] = {
+{ "format", BinaryFormatCmd, NULL, NULL, NULL, 0 },
+{ "scan", BinaryScanCmd, NULL, NULL, NULL, 0 },
+{ "encode", NULL, NULL, NULL, NULL, 0 },
+{ "decode", NULL, NULL, NULL, NULL, 0 },
+{ NULL, NULL, NULL, NULL, NULL, 0 }
+};
+static const EnsembleImplMap encodeMap[] = {
+{ "hex", BinaryEncodeHex, NULL, NULL, (ClientData)HexDigits, 0 },
+{ "uuencode", BinaryEncode64, NULL, NULL, (ClientData)UueDigits, 0 },
+{ "base64", BinaryEncode64, NULL, NULL, (ClientData)B64Digits, 0 },
+{ NULL, NULL, NULL, NULL, NULL, 0 }
+};
+static const EnsembleImplMap decodeMap[] = {
+{ "hex", BinaryDecodeHex, NULL, NULL, NULL, 0 },
+{ "uuencode", BinaryDecodeUu, NULL, NULL, NULL, 0 },
+{ "base64", BinaryDecode64, NULL, NULL, NULL, 0 },
+{ NULL, NULL, NULL, NULL, NULL, 0 }
+};
+
Tcl_Command
TclInitBinaryCmd(
Tcl_Interp *interp)
{
- const EnsembleImplMap binaryMap[] = {
- { "format", BinaryFormatCmd, NULL, NULL ,NULL },
- { "scan", BinaryScanCmd, NULL,NULL ,NULL },
- { "encode", NULL, NULL, NULL, NULL },
- { "decode", NULL, NULL, NULL, NULL },
- { NULL, NULL, NULL, NULL, NULL }
- };
- const EnsembleImplMap encodeMap[] = {
- { "hex", BinaryEncodeHex, NULL, NULL, (ClientData)HexDigits },
- { "uuencode", BinaryEncode64, NULL, NULL, (ClientData)UueDigits },
- { "base64", BinaryEncode64, NULL, NULL, (ClientData)B64Digits },
- { NULL, NULL, NULL, NULL, NULL }
- };
- const EnsembleImplMap decodeMap[] = {
- { "hex", BinaryDecodeHex, NULL, NULL, NULL },
- { "uuencode", BinaryDecodeUu, NULL, NULL, NULL },
- { "base64", BinaryDecode64, NULL, NULL, NULL },
- { NULL, NULL, NULL, NULL, NULL }
- };
Tcl_Command binaryEnsemble;
binaryEnsemble = TclMakeEnsemble(interp, "binary", binaryMap);
@@ -873,9 +871,9 @@ BinaryFormatCmd(
if (count == BINARY_ALL) {
count = listc;
} else if (count > listc) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"number of elements in list does not match count",
- NULL);
+ -1));
return TCL_ERROR;
}
}
@@ -884,9 +882,8 @@ BinaryFormatCmd(
case 'x':
if (count == BINARY_ALL) {
- Tcl_AppendResult(interp,
- "cannot use \"*\" in format string with \"x\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot use \"*\" in format string with \"x\"", -1));
return TCL_ERROR;
} else if (count == BINARY_NOCOUNT) {
count = 1;
@@ -1198,8 +1195,9 @@ BinaryFormatCmd(
badValue:
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "expected ", errorString,
- " string but got \"", errorValue, "\" instead", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected %s string but got \"%s\" instead",
+ errorString, errorValue));
return TCL_ERROR;
badCount:
@@ -1217,12 +1215,13 @@ BinaryFormatCmd(
Tcl_UtfToUniChar(errorString, &ch);
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad field specifier \"%s\"", buf));
return TCL_ERROR;
}
error:
- Tcl_AppendResult(interp, errorString, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
return TCL_ERROR;
}
@@ -1586,12 +1585,13 @@ BinaryScanCmd(
Tcl_UtfToUniChar(errorString, &ch);
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad field specifier \"%s\"", buf));
return TCL_ERROR;
}
error:
- Tcl_AppendResult(interp, errorString, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
return TCL_ERROR;
}
@@ -2454,7 +2454,7 @@ BinaryDecodeHex(
} \
} \
if (cursor > limit) { \
- Tcl_Panic("limit hit\n"); \
+ Tcl_Panic("limit hit"); \
} \
} while (0)
@@ -2658,12 +2658,12 @@ BinaryDecode64(
Tcl_Obj *const objv[])
{
Tcl_Obj *resultObj = NULL;
- unsigned char *data, *datastart, *dataend, c;
+ unsigned char *data, *datastart, *dataend, c = '\0';
unsigned char *begin = NULL;
unsigned char *cursor = NULL;
int strict = 0;
int i, index, size, cut = 0, count = 0;
- enum {OPT_STRICT };
+ enum { OPT_STRICT };
static const char *const optStrings[] = { "-strict", NULL };
if (objc < 2 || objc > 3) {
@@ -2691,43 +2691,85 @@ BinaryDecode64(
while (data < dataend) {
unsigned long value = 0;
- for (i=0 ; i<4 ; i++) {
+ /*
+ * Decode the current block. Each base64 block consists of four input
+ * characters A-Z, a-z, 0-9, +, or /. Each character supplies six bits
+ * of output data, so each block's output is 24 bits (three bytes) in
+ * length. The final block can be shorter by one or two bytes, denoted
+ * by the input ending with one or two ='s, respectively.
+ */
+
+ for (i = 0; i < 4; i++) {
+ /*
+ * Get the next input character. At end of input, pad with at most
+ * two ='s. If more than two ='s would be needed, instead discard
+ * the block read thus far.
+ */
+
if (data < dataend) {
c = *data++;
+ } else if (i > 1) {
+ c = '=';
+ } else {
+ cut += 3;
+ break;
+ }
- if (c >= 'A' && c <= 'Z') {
- value = (value << 6) | ((c - 'A') & 0x3f);
- } else if (c >= 'a' && c <= 'z') {
- value = (value << 6) | ((c - 'a' + 26) & 0x3f);
- } else if (c >= '0' && c <= '9') {
- value = (value << 6) | ((c - '0' + 52) & 0x3f);
- } else if (c == '+') {
- value = (value << 6) | 0x3e;
- } else if (c == '/') {
- value = (value << 6) | 0x3f;
- } else if (c == '=') {
- value <<= 6;
- if (cut < 2) {
- cut++;
- }
+ /*
+ * Load the character into the block value. Handle ='s specially
+ * because they're only valid as the last character or two of the
+ * final block of input. Unless strict mode is enabled, skip any
+ * input whitespace characters.
+ */
+
+ if (cut) {
+ if (c == '=' && i > 1) {
+ value <<= 6;
+ cut++;
+ } else if (!strict && isspace(c)) {
+ i--;
} else {
- if (strict || !isspace(c)) {
- goto bad64;
- }
- i--;
- continue;
+ goto bad64;
}
- } else {
+ } else if (c >= 'A' && c <= 'Z') {
+ value = (value << 6) | ((c - 'A') & 0x3f);
+ } else if (c >= 'a' && c <= 'z') {
+ value = (value << 6) | ((c - 'a' + 26) & 0x3f);
+ } else if (c >= '0' && c <= '9') {
+ value = (value << 6) | ((c - '0' + 52) & 0x3f);
+ } else if (c == '+') {
+ value = (value << 6) | 0x3e;
+ } else if (c == '/') {
+ value = (value << 6) | 0x3f;
+ } else if (c == '=') {
value <<= 6;
cut++;
+ } else if (strict || !isspace(c)) {
+ goto bad64;
+ } else {
+ i--;
}
}
*cursor++ = UCHAR((value >> 16) & 0xff);
*cursor++ = UCHAR((value >> 8) & 0xff);
*cursor++ = UCHAR(value & 0xff);
- }
- if (cut > size) {
- cut = size;
+
+ /*
+ * Since = is only valid within the final block, if it was encountered
+ * but there are still more input characters, confirm that strict mode
+ * is off and all subsequent characters are whitespace.
+ */
+
+ if (cut && data < dataend) {
+ if (strict) {
+ goto bad64;
+ }
+ for (; data < dataend; data++) {
+ if (!isspace(*data)) {
+ goto bad64;
+ }
+ }
+ }
}
Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
Tcl_SetObjResult(interp, resultObj);
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 70aead9..ab977cb 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -13,8 +13,6 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* This code contributed by Karl Lehenbauer and Mark Diekhans
- *
- * RCS: @(#) $Id: tclCkalloc.c,v 1.38 2010/02/25 22:20:10 nijtmans Exp $
*/
#include "tclInt.h"
@@ -22,6 +20,12 @@
#define FALSE 0
#define TRUE 1
+#undef Tcl_Alloc
+#undef Tcl_Free
+#undef Tcl_Realloc
+#undef Tcl_AttemptAlloc
+#undef Tcl_AttemptRealloc
+
#ifdef TCL_MEM_DEBUG
/*
@@ -32,12 +36,12 @@
typedef struct MemTag {
int refCount; /* Number of mem_headers referencing this
* tag. */
- char string[4]; /* Actual size of string will be as large as
+ char string[1]; /* Actual size of string will be as large as
* needed for actual tag. This must be the
* last field in the structure. */
} MemTag;
-#define TAG_SIZE(bytesInString) ((unsigned) sizeof(MemTag) + bytesInString - 3)
+#define TAG_SIZE(bytesInString) ((unsigned) ((TclOffset(MemTag, string) + 1) + bytesInString))
static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
* by "memory tag" command). */
@@ -83,7 +87,7 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */
*/
#define BODY_OFFSET \
- ((unsigned long) (&((struct mem_header *) 0)->body))
+ ((size_t) (&((struct mem_header *) 0)->body))
static int total_mallocs = 0;
static int total_frees = 0;
@@ -165,22 +169,36 @@ TclInitDbCkalloc(void)
*----------------------------------------------------------------------
*/
-void
+int
TclDumpMemoryInfo(
- FILE *outFile)
+ ClientData clientData,
+ int flags)
{
- fprintf(outFile,"total mallocs %10d\n",
- total_mallocs);
- fprintf(outFile,"total frees %10d\n",
- total_frees);
- fprintf(outFile,"current packets allocated %10d\n",
- current_malloc_packets);
- fprintf(outFile,"current bytes allocated %10lu\n",
- current_bytes_malloced);
- fprintf(outFile,"maximum packets allocated %10d\n",
- maximum_malloc_packets);
- fprintf(outFile,"maximum bytes allocated %10lu\n",
- maximum_bytes_malloced);
+ char buf[1024];
+
+ if (clientData == NULL) {
+ return 0;
+ }
+ sprintf(buf,
+ "total mallocs %10d\n"
+ "total frees %10d\n"
+ "current packets allocated %10d\n"
+ "current bytes allocated %10lu\n"
+ "maximum packets allocated %10d\n"
+ "maximum bytes allocated %10lu\n",
+ total_mallocs,
+ total_frees,
+ current_malloc_packets,
+ (unsigned long)current_bytes_malloced,
+ maximum_malloc_packets,
+ (unsigned long)maximum_bytes_malloced);
+ if (flags == 0) {
+ fprintf((FILE *)clientData, "%s", buf);
+ } else {
+ /* Assume objPtr to append to */
+ Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1);
+ }
+ return 1;
}
/*
@@ -228,7 +246,7 @@ ValidateMemory(
}
}
if (guard_failed) {
- TclDumpMemoryInfo(stderr);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
fprintf(stderr, "low guard failed at %lx, %s %d\n",
(long unsigned) memHeaderP->body, file, line);
fflush(stderr); /* In case name pointer is bad. */
@@ -250,7 +268,7 @@ ValidateMemory(
}
if (guard_failed) {
- TclDumpMemoryInfo(stderr);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
fprintf(stderr, "high guard failed at %lx, %s %d\n",
(long unsigned) memHeaderP->body, file, line);
fflush(stderr); /* In case name pointer is bad. */
@@ -389,7 +407,7 @@ Tcl_DbCkalloc(
}
if (result == NULL) {
fflush(stdout);
- TclDumpMemoryInfo(stderr);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
}
@@ -443,11 +461,7 @@ Tcl_DbCkalloc(
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
break_on_malloc = 0;
(void) fflush(stdout);
- fprintf(stderr,"reached malloc break limit (%d)\n",
- total_mallocs);
- fprintf(stderr, "program will now enter C debugger\n");
- (void) fflush(stderr);
- abort();
+ Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
}
current_malloc_packets++;
@@ -483,7 +497,7 @@ Tcl_AttemptDbCkalloc(
}
if (result == NULL) {
fflush(stdout);
- TclDumpMemoryInfo(stderr);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
return NULL;
}
@@ -536,11 +550,7 @@ Tcl_AttemptDbCkalloc(
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
break_on_malloc = 0;
(void) fflush(stdout);
- fprintf(stderr,"reached malloc break limit (%d)\n",
- total_mallocs);
- fprintf(stderr, "program will now enter C debugger\n");
- (void) fflush(stderr);
- abort();
+ Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
}
current_malloc_packets++;
@@ -595,7 +605,7 @@ Tcl_DbCkfree(
* words on these machines).
*/
- memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);
+ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
if (alloc_tracing) {
fprintf(stderr, "ckfree %lx %ld %s %d\n",
@@ -672,7 +682,7 @@ Tcl_DbCkrealloc(
* See comment from Tcl_DbCkfree before you change the following line.
*/
- memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);
+ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
copySize = size;
if (copySize > (unsigned int) memp->length) {
@@ -703,7 +713,7 @@ Tcl_AttemptDbCkrealloc(
* See comment from Tcl_DbCkfree before you change the following line.
*/
- memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);
+ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
copySize = size;
if (copySize > (unsigned int) memp->length) {
@@ -736,12 +746,6 @@ Tcl_AttemptDbCkrealloc(
*----------------------------------------------------------------------
*/
-#undef Tcl_Alloc
-#undef Tcl_Free
-#undef Tcl_Realloc
-#undef Tcl_AttemptAlloc
-#undef Tcl_AttemptRealloc
-
char *
Tcl_Alloc(
unsigned int size)
@@ -812,17 +816,19 @@ MemoryCmd(
FILE *fileP;
Tcl_DString buffer;
int result;
+ size_t len;
if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option [args..]\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s option [args..]\"", argv[0]));
return TCL_ERROR;
}
- if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) {
+ if (strcmp(argv[1], "active") == 0 || strcmp(argv[1], "display") == 0) {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " file\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s %s file\"",
+ argv[0], argv[1]));
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -832,7 +838,8 @@ MemoryCmd(
result = Tcl_DumpActiveMemory(fileName);
Tcl_DStringFree(&buffer);
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "error accessing ", argv[2], NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
+ argv[2], Tcl_PosixError(interp)));
return TCL_ERROR;
}
return TCL_OK;
@@ -851,22 +858,22 @@ MemoryCmd(
"%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n",
"total mallocs", total_mallocs, "total frees", total_frees,
"current packets allocated", current_malloc_packets,
- "current bytes allocated", current_bytes_malloced,
+ "current bytes allocated", (unsigned long)current_bytes_malloced,
"maximum packets allocated", maximum_malloc_packets,
- "maximum bytes allocated", maximum_bytes_malloced));
+ "maximum bytes allocated", (unsigned long)maximum_bytes_malloced));
return TCL_OK;
}
- if (strcmp(argv[1],"init") == 0) {
+ if (strcmp(argv[1], "init") == 0) {
if (argc != 3) {
goto bad_suboption;
}
init_malloced_bodies = (strcmp(argv[2],"on") == 0);
return TCL_OK;
}
- if (strcmp(argv[1],"objs") == 0) {
+ if (strcmp(argv[1], "objs") == 0) {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " objs file\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s objs file\"", argv[0]));
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -875,7 +882,9 @@ MemoryCmd(
}
fileP = fopen(fileName, "w");
if (fileP == NULL) {
- Tcl_AppendResult(interp, "cannot open output file", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot open output file: %s",
+ Tcl_PosixError(interp)));
return TCL_ERROR;
}
TclDbDumpActiveObjects(fileP);
@@ -885,8 +894,8 @@ MemoryCmd(
}
if (strcmp(argv[1],"onexit") == 0) {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " onexit file\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s onexit file\"", argv[0]));
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -900,16 +909,17 @@ MemoryCmd(
}
if (strcmp(argv[1],"tag") == 0) {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " tag string\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s tag string\"", argv[0]));
return TCL_ERROR;
}
if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
TclpFree((char *) curTagPtr);
}
- curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(strlen(argv[2])));
+ len = strlen(argv[2]);
+ curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len));
curTagPtr->refCount = 0;
- strcpy(curTagPtr->string, argv[2]);
+ memcpy(curTagPtr->string, argv[2], len + 1);
return TCL_OK;
}
if (strcmp(argv[1],"trace") == 0) {
@@ -937,19 +947,20 @@ MemoryCmd(
return TCL_OK;
}
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": should be active, break_on_malloc, info, init, onexit, "
- "tag, trace, trace_on_at_malloc, or validate", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": should be active, break_on_malloc, info, "
+ "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate",
+ argv[1]));
return TCL_ERROR;
argError:
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " count\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s %s count\"", argv[0], argv[1]));
return TCL_ERROR;
bad_suboption:
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " on|off\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1]));
return TCL_ERROR;
}
@@ -979,8 +990,8 @@ CheckmemCmd(
const char *argv[]) /* String values of arguments. */
{
if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " fileName\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s fileName\"", argv[0]));
return TCL_ERROR;
}
tclMemDumpFileName = dumpFile;
@@ -1247,10 +1258,12 @@ Tcl_ValidateAllMemory(
{
}
-void
+int
TclDumpMemoryInfo(
- FILE *outFile)
+ ClientData clientData,
+ int flags)
{
+ return 1;
}
#endif /* TCL_MEM_DEBUG */
@@ -1305,5 +1318,7 @@ TclFinalizeMemorySubsystem(void)
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 7519da8..6d2976d 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -11,8 +11,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclClock.c,v 1.75 2010/03/05 14:34:03 dkf Exp $
*/
#include "tclInt.h"
@@ -268,9 +266,9 @@ TclClockInit(
* Create the client data, which is a refcounted literal pool.
*/
- data = (ClockClientData *) ckalloc(sizeof(ClockClientData));
+ data = ckalloc(sizeof(ClockClientData));
data->refCount = 0;
- data->literals = (Tcl_Obj **) ckalloc(LIT__END * sizeof(Tcl_Obj*));
+ data->literals = ckalloc(LIT__END * sizeof(Tcl_Obj*));
for (i = 0; i < LIT__END; ++i) {
data->literals[i] = Tcl_NewStringObj(literals[i], -1);
Tcl_IncrRefCount(data->literals[i]);
@@ -280,8 +278,8 @@ TclClockInit(
* Install the commands.
*/
- strcpy(cmdName, "::tcl::clock::");
#define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */
+ memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN);
for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) {
strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name);
data->refCount++;
@@ -880,8 +878,8 @@ ConvertLocalToUTCUsingC(
if (localErrno != 0
|| (fields->seconds == -1 && timeVal.tm_yday == -1)) {
- Tcl_SetResult(interp, "time value too large/small to represent",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "time value too large/small to represent", -1));
return TCL_ERROR;
}
return TCL_OK;
@@ -1020,17 +1018,17 @@ ConvertUTCToLocalUsingC(
tock = (time_t) fields->seconds;
if ((Tcl_WideInt) tock != fields->seconds) {
- Tcl_AppendResult(interp,
- "number too large to represent as a Posix time", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "number too large to represent as a Posix time", -1));
Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL);
return TCL_ERROR;
}
TzsetIfNecessary();
timeVal = ThreadSafeLocalTime(&tock);
if (timeVal == NULL) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"localtime failed (clock value may be too "
- "large/small to represent)", NULL);
+ "large/small to represent)", -1));
Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL);
return TCL_ERROR;
}
@@ -2026,8 +2024,8 @@ ClockDeleteCmdProc(
for (i = 0; i < LIT__END; ++i) {
Tcl_DecrRefCount(data->literals[i]);
}
- ckfree((char *) data->literals);
- ckfree((char *) data);
+ ckfree(data->literals);
+ ckfree(data);
}
}
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index eac0cea..133a61b 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -9,13 +9,10 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.127 2010/09/23 18:08:35 dgp Exp $
*/
#include "tclInt.h"
#include <locale.h>
-#include "tclFileSystem.h"
/*
* The state structure used by [foreach]. Note that the actual structure has
@@ -35,6 +32,9 @@ struct ForeachState {
int *argcList; /* Array of value list sizes. */
Tcl_Obj ***argvList; /* Array of value lists. */
Tcl_Obj **aCopyList; /* Copies of value list arguments. */
+ Tcl_Obj *resultList; /* List of result values from the loop body,
+ * or NULL if we're not collecting them
+ * ([lmap] vs [foreach]). */
};
/*
@@ -46,8 +46,6 @@ static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
static int EncodingDirsObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int FileTempfileCmd(Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
static inline int ForeachAssignments(Tcl_Interp *interp,
struct ForeachState *statePtr);
static inline void ForeachCleanup(Tcl_Interp *interp,
@@ -57,6 +55,8 @@ static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
static const char * GetTypeFromMode(int mode);
static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
Tcl_StatBuf *statPtr);
+static inline int EachloopCmd(Tcl_Interp *interp, int collect,
+ int objc, Tcl_Obj *const objv[]);
static Tcl_NRPostProc CatchObjCmdCallback;
static Tcl_NRPostProc ExprCallback;
static Tcl_NRPostProc ForSetupCallback;
@@ -65,6 +65,33 @@ static Tcl_NRPostProc ForNextCallback;
static Tcl_NRPostProc ForPostNextCallback;
static Tcl_NRPostProc ForeachLoopStep;
static Tcl_NRPostProc EvalCmdErrMsg;
+
+static Tcl_ObjCmdProc BadFileSubcommand;
+static Tcl_ObjCmdProc FileAttrAccessTimeCmd;
+static Tcl_ObjCmdProc FileAttrIsDirectoryCmd;
+static Tcl_ObjCmdProc FileAttrIsExecutableCmd;
+static Tcl_ObjCmdProc FileAttrIsExistingCmd;
+static Tcl_ObjCmdProc FileAttrIsFileCmd;
+static Tcl_ObjCmdProc FileAttrIsOwnedCmd;
+static Tcl_ObjCmdProc FileAttrIsReadableCmd;
+static Tcl_ObjCmdProc FileAttrIsWritableCmd;
+static Tcl_ObjCmdProc FileAttrLinkStatCmd;
+static Tcl_ObjCmdProc FileAttrModifyTimeCmd;
+static Tcl_ObjCmdProc FileAttrSizeCmd;
+static Tcl_ObjCmdProc FileAttrStatCmd;
+static Tcl_ObjCmdProc FileAttrTypeCmd;
+static Tcl_ObjCmdProc FilesystemSeparatorCmd;
+static Tcl_ObjCmdProc FilesystemVolumesCmd;
+static Tcl_ObjCmdProc PathDirNameCmd;
+static Tcl_ObjCmdProc PathExtensionCmd;
+static Tcl_ObjCmdProc PathFilesystemCmd;
+static Tcl_ObjCmdProc PathJoinCmd;
+static Tcl_ObjCmdProc PathNativeNameCmd;
+static Tcl_ObjCmdProc PathNormalizeCmd;
+static Tcl_ObjCmdProc PathRootNameCmd;
+static Tcl_ObjCmdProc PathSplitCmd;
+static Tcl_ObjCmdProc PathTailCmd;
+static Tcl_ObjCmdProc PathTypeCmd;
/*
*----------------------------------------------------------------------
@@ -172,7 +199,8 @@ Tcl_CaseObjCmd(
if (i == caseObjc-1) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "extra case pattern with no body", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra case pattern with no body", -1));
return TCL_ERROR;
}
@@ -213,7 +241,7 @@ Tcl_CaseObjCmd(
break;
}
}
- ckfree((char *) patObjv);
+ ckfree(patObjv);
if (j < patObjc) {
break;
}
@@ -324,10 +352,7 @@ CatchObjCmdCallback(
if (objc >= 3) {
if (NULL == Tcl_ObjSetVar2(interp, varNamePtr, NULL,
- Tcl_GetObjResult(interp), 0)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "couldn't save command result in variable", NULL);
+ Tcl_GetObjResult(interp), TCL_LEAVE_ERR_MSG)) {
return TCL_ERROR;
}
}
@@ -335,11 +360,9 @@ CatchObjCmdCallback(
Tcl_Obj *options = Tcl_GetReturnOptions(interp, result);
if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL,
- options, 0)) {
- Tcl_DecrRefCount(options);
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "couldn't save return options in variable", NULL);
+ options, TCL_LEAVE_ERR_MSG)) {
+ /* Do not decrRefCount 'options', it was already done by
+ * Tcl_ObjSetVar2 */
return TCL_ERROR;
}
}
@@ -393,8 +416,9 @@ Tcl_CdObjCmd(
} else {
result = Tcl_FSChdir(dir);
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "couldn't change working directory to \"",
- TclGetString(dir), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't change working directory to \"%s\": %s",
+ TclGetString(dir), Tcl_PosixError(interp)));
result = TCL_ERROR;
}
}
@@ -548,9 +572,7 @@ Tcl_EncodingObjCmd(
* truncate the string at the first null byte.
*/
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
- Tcl_DStringFree(&ds);
+ Tcl_SetObjResult(interp, TclDStringToObj(&ds));
} else {
/*
* Store the result as binary data.
@@ -568,7 +590,7 @@ Tcl_EncodingObjCmd(
break;
}
case ENC_DIRS:
- return EncodingDirsObjCmd(dummy, interp, objc-1, objv+1);
+ return EncodingDirsObjCmd(dummy, interp, objc, objv);
case ENC_NAMES:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -615,20 +637,27 @@ EncodingDirsObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- if (objc > 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
+ Tcl_Obj *dirListObj;
+
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?dirList?");
return TCL_ERROR;
}
- if (objc == 1) {
+ if (objc == 2) {
Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
return TCL_OK;
}
- if (Tcl_SetEncodingSearchPath(objv[1]) == TCL_ERROR) {
- Tcl_AppendResult(interp, "expected directory list but got \"",
- TclGetString(objv[1]), "\"", NULL);
+
+ dirListObj = objv[2];
+ if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected directory list but got \"%s\"",
+ TclGetString(dirListObj)));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH",
+ NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, objv[1]);
+ Tcl_SetObjResult(interp, dirListObj);
return TCL_OK;
}
@@ -720,6 +749,16 @@ Tcl_EvalObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
+ return Tcl_NRCallObjProc(interp, TclNREvalObjCmd, dummy, objc, objv);
+}
+
+int
+TclNREvalObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
register Tcl_Obj *objPtr;
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = NULL;
@@ -882,13 +921,14 @@ ExprCallback(
/*
*----------------------------------------------------------------------
*
- * Tcl_FileObjCmd --
+ * TclInitFileCmd --
*
- * This procedure is invoked to process the "file" Tcl command. See the
- * user documentation for details on what it does. PLEASE NOTE THAT THIS
- * FAILS WITH FILENAMES AND PATHS WITH EMBEDDED NULLS. With the
- * object-based Tcl_FS APIs, the above NOTE may no longer be true. In any
- * case this assertion should be tested.
+ * This function builds the "file" Tcl command ensemble. See the user
+ * documentation for details on what that ensemble does.
+ *
+ * PLEASE NOTE THAT THIS FAILS WITH FILENAMES AND PATHS WITH EMBEDDED
+ * NULLS. With the object-based Tcl_FS APIs, the above NOTE may no longer
+ * be true. In any case this assertion should be tested.
*
* Results:
* A standard Tcl result.
@@ -899,570 +939,1210 @@ ExprCallback(
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
-int
-Tcl_FileObjCmd(
- ClientData dummy, /* Not used. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument objects. */
+Tcl_Command
+TclInitFileCmd(
+ Tcl_Interp *interp)
{
- int index, value;
- Tcl_StatBuf buf;
- struct utimbuf tval;
-
/*
- * This list of constants should match the fileOption string array below.
+ * Note that most subcommands are unsafe because either they manipulate
+ * the native filesystem or because they reveal information about the
+ * native filesystem.
*/
- static const char *const fileOptions[] = {
- "atime", "attributes", "channels", "copy",
- "delete",
- "dirname", "executable", "exists", "extension",
- "isdirectory", "isfile", "join", "link",
- "lstat", "mtime", "mkdir", "nativename",
- "normalize", "owned",
- "pathtype", "readable", "readlink", "rename",
- "rootname", "separator", "size", "split",
- "stat", "system", "tail", "tempfile",
- "type", "volumes", "writable",
- NULL
+ static const EnsembleImplMap initMap[] = {
+ {"atime", FileAttrAccessTimeCmd, NULL, NULL, NULL, 0},
+ {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 0},
+ {"channels", TclChannelNamesCmd, NULL, NULL, NULL, 0},
+ {"copy", TclFileCopyCmd, NULL, NULL, NULL, 0},
+ {"delete", TclFileDeleteCmd, NULL, NULL, NULL, 0},
+ {"dirname", PathDirNameCmd, NULL, NULL, NULL, 0},
+ {"executable", FileAttrIsExecutableCmd, NULL, NULL, NULL, 0},
+ {"exists", FileAttrIsExistingCmd, NULL, NULL, NULL, 0},
+ {"extension", PathExtensionCmd, NULL, NULL, NULL, 0},
+ {"isdirectory", FileAttrIsDirectoryCmd, NULL, NULL, NULL, 0},
+ {"isfile", FileAttrIsFileCmd, NULL, NULL, NULL, 0},
+ {"join", PathJoinCmd, NULL, NULL, NULL, 0},
+ {"link", TclFileLinkCmd, NULL, NULL, NULL, 0},
+ {"lstat", FileAttrLinkStatCmd, NULL, NULL, NULL, 0},
+ {"mtime", FileAttrModifyTimeCmd, NULL, NULL, NULL, 0},
+ {"mkdir", TclFileMakeDirsCmd, NULL, NULL, NULL, 0},
+ {"nativename", PathNativeNameCmd, NULL, NULL, NULL, 0},
+ {"normalize", PathNormalizeCmd, NULL, NULL, NULL, 0},
+ {"owned", FileAttrIsOwnedCmd, NULL, NULL, NULL, 0},
+ {"pathtype", PathTypeCmd, NULL, NULL, NULL, 0},
+ {"readable", FileAttrIsReadableCmd, NULL, NULL, NULL, 0},
+ {"readlink", TclFileReadLinkCmd, NULL, NULL, NULL, 0},
+ {"rename", TclFileRenameCmd, NULL, NULL, NULL, 0},
+ {"rootname", PathRootNameCmd, NULL, NULL, NULL, 0},
+ {"separator", FilesystemSeparatorCmd, NULL, NULL, NULL, 0},
+ {"size", FileAttrSizeCmd, NULL, NULL, NULL, 0},
+ {"split", PathSplitCmd, NULL, NULL, NULL, 0},
+ {"stat", FileAttrStatCmd, NULL, NULL, NULL, 0},
+ {"system", PathFilesystemCmd, NULL, NULL, NULL, 0},
+ {"tail", PathTailCmd, NULL, NULL, NULL, 0},
+ {"tempfile", TclFileTemporaryCmd, NULL, NULL, NULL, 0},
+ {"type", FileAttrTypeCmd, NULL, NULL, NULL, 0},
+ {"volumes", FilesystemVolumesCmd, NULL, NULL, NULL, 0},
+ {"writable", FileAttrIsWritableCmd, NULL, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
};
- enum options {
- FCMD_ATIME, FCMD_ATTRIBUTES, FCMD_CHANNELS, FCMD_COPY,
- FCMD_DELETE,
- FCMD_DIRNAME, FCMD_EXECUTABLE, FCMD_EXISTS, FCMD_EXTENSION,
- FCMD_ISDIRECTORY, FCMD_ISFILE, FCMD_JOIN, FCMD_LINK,
- FCMD_LSTAT, FCMD_MTIME, FCMD_MKDIR, FCMD_NATIVENAME,
- FCMD_NORMALIZE, FCMD_OWNED,
- FCMD_PATHTYPE, FCMD_READABLE, FCMD_READLINK, FCMD_RENAME,
- FCMD_ROOTNAME, FCMD_SEPARATOR, FCMD_SIZE, FCMD_SPLIT,
- FCMD_STAT, FCMD_SYSTEM, FCMD_TAIL, FCMD_TEMPFILE,
- FCMD_TYPE, FCMD_VOLUMES, FCMD_WRITABLE
+ return TclMakeEnsemble(interp, "file", initMap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMakeFileCommandSafe --
+ *
+ * This function hides the unsafe subcommands of the "file" Tcl command
+ * ensemble. It must only be called from TclHideUnsafeCommands.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Adds commands to the table of hidden commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMakeFileCommandSafe(
+ Tcl_Interp *interp)
+{
+ static const struct {
+ const char *cmdName;
+ int unsafe;
+ } unsafeInfo[] = {
+ {"atime", 1},
+ {"attributes", 1},
+ {"channels", 0},
+ {"copy", 1},
+ {"delete", 1},
+ {"dirname", 1},
+ {"executable", 1},
+ {"exists", 1},
+ {"extension", 1},
+ {"isdirectory", 1},
+ {"isfile", 1},
+ {"join", 0},
+ {"link", 1},
+ {"lstat", 1},
+ {"mtime", 1},
+ {"mkdir", 1},
+ {"nativename", 1},
+ {"normalize", 1},
+ {"owned", 1},
+ {"pathtype", 0},
+ {"readable", 1},
+ {"readlink", 1},
+ {"rename", 1},
+ {"rootname", 1},
+ {"separator", 0},
+ {"size", 1},
+ {"split", 0},
+ {"stat", 1},
+ {"system", 0},
+ {"tail", 1},
+ {"tempfile", 1},
+ {"type", 1},
+ {"volumes", 1},
+ {"writable", 1},
+ {NULL, 0}
};
+ int i;
+ Tcl_DString oldBuf, newBuf;
+
+ Tcl_DStringInit(&oldBuf);
+ TclDStringAppendLiteral(&oldBuf, "::tcl::file::");
+ Tcl_DStringInit(&newBuf);
+ TclDStringAppendLiteral(&newBuf, "tcl:file:");
+ for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
+ if (unsafeInfo[i].unsafe) {
+ const char *oldName, *newName;
+
+ Tcl_DStringSetLength(&oldBuf, 13);
+ oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
+ Tcl_DStringSetLength(&newBuf, 9);
+ newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
+ if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
+ || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
+ Tcl_Panic("problem making 'file %s' safe: %s",
+ unsafeInfo[i].cmdName,
+ Tcl_GetString(Tcl_GetObjResult(interp)));
+ }
+ Tcl_CreateObjCommand(interp, oldName, BadFileSubcommand,
+ (ClientData) unsafeInfo[i].cmdName, NULL);
+ }
+ }
+ Tcl_DStringFree(&oldBuf);
+ Tcl_DStringFree(&newBuf);
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ /*
+ * Ugh. The [file] command is now actually safe, but it is assumed by
+ * scripts that it is not, which messes up security policies. [Bug
+ * 3211758]
+ */
+
+ if (Tcl_HideCommand(interp, "file", "file") != TCL_OK) {
+ Tcl_Panic("problem making 'file' safe: %s",
+ Tcl_GetString(Tcl_GetObjResult(interp)));
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BadFileSubcommand --
+ *
+ * Command used to act as a backstop implementation when subcommands of
+ * "file" are unsafe (the real implementations of the subcommands are
+ * hidden). The clientData is always the full official subcommand name.
+ *
+ * Results:
+ * A standard Tcl result (always a TCL_ERROR).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BadFileSubcommand(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ const char *subcommandName = (const char *) clientData;
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "not allowed to invoke subcommand %s of file", subcommandName));
+ Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrAccessTimeCmd --
+ *
+ * This function is invoked to process the "file atime" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * May update the access time on the file, if requested by the user.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileAttrAccessTimeCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_StatBuf buf;
+ struct utimbuf tval;
+
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0,
- &index) != TCL_OK) {
+ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
+ if (objc == 3) {
+ /*
+ * Need separate variable for reading longs from an object on 64-bit
+ * platforms. [Bug 698146]
+ */
- switch ((enum options) index) {
+ long newTime;
- case FCMD_ATIME:
- case FCMD_MTIME:
- if ((objc < 3) || (objc > 4)) {
- Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
+ if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
return TCL_ERROR;
}
- if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
+
+ tval.actime = newTime;
+ tval.modtime = buf.st_mtime;
+
+ if (Tcl_FSUtime(objv[1], &tval) != 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set access time for file \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
- if (objc == 4) {
- /*
- * Need separate variable for reading longs from an object on
- * 64-bit platforms. [Bug #698146]
- */
- long newTime;
+ /*
+ * Do another stat to ensure that the we return the new recognized
+ * atime - hopefully the same as the one we sent in. However, fs's
+ * like FAT don't even know what atime is.
+ */
- if (TclGetLongFromObj(interp, objv[3], &newTime) != TCL_OK) {
- return TCL_ERROR;
- }
+ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
- if (index == FCMD_ATIME) {
- tval.actime = newTime;
- tval.modtime = buf.st_mtime;
- } else { /* index == FCMD_MTIME */
- tval.actime = buf.st_atime;
- tval.modtime = newTime;
- }
+ Tcl_SetObjResult(interp, Tcl_NewLongObj((long) buf.st_atime));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrModifyTimeCmd --
+ *
+ * This function is invoked to process the "file mtime" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * May update the modification time on the file, if requested by the
+ * user.
+ *
+ *----------------------------------------------------------------------
+ */
- if (Tcl_FSUtime(objv[2], &tval) != 0) {
- Tcl_AppendResult(interp, "could not set ",
- (index == FCMD_ATIME ? "access" : "modification"),
- " time for file \"", TclGetString(objv[2]), "\": ",
- Tcl_PosixError(interp), NULL);
- return TCL_ERROR;
- }
+static int
+FileAttrModifyTimeCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_StatBuf buf;
+ struct utimbuf tval;
- /*
- * Do another stat to ensure that the we return the new recognized
- * atime - hopefully the same as the one we sent in. However, fs's
- * like FAT don't even know what atime is.
- */
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
+ return TCL_ERROR;
+ }
+ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ /*
+ * Need separate variable for reading longs from an object on 64-bit
+ * platforms. [Bug 698146]
+ */
- if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
- return TCL_ERROR;
- }
- }
+ long newTime;
- Tcl_SetObjResult(interp, Tcl_NewLongObj((long)
- (index == FCMD_ATIME ? buf.st_atime : buf.st_mtime)));
- return TCL_OK;
- case FCMD_ATTRIBUTES:
- return TclFileAttrsCmd(interp, objc, objv);
- case FCMD_CHANNELS:
- if ((objc < 2) || (objc > 3)) {
- Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+ if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
return TCL_ERROR;
}
- return Tcl_GetChannelNamesEx(interp,
- ((objc == 2) ? NULL : TclGetString(objv[2])));
- case FCMD_COPY:
- return TclFileCopyCmd(interp, objc, objv);
- case FCMD_DELETE:
- return TclFileDeleteCmd(interp, objc, objv);
- case FCMD_DIRNAME: {
- Tcl_Obj *dirPtr;
-
- if (objc != 3) {
- goto only3Args;
- }
- dirPtr = TclPathPart(interp, objv[2], TCL_PATH_DIRNAME);
- if (dirPtr == NULL) {
+
+ tval.actime = buf.st_atime;
+ tval.modtime = newTime;
+
+ if (Tcl_FSUtime(objv[1], &tval) != 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set modification time for file \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, dirPtr);
- Tcl_DecrRefCount(dirPtr);
- return TCL_OK;
- }
- case FCMD_EXECUTABLE:
- if (objc != 3) {
- goto only3Args;
- }
- return CheckAccess(interp, objv[2], X_OK);
- case FCMD_EXISTS:
- if (objc != 3) {
- goto only3Args;
- }
- return CheckAccess(interp, objv[2], F_OK);
- case FCMD_EXTENSION: {
- Tcl_Obj *ext;
- if (objc != 3) {
- goto only3Args;
- }
- ext = TclPathPart(interp, objv[2], TCL_PATH_EXTENSION);
- if (ext == NULL) {
+ /*
+ * Do another stat to ensure that the we return the new recognized
+ * mtime - hopefully the same as the one we sent in.
+ */
+
+ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, ext);
- Tcl_DecrRefCount(ext);
- return TCL_OK;
}
- case FCMD_ISDIRECTORY:
- if (objc != 3) {
- goto only3Args;
- }
- value = 0;
- if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
- value = S_ISDIR(buf.st_mode);
- }
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
- return TCL_OK;
- case FCMD_ISFILE:
- if (objc != 3) {
- goto only3Args;
- }
- value = 0;
- if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
- value = S_ISREG(buf.st_mode);
- }
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
- return TCL_OK;
- case FCMD_OWNED:
- if (objc != 3) {
- goto only3Args;
- }
- value = 0;
- if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
- /*
- * For Windows, there are no user ids associated with a file, so
- * we always return 1.
- *
- * TODO: use GetSecurityInfo to get the real owner of the file and
- * test for equivalence to the current user.
- */
-#if defined(__WIN32__)
- value = 1;
-#else
- value = (geteuid() == buf.st_uid);
-#endif
- }
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
- return TCL_OK;
- case FCMD_JOIN: {
- Tcl_Obj *resObj;
+ Tcl_SetObjResult(interp, Tcl_NewLongObj((long) buf.st_mtime));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrLinkStatCmd --
+ *
+ * This function is invoked to process the "file lstat" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Writes to an array named by the user.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
- return TCL_ERROR;
- }
- resObj = Tcl_FSJoinToPath(NULL, objc - 2, objv + 2);
- Tcl_SetObjResult(interp, resObj);
- return TCL_OK;
+static int
+FileAttrLinkStatCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_StatBuf buf;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name varName");
+ return TCL_ERROR;
+ }
+ if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) {
+ return TCL_ERROR;
}
- case FCMD_LINK: {
- Tcl_Obj *contents;
+ return StoreStatData(interp, objv[2], &buf);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrStatCmd --
+ *
+ * This function is invoked to process the "file stat" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Writes to an array named by the user.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc < 3 || objc > 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "?-linktype? linkname ?target?");
- return TCL_ERROR;
- }
+static int
+FileAttrStatCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_StatBuf buf;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name varName");
+ return TCL_ERROR;
+ }
+ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return StoreStatData(interp, objv[2], &buf);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrTypeCmd --
+ *
+ * This function is invoked to process the "file type" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileAttrTypeCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_StatBuf buf;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ GetTypeFromMode((unsigned short) buf.st_mode), -1));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrSizeCmd --
+ *
+ * This function is invoked to process the "file size" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileAttrSizeCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_StatBuf buf;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrIsDirectoryCmd --
+ *
+ * This function is invoked to process the "file isdirectory" Tcl
+ * command. See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileAttrIsDirectoryCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_StatBuf buf;
+ int value = 0;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
+ value = S_ISDIR(buf.st_mode);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrIsExecutableCmd --
+ *
+ * This function is invoked to process the "file executable" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileAttrIsExecutableCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ return CheckAccess(interp, objv[1], X_OK);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrIsExistingCmd --
+ *
+ * This function is invoked to process the "file exists" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileAttrIsExistingCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ return CheckAccess(interp, objv[1], F_OK);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrIsFileCmd --
+ *
+ * This function is invoked to process the "file isfile" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileAttrIsFileCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_StatBuf buf;
+ int value = 0;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
+ value = S_ISREG(buf.st_mode);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrIsOwnedCmd --
+ *
+ * This function is invoked to process the "file owned" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileAttrIsOwnedCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_StatBuf buf;
+ int value = 0;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
/*
- * Index of the 'source' argument.
+ * For Windows, there are no user ids associated with a file, so we
+ * always return 1.
+ *
+ * TODO: use GetSecurityInfo to get the real owner of the file and
+ * test for equivalence to the current user.
*/
- if (objc == 5) {
- index = 3;
- } else {
- index = 2;
- }
+#if defined(__WIN32__) || defined(__CYGWIN__)
+ value = 1;
+#else
+ value = (geteuid() == buf.st_uid);
+#endif
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrIsReadableCmd --
+ *
+ * This function is invoked to process the "file readable" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc > 3) {
- int linkAction;
- if (objc == 5) {
- /*
- * We have a '-linktype' argument.
- */
-
- static const char *const linkTypes[] = {
- "-symbolic", "-hard", NULL
- };
- if (Tcl_GetIndexFromObj(interp, objv[2], linkTypes, "switch",
- 0, &linkAction) != TCL_OK) {
- return TCL_ERROR;
- }
- if (linkAction == 0) {
- linkAction = TCL_CREATE_SYMBOLIC_LINK;
- } else {
- linkAction = TCL_CREATE_HARD_LINK;
- }
- } else {
- linkAction = TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK;
- }
- if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
- return TCL_ERROR;
- }
+static int
+FileAttrIsReadableCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ return CheckAccess(interp, objv[1], R_OK);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileAttrIsWritableCmd --
+ *
+ * This function is invoked to process the "file writable" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * Create link from source to target.
- */
+static int
+FileAttrIsWritableCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ return CheckAccess(interp, objv[1], W_OK);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PathDirNameCmd --
+ *
+ * This function is invoked to process the "file dirname" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
- if (contents == NULL) {
- /*
- * We handle three common error cases specially, and for all
- * other errors, we use the standard posix error message.
- */
-
- if (errno == EEXIST) {
- Tcl_AppendResult(interp, "could not create new link \"",
- TclGetString(objv[index]),
- "\": that path already exists", NULL);
- } else if (errno == ENOENT) {
- /*
- * There are two cases here: either the target doesn't
- * exist, or the directory of the src doesn't exist.
- */
-
- int access;
- Tcl_Obj *dirPtr = TclPathPart(interp, objv[index],
- TCL_PATH_DIRNAME);
-
- if (dirPtr == NULL) {
- return TCL_ERROR;
- }
- access = Tcl_FSAccess(dirPtr, F_OK);
- Tcl_DecrRefCount(dirPtr);
- if (access != 0) {
- Tcl_AppendResult(interp,
- "could not create new link \"",
- TclGetString(objv[index]),
- "\": no such file or directory", NULL);
- } else {
- Tcl_AppendResult(interp,
- "could not create new link \"",
- TclGetString(objv[index]), "\": target \"",
- TclGetString(objv[index+1]),
- "\" doesn't exist", NULL);
- }
- } else {
- Tcl_AppendResult(interp,
- "could not create new link \"",
- TclGetString(objv[index]), "\" pointing to \"",
- TclGetString(objv[index+1]), "\": ",
- Tcl_PosixError(interp), NULL);
- }
- return TCL_ERROR;
- }
- } else {
- if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
- return TCL_ERROR;
- }
+static int
+PathDirNameCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *dirPtr;
- /*
- * Read link
- */
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ dirPtr = TclPathPart(interp, objv[1], TCL_PATH_DIRNAME);
+ if (dirPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, dirPtr);
+ Tcl_DecrRefCount(dirPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PathExtensionCmd --
+ *
+ * This function is invoked to process the "file extension" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- contents = Tcl_FSLink(objv[index], NULL, 0);
- if (contents == NULL) {
- Tcl_AppendResult(interp, "could not read link \"",
- TclGetString(objv[index]), "\": ",
- Tcl_PosixError(interp), NULL);
- return TCL_ERROR;
- }
- }
- Tcl_SetObjResult(interp, contents);
- if (objc == 3) {
- /*
- * If we are reading a link, we need to free this result refCount.
- * If we are creating a link, this will just be objv[index+1], and
- * so we don't own it.
- */
+static int
+PathExtensionCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *dirPtr;
- Tcl_DecrRefCount(contents);
- }
- return TCL_OK;
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
}
- case FCMD_LSTAT:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "name varName");
- return TCL_ERROR;
- }
- if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
- return TCL_ERROR;
- }
- return StoreStatData(interp, objv[3], &buf);
- case FCMD_STAT:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "name varName");
- return TCL_ERROR;
- }
- if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
- return TCL_ERROR;
- }
- return StoreStatData(interp, objv[3], &buf);
- case FCMD_SIZE:
- if (objc != 3) {
- goto only3Args;
- }
- if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp,
- Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size));
- return TCL_OK;
- case FCMD_TYPE:
- if (objc != 3) {
- goto only3Args;
- }
- if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- GetTypeFromMode((unsigned short) buf.st_mode), -1));
- return TCL_OK;
- case FCMD_MKDIR:
- return TclFileMakeDirsCmd(interp, objc, objv);
- case FCMD_NATIVENAME: {
- const char *fileName;
- Tcl_DString ds;
-
- if (objc != 3) {
- goto only3Args;
- }
- fileName = TclGetString(objv[2]);
- fileName = Tcl_TranslateFileName(interp, fileName, &ds);
- if (fileName == NULL) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, Tcl_NewStringObj(fileName,
- Tcl_DStringLength(&ds)));
- Tcl_DStringFree(&ds);
- return TCL_OK;
+ dirPtr = TclPathPart(interp, objv[1], TCL_PATH_EXTENSION);
+ if (dirPtr == NULL) {
+ return TCL_ERROR;
}
- case FCMD_NORMALIZE: {
- Tcl_Obj *fileName;
+ Tcl_SetObjResult(interp, dirPtr);
+ Tcl_DecrRefCount(dirPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PathRootNameCmd --
+ *
+ * This function is invoked to process the "file root" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "filename");
- return TCL_ERROR;
- }
+static int
+PathRootNameCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *dirPtr;
- fileName = Tcl_FSGetNormalizedPath(interp, objv[2]);
- if (fileName == NULL) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, fileName);
- return TCL_OK;
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ dirPtr = TclPathPart(interp, objv[1], TCL_PATH_ROOT);
+ if (dirPtr == NULL) {
+ return TCL_ERROR;
}
- case FCMD_PATHTYPE: {
- Tcl_Obj *typeName;
+ Tcl_SetObjResult(interp, dirPtr);
+ Tcl_DecrRefCount(dirPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PathTailCmd --
+ *
+ * This function is invoked to process the "file tail" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc != 3) {
- goto only3Args;
- }
+static int
+PathTailCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *dirPtr;
- switch (Tcl_FSGetPathType(objv[2])) {
- case TCL_PATH_ABSOLUTE:
- TclNewLiteralStringObj(typeName, "absolute");
- break;
- case TCL_PATH_RELATIVE:
- TclNewLiteralStringObj(typeName, "relative");
- break;
- case TCL_PATH_VOLUME_RELATIVE:
- TclNewLiteralStringObj(typeName, "volumerelative");
- break;
- default:
- return TCL_OK;
- }
- Tcl_SetObjResult(interp, typeName);
- return TCL_OK;
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
}
- case FCMD_READABLE:
- if (objc != 3) {
- goto only3Args;
- }
- return CheckAccess(interp, objv[2], R_OK);
- case FCMD_READLINK: {
- Tcl_Obj *contents;
+ dirPtr = TclPathPart(interp, objv[1], TCL_PATH_TAIL);
+ if (dirPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, dirPtr);
+ Tcl_DecrRefCount(dirPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PathFilesystemCmd --
+ *
+ * This function is invoked to process the "file system" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc != 3) {
- goto only3Args;
- }
+static int
+PathFilesystemCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *fsInfo;
- if (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {
- return TCL_ERROR;
- }
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ fsInfo = Tcl_FSFileSystemInfo(objv[1]);
+ if (fsInfo == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unrecognised path", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
+ Tcl_GetString(objv[1]), NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, fsInfo);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PathJoinCmd --
+ *
+ * This function is invoked to process the "file join" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- contents = Tcl_FSLink(objv[2], NULL, 0);
+static int
+PathJoinCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, TclJoinPath(objc - 1, objv + 1));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PathNativeNameCmd --
+ *
+ * This function is invoked to process the "file nativename" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- if (contents == NULL) {
- Tcl_AppendResult(interp, "could not readlink \"",
- TclGetString(objv[2]), "\": ", Tcl_PosixError(interp),
- NULL);
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, contents);
- Tcl_DecrRefCount(contents);
- return TCL_OK;
+static int
+PathNativeNameCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_DString ds;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
}
- case FCMD_RENAME:
- return TclFileRenameCmd(interp, objc, objv);
- case FCMD_ROOTNAME: {
- Tcl_Obj *root;
+ if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, TclDStringToObj(&ds));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PathNormalizeCmd --
+ *
+ * This function is invoked to process the "file normalize" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc != 3) {
- goto only3Args;
- }
- root = TclPathPart(interp, objv[2], TCL_PATH_ROOT);
- if (root == NULL) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, root);
- Tcl_DecrRefCount(root);
- return TCL_OK;
+static int
+PathNormalizeCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *fileName;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
}
- case FCMD_SEPARATOR:
- if ((objc < 2) || (objc > 3)) {
- Tcl_WrongNumArgs(interp, 2, objv, "?name?");
- return TCL_ERROR;
- }
- if (objc == 2) {
- const char *separator = NULL; /* lint */
+ fileName = Tcl_FSGetNormalizedPath(interp, objv[1]);
+ if (fileName == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, fileName);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PathSplitCmd --
+ *
+ * This function is invoked to process the "file split" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- switch (tclPlatform) {
- case TCL_PLATFORM_UNIX:
- separator = "/";
- break;
- case TCL_PLATFORM_WINDOWS:
- separator = "\\";
- break;
- }
- Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1));
- } else {
- Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[2]);
+static int
+PathSplitCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *res;
- if (separatorObj == NULL) {
- Tcl_SetResult(interp, "Unrecognised path", TCL_STATIC);
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, separatorObj);
- }
- return TCL_OK;
- case FCMD_SPLIT: {
- Tcl_Obj *res;
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ res = Tcl_FSSplitPath(objv[1], NULL);
+ if (res == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": no such file or directory",
+ TclGetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH",
+ NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, res);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PathTypeCmd --
+ *
+ * This function is invoked to process the "file pathtype" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc != 3) {
- goto only3Args;
- }
- res = Tcl_FSSplitPath(objv[2], NULL);
- if (res == NULL) {
- /* How can the interp be NULL here?! DKF */
- if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(objv[2]),
- "\": no such file or directory", NULL);
- }
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, res);
+static int
+PathTypeCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *typeName;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ switch (Tcl_FSGetPathType(objv[1])) {
+ case TCL_PATH_ABSOLUTE:
+ TclNewLiteralStringObj(typeName, "absolute");
+ break;
+ case TCL_PATH_RELATIVE:
+ TclNewLiteralStringObj(typeName, "relative");
+ break;
+ case TCL_PATH_VOLUME_RELATIVE:
+ TclNewLiteralStringObj(typeName, "volumerelative");
+ break;
+ default:
+ /* Should be unreachable */
return TCL_OK;
}
- case FCMD_SYSTEM: {
- Tcl_Obj *fsInfo;
+ Tcl_SetObjResult(interp, typeName);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FilesystemSeparatorCmd --
+ *
+ * This function is invoked to process the "file separator" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc != 3) {
- goto only3Args;
- }
- fsInfo = Tcl_FSFileSystemInfo(objv[2]);
- if (fsInfo == NULL) {
- Tcl_SetResult(interp, "Unrecognised path", TCL_STATIC);
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, fsInfo);
- return TCL_OK;
+static int
+FilesystemSeparatorCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ if (objc < 1 || objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?name?");
+ return TCL_ERROR;
}
- case FCMD_TAIL: {
- Tcl_Obj *dirPtr;
+ if (objc == 1) {
+ const char *separator = NULL; /* lint */
- if (objc != 3) {
- goto only3Args;
- }
- dirPtr = TclPathPart(interp, objv[2], TCL_PATH_TAIL);
- if (dirPtr == NULL) {
- return TCL_ERROR;
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ separator = "/";
+ break;
+ case TCL_PLATFORM_WINDOWS:
+ separator = "\\";
+ break;
}
- Tcl_SetObjResult(interp, dirPtr);
- Tcl_DecrRefCount(dirPtr);
- return TCL_OK;
- }
- case FCMD_TEMPFILE:
- return FileTempfileCmd(interp, objc, objv);
- case FCMD_VOLUMES:
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1));
+ } else {
+ Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[1]);
+
+ if (separatorObj == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unrecognised path", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
+ Tcl_GetString(objv[1]), NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_FSListVolumes());
- return TCL_OK;
- case FCMD_WRITABLE:
- if (objc != 3) {
- goto only3Args;
- }
- return CheckAccess(interp, objv[2], W_OK);
+ Tcl_SetObjResult(interp, separatorObj);
}
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FilesystemVolumesCmd --
+ *
+ * This function is invoked to process the "file volumes" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- only3Args:
- Tcl_WrongNumArgs(interp, 2, objv, "name");
- return TCL_ERROR;
+static int
+FilesystemVolumesCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_FSListVolumes());
+ return TCL_OK;
}
/*
@@ -1542,9 +2222,9 @@ GetStatBuf(
if (status < 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(pathPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(pathPtr), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1590,13 +2270,13 @@ StoreStatData(
*/
#define STORE_ARY(fieldName, object) \
- TclNewLiteralStringObj(field, fieldName); \
- Tcl_IncrRefCount(field); \
- value = (object); \
+ TclNewLiteralStringObj(field, fieldName); \
+ Tcl_IncrRefCount(field); \
+ value = (object); \
if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \
- TclDecrRefCount(field); \
- return TCL_ERROR; \
- } \
+ TclDecrRefCount(field); \
+ return TCL_ERROR; \
+ } \
TclDecrRefCount(field);
/*
@@ -1670,165 +2350,6 @@ GetTypeFromMode(
}
/*
- *---------------------------------------------------------------------------
- *
- * FileTempfileCmd
- *
- * This function implements the "tempfile" subcommand of the "file"
- * command.
- *
- * Results:
- * Returns a standard Tcl result.
- *
- * Side effects:
- * Creates a temporary file. Opens a channel to that file and puts the
- * name of that channel in the result. *Might* register suitable exit
- * handlers to ensure that the temporary file gets deleted. Might write
- * to a variable, so reentrancy is a potential issue.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-FileTempfileCmd(
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[])
-{
- Tcl_Obj *nameVarObj = NULL; /* Variable to store the name of the temporary
- * file in. */
- Tcl_Obj *nameObj = NULL; /* Object that will contain the filename. */
- Tcl_Channel chan; /* The channel opened (RDWR) on the temporary
- * file, or NULL if there's an error. */
- Tcl_Obj *tempDirObj = NULL, *tempBaseObj = NULL, *tempExtObj = NULL;
- /* Pieces of template. Each piece is NULL if
- * it is omitted. The platform temporary file
- * engine might ignore some pieces. */
-
- if (objc < 2 || objc > 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "?nameVar? ?template?");
- return TCL_ERROR;
- }
-
- if (objc > 2) {
- nameVarObj = objv[2];
- TclNewObj(nameObj);
- }
- if (objc > 3) {
- int length;
- const char *string = TclGetStringFromObj(objv[3], &length);
-
- /*
- * Treat an empty string as if it wasn't there.
- */
-
- if (length == 0) {
- goto makeTemporary;
- }
-
- /*
- * The template only gives a directory if there is a directory
- * separator in it.
- */
-
- if (strchr(string, '/') != NULL
- || (tclPlatform == TCL_PLATFORM_WINDOWS
- && strchr(string, '\\') != NULL)) {
- tempDirObj = TclPathPart(interp, objv[3], TCL_PATH_DIRNAME);
-
- /*
- * Only allow creation of temporary files in the native filesystem
- * since they are frequently used for integration with external
- * tools or system libraries. [Bug 2388866]
- */
-
- if (tempDirObj != NULL && Tcl_FSGetFileSystemForPath(tempDirObj)
- != &tclNativeFilesystem) {
- TclDecrRefCount(tempDirObj);
- tempDirObj = NULL;
- }
- }
-
- /*
- * The template only gives the filename if the last character isn't a
- * directory separator.
- */
-
- if (string[length-1] != '/' && (tclPlatform != TCL_PLATFORM_WINDOWS
- || string[length-1] != '\\')) {
- Tcl_Obj *tailObj = TclPathPart(interp, objv[3], TCL_PATH_TAIL);
-
- if (tailObj != NULL) {
- tempBaseObj = TclPathPart(interp, tailObj, TCL_PATH_ROOT);
- tempExtObj = TclPathPart(interp, tailObj, TCL_PATH_EXTENSION);
- TclDecrRefCount(tailObj);
- }
- }
- }
-
- /*
- * Convert empty parts of the template into unspecified parts.
- */
-
- if (tempDirObj && !TclGetString(tempDirObj)[0]) {
- TclDecrRefCount(tempDirObj);
- tempDirObj = NULL;
- }
- if (tempBaseObj && !TclGetString(tempBaseObj)[0]) {
- TclDecrRefCount(tempBaseObj);
- tempBaseObj = NULL;
- }
- if (tempExtObj && !TclGetString(tempExtObj)[0]) {
- TclDecrRefCount(tempExtObj);
- tempExtObj = NULL;
- }
-
- /*
- * Create and open the temporary file.
- */
-
- makeTemporary:
- chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj);
-
- /*
- * If we created pieces of template, get rid of them now.
- */
-
- if (tempDirObj) {
- TclDecrRefCount(tempDirObj);
- }
- if (tempBaseObj) {
- TclDecrRefCount(tempBaseObj);
- }
- if (tempExtObj) {
- TclDecrRefCount(tempExtObj);
- }
-
- /*
- * Deal with results.
- */
-
- if (chan == NULL) {
- if (nameVarObj) {
- TclDecrRefCount(nameObj);
- }
- Tcl_AppendResult(interp, "can't create temporary file: ",
- Tcl_PosixError(interp), NULL);
- return TCL_ERROR;
- }
- Tcl_RegisterChannel(interp, chan);
- if (nameVarObj != NULL) {
- if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj,
- TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_UnregisterChannel(interp, chan);
- return TCL_ERROR;
- }
- }
- Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
- return TCL_OK;
-}
-
-/*
*----------------------------------------------------------------------
*
* Tcl_ForObjCmd --
@@ -2050,7 +2571,7 @@ ForPostNextCallback(
/*
*----------------------------------------------------------------------
*
- * Tcl_ForeachObjCmd, TclNRForeachCmd --
+ * Tcl_ForeachObjCmd, TclNRForeachCmd, EachloopCmd --
*
* This object-based procedure is invoked to process the "foreach" Tcl
* command. See the user documentation for details on what it does.
@@ -2082,6 +2603,38 @@ TclNRForeachCmd(
int objc,
Tcl_Obj *const objv[])
{
+ return EachloopCmd(interp, TCL_EACH_KEEP_NONE, objc, objv);
+}
+
+int
+Tcl_LmapObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, TclNRLmapCmd, dummy, objc, objv);
+}
+
+int
+TclNRLmapCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv);
+}
+
+static inline int
+EachloopCmd(
+ Tcl_Interp *interp, /* Our context for variables and script
+ * evaluation. */
+ int collect, /* Select collecting or accumulating mode
+ * (TCL_EACH_*) */
+ int objc, /* The arguments being passed in... */
+ Tcl_Obj *const objv[])
+{
int numLists = (objc-2) / 2;
register struct ForeachState *statePtr;
int i, j, result;
@@ -2125,6 +2678,12 @@ TclNRForeachCmd(
statePtr->bodyPtr = objv[objc - 1];
statePtr->bodyIdx = objc - 1;
+ if (collect == TCL_EACH_COLLECT) {
+ statePtr->resultList = Tcl_NewListObj(0, NULL);
+ } else {
+ statePtr->resultList = NULL;
+ }
+
/*
* Break up the value lists and variable lists into elements.
*/
@@ -2138,7 +2697,12 @@ TclNRForeachCmd(
TclListObjGetElements(NULL, statePtr->vCopyList[i],
&statePtr->varcList[i], &statePtr->varvList[i]);
if (statePtr->varcList[i] < 1) {
- Tcl_AppendResult(interp, "foreach varlist is empty", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s varlist is empty",
+ (statePtr->resultList != NULL ? "lmap" : "foreach")));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+ (statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
+ "NEEDVARS", NULL);
result = TCL_ERROR;
goto done;
}
@@ -2207,14 +2771,21 @@ ForeachLoopStep(
switch (result) {
case TCL_CONTINUE:
result = TCL_OK;
+ break;
case TCL_OK:
+ if (statePtr->resultList != NULL) {
+ Tcl_ListObjAppendElement(interp, statePtr->resultList,
+ Tcl_GetObjResult(interp));
+ }
break;
case TCL_BREAK:
result = TCL_OK;
- goto done;
+ goto finish;
case TCL_ERROR:
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"foreach\" body line %d)", Tcl_GetErrorLine(interp)));
+ "\n (\"%s\" body line %d)",
+ (statePtr->resultList != NULL ? "lmap" : "foreach"),
+ Tcl_GetErrorLine(interp)));
default:
goto done;
}
@@ -2239,7 +2810,14 @@ ForeachLoopStep(
* We're done. Tidy up our work space and finish off.
*/
- Tcl_ResetResult(interp);
+ finish:
+ if (statePtr->resultList == NULL) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_SetObjResult(interp, statePtr->resultList);
+ statePtr->resultList = NULL; /* Don't clean it up */
+ }
+
done:
ForeachCleanup(interp, statePtr);
return result;
@@ -2272,7 +2850,8 @@ ForeachAssignments(
if (varValuePtr == NULL) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (setting foreach loop variable \"%s\")",
+ "\n (setting %s loop variable \"%s\")",
+ (statePtr->resultList != NULL ? "lmap" : "foreach"),
TclGetString(statePtr->varvList[i][v])));
return TCL_ERROR;
}
@@ -2301,6 +2880,9 @@ ForeachCleanup(
TclDecrRefCount(statePtr->aCopyList[i]);
}
}
+ if (statePtr->resultList != NULL) {
+ TclDecrRefCount(statePtr->resultList);
+ }
TclStackFree(interp, statePtr);
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 5ff71a5..155e8e4 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -15,8 +15,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.185 2010/09/27 19:42:38 msofer Exp $
*/
#include "tclInt.h"
@@ -29,13 +27,16 @@
*/
typedef struct SortElement {
- union {
+ union { /* The value that we sorting by. */
const char *strValuePtr;
long intValue;
double doubleValue;
Tcl_Obj *objValuePtr;
- } index;
- Tcl_Obj *objPtr; /* Object being sorted, or its index. */
+ } collationKey;
+ union { /* Object being sorted, or its index. */
+ Tcl_Obj *objPtr;
+ int index;
+ } payload;
struct SortElement *nextPtr;/* Next element in the list, or NULL for end
* of list. */
} SortElement;
@@ -160,31 +161,31 @@ static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr,
*/
static const EnsembleImplMap defaultInfoMap[] = {
- {"args", InfoArgsCmd, NULL, NULL, NULL},
- {"body", InfoBodyCmd, NULL, NULL, NULL},
- {"cmdcount", InfoCmdCountCmd, NULL, NULL, NULL},
- {"commands", InfoCommandsCmd, NULL, NULL, NULL},
- {"complete", InfoCompleteCmd, NULL, NULL, NULL},
- {"coroutine", TclInfoCoroutineCmd, NULL, NULL, NULL},
- {"default", InfoDefaultCmd, NULL, NULL, NULL},
- {"errorstack", InfoErrorStackCmd, NULL, NULL, NULL},
- {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, NULL, NULL},
- {"frame", InfoFrameCmd, NULL, NULL, NULL},
- {"functions", InfoFunctionsCmd, NULL, NULL, NULL},
- {"globals", TclInfoGlobalsCmd, NULL, NULL, NULL},
- {"hostname", InfoHostnameCmd, NULL, NULL, NULL},
- {"level", InfoLevelCmd, NULL, NULL, NULL},
- {"library", InfoLibraryCmd, NULL, NULL, NULL},
- {"loaded", InfoLoadedCmd, NULL, NULL, NULL},
- {"locals", TclInfoLocalsCmd, NULL, NULL, NULL},
- {"nameofexecutable", InfoNameOfExecutableCmd, NULL, NULL, NULL},
- {"patchlevel", InfoPatchLevelCmd, NULL, NULL, NULL},
- {"procs", InfoProcsCmd, NULL, NULL, NULL},
- {"script", InfoScriptCmd, NULL, NULL, NULL},
- {"sharedlibextension", InfoSharedlibCmd, NULL, NULL, NULL},
- {"tclversion", InfoTclVersionCmd, NULL, NULL, NULL},
- {"vars", TclInfoVarsCmd, NULL, NULL, NULL},
- {NULL, NULL, NULL, NULL, NULL}
+ {"args", InfoArgsCmd, NULL, NULL, NULL, 0},
+ {"body", InfoBodyCmd, NULL, NULL, NULL, 0},
+ {"cmdcount", InfoCmdCountCmd, NULL, NULL, NULL, 0},
+ {"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0},
+ {"complete", InfoCompleteCmd, NULL, NULL, NULL, 0},
+ {"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0},
+ {"default", InfoDefaultCmd, NULL, NULL, NULL, 0},
+ {"errorstack", InfoErrorStackCmd, NULL, NULL, NULL, 0},
+ {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, NULL, NULL, 0},
+ {"frame", InfoFrameCmd, NULL, NULL, NULL, 0},
+ {"functions", InfoFunctionsCmd, NULL, NULL, NULL, 0},
+ {"globals", TclInfoGlobalsCmd, NULL, NULL, NULL, 0},
+ {"hostname", InfoHostnameCmd, NULL, NULL, NULL, 0},
+ {"level", InfoLevelCmd, TclCompileInfoLevelCmd, NULL, NULL, 0},
+ {"library", InfoLibraryCmd, NULL, NULL, NULL, 0},
+ {"loaded", InfoLoadedCmd, NULL, NULL, NULL, 0},
+ {"locals", TclInfoLocalsCmd, NULL, NULL, NULL, 0},
+ {"nameofexecutable", InfoNameOfExecutableCmd, NULL, NULL, NULL, 0},
+ {"patchlevel", InfoPatchLevelCmd, NULL, NULL, NULL, 0},
+ {"procs", InfoProcsCmd, NULL, NULL, NULL, 0},
+ {"script", InfoScriptCmd, NULL, NULL, NULL, 0},
+ {"sharedlibextension", InfoSharedlibCmd, NULL, NULL, NULL, 0},
+ {"tclversion", InfoTclVersionCmd, NULL, NULL, NULL, 0},
+ {"vars", TclInfoVarsCmd, NULL, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
};
/*
@@ -228,8 +229,9 @@ TclNRIfObjCmd(
Tcl_Obj *boolObj;
if (objc <= 1) {
- Tcl_AppendResult(interp, "wrong # args: no expression after \"",
- TclGetString(objv[0]), "\" argument", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: no expression after \"%s\" argument",
+ TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
@@ -318,8 +320,9 @@ IfConditionCallback(
*/
if (i >= objc) {
- Tcl_AppendResult(interp, "wrong # args: ",
- "no expression after \"", clause, "\" argument", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: no expression after \"%s\" argument",
+ clause));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
@@ -344,8 +347,9 @@ IfConditionCallback(
}
}
if (i < objc - 1) {
- Tcl_AppendResult(interp, "wrong # args: ",
- "extra words after \"else\" clause in \"if\" command", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args: extra words after \"else\" clause in \"if\" command",
+ -1));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
@@ -360,9 +364,9 @@ IfConditionCallback(
return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);
missingScript:
- clause = TclGetString(objv[i-1]);
- Tcl_AppendResult(interp, "wrong # args: no script following \"", clause,
- "\" argument", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: no script following \"%s\" argument",
+ TclGetString(objv[i-1])));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
@@ -490,7 +494,8 @@ InfoArgsCmd(
name = TclGetString(objv[1]);
procPtr = TclFindProc(iPtr, name);
if (procPtr == NULL) {
- Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
return TCL_ERROR;
}
@@ -551,7 +556,8 @@ InfoBodyCmd(
name = TclGetString(objv[1]);
procPtr = TclFindProc(iPtr, name);
if (procPtr == NULL) {
- Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
return TCL_ERROR;
}
@@ -965,7 +971,7 @@ InfoDefaultCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- const char *procName, *argName, *varName;
+ const char *procName, *argName;
Proc *procPtr;
CompiledLocal *localPtr;
Tcl_Obj *valueObjPtr;
@@ -980,7 +986,8 @@ InfoDefaultCmd(
procPtr = TclFindProc(iPtr, procName);
if (procPtr == NULL) {
- Tcl_AppendResult(interp, "\"", procName, "\" isn't a procedure",NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", procName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName,
NULL);
return TCL_ERROR;
@@ -992,18 +999,18 @@ InfoDefaultCmd(
&& (strcmp(argName, localPtr->name) == 0)) {
if (localPtr->defValuePtr != NULL) {
valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
- localPtr->defValuePtr, 0);
+ localPtr->defValuePtr, TCL_LEAVE_ERR_MSG);
if (valueObjPtr == NULL) {
- goto defStoreError;
+ return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
} else {
Tcl_Obj *nullObjPtr = Tcl_NewObj();
valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
- nullObjPtr, 0);
+ nullObjPtr, TCL_LEAVE_ERR_MSG);
if (valueObjPtr == NULL) {
- goto defStoreError;
+ return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
}
@@ -1011,16 +1018,11 @@ InfoDefaultCmd(
}
}
- Tcl_AppendResult(interp, "procedure \"", procName,
- "\" doesn't have an argument \"", argName, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "procedure \"%s\" doesn't have an argument \"%s\"",
+ procName, argName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, NULL);
return TCL_ERROR;
-
- defStoreError:
- varName = TclGetString(objv[3]);
- Tcl_AppendResult(interp, "couldn't store default value in variable \"",
- varName, "\"", NULL);
- return TCL_ERROR;
}
/*
@@ -1057,18 +1059,18 @@ InfoErrorStackCmd(
Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
return TCL_ERROR;
}
-
+
target = interp;
if (objc == 2) {
- target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
- if (target == NULL) {
- return TCL_ERROR;
- }
+ target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
+ if (target == NULL) {
+ return TCL_ERROR;
+ }
}
iPtr = (Interp *) target;
Tcl_SetObjResult(interp, iPtr->errorStack);
-
+
return TCL_OK;
}
@@ -1145,32 +1147,41 @@ InfoFrameCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- int level, topLevel;
- CmdFrame *framePtr;
+ int level, topLevel, code = TCL_OK;
+ CmdFrame *runPtr, *framePtr;
+ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?number?");
+ return TCL_ERROR;
+ }
topLevel = ((iPtr->cmdFramePtr == NULL)
? 0
: iPtr->cmdFramePtr->level);
-
- if (iPtr->execEnvPtr->corPtr) {
+ if (corPtr) {
/*
* A coroutine: must fix the level computations AND the cmdFrame chain,
* which is interrupted at the base.
*/
- CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
- CmdFrame *runPtr = iPtr->cmdFramePtr;
- CmdFrame *lastPtr = NULL;
-
- topLevel += corPtr->caller.cmdFramePtr->level;
- while (runPtr && (runPtr != corPtr->caller.cmdFramePtr)) {
- lastPtr = runPtr;
- runPtr = runPtr->nextPtr;
- }
- if (lastPtr && !runPtr) {
- lastPtr->nextPtr = corPtr->caller.cmdFramePtr;
- }
+ CmdFrame *lastPtr = NULL;
+
+ runPtr = iPtr->cmdFramePtr;
+
+ /* TODO - deal with overflow */
+ topLevel += corPtr->caller.cmdFramePtr->level;
+ while (runPtr) {
+ runPtr->level += corPtr->caller.cmdFramePtr->level;
+ lastPtr = runPtr;
+ runPtr = runPtr->nextPtr;
+ }
+ if (lastPtr) {
+ lastPtr->nextPtr = corPtr->caller.cmdFramePtr;
+ } else {
+ iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr;
+ }
}
if (objc == 1) {
@@ -1179,10 +1190,7 @@ InfoFrameCmd(
*/
Tcl_SetObjResult(interp, Tcl_NewIntObj(topLevel));
- return TCL_OK;
- } else if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "?number?");
- return TCL_ERROR;
+ goto done;
}
/*
@@ -1190,16 +1198,18 @@ InfoFrameCmd(
*/
if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
if ((level > topLevel) || (level <= - topLevel)) {
levelError:
- Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad level \"%s\"", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME",
TclGetString(objv[1]), NULL);
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
/*
@@ -1219,7 +1229,24 @@ InfoFrameCmd(
}
Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
- return TCL_OK;
+
+ done:
+ if (corPtr) {
+
+ if (iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr) {
+ iPtr->cmdFramePtr = NULL;
+ } else {
+ runPtr = iPtr->cmdFramePtr;
+ while (runPtr->nextPtr != corPtr->caller.cmdFramePtr) {
+ runPtr->level -= corPtr->caller.cmdFramePtr->level;
+ runPtr = runPtr->nextPtr;
+ }
+ runPtr->level = 1;
+ runPtr->nextPtr = NULL;
+ }
+
+ }
+ return code;
}
/*
@@ -1382,15 +1409,15 @@ TclInfoFrame(
Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
if (namePtr) {
- Tcl_Obj *procNameObj;
+ Tcl_Obj *procNameObj;
/*
* This is a regular command.
*/
- TclNewObj(procNameObj);
- Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
- procNameObj);
+ TclNewObj(procNameObj);
+ Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
+ procNameObj);
ADD_PAIR("proc", procNameObj);
} else if (procPtr->cmdPtr->clientData) {
ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
@@ -1465,19 +1492,42 @@ InfoFunctionsCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- const char *pattern;
+ Tcl_Obj *script;
+ int code;
- if (objc == 1) {
- pattern = NULL;
- } else if (objc == 2) {
- pattern = TclGetString(objv[1]);
- } else {
+ if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_ListMathFuncs(interp, pattern));
- return TCL_OK;
+ script = Tcl_NewStringObj(
+" ::apply [::list {{pattern *}} {\n"
+" ::set cmds {}\n"
+" ::foreach cmd [::info commands ::tcl::mathfunc::$pattern] {\n"
+" ::lappend cmds [::namespace tail $cmd]\n"
+" }\n"
+" ::foreach cmd [::info commands tcl::mathfunc::$pattern] {\n"
+" ::set cmd [::namespace tail $cmd]\n"
+" ::if {$cmd ni $cmds} {\n"
+" ::lappend cmds $cmd\n"
+" }\n"
+" }\n"
+" ::return $cmds\n"
+" } [::namespace current]] ", -1);
+
+ if (objc == 2) {
+ Tcl_Obj *arg = Tcl_NewListObj(1, &(objv[1]));
+
+ Tcl_AppendObjToObj(script, arg);
+ Tcl_DecrRefCount(arg);
+ }
+
+ Tcl_IncrRefCount(script);
+ code = Tcl_EvalObjEx(interp, script, 0);
+
+ Tcl_DecrRefCount(script);
+
+ return code;
}
/*
@@ -1519,7 +1569,10 @@ InfoHostnameCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
return TCL_OK;
}
- Tcl_SetResult(interp, "unable to determine name of host", TCL_STATIC);
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to determine name of host", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL);
return TCL_ERROR;
}
@@ -1589,8 +1642,8 @@ InfoLevelCmd(
return TCL_ERROR;
levelError:
- Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad level \"%s\"", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
TclGetString(objv[1]), NULL);
return TCL_ERROR;
@@ -1636,7 +1689,10 @@ InfoLibraryCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
return TCL_OK;
}
- Tcl_SetResult(interp, "no library has been specified for Tcl",TCL_STATIC);
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no library has been specified for Tcl", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL);
return TCL_ERROR;
}
@@ -1669,7 +1725,6 @@ InfoLoadedCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *interpName;
- int result;
if ((objc != 1) && (objc != 2)) {
Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
@@ -1681,8 +1736,7 @@ InfoLoadedCmd(
} else { /* Get pkgs just in specified interp. */
interpName = TclGetString(objv[1]);
}
- result = TclGetLoadedPackages(interp, interpName);
- return result;
+ return TclGetLoadedPackages(interp, interpName);
}
/*
@@ -2266,11 +2320,11 @@ Tcl_LindexObjCmd(
if (elemPtr == NULL) {
return TCL_ERROR;
- } else {
- Tcl_SetObjResult(interp, elemPtr);
- Tcl_DecrRefCount(elemPtr);
- return TCL_OK;
}
+
+ Tcl_SetObjResult(interp, elemPtr);
+ Tcl_DecrRefCount(elemPtr);
+ return TCL_OK;
}
/*
@@ -2384,7 +2438,7 @@ Tcl_ListObjCmd(
*/
if (objc > 1) {
- Tcl_SetObjResult(interp, Tcl_NewListObj((objc-1), &(objv[1])));
+ Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, &objv[1]));
}
return TCL_OK;
}
@@ -2505,9 +2559,9 @@ Tcl_LrangeObjCmd(
}
if (Tcl_IsShared(objv[1]) ||
- (((List *) objv[1]->internalRep.twoPtrValue.ptr1)->refCount > 1)) {
+ ((ListRepPtr(objv[1])->refCount > 1))) {
Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1,
- &(elemPtrs[first])));
+ &elemPtrs[first]));
} else {
/*
* In-place is possible.
@@ -2571,8 +2625,10 @@ Tcl_LrepeatObjCmd(
return TCL_ERROR;
}
if (elementCount < 0) {
- Tcl_SetObjResult(interp, Tcl_Format(NULL,
- "bad count \"%d\": must be integer >= 0", 1, objv+1));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad count \"%d\": must be integer >= 0", elementCount));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
+ NULL);
return TCL_ERROR;
}
@@ -2583,22 +2639,15 @@ Tcl_LrepeatObjCmd(
objc -= 2;
objv += 2;
- /*
- * Final sanity check. Total number of elements must fit in a signed
- * integer. We also limit the number of elements to 512M-1 so allocations
- * on 32-bit machines are guaranteed to be less than 2GB! [Bug 2130992]
- */
+ /* Final sanity check. Do not exceed limits on max list length. */
- totalElems = objc * elementCount;
- if (totalElems != 0 && (totalElems/objc != elementCount
- || totalElems/elementCount != objc)) {
- Tcl_AppendResult(interp, "too many elements in result list", NULL);
- return TCL_ERROR;
- }
- if (totalElems >= 0x20000000) {
- Tcl_AppendResult(interp, "too many elements in result list", NULL);
+ if (elementCount && objc > LIST_MAX/elementCount) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max length of a Tcl list (%d elements) exceeded", LIST_MAX));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
}
+ totalElems = objc * elementCount;
/*
* Get an empty list object that is allocated large enough to hold each
@@ -2607,7 +2656,7 @@ Tcl_LrepeatObjCmd(
listPtr = Tcl_NewListObj(totalElems, NULL);
if (totalElems) {
- List *listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
+ List *listRepPtr = ListRepPtr(listPtr);
listRepPtr->elemCount = elementCount*objc;
dataArray = &listRepPtr->elements;
@@ -2710,8 +2759,10 @@ Tcl_LreplaceObjCmd(
*/
if ((first >= listLen) && (listLen > 0)) {
- Tcl_AppendResult(interp, "list doesn't contain element ",
- TclGetString(objv[2]), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "list doesn't contain element %s", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
+ NULL);
return TCL_ERROR;
}
if (last >= listLen) {
@@ -2795,15 +2846,15 @@ Tcl_LreverseObjCmd(
return TCL_OK;
}
- if (Tcl_IsShared(objv[1])) {
+ if (Tcl_IsShared(objv[1])
+ || (ListRepPtr(objv[1])->refCount > 1)) { /* Bug 1675044 */
Tcl_Obj *resultObj, **dataArray;
- List *listPtr;
+ List *listRepPtr;
- makeNewReversedList:
resultObj = Tcl_NewListObj(elemc, NULL);
- listPtr = resultObj->internalRep.twoPtrValue.ptr1;
- listPtr->elemCount = elemc;
- dataArray = &listPtr->elements;
+ listRepPtr = ListRepPtr(resultObj);
+ listRepPtr->elemCount = elemc;
+ dataArray = &listRepPtr->elements;
for (i=0,j=elemc-1 ; i<elemc ; i++,j--) {
dataArray[j] = elemv[i];
@@ -2812,15 +2863,6 @@ Tcl_LreverseObjCmd(
Tcl_SetObjResult(interp, resultObj);
} else {
- /*
- * It is theoretically possible for a list object to have a shared
- * internal representation, but be an unshared object. Check for this
- * and use the "shared" code if we have that problem. [Bug 1675044]
- */
-
- if (((List *) objv[1]->internalRep.twoPtrValue.ptr1)->refCount > 1) {
- goto makeNewReversedList;
- }
/*
* Not shared, so swap "in place". This relies on Tcl_LOGE above
@@ -2991,7 +3033,9 @@ Tcl_LsearchObjCmd(
Tcl_DecrRefCount(startPtr);
}
if (i > objc-4) {
- Tcl_AppendResult(interp, "missing starting index", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing starting index", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
result = TCL_ERROR;
goto done;
}
@@ -3021,9 +3065,10 @@ Tcl_LsearchObjCmd(
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-index\" option must be followed by list index",
- NULL);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
@@ -3081,14 +3126,18 @@ Tcl_LsearchObjCmd(
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
- Tcl_AppendResult(interp,
- "-subindices cannot be used without -index option", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "-subindices cannot be used without -index option", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
+ "BAD_OPTION_MIX", NULL);
return TCL_ERROR;
}
if (bisect && (allMatches || negatedMatch)) {
- Tcl_AppendResult(interp,
- "-bisect is not compatible with -all or -not", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "-bisect is not compatible with -all or -not", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
+ "BAD_OPTION_MIX", NULL);
return TCL_ERROR;
}
@@ -3520,7 +3569,7 @@ Tcl_LsetObjCmd(
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv,
- "listVar ?index? ?index ...? value");
+ "listVar ?index? ?index ...? value");
return TCL_ERROR;
}
@@ -3640,6 +3689,7 @@ Tcl_LsortObjCmd(
group = 0;
groupSize = 1;
groupOffset = 0;
+ indexPtr = NULL;
for (i = 1; i < objc-1; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
&index) != TCL_OK) {
@@ -3652,9 +3702,10 @@ Tcl_LsortObjCmd(
break;
case LSORT_COMMAND:
if (i == objc-2) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-command\" option must be followed "
- "by comparison command", NULL);
+ "by comparison command", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
sortInfo.resultCode = TCL_ERROR;
goto done2;
}
@@ -3672,65 +3723,41 @@ Tcl_LsortObjCmd(
sortInfo.isIncreasing = 1;
break;
case LSORT_INDEX: {
+ int indexc, dummy;
Tcl_Obj **indexv;
- /* === START SPECIAL CASE ===
- *
- * When reviewing code flow in this function, note that from here
- * to the line a bit below (END SPECIAL CASE) the contents of the
- * indexc and indexv fields of the sortInfo structure may not be
- * matched, so jumping to the done2 label to exit is wrong.
- */
-
- if (sortInfo.indexc > 1) {
- TclStackFree(interp, sortInfo.indexv);
- }
if (i == objc-2) {
- Tcl_AppendResult(interp, "\"-index\" option must be "
- "followed by list index", NULL);
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-index\" option must be followed by list index",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
-
- /*
- * Take copy to prevent shimmering problems.
- */
-
- if (TclListObjGetElements(interp, objv[i+1], &sortInfo.indexc,
+ if (TclListObjGetElements(interp, objv[i+1], &indexc,
&indexv) != TCL_OK) {
- return TCL_ERROR;
- }
- /* === END SPECIAL CASE === */
-
- switch (sortInfo.indexc) {
- case 0:
- sortInfo.indexv = NULL;
- break;
- case 1:
- sortInfo.indexv = &sortInfo.singleIndex;
- break;
- default:
- sortInfo.indexv =
- TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
- allocatedIndexVector = 1; /* Cannot use indexc field, as
- * it might be decreased by 1
- * later. */
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
/*
- * Fill the array by parsing each index. We don't know whether
- * their scale is sensible yet, but we at least perform the
- * syntactic check here.
+ * Check each of the indices for syntactic correctness. Note that
+ * we do not store the converted values here because we do not
+ * know if this is the only -index option yet and so we can't
+ * allocate any space; that happens after the scan through all the
+ * options is done.
*/
- for (j=0 ; j<sortInfo.indexc ; j++) {
+ for (j=0 ; j<indexc ; j++) {
if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
- &sortInfo.indexv[j]) != TCL_OK) {
+ &dummy) != TCL_OK) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (-index option item number %d)", j));
sortInfo.resultCode = TCL_ERROR;
goto done2;
}
}
+ indexPtr = objv[i+1];
i++;
break;
}
@@ -3751,8 +3778,10 @@ Tcl_LsortObjCmd(
break;
case LSORT_STRIDE:
if (i == objc-2) {
- Tcl_AppendResult(interp, "\"-stride\" option must be ",
- "followed by stride length", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-stride\" option must be "
+ "followed by stride length", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
sortInfo.resultCode = TCL_ERROR;
goto done2;
}
@@ -3761,8 +3790,10 @@ Tcl_LsortObjCmd(
goto done2;
}
if (groupSize < 2) {
- Tcl_AppendResult(interp, "stride length must be at least 2",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "stride length must be at least 2", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
+ "BADSTRIDE", NULL);
sortInfo.resultCode = TCL_ERROR;
goto done2;
}
@@ -3775,6 +3806,35 @@ Tcl_LsortObjCmd(
sortInfo.sortMode = SORTMODE_ASCII_NC;
}
+ /*
+ * Now extract the -index list for real, if present. No failures are
+ * expected here; the values are all of the right type or convertible to
+ * it.
+ */
+
+ if (indexPtr) {
+ Tcl_Obj **indexv;
+
+ TclListObjGetElements(interp, indexPtr, &sortInfo.indexc, &indexv);
+ switch (sortInfo.indexc) {
+ case 0:
+ sortInfo.indexv = NULL;
+ break;
+ case 1:
+ sortInfo.indexv = &sortInfo.singleIndex;
+ break;
+ default:
+ sortInfo.indexv =
+ TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
+ allocatedIndexVector = 1; /* Cannot use indexc field, as it
+ * might be decreased by 1 later. */
+ }
+ for (j=0 ; j<sortInfo.indexc ; j++) {
+ TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
+ &sortInfo.indexv[j]);
+ }
+ }
+
listObj = objv[objc-1];
if (sortInfo.sortMode == SORTMODE_COMMAND) {
@@ -3827,8 +3887,10 @@ Tcl_LsortObjCmd(
if (group) {
if (length % groupSize) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"list size must be a multiple of the stride length",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE",
NULL);
sortInfo.resultCode = TCL_ERROR;
goto done;
@@ -3845,9 +3907,11 @@ Tcl_LsortObjCmd(
groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1;
}
if (groupOffset < 0 || groupOffset >= groupSize) {
- Tcl_AppendResult(interp, "when used with \"-stride\", the "
- "leading \"-index\" value must be within the group",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "when used with \"-stride\", the leading \"-index\""
+ " value must be within the group", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
+ "BADINDEX", NULL);
sortInfo.resultCode = TCL_ERROR;
goto done;
}
@@ -3918,7 +3982,7 @@ Tcl_LsortObjCmd(
*/
if (sortMode == SORTMODE_ASCII) {
- elementArray[i].index.strValuePtr = TclGetString(indexPtr);
+ elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr);
} else if (sortMode == SORTMODE_INTEGER) {
long a;
@@ -3926,7 +3990,7 @@ Tcl_LsortObjCmd(
sortInfo.resultCode = TCL_ERROR;
goto done1;
}
- elementArray[i].index.intValue = a;
+ elementArray[i].collationKey.intValue = a;
} else if (sortInfo.sortMode == SORTMODE_REAL) {
double a;
@@ -3935,9 +3999,9 @@ Tcl_LsortObjCmd(
sortInfo.resultCode = TCL_ERROR;
goto done1;
}
- elementArray[i].index.doubleValue = a;
+ elementArray[i].collationKey.doubleValue = a;
} else {
- elementArray[i].index.objValuePtr = indexPtr;
+ elementArray[i].collationKey.objValuePtr = indexPtr;
}
/*
@@ -3946,9 +4010,9 @@ Tcl_LsortObjCmd(
*/
if (indices || group) {
- elementArray[i].objPtr = INT2PTR(idx);
+ elementArray[i].payload.index = idx;
} else {
- elementArray[i].objPtr = listObjPtrs[idx];
+ elementArray[i].payload.objPtr = listObjPtrs[idx];
}
/*
@@ -3986,11 +4050,11 @@ Tcl_LsortObjCmd(
Tcl_Obj **newArray, *objPtr;
resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL);
- listRepPtr = resultPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr = ListRepPtr(resultPtr);
newArray = &listRepPtr->elements;
if (group) {
for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) {
- idx = PTR2INT(elementPtr->objPtr);
+ idx = elementPtr->payload.index;
for (j = 0; j < groupSize; j++) {
if (indices) {
objPtr = Tcl_NewIntObj(idx + j - groupOffset);
@@ -4005,13 +4069,13 @@ Tcl_LsortObjCmd(
}
} else if (indices) {
for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
- objPtr = Tcl_NewIntObj(PTR2INT(elementPtr->objPtr));
+ objPtr = Tcl_NewIntObj(elementPtr->payload.index);
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
}
} else {
for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
- objPtr = elementPtr->objPtr;
+ objPtr = elementPtr->payload.objPtr;
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
}
@@ -4166,25 +4230,25 @@ SortCompare(
int order = 0;
if (infoPtr->sortMode == SORTMODE_ASCII) {
- order = strcmp(elemPtr1->index.strValuePtr,
- elemPtr2->index.strValuePtr);
+ order = strcmp(elemPtr1->collationKey.strValuePtr,
+ elemPtr2->collationKey.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
- order = strcasecmp(elemPtr1->index.strValuePtr,
- elemPtr2->index.strValuePtr);
+ order = strcasecmp(elemPtr1->collationKey.strValuePtr,
+ elemPtr2->collationKey.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
- order = DictionaryCompare(elemPtr1->index.strValuePtr,
- elemPtr2->index.strValuePtr);
+ order = DictionaryCompare(elemPtr1->collationKey.strValuePtr,
+ elemPtr2->collationKey.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_INTEGER) {
long a, b;
- a = elemPtr1->index.intValue;
- b = elemPtr2->index.intValue;
+ a = elemPtr1->collationKey.intValue;
+ b = elemPtr2->collationKey.intValue;
order = ((a >= b) - (a <= b));
} else if (infoPtr->sortMode == SORTMODE_REAL) {
double a, b;
- a = elemPtr1->index.doubleValue;
- b = elemPtr2->index.doubleValue;
+ a = elemPtr1->collationKey.doubleValue;
+ b = elemPtr2->collationKey.doubleValue;
order = ((a >= b) - (a <= b));
} else {
Tcl_Obj **objv, *paramObjv[2];
@@ -4201,8 +4265,8 @@ SortCompare(
}
- objPtr1 = elemPtr1->index.objValuePtr;
- objPtr2 = elemPtr2->index.objValuePtr;
+ objPtr1 = elemPtr1->collationKey.objValuePtr;
+ objPtr2 = elemPtr2->collationKey.objValuePtr;
paramObjv[0] = objPtr1;
paramObjv[1] = objPtr2;
@@ -4231,9 +4295,10 @@ SortCompare(
if (TclGetIntFromObj(infoPtr->interp,
Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
- Tcl_ResetResult(infoPtr->interp);
- Tcl_AppendResult(infoPtr->interp,
- "-compare command returned non-integer result", NULL);
+ Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj(
+ "-compare command returned non-integer result", -1));
+ Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
+ "COMPARISONFAILED", NULL);
infoPtr->resultCode = TCL_ERROR;
return 0;
}
@@ -4444,12 +4509,11 @@ SelectObjFromSublist(
return NULL;
}
if (currentObj == NULL) {
- char buffer[TCL_INTEGER_SPACE];
-
- TclFormatInt(buffer, index);
- Tcl_AppendResult(infoPtr->interp, "element ", buffer,
- " missing from sublist \"", TclGetString(objPtr), "\"",
- NULL);
+ Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
+ "element %d missing from sublist \"%s\"",
+ index, TclGetString(objPtr)));
+ Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
+ "INDEXFAILED", NULL);
infoPtr->resultCode = TCL_ERROR;
return NULL;
}
@@ -4464,6 +4528,5 @@ SelectObjFromSublist(
* c-basic-offset: 4
* fill-column: 78
* tab-width: 8
- * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 7690649..fc957c4 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -14,8 +14,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.214 2010/08/30 14:02:09 msofer Exp $
*/
#include "tclInt.h"
@@ -36,12 +34,35 @@ static int UniCharIsHexDigit(int character);
/*
* Default set of characters to trim in [string trim] and friends. This is a
- * UTF-8 literal string containing space, tab, newline, carriage return,
- * ethiopic wordspace (U+1361), ogham space mark (U+1680), and ideographic
- * space (U+3000). [TIP #318]
+ * UTF-8 literal string containing all Unicode space characters [TIP #413]
*/
-#define DEFAULT_TRIM_SET " \t\n\r\xe1\x8d\xa1\xe1\x9a\x80\xe3\x80\x80"
+#define DEFAULT_TRIM_SET \
+ "\x09\x0a\x0b\x0c\x0d " /* ASCII */\
+ "\xc0\x80" /* nul (U+0000) */\
+ "\xc2\x85" /* next line (U+0085) */\
+ "\xc2\xa0" /* non-breaking space (U+00a0) */\
+ "\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
+ "\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
+ "\xe2\x80\x80" /* en quad (U+2000) */\
+ "\xe2\x80\x81" /* em quad (U+2001) */\
+ "\xe2\x80\x82" /* en space (U+2002) */\
+ "\xe2\x80\x83" /* em space (U+2003) */\
+ "\xe2\x80\x84" /* three-per-em space (U+2004) */\
+ "\xe2\x80\x85" /* four-per-em space (U+2005) */\
+ "\xe2\x80\x86" /* six-per-em space (U+2006) */\
+ "\xe2\x80\x87" /* figure space (U+2007) */\
+ "\xe2\x80\x88" /* punctuation space (U+2008) */\
+ "\xe2\x80\x89" /* thin space (U+2009) */\
+ "\xe2\x80\x8a" /* hair space (U+200a) */\
+ "\xe2\x80\x8b" /* zero width space (U+200b) */\
+ "\xe2\x80\xa8" /* line separator (U+2028) */\
+ "\xe2\x80\xa9" /* paragraph separator (U+2029) */\
+ "\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
+ "\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
+ "\xe2\x81\xa0" /* word joiner (U+2060) */\
+ "\xe3\x80\x80" /* ideographic space (U+3000) */\
+ "\xef\xbb\xbf" /* zero width no-break space (U+feff) */
/*
*----------------------------------------------------------------------
@@ -206,8 +227,8 @@ Tcl_RegexpObjCmd(
*/
if (doinline && ((objc - 2) != 0)) {
- Tcl_AppendResult(interp, "regexp match variables not allowed"
- " when using -inline", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "regexp match variables not allowed when using -inline", -1));
goto optionError;
}
@@ -284,8 +305,11 @@ Tcl_RegexpObjCmd(
* start of the string unless the previous character is a newline.
*/
- if ((offset == 0) || ((offset > 0) &&
- (Tcl_GetUniChar(objPtr, offset-1) == (Tcl_UniChar) '\n'))) {
+ if (offset == 0) {
+ eflags = 0;
+ } else if (offset > stringLength) {
+ eflags = TCL_REG_NOTBOL;
+ } else if (Tcl_GetUniChar(objPtr, offset-1) == (Tcl_UniChar)'\n') {
eflags = 0;
} else {
eflags = TCL_REG_NOTBOL;
@@ -385,12 +409,8 @@ Tcl_RegexpObjCmd(
return TCL_ERROR;
}
} else {
- Tcl_Obj *valuePtr;
-
- valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0);
- if (valuePtr == NULL) {
- Tcl_AppendResult(interp, "couldn't set variable \"",
- TclGetString(objv[i]), "\"", NULL);
+ if (Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr,
+ TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
}
@@ -818,9 +838,8 @@ Tcl_RegsubObjCmd(
Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
}
if (objc == 4) {
- if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, 0) == NULL) {
- Tcl_AppendResult(interp, "couldn't set variable \"",
- TclGetString(objv[3]), "\"", NULL);
+ if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
+ TCL_LEAVE_ERR_MSG) == NULL) {
result = TCL_ERROR;
} else {
/*
@@ -1440,18 +1459,19 @@ StringIsCmd(
static const char *const isClasses[] = {
"alnum", "alpha", "ascii", "control",
- "boolean", "digit", "double", "false",
- "graph", "integer", "list", "lower",
- "print", "punct", "space", "true",
- "upper", "wideinteger", "wordchar", "xdigit",
- NULL
+ "boolean", "digit", "double", "entier",
+ "false", "graph", "integer", "list",
+ "lower", "print", "punct", "space",
+ "true", "upper", "wideinteger", "wordchar",
+ "xdigit", NULL
};
enum isClasses {
- STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
- STR_IS_BOOL, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_FALSE,
- STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST, STR_IS_LOWER,
- STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE, STR_IS_TRUE,
- STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT
+ STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
+ STR_IS_BOOL, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER,
+ STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST,
+ STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE,
+ STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD,
+ STR_IS_XDIGIT
};
static const char *const isOptions[] = {
"-strict", "-failindex", NULL
@@ -1567,7 +1587,6 @@ StringIsCmd(
if (stop < end) {
result = 0;
TclFreeIntRep(objPtr);
- objPtr->typePtr = NULL;
}
}
break;
@@ -1580,6 +1599,51 @@ StringIsCmd(
break;
}
goto failedIntParse;
+ case STR_IS_ENTIER:
+ if ((objPtr->typePtr == &tclIntType) ||
+#ifndef NO_WIDE_TYPE
+ (objPtr->typePtr == &tclWideIntType) ||
+#endif
+ (objPtr->typePtr == &tclBignumType)) {
+ break;
+ }
+ string1 = TclGetStringFromObj(objPtr, &length1);
+ if (length1 == 0) {
+ if (strict) {
+ result = 0;
+ }
+ goto str_is_done;
+ }
+ end = string1 + length1;
+ if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
+ (const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
+ if (stop == end) {
+ /*
+ * Entire string parses as an integer.
+ */
+
+ break;
+ } else {
+ /*
+ * Some prefix parsed as an integer, but not the whole string,
+ * so return failure index as the point where parsing stopped.
+ * Clear out the internal rep, since keeping it would leave
+ * *objPtr in an inconsistent state.
+ */
+
+ result = 0;
+ failat = stop - string1;
+ TclFreeIntRep(objPtr);
+ }
+ } else {
+ /*
+ * No prefix is a valid integer. Fail at beginning.
+ */
+
+ result = 0;
+ failat = 0;
+ }
+ break;
case STR_IS_WIDE:
if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
break;
@@ -1624,7 +1688,6 @@ StringIsCmd(
failat = stop - string1;
TclFreeIntRep(objPtr);
- objPtr->typePtr = NULL;
}
} else {
/*
@@ -1652,7 +1715,7 @@ StringIsCmd(
*/
const char *elemStart, *nextElem;
- int lenRemain, elemSize, hasBrace;
+ int lenRemain, elemSize;
register const char *p;
string1 = TclGetStringFromObj(objPtr, &length1);
@@ -1661,7 +1724,7 @@ StringIsCmd(
for (p=string1, lenRemain=length1; lenRemain > 0;
p=nextElem, lenRemain=end-nextElem) {
if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
- &elemStart, &nextElem, &elemSize, &hasBrace)) {
+ &elemStart, &nextElem, &elemSize, NULL)) {
Tcl_Obj *tmpStr;
/*
@@ -1674,7 +1737,7 @@ StringIsCmd(
* if it is the first "element" that has the failure.
*/
- while (isspace(UCHAR(*p))) { /* INTL: ? */
+ while (TclIsSpaceProc(*p)) {
p++;
}
TclNewStringObj(tmpStr, string1, p-string1);
@@ -1799,8 +1862,10 @@ StringMapCmd(
strncmp(string, "-nocase", (size_t) length2) == 0) {
nocase = 1;
} else {
- Tcl_AppendResult(interp, "bad option \"", string,
- "\": must be -nocase", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase", string));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
+ string, NULL);
return TCL_ERROR;
}
}
@@ -1863,6 +1928,8 @@ StringMapCmd(
Tcl_SetObjResult(interp,
Tcl_NewStringObj("char map list unbalanced", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "MAP",
+ "UNBALANCED", NULL);
return TCL_ERROR;
}
}
@@ -2062,8 +2129,10 @@ StringMatchCmd(
strncmp(string, "-nocase", (size_t) length) == 0) {
nocase = TCL_MATCH_NOCASE;
} else {
- Tcl_AppendResult(interp, "bad option \"", string,
- "\": must be -nocase", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase", string));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
+ string, NULL);
return TCL_ERROR;
}
}
@@ -2196,6 +2265,7 @@ StringReptCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"result exceeds max size for a Tcl value (%d bytes)",
INT_MAX));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
}
length2 = length1 * count;
@@ -2216,6 +2286,7 @@ StringReptCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"string size overflow, out of memory allocating %u bytes",
length2 + 1));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
}
for (index = 0; index < count; index++) {
@@ -2519,8 +2590,11 @@ StringEqualCmd(
return TCL_ERROR;
}
} else {
- Tcl_AppendResult(interp, "bad option \"", string2,
- "\": must be -nocase or -length", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase or -length",
+ string2));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
+ string2, NULL);
return TCL_ERROR;
}
}
@@ -2666,8 +2740,11 @@ StringCmpCmd(
return TCL_ERROR;
}
} else {
- Tcl_AppendResult(interp, "bad option \"", string2,
- "\": must be -nocase or -length", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase or -length",
+ string2));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
+ string2, NULL);
return TCL_ERROR;
}
}
@@ -3105,10 +3182,8 @@ StringTrimCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_UniChar ch, trim;
- register const char *p, *end;
- const char *check, *checkEnd, *string1, *string2;
- int offset, length1, length2;
+ const char *string1, *string2;
+ int triml, trimr, length1, length2;
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
@@ -3120,58 +3195,12 @@ StringTrimCmd(
return TCL_ERROR;
}
string1 = TclGetStringFromObj(objv[1], &length1);
- checkEnd = string2 + length2;
-
- /*
- * The outer loop iterates over the string. The inner loop iterates over
- * the trim characters. The loops terminate as soon as a non-trim
- * character is discovered and string1 is left pointing at the first
- * non-trim character.
- */
- end = string1 + length1;
- for (p = string1; p < end; p += offset) {
- offset = TclUtfToUniChar(p, &ch);
+ triml = TclTrimLeft(string1, length1, string2, length2);
+ trimr = TclTrimRight(string1 + triml, length1 - triml, string2, length2);
- for (check = string2; ; ) {
- if (check >= checkEnd) {
- p = end;
- break;
- }
- check += TclUtfToUniChar(check, &trim);
- if (ch == trim) {
- length1 -= offset;
- string1 += offset;
- break;
- }
- }
- }
-
- /*
- * The outer loop iterates over the string. The inner loop iterates over
- * the trim characters. The loops terminate as soon as a non-trim
- * character is discovered and length1 marks the last non-trim character.
- */
-
- end = string1;
- for (p = string1 + length1; p > end; ) {
- p = Tcl_UtfPrev(p, string1);
- offset = TclUtfToUniChar(p, &ch);
- check = string2;
- while (1) {
- if (check >= checkEnd) {
- p = end;
- break;
- }
- check += TclUtfToUniChar(check, &trim);
- if (ch == trim) {
- length1 -= offset;
- break;
- }
- }
- }
-
- Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1));
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(string1 + triml, length1 - triml - trimr));
return TCL_OK;
}
@@ -3201,10 +3230,8 @@ StringTrimLCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_UniChar ch, trim;
- register const char *p, *end;
- const char *check, *checkEnd, *string1, *string2;
- int offset, length1, length2;
+ const char *string1, *string2;
+ int trim, length1, length2;
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
@@ -3216,34 +3243,10 @@ StringTrimLCmd(
return TCL_ERROR;
}
string1 = TclGetStringFromObj(objv[1], &length1);
- checkEnd = string2 + length2;
- /*
- * The outer loop iterates over the string. The inner loop iterates over
- * the trim characters. The loops terminate as soon as a non-trim
- * character is discovered and string1 is left pointing at the first
- * non-trim character.
- */
-
- end = string1 + length1;
- for (p = string1; p < end; p += offset) {
- offset = TclUtfToUniChar(p, &ch);
-
- for (check = string2; ; ) {
- if (check >= checkEnd) {
- p = end;
- break;
- }
- check += TclUtfToUniChar(check, &trim);
- if (ch == trim) {
- length1 -= offset;
- string1 += offset;
- break;
- }
- }
- }
+ trim = TclTrimLeft(string1, length1, string2, length2);
- Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(string1+trim, length1-trim));
return TCL_OK;
}
@@ -3273,10 +3276,8 @@ StringTrimRCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_UniChar ch, trim;
- register const char *p, *end;
- const char *check, *checkEnd, *string1, *string2;
- int offset, length1, length2;
+ const char *string1, *string2;
+ int trim, length1, length2;
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
@@ -3288,33 +3289,10 @@ StringTrimRCmd(
return TCL_ERROR;
}
string1 = TclGetStringFromObj(objv[1], &length1);
- checkEnd = string2 + length2;
- /*
- * The outer loop iterates over the string. The inner loop iterates over
- * the trim characters. The loops terminate as soon as a non-trim
- * character is discovered and length1 marks the last non-trim character.
- */
+ trim = TclTrimRight(string1, length1, string2, length2);
- end = string1;
- for (p = string1 + length1; p > end; ) {
- p = Tcl_UtfPrev(p, string1);
- offset = TclUtfToUniChar(p, &ch);
- check = string2;
- while (1) {
- if (check >= checkEnd) {
- p = end;
- break;
- }
- check += TclUtfToUniChar(check, &trim);
- if (ch == trim) {
- length1 -= offset;
- break;
- }
- }
- }
-
- Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim));
return TCL_OK;
}
@@ -3346,29 +3324,29 @@ TclInitStringCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
static const EnsembleImplMap stringImplMap[] = {
- {"bytelength", StringBytesCmd, NULL, NULL, NULL},
- {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL},
- {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL},
- {"first", StringFirstCmd, NULL, NULL, NULL},
- {"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL},
- {"is", StringIsCmd, NULL, NULL, NULL},
- {"last", StringLastCmd, NULL, NULL, NULL},
- {"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL},
- {"map", StringMapCmd, NULL, NULL, NULL},
- {"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL},
- {"range", StringRangeCmd, NULL, NULL, NULL},
- {"repeat", StringReptCmd, NULL, NULL, NULL},
- {"replace", StringRplcCmd, NULL, NULL, NULL},
- {"reverse", StringRevCmd, NULL, NULL, NULL},
- {"tolower", StringLowerCmd, NULL, NULL, NULL},
- {"toupper", StringUpperCmd, NULL, NULL, NULL},
- {"totitle", StringTitleCmd, NULL, NULL, NULL},
- {"trim", StringTrimCmd, NULL, NULL, NULL},
- {"trimleft", StringTrimLCmd, NULL, NULL, NULL},
- {"trimright", StringTrimRCmd, NULL, NULL, NULL},
- {"wordend", StringEndCmd, NULL, NULL, NULL},
- {"wordstart", StringStartCmd, NULL, NULL, NULL},
- {NULL, NULL, NULL, NULL, NULL}
+ {"bytelength", StringBytesCmd, NULL, NULL, NULL, 0},
+ {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
+ {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
+ {"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
+ {"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0},
+ {"is", StringIsCmd, NULL, NULL, NULL, 0},
+ {"last", StringLastCmd, TclCompileStringLastCmd, NULL, NULL, 0},
+ {"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0},
+ {"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0},
+ {"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0},
+ {"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0},
+ {"repeat", StringReptCmd, NULL, NULL, NULL, 0},
+ {"replace", StringRplcCmd, NULL, NULL, NULL, 0},
+ {"reverse", StringRevCmd, NULL, NULL, NULL, 0},
+ {"tolower", StringLowerCmd, NULL, NULL, NULL, 0},
+ {"toupper", StringUpperCmd, NULL, NULL, NULL, 0},
+ {"totitle", StringTitleCmd, NULL, NULL, NULL, 0},
+ {"trim", StringTrimCmd, NULL, NULL, NULL, 0},
+ {"trimleft", StringTrimLCmd, NULL, NULL, NULL, 0},
+ {"trimright", StringTrimRCmd, NULL, NULL, NULL, 0},
+ {"wordend", StringEndCmd, NULL, NULL, NULL, 0},
+ {"wordstart", StringStartCmd, NULL, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
};
return TclMakeEnsemble(interp, "string", stringImplMap);
@@ -3562,9 +3540,11 @@ TclNRSwitchObjCmd(
* Mode already set via -exact, -glob, or -regexp.
*/
- Tcl_AppendResult(interp, "bad option \"",
- TclGetString(objv[i]), "\": ", options[mode],
- " option already found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": %s option already found",
+ TclGetString(objv[i]), options[mode]));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+ "DOUBLEOPT", NULL);
return TCL_ERROR;
}
foundmode = 1;
@@ -3579,8 +3559,11 @@ TclNRSwitchObjCmd(
case OPT_INDEXV:
i++;
if (i >= objc-2) {
- Tcl_AppendResult(interp, "missing variable name argument to ",
- "-indexvar", " option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing variable name argument to %s option",
+ "-indexvar"));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+ "NOVAR", NULL);
return TCL_ERROR;
}
indexVarObj = objv[i];
@@ -3589,8 +3572,11 @@ TclNRSwitchObjCmd(
case OPT_MATCHV:
i++;
if (i >= objc-2) {
- Tcl_AppendResult(interp, "missing variable name argument to ",
- "-matchvar", " option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing variable name argument to %s option",
+ "-matchvar"));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+ "NOVAR", NULL);
return TCL_ERROR;
}
matchVarObj = objv[i];
@@ -3606,13 +3592,17 @@ TclNRSwitchObjCmd(
return TCL_ERROR;
}
if (indexVarObj != NULL && mode != OPT_REGEXP) {
- Tcl_AppendResult(interp,
- "-indexvar option requires -regexp option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s option requires -regexp option", "-indexvar"));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+ "MODERESTRICTION", NULL);
return TCL_ERROR;
}
if (matchVarObj != NULL && mode != OPT_REGEXP) {
- Tcl_AppendResult(interp,
- "-matchvar option requires -regexp option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s option requires -regexp option", "-matchvar"));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+ "MODERESTRICTION", NULL);
return TCL_ERROR;
}
@@ -3659,7 +3649,10 @@ TclNRSwitchObjCmd(
if (objc % 2) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "extra switch pattern with no body", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra switch pattern with no body", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
+ NULL);
/*
* Check if this can be due to a badly placed comment in the switch
@@ -3672,10 +3665,12 @@ TclNRSwitchObjCmd(
if (splitObjs) {
for (i=0 ; i<objc ; i+=2) {
if (TclGetString(objv[i])[0] == '#') {
- Tcl_AppendResult(interp, ", this may be due to a "
- "comment incorrectly placed outside of a "
- "switch body - see the \"switch\" "
- "documentation", NULL);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ ", this may be due to a comment incorrectly"
+ " placed outside of a switch body - see the"
+ " \"switch\" documentation", -1);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+ "BADARM", "COMMENT?", NULL);
break;
}
}
@@ -3690,9 +3685,11 @@ TclNRSwitchObjCmd(
*/
if (strcmp(TclGetString(objv[objc-1]), "-") == 0) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "no body specified for pattern \"",
- TclGetString(objv[objc-2]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no body specified for pattern \"%s\"",
+ TclGetString(objv[objc-2])));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
+ "FALLTHROUGH", NULL);
return TCL_ERROR;
}
@@ -3789,8 +3786,12 @@ TclNRSwitchObjCmd(
if (indexVarObj != NULL) {
Tcl_Obj *rangeObjAry[2];
- rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
- rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end);
+ if (info.matches[j].end > 0) {
+ rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
+ rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1);
+ } else {
+ rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1);
+ }
/*
* Never fails; the object is always clean at this point.
@@ -3881,7 +3882,7 @@ TclNRSwitchObjCmd(
if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
int bline = ctxPtr->line[bidx];
- ctxPtr->line = (int *) ckalloc(objc * sizeof(int));
+ ctxPtr->line = ckalloc(objc * sizeof(int));
ctxPtr->nline = objc;
TclListLines(blist, bline, objc, ctxPtr->line, objv);
} else {
@@ -3895,7 +3896,7 @@ TclNRSwitchObjCmd(
int k;
- ctxPtr->line = (int *) ckalloc(objc * sizeof(int));
+ ctxPtr->line = ckalloc(objc * sizeof(int));
ctxPtr->nline = objc;
for (k=0; k < objc; k++) {
ctxPtr->line[k] = -1;
@@ -3925,6 +3926,7 @@ TclNRSwitchObjCmd(
INT2PTR(pc), (ClientData) pattern);
return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j);
}
+
static int
SwitchPostProc(
ClientData data[], /* Data passed from Tcl_NRAddCallback above */
@@ -3944,7 +3946,7 @@ SwitchPostProc(
*/
if (splitObjs) {
- ckfree((char *) ctxPtr->line);
+ ckfree(ctxPtr->line);
if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
/*
* Death of SrcInfo reference.
@@ -4011,7 +4013,10 @@ Tcl_ThrowObjCmd(
if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
return TCL_ERROR;
} else if (len < 1) {
- Tcl_AppendResult(interp, "type must be non-empty list", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "type must be non-empty list", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION",
+ NULL);
return TCL_ERROR;
}
@@ -4193,14 +4198,19 @@ TclNRTryObjCmd(
switch ((enum Handlers) type) {
case TryFinally: /* finally script */
if (i < objc-2) {
- Tcl_AppendResult(interp, "finally clause must be last", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "finally clause must be last", -1));
Tcl_DecrRefCount(handlersObj);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
+ "NONTERMINAL", NULL);
return TCL_ERROR;
} else if (i == objc-1) {
- Tcl_AppendResult(interp, "wrong # args to finally clause: ",
- "must be \"", TclGetString(objv[0]),
- " ... finally script\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args to finally clause: must be"
+ " \"... finally script\"", -1));
Tcl_DecrRefCount(handlersObj);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
+ "ARGUMENT", NULL);
return TCL_ERROR;
}
finallyObj = objv[++i];
@@ -4208,13 +4218,16 @@ TclNRTryObjCmd(
case TryOn: /* on code variableList script */
if (i > objc-4) {
- Tcl_AppendResult(interp, "wrong # args to on clause: ",
- "must be \"", TclGetString(objv[0]),
- " ... on code variableList script\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args to on clause: must be \"... on code"
+ " variableList script\"", -1));
Tcl_DecrRefCount(handlersObj);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON",
+ "ARGUMENT", NULL);
return TCL_ERROR;
}
- if (TCL_ERROR == TclGetCompletionCodeFromObj(interp, objv[i+1], &code)) {
+ if (TclGetCompletionCodeFromObj(interp, objv[i+1],
+ &code) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
@@ -4223,10 +4236,13 @@ TclNRTryObjCmd(
case TryTrap: /* trap pattern variableList script */
if (i > objc-4) {
- Tcl_AppendResult(interp, "wrong # args to trap clause: ",
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args to trap clause: "
"must be \"... trap pattern variableList script\"",
- NULL);
+ -1));
Tcl_DecrRefCount(handlersObj);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
+ "ARGUMENT", NULL);
return TCL_ERROR;
}
code = 1;
@@ -4235,6 +4251,8 @@ TclNRTryObjCmd(
"bad prefix '%s': must be a list",
Tcl_GetString(objv[i+1])));
Tcl_DecrRefCount(handlersObj);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
+ "EXNFORMAT", NULL);
return TCL_ERROR;
}
info[2] = objv[i+1];
@@ -4262,10 +4280,11 @@ TclNRTryObjCmd(
}
}
if (bodyShared) {
- Tcl_AppendResult(interp,
- "last non-finally clause must not have a body of \"-\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "last non-finally clause must not have a body of \"-\"", -1));
Tcl_DecrRefCount(handlersObj);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH",
+ NULL);
return TCL_ERROR;
}
if (!haveHandlers) {
@@ -4499,6 +4518,8 @@ TryPostBody(
((Interp *) interp)->cmdFramePtr, 4*i + 5);
handlerFailed:
+ resultObj = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(resultObj);
options = During(interp, result, options, NULL);
break;
@@ -4772,7 +4793,7 @@ TclListLines(
int i, length = strlen(listStr);
const char *element = NULL, *next = NULL;
ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
- int *clNext= (clLocPtr ? &clLocPtr->loc[0] : NULL);
+ int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
for (i = 0; i < n; i++) {
TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 473dcb4..160fa3c 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -11,12 +11,11 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclCompCmds.c,v 1.169 2010/04/30 09:23:06 dkf Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
+#include <assert.h>
/*
* Prototypes for procedures defined later in this file:
@@ -42,6 +41,13 @@ static int PushVarName(Tcl_Interp *interp,
int flags, int *localIndexPtr,
int *simpleVarNamePtr, int *isScalarPtr,
int line, int *clNext);
+static int CompileEachloopCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ CompileEnv *envPtr, int collect);
+static int CompileDictEachCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr, int collect);
+
/*
* Macro that encapsulates an efficiency trick that avoids a function call for
@@ -85,6 +91,18 @@ static int PushVarName(Tcl_Interp *interp,
mapPtr->loc[eclIndex].next[(word)])
/*
+ * Often want to issue one of two versions of an instruction based on whether
+ * the argument will fit in a single byte or not. This makes it much clearer.
+ */
+
+#define Emit14Inst(nm,idx,envPtr) \
+ if (idx <= 255) { \
+ TclEmitInstInt1(nm##1,idx,envPtr); \
+ } else { \
+ TclEmitInstInt4(nm##4,idx,envPtr); \
+ }
+
+/*
* Flags bits used by PushVarName.
*/
@@ -188,18 +206,14 @@ TclCompileAppendCmd(
if (isScalar) {
if (localIndex < 0) {
TclEmitOpcode(INST_APPEND_STK, envPtr);
- } else if (localIndex <= 255) {
- TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr);
} else {
- TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr);
+ Emit14Inst(INST_APPEND_SCALAR, localIndex, envPtr);
}
} else {
if (localIndex < 0) {
TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr);
- } else if (localIndex <= 255) {
- TclEmitInstInt1(INST_APPEND_ARRAY1, localIndex, envPtr);
} else {
- TclEmitInstInt4(INST_APPEND_ARRAY4, localIndex, envPtr);
+ Emit14Inst(INST_APPEND_ARRAY, localIndex, envPtr);
}
}
} else {
@@ -212,6 +226,245 @@ TclCompileAppendCmd(
/*
*----------------------------------------------------------------------
*
+ * TclCompileArray*Cmd --
+ *
+ * Functions called to compile "array" sucommands.
+ *
+ * Results:
+ * All return TCL_OK for a successful compile, and TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "array" subcommand at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileArrayExistsCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+ int simpleVarName, isScalar, localIndex;
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ PushVarNameWord(interp, tokenPtr, envPtr, 0,
+ &localIndex, &simpleVarName, &isScalar, 1);
+ if (!isScalar) {
+ return TCL_ERROR;
+ }
+
+ if (localIndex >= 0) {
+ TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
+ } else {
+ TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr);
+ }
+ return TCL_OK;
+}
+
+int
+TclCompileArraySetCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+ int simpleVarName, isScalar, localIndex;
+ int dataVar, iterVar, keyVar, valVar, infoIndex;
+ int back, fwd, offsetBack, offsetFwd, savedStackDepth;
+ ForeachInfo *infoPtr;
+
+ if (parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ PushVarNameWord(interp, tokenPtr, envPtr, 0,
+ &localIndex, &simpleVarName, &isScalar, 1);
+ if (!isScalar) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+
+ /*
+ * Special case: literal empty value argument is just an "ensure array"
+ * operation.
+ */
+
+ if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD && tokenPtr[1].size == 0) {
+ if (localIndex >= 0) {
+ TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
+ TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
+ TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
+ } else {
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr);
+ TclEmitInstInt1(INST_JUMP_TRUE1, 5, envPtr);
+ savedStackDepth = envPtr->currStackDepth;
+ TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr);
+ TclEmitInstInt1(INST_JUMP1, 3, envPtr);
+ envPtr->currStackDepth = savedStackDepth;
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+ PushLiteral(envPtr, "", 0);
+ return TCL_OK;
+ }
+
+ /*
+ * Prepare for the internal foreach.
+ */
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_ERROR;
+ }
+ dataVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+ iterVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+ keyVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+ valVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+
+ infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *));
+ infoPtr->numLists = 1;
+ infoPtr->firstValueTemp = dataVar;
+ infoPtr->loopCtTemp = iterVar;
+ infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) * 2*sizeof(int));
+ infoPtr->varLists[0]->numVars = 2;
+ infoPtr->varLists[0]->varIndexes[0] = keyVar;
+ infoPtr->varLists[0]->varIndexes[1] = valVar;
+ infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
+
+ /*
+ * Start issuing instructions to write to the array.
+ */
+
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ PushLiteral(envPtr, "1", 1);
+ TclEmitOpcode( INST_BITAND, envPtr);
+ offsetFwd = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
+ savedStackDepth = envPtr->currStackDepth;
+ PushLiteral(envPtr, "list must have an even number of elements",
+ strlen("list must have an even number of elements"));
+ PushLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}",
+ strlen("-errorCode {TCL ARGUMENT FORMAT}"));
+ TclEmitInstInt4( INST_RETURN_IMM, 1, envPtr);
+ TclEmitInt4( 0, envPtr);
+ envPtr->currStackDepth = savedStackDepth;
+ fwd = CurrentOffset(envPtr) - offsetFwd;
+ TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+ Emit14Inst( INST_STORE_SCALAR, dataVar, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+
+ if (localIndex >= 0) {
+ TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
+ TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
+ TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
+ TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
+ offsetBack = CurrentOffset(envPtr);
+ TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
+ offsetFwd = CurrentOffset(envPtr);
+ TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
+ savedStackDepth = envPtr->currStackDepth;
+ Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr);
+ Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ back = offsetBack - CurrentOffset(envPtr);
+ TclEmitInstInt1(INST_JUMP1, back, envPtr);
+ fwd = CurrentOffset(envPtr) - offsetFwd;
+ TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+ envPtr->currStackDepth = savedStackDepth;
+ } else {
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr);
+ TclEmitInstInt1(INST_JUMP_TRUE1, 4, envPtr);
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr);
+ TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
+ offsetBack = CurrentOffset(envPtr);
+ TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
+ offsetFwd = CurrentOffset(envPtr);
+ TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
+ savedStackDepth = envPtr->currStackDepth;
+ TclEmitOpcode( INST_DUP, envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr);
+ TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ back = offsetBack - CurrentOffset(envPtr);
+ TclEmitInstInt1(INST_JUMP1, back, envPtr);
+ fwd = CurrentOffset(envPtr) - offsetFwd;
+ TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+ envPtr->currStackDepth = savedStackDepth;
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( dataVar, envPtr);
+ PushLiteral(envPtr, "", 0);
+ return TCL_OK;
+}
+
+int
+TclCompileArrayUnsetCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ int simpleVarName, isScalar, localIndex, savedStackDepth;
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+
+ PushVarNameWord(interp, tokenPtr, envPtr, 0,
+ &localIndex, &simpleVarName, &isScalar, 1);
+ if (!isScalar) {
+ return TCL_ERROR;
+ }
+
+ if (localIndex >= 0) {
+ TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
+ TclEmitInstInt1(INST_JUMP_FALSE1, 8, envPtr);
+ TclEmitInstInt1(INST_UNSET_SCALAR, 1, envPtr);
+ TclEmitInt4( localIndex, envPtr);
+ } else {
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr);
+ TclEmitInstInt1(INST_JUMP_FALSE1, 6, envPtr);
+ savedStackDepth = envPtr->currStackDepth;
+ TclEmitInstInt1(INST_UNSET_STK, 1, envPtr);
+ TclEmitInstInt1(INST_JUMP1, 3, envPtr);
+ envPtr->currStackDepth = savedStackDepth;
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+ PushLiteral(envPtr, "", 0);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileBreakCmd --
*
* Procedure called to compile the "break" command.
@@ -245,6 +498,7 @@ TclCompileBreakCmd(
*/
TclEmitOpcode(INST_BREAK, envPtr);
+ PushLiteral(envPtr, "", 0); /* Evil hack! */
return TCL_OK;
}
@@ -279,7 +533,8 @@ TclCompileCatchCmd(
Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
const char *name;
int resultIndex, optsIndex, nameChars, range;
- int savedStackDepth = envPtr->currStackDepth;
+ int initStackDepth = envPtr->currStackDepth;
+ int savedStackDepth;
DefineLineInformation; /* TIP #280 */
/*
@@ -345,112 +600,168 @@ TclCompileCatchCmd(
}
/*
- * We will compile the catch command. Emit a beginCatch instruction at the
- * start of the catch body: the subcommand it controls.
+ * We will compile the catch command. Declare the exception range that it
+ * uses.
*/
range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
- TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
/*
- * If the body is a simple word, compile the instructions to eval it.
- * Otherwise, compile instructions to substitute its text without
- * catching, a catch instruction that resets the stack to what it was
- * before substituting the body, and then an instruction to eval the body.
- * Care has to be taken to register the correct startOffset for the catch
- * range so that errors in the substitution are not caught. [Bug 219184]
+ * If the body is a simple word, compile a BEGIN_CATCH instruction,
+ * followed by the instructions to eval the body.
+ * Otherwise, compile instructions to substitute the body text before
+ * starting the catch, then BEGIN_CATCH, and then EVAL_STK to evaluate the
+ * substituted body.
+ * Care has to be taken to make sure that substitution happens outside the
+ * catch range so that errors in the substitution are not caught.
+ * [Bug 219184]
+ * The reason for duplicating the script is that EVAL_STK would otherwise
+ * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
*/
SetLineInformation(1);
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ savedStackDepth = envPtr->currStackDepth;
+ TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
CompileBody(envPtr, cmdTokenPtr, interp);
- ExceptionRangeEnds(envPtr, range);
} else {
CompileTokens(envPtr, cmdTokenPtr, interp);
+ savedStackDepth = envPtr->currStackDepth;
+ TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
- TclEmitOpcode(INST_EVAL_STK, envPtr);
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_EVAL_STK, envPtr);
+ }
+ /* Stack at this point:
+ * nonsimple: script <mark> result
+ * simple: <mark> result
+ */
+
+ if (resultIndex == -1) {
+ /*
+ * Special case when neither result nor options are being saved. In
+ * that case, we can skip quite a bit of the command epilogue; all we
+ * have to do is drop the result and push the return code (and, of
+ * course, finish the catch context).
+ */
+
+ TclEmitOpcode( INST_POP, envPtr);
+ PushLiteral(envPtr, "0", 1);
+ TclEmitInstInt1( INST_JUMP1, 3, envPtr);
+ envPtr->currStackDepth = savedStackDepth;
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr);
ExceptionRangeEnds(envPtr, range);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+
+ /*
+ * Stack at this point:
+ * nonsimple: script <mark> returnCode
+ * simple: <mark> returnCode
+ */
+
+ goto dropScriptAtEnd;
}
/*
- * The "no errors" epilogue code: store the body's result into the
- * variable (if any), push "0" (TCL_OK) as the catch's "no error" result,
- * and jump around the "error case" code. Note that we issue the push of
- * the return options first so that if alterations happen to the current
- * interpreter state during the writing of the variable, we won't see
- * them; this results in a slightly complex instruction issuing flow
- * (can't exchange, only duplicate and pop).
+ * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
+ * and jump around the "error case" code.
*/
- if (resultIndex != -1) {
- if (optsIndex != -1) {
- TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
- TclEmitInstInt4(INST_OVER, 1, envPtr);
- }
- if (resultIndex <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, resultIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4, resultIndex, envPtr);
- }
- if (optsIndex != -1) {
- TclEmitOpcode(INST_POP, envPtr);
- if (optsIndex <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, optsIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4, optsIndex, envPtr);
- }
- TclEmitOpcode(INST_POP, envPtr);
- }
- }
- TclEmitOpcode(INST_POP, envPtr);
PushLiteral(envPtr, "0", 1);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+ /* Stack at this point: ?script? <mark> result TCL_OK */
- /*
- * The "error case" code: store the body's result into the variable (if
- * any), then push the error result code. The initial PC offset here is
- * the catch's error target. Note that if we are saving the return
- * options, we do that first so the preservation cannot get affected by
- * any intermediate result handling.
+ /*
+ * Emit the "error case" epilogue. Push the interpreter result and the
+ * return code.
*/
envPtr->currStackDepth = savedStackDepth;
ExceptionRangeTarget(envPtr, range, catchOffset);
- if (resultIndex != -1) {
- if (optsIndex != -1) {
- TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
- }
- TclEmitOpcode(INST_PUSH_RESULT, envPtr);
- if (resultIndex <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, resultIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4, resultIndex, envPtr);
- }
- TclEmitOpcode(INST_POP, envPtr);
- if (optsIndex != -1) {
- if (optsIndex <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, optsIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4, optsIndex, envPtr);
- }
- TclEmitOpcode(INST_POP, envPtr);
- }
- }
- TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
+ /* Stack at this point: ?script? */
+ TclEmitOpcode( INST_PUSH_RESULT, envPtr);
+ TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr);
/*
- * Update the target of the jump after the "no errors" code, then emit an
- * endCatch instruction at the end of the catch command.
+ * Update the target of the jump after the "no errors" code.
*/
+ /* Stack at this point: ?script? result returnCode */
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
- CurrentOffset(envPtr) - jumpFixup.codeOffset);
+ (int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
}
- TclEmitOpcode(INST_END_CATCH, envPtr);
- envPtr->currStackDepth = savedStackDepth + 1;
+ /*
+ * Push the return options if the caller wants them.
+ */
+
+ if (optsIndex != -1) {
+ TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
+ }
+
+ /*
+ * End the catch
+ */
+
+ ExceptionRangeEnds(envPtr, range);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+
+ /*
+ * At this point, the top of the stack is inconveniently ordered:
+ * ?script? result returnCode ?returnOptions?
+ * Reverse the stack to bring the result to the top.
+ */
+
+ if (optsIndex != -1) {
+ TclEmitInstInt4( INST_REVERSE, 3, envPtr);
+ } else {
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ }
+
+ /*
+ * Store the result and remove it from the stack.
+ */
+
+ Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+
+ /*
+ * Stack is now ?script? ?returnOptions? returnCode.
+ * If the options dict has been requested, it is buried on the stack under
+ * the return code. Reverse the stack to bring it to the top, store it and
+ * remove it from the stack.
+ */
+
+ if (optsIndex != -1) {
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+
+ dropScriptAtEnd:
+
+ /*
+ * Stack is now ?script? result. Get rid of the subst'ed script if it's
+ * hanging arond.
+ */
+
+ if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+
+ /*
+ * Result of all this, on either branch, should have been to leave one
+ * operand -- the return code -- on the stack.
+ */
+
+ if (envPtr->currStackDepth != initStackDepth + 1) {
+ Tcl_Panic("in TclCompileCatchCmd, currStackDepth = %d should be %d",
+ envPtr->currStackDepth, initStackDepth+1);
+ }
return TCL_OK;
}
@@ -494,6 +805,7 @@ TclCompileContinueCmd(
*/
TclEmitOpcode(INST_CONTINUE, envPtr);
+ PushLiteral(envPtr, "", 0); /* Evil hack! */
return TCL_OK;
}
@@ -512,25 +824,6 @@ TclCompileContinueCmd(
* Instructions are added to envPtr to execute the "dict" subcommand at
* runtime.
*
- * Notes:
- * The following commands are in fairly common use and are possibly worth
- * bytecoding:
- * dict append
- * dict create [*]
- * dict exists [*]
- * dict for
- * dict get [*]
- * dict incr
- * dict keys [*]
- * dict lappend
- * dict set
- * dict unset
- *
- * In practice, those that are pure-value operators (marked with [*]) can
- * probably be left alone (except perhaps [dict get] which is very very
- * common) and [dict update] should be considered instead (really big
- * win!)
- *
*----------------------------------------------------------------------
*/
@@ -595,6 +888,7 @@ TclCompileDictSetCmd(
TclEmitInstInt4( INST_DICT_SET, numWords-2, envPtr);
TclEmitInt4( dictVarIndex, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
return TCL_OK;
}
@@ -712,6 +1006,310 @@ TclCompileDictGetCmd(
tokenPtr = TokenAfter(tokenPtr);
}
TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileDictExistsCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokenPtr;
+ int numWords, i;
+ DefineLineInformation; /* TIP #280 */
+
+ /*
+ * There must be at least two arguments after the command (the single-arg
+ * case is legal, but too special and magic for us to deal with here).
+ */
+
+ if (parsePtr->numWords < 3) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ numWords = parsePtr->numWords-1;
+
+ /*
+ * Now we do the code generation.
+ */
+
+ for (i=0 ; i<numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ TclEmitInstInt4(INST_DICT_EXISTS, numWords-1, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileDictUnsetCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokenPtr;
+ DefineLineInformation; /* TIP #280 */
+ int i, dictVarIndex, nameChars;
+ const char *name;
+
+ /*
+ * There must be at least one argument after the variable name for us to
+ * compile to bytecode.
+ */
+
+ if (parsePtr->numWords < 3) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * The dictionary variable must be a local scalar that is knowable at
+ * compile time; anything else exceeds the complexity of the opcode. So
+ * discover what the index is.
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+ name = tokenPtr[1].start;
+ nameChars = tokenPtr[1].size;
+ if (!TclIsLocalScalar(name, nameChars)) {
+ return TCL_ERROR;
+ }
+ dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
+ if (dictVarIndex < 0) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Remaining words (the key path) can be handled normally.
+ */
+
+ for (i=2 ; i<parsePtr->numWords ; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+
+ /*
+ * Now emit the instruction to do the dict manipulation.
+ */
+
+ TclEmitInstInt4( INST_DICT_UNSET, parsePtr->numWords-2, envPtr);
+ TclEmitInt4( dictVarIndex, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileDictCreateCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ int worker; /* Temp var for building the value in. */
+ Tcl_Token *tokenPtr;
+ Tcl_Obj *keyObj, *valueObj, *dictObj;
+ const char *bytes;
+ int i, len;
+
+ if ((parsePtr->numWords & 1) == 0) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * See if we can build the value at compile time...
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ dictObj = Tcl_NewObj();
+ Tcl_IncrRefCount(dictObj);
+ for (i=1 ; i<parsePtr->numWords ; i+=2) {
+ keyObj = Tcl_NewObj();
+ Tcl_IncrRefCount(keyObj);
+ if (!TclWordKnownAtCompileTime(tokenPtr, keyObj)) {
+ Tcl_DecrRefCount(keyObj);
+ Tcl_DecrRefCount(dictObj);
+ goto nonConstant;
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+ valueObj = Tcl_NewObj();
+ Tcl_IncrRefCount(valueObj);
+ if (!TclWordKnownAtCompileTime(tokenPtr, valueObj)) {
+ Tcl_DecrRefCount(keyObj);
+ Tcl_DecrRefCount(valueObj);
+ Tcl_DecrRefCount(dictObj);
+ goto nonConstant;
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+ Tcl_DictObjPut(NULL, dictObj, keyObj, valueObj);
+ Tcl_DecrRefCount(keyObj);
+ Tcl_DecrRefCount(valueObj);
+ }
+
+ /*
+ * We did! Excellent. The "verifyDict" is to do type forcing.
+ */
+
+ bytes = Tcl_GetStringFromObj(dictObj, &len);
+ PushLiteral(envPtr, bytes, len);
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_DICT_VERIFY, envPtr);
+ Tcl_DecrRefCount(dictObj);
+ return TCL_OK;
+
+ /*
+ * Otherwise, we've got to issue runtime code to do the building, which we
+ * do by [dict set]ting into an unnamed local variable. This requires that
+ * we are in a context with an LVT.
+ */
+
+ nonConstant:
+ worker = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+ if (worker < 0) {
+ return TCL_ERROR;
+ }
+
+ PushLiteral(envPtr, "", 0);
+ Emit14Inst( INST_STORE_SCALAR, worker, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ for (i=1 ; i<parsePtr->numWords ; i+=2) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i+1);
+ tokenPtr = TokenAfter(tokenPtr);
+ TclEmitInstInt4( INST_DICT_SET, 1, envPtr);
+ TclEmitInt4( worker, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+ Emit14Inst( INST_LOAD_SCALAR, worker, envPtr);
+ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( worker, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileDictMergeCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+ int i, workerIndex, infoIndex, outLoop;
+
+ /*
+ * Deal with some special edge cases. Note that in the case with one
+ * argument, the only thing to do is to verify the dict-ness.
+ */
+
+ if (parsePtr->numWords < 2) {
+ PushLiteral(envPtr, "", 0);
+ return TCL_OK;
+ } else if (parsePtr->numWords == 2) {
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_DICT_VERIFY, envPtr);
+ return TCL_OK;
+ }
+
+ /*
+ * There's real merging work to do.
+ *
+ * Allocate some working space. This means we'll only ever compile this
+ * command when there's an LVT present.
+ */
+
+ workerIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+ if (workerIndex < 0) {
+ return TCL_ERROR;
+ }
+ infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+
+ /*
+ * Get the first dictionary and verify that it is so.
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_DICT_VERIFY, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, workerIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+
+ /*
+ * For each of the remaining dictionaries...
+ */
+
+ outLoop = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+ TclEmitInstInt4( INST_BEGIN_CATCH4, outLoop, envPtr);
+ ExceptionRangeStarts(envPtr, outLoop);
+ for (i=2 ; i<parsePtr->numWords ; i++) {
+ /*
+ * Get the dictionary, and merge its pairs into the first dict (using
+ * a small loop).
+ */
+
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr);
+ TclEmitInstInt1( INST_JUMP_TRUE1, 24, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4( INST_DICT_SET, 1, envPtr);
+ TclEmitInt4( workerIndex, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr);
+ TclEmitInstInt1( INST_JUMP_FALSE1, -20, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
+ }
+ ExceptionRangeEnds(envPtr, outLoop);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+
+ /*
+ * Clean up any state left over.
+ */
+
+ Emit14Inst( INST_LOAD_SCALAR, workerIndex, envPtr);
+ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( workerIndex, envPtr);
+ TclEmitInstInt1( INST_JUMP1, 18, envPtr);
+
+ /*
+ * If an exception happens when starting to iterate over the second (and
+ * subsequent) dicts. This is strictly not necessary, but it is nice.
+ */
+
+ ExceptionRangeTarget(envPtr, outLoop, catchOffset);
+ TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
+ TclEmitOpcode( INST_PUSH_RESULT, envPtr);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( workerIndex, envPtr);
+ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
+ TclEmitOpcode( INST_RETURN_STK, envPtr);
+
return TCL_OK;
}
@@ -724,11 +1322,42 @@ TclCompileDictForCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr,
+ TCL_EACH_KEEP_NONE);
+}
+
+int
+TclCompileDictMapCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr,
+ TCL_EACH_COLLECT);
+}
+
+int
+CompileDictEachCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr, /* Holds resulting instructions. */
+ int collect) /* Flag == TCL_EACH_COLLECT to collect and
+ * construct a new dictionary with the loop
+ * body result. */
+{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
int numVars, endTargetOffset;
+ int collectVar = -1; /* Index of temp var holding the result
+ * dict. */
int savedStackDepth = envPtr->currStackDepth;
/* Needed because jumps confuse the stack
* space calculator. */
@@ -752,12 +1381,25 @@ TclCompileDictForCmd(
}
/*
+ * Create temporary variable to capture return values from loop body when
+ * we're collecting results.
+ */
+
+ if (collect == TCL_EACH_COLLECT) {
+ collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1,
+ envPtr);
+ if (collectVar < 0) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
* Check we've got a pair of variables and that they are local variables.
* Then extract their indices in the LVT.
*/
Tcl_DStringInit(&buffer);
- Tcl_DStringAppend(&buffer, varsTokenPtr[1].start, varsTokenPtr[1].size);
+ TclDStringAppendToken(&buffer, &varsTokenPtr[1]);
if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
&argv) != TCL_OK) {
Tcl_DStringFree(&buffer);
@@ -765,24 +1407,24 @@ TclCompileDictForCmd(
}
Tcl_DStringFree(&buffer);
if (numVars != 2) {
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
nameChars = strlen(argv[0]);
if (!TclIsLocalScalar(argv[0], nameChars)) {
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, envPtr);
nameChars = strlen(argv[1]);
if (!TclIsLocalScalar(argv[1], nameChars)) {
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, envPtr);
- ckfree((char *) argv);
+ ckfree(argv);
if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
return TCL_ERROR;
@@ -804,14 +1446,24 @@ TclCompileDictForCmd(
* Preparation complete; issue instructions. Note that this code issues
* fixed-sized jumps. That simplifies things a lot!
*
- * First up, get the dictionary and start the iteration. No catching of
- * errors at this point.
+ * First up, initialize the accumulator dictionary if needed.
+ */
+
+ if (collect == TCL_EACH_COLLECT) {
+ PushLiteral(envPtr, "", 0);
+ Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+
+ /*
+ * Get the dictionary and start the iteration. No catching of errors at
+ * this point.
*/
CompileWord(envPtr, dictTokenPtr, interp, 3);
- TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr);
+ TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr);
emptyTargetOffset = CurrentOffset(envPtr);
- TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr);
+ TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr);
/*
* Now we catch errors from here on so that we can finalize the search
@@ -819,7 +1471,7 @@ TclCompileDictForCmd(
*/
catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
- TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange, envPtr);
+ TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange, envPtr);
ExceptionRangeStarts(envPtr, catchRange);
/*
@@ -827,10 +1479,10 @@ TclCompileDictForCmd(
*/
bodyTargetOffset = CurrentOffset(envPtr);
- TclEmitInstInt4( INST_STORE_SCALAR4, keyVarIndex, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- TclEmitInstInt4( INST_STORE_SCALAR4, valueVarIndex, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, keyVarIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, valueVarIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
/*
* Set up the loop exception targets.
@@ -843,9 +1495,17 @@ TclCompileDictForCmd(
* Compile the loop body itself. It should be stack-neutral.
*/
- SetLineInformation(4);
+ SetLineInformation(3);
CompileBody(envPtr, bodyTokenPtr, interp);
- TclEmitOpcode( INST_POP, envPtr);
+ if (collect == TCL_EACH_COLLECT) {
+ Emit14Inst( INST_LOAD_SCALAR, keyVarIndex, envPtr);
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ TclEmitInstInt4(INST_DICT_SET, 1, envPtr);
+ TclEmitInt4( collectVar, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+ TclEmitOpcode( INST_POP, envPtr);
/*
* Both exception target ranges (error and loop) end here.
@@ -861,11 +1521,11 @@ TclCompileDictForCmd(
*/
ExceptionRangeTarget(envPtr, loopRange, continueOffset);
- TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr);
+ TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr);
jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
- TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
+ TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
/*
* Now do the final cleanup for the no-error case (this is where we break
@@ -876,10 +1536,11 @@ TclCompileDictForCmd(
*/
ExceptionRangeTarget(envPtr, loopRange, breakOffset);
- TclEmitInstInt4( INST_DICT_DONE, infoIndex, envPtr);
- TclEmitOpcode( INST_END_CATCH, envPtr);
+ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
endTargetOffset = CurrentOffset(envPtr);
- TclEmitInstInt4( INST_JUMP4, 0, envPtr);
+ TclEmitInstInt4( INST_JUMP4, 0, envPtr);
/*
* Error handler "finally" clause, which force-terminates the iteration
@@ -887,11 +1548,16 @@ TclCompileDictForCmd(
*/
ExceptionRangeTarget(envPtr, catchRange, catchOffset);
- TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
- TclEmitOpcode( INST_PUSH_RESULT, envPtr);
- TclEmitInstInt4( INST_DICT_DONE, infoIndex, envPtr);
- TclEmitOpcode( INST_END_CATCH, envPtr);
- TclEmitOpcode( INST_RETURN_STK, envPtr);
+ TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
+ TclEmitOpcode( INST_PUSH_RESULT, envPtr);
+ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+ if (collect == TCL_EACH_COLLECT) {
+ TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( collectVar, envPtr);
+ }
+ TclEmitOpcode( INST_RETURN_STK, envPtr);
/*
* Otherwise we're done (the jump after the DICT_FIRST points here) and we
@@ -899,24 +1565,31 @@ TclCompileDictForCmd(
* easy!) Note that we skip the END_CATCH. [Bug 1382528]
*/
- envPtr->currStackDepth = savedStackDepth+2;
+ envPtr->currStackDepth = savedStackDepth + 2;
jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
envPtr->codeStart + emptyTargetOffset);
- TclEmitOpcode( INST_POP, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- TclEmitInstInt4( INST_DICT_DONE, infoIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
/*
* Final stage of the command (normal case) is that we push an empty
- * object. This is done last to promote peephole optimization when it's
- * dropped immediately.
+ * object (or push the accumulator as the result object). This is done
+ * last to promote peephole optimization when it's dropped immediately.
*/
jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset;
TclUpdateInstInt4AtPc(INST_JUMP4, jumpDisplacement,
envPtr->codeStart + endTargetOffset);
- PushLiteral(envPtr, "", 0);
+ if (collect == TCL_EACH_COLLECT) {
+ Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr);
+ TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( collectVar, envPtr);
+ } else {
+ PushLiteral(envPtr, "", 0);
+ }
return TCL_OK;
}
@@ -981,8 +1654,7 @@ TclCompileDictUpdateCmd(
* that are to be used.
*/
- duiPtr = (DictUpdateInfo *)
- ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
+ duiPtr = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
duiPtr->length = numVars;
keyTokenPtrs = TclStackAlloc(interp,
sizeof(Tcl_Token *) * numVars);
@@ -1022,7 +1694,7 @@ TclCompileDictUpdateCmd(
}
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
failedUpdateInfoAssembly:
- ckfree((char *) duiPtr);
+ ckfree(duiPtr);
TclStackFree(interp, keyTokenPtrs);
return TCL_ERROR;
}
@@ -1038,15 +1710,16 @@ TclCompileDictUpdateCmd(
for (i=0 ; i<numVars ; i++) {
CompileWord(envPtr, keyTokenPtrs[i], interp, i);
}
- TclEmitInstInt4( INST_LIST, numVars, envPtr);
- TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr);
- TclEmitInt4( infoIndex, envPtr);
+ TclEmitInstInt4( INST_LIST, numVars, envPtr);
+ TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
- TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
+ TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
envPtr->currStackDepth++;
+ SetLineInformation(parsePtr->numWords - 1);
CompileBody(envPtr, bodyTokenPtr, interp);
envPtr->currStackDepth = savedStackDepth;
ExceptionRangeEnds(envPtr, range);
@@ -1056,10 +1729,10 @@ TclCompileDictUpdateCmd(
* the body evaluation: swap them and finish the update code.
*/
- TclEmitOpcode( INST_END_CATCH, envPtr);
- TclEmitInstInt4( INST_REVERSE, 2, envPtr);
- TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
- TclEmitInt4( infoIndex, envPtr);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
/*
* Jump around the exceptional termination code.
@@ -1074,20 +1747,21 @@ TclCompileDictUpdateCmd(
*/
ExceptionRangeTarget(envPtr, range, catchOffset);
- TclEmitOpcode( INST_PUSH_RESULT, envPtr);
- TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
- TclEmitOpcode( INST_END_CATCH, envPtr);
- TclEmitInstInt4( INST_REVERSE, 3, envPtr);
+ TclEmitOpcode( INST_PUSH_RESULT, envPtr);
+ TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 3, envPtr);
- TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
- TclEmitInt4( infoIndex, envPtr);
- TclEmitOpcode( INST_RETURN_STK, envPtr);
+ TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
+ TclEmitOpcode( INST_RETURN_STK, envPtr);
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
- CurrentOffset(envPtr) - jumpFixup.codeOffset);
+ (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
}
TclStackFree(interp, keyTokenPtrs);
+ envPtr->currStackDepth = savedStackDepth + 1;
return TCL_OK;
}
@@ -1194,7 +1868,272 @@ TclCompileDictLappendCmd(
}
CompileWord(envPtr, keyTokenPtr, interp, 3);
CompileWord(envPtr, valueTokenPtr, interp, 4);
- TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
+ TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileDictWithCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ int i, range, varNameTmp, pathTmp, keysTmp, gotPath, dictVar = -1;
+ int bodyIsEmpty = 1;
+ Tcl_Token *varTokenPtr, *tokenPtr;
+ int savedStackDepth = envPtr->currStackDepth;
+ JumpFixup jumpFixup;
+ const char *ptr, *end;
+
+ /*
+ * There must be at least one argument after the command.
+ */
+
+ if (parsePtr->numWords < 3) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the command (trivially). Expect the following:
+ * dict with <any (varName)> ?<any> ...? <literal>
+ */
+
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ tokenPtr = TokenAfter(varTokenPtr);
+ for (i=3 ; i<parsePtr->numWords ; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Test if the last word is an empty script; if so, we can compile it in
+ * all cases, but if it is non-empty we need local variable table entries
+ * to hold the temporary variables (used to keep stack usage simple).
+ */
+
+ for (ptr=tokenPtr[1].start,end=ptr+tokenPtr[1].size ; ptr!=end ; ptr++) {
+ if (*ptr!=' ' && *ptr!='\t' && *ptr!='\n' && *ptr!='\r') {
+ if (envPtr->procPtr == NULL) {
+ return TCL_ERROR;
+ }
+ bodyIsEmpty = 0;
+ break;
+ }
+ }
+
+ /*
+ * Determine if we're manipulating a dict in a simple local variable.
+ */
+
+ gotPath = (parsePtr->numWords > 3);
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD &&
+ TclIsLocalScalar(varTokenPtr[1].start, varTokenPtr[1].size)) {
+ dictVar = TclFindCompiledLocal(varTokenPtr[1].start,
+ varTokenPtr[1].size, 1, envPtr);
+ }
+
+ /*
+ * Special case: an empty body means we definitely have no need to issue
+ * try-finally style code or to allocate local variable table entries for
+ * storing temporaries. Still need to do both INST_DICT_EXPAND and
+ * INST_DICT_RECOMBINE_* though, because we can't determine if we're free
+ * of traces.
+ */
+
+ if (bodyIsEmpty) {
+ if (dictVar >= 0) {
+ if (gotPath) {
+ /*
+ * Case: Path into dict in LVT with empty body.
+ */
+
+ tokenPtr = TokenAfter(varTokenPtr);
+ for (i=2 ; i<parsePtr->numWords-1 ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i-1);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr);
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ TclEmitOpcode( INST_DICT_EXPAND, envPtr);
+ TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
+ PushLiteral(envPtr, "", 0);
+ } else {
+ /*
+ * Case: Direct dict in LVT with empty body.
+ */
+
+ PushLiteral(envPtr, "", 0);
+ Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr);
+ PushLiteral(envPtr, "", 0);
+ TclEmitOpcode( INST_DICT_EXPAND, envPtr);
+ TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
+ PushLiteral(envPtr, "", 0);
+ }
+ } else {
+ if (gotPath) {
+ /*
+ * Case: Path into dict in non-simple var with empty body.
+ */
+
+ tokenPtr = varTokenPtr;
+ for (i=1 ; i<parsePtr->numWords-1 ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i-1);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ TclEmitOpcode( INST_LOAD_STK, envPtr);
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ TclEmitOpcode( INST_DICT_EXPAND, envPtr);
+ TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr);
+ PushLiteral(envPtr, "", 0);
+ } else {
+ /*
+ * Case: Direct dict in non-simple var with empty body.
+ */
+
+ CompileWord(envPtr, varTokenPtr, interp, 0);
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LOAD_STK, envPtr);
+ PushLiteral(envPtr, "", 0);
+ TclEmitOpcode( INST_DICT_EXPAND, envPtr);
+ PushLiteral(envPtr, "", 0);
+ TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr);
+ PushLiteral(envPtr, "", 0);
+ }
+ }
+ envPtr->currStackDepth = savedStackDepth + 1;
+ return TCL_OK;
+ }
+
+ /*
+ * OK, we have a non-trivial body. This means that the focus is on
+ * generating a try-finally structure where the INST_DICT_RECOMBINE_* goes
+ * in the 'finally' clause.
+ *
+ * Start by allocating local (unnamed, untraced) working variables.
+ */
+
+ if (dictVar == -1) {
+ varNameTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+ } else {
+ varNameTmp = -1;
+ }
+ if (gotPath) {
+ pathTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+ } else {
+ pathTmp = -1;
+ }
+ keysTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+
+ /*
+ * Issue instructions. First, the part to expand the dictionary.
+ */
+
+ if (varNameTmp > -1) {
+ CompileWord(envPtr, varTokenPtr, interp, 0);
+ Emit14Inst( INST_STORE_SCALAR, varNameTmp, envPtr);
+ }
+ tokenPtr = TokenAfter(varTokenPtr);
+ if (gotPath) {
+ for (i=2 ; i<parsePtr->numWords-1 ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i-1);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ TclEmitInstInt4( INST_LIST, parsePtr->numWords-3,envPtr);
+ Emit14Inst( INST_STORE_SCALAR, pathTmp, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+ if (dictVar == -1) {
+ TclEmitOpcode( INST_LOAD_STK, envPtr);
+ } else {
+ Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr);
+ }
+ if (gotPath) {
+ Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr);
+ } else {
+ PushLiteral(envPtr, "", 0);
+ }
+ TclEmitOpcode( INST_DICT_EXPAND, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, keysTmp, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+
+ /*
+ * Now the body of the [dict with].
+ */
+
+ range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+ TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
+
+ ExceptionRangeStarts(envPtr, range);
+ envPtr->currStackDepth++;
+ SetLineInformation(parsePtr->numWords-1);
+ CompileBody(envPtr, tokenPtr, interp);
+ envPtr->currStackDepth = savedStackDepth;
+ ExceptionRangeEnds(envPtr, range);
+
+ /*
+ * Now fold the results back into the dictionary in the OK case.
+ */
+
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+ if (varNameTmp > -1) {
+ Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr);
+ }
+ if (gotPath) {
+ Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr);
+ } else {
+ PushLiteral(envPtr, "", 0);
+ }
+ Emit14Inst( INST_LOAD_SCALAR, keysTmp, envPtr);
+ if (dictVar == -1) {
+ TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr);
+ } else {
+ TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
+ }
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+
+ /*
+ * Now fold the results back into the dictionary in the exception case.
+ */
+
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
+ TclEmitOpcode( INST_PUSH_RESULT, envPtr);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+ if (varNameTmp > -1) {
+ Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr);
+ }
+ if (parsePtr->numWords > 3) {
+ Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr);
+ } else {
+ PushLiteral(envPtr, "", 0);
+ }
+ Emit14Inst( INST_LOAD_SCALAR, keysTmp, envPtr);
+ if (dictVar == -1) {
+ TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr);
+ } else {
+ TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
+ }
+ TclEmitOpcode( INST_RETURN_STK, envPtr);
+
+ /*
+ * Prepare for the start of the next command.
+ */
+
+ envPtr->currStackDepth = savedStackDepth + 1;
+ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
+ Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
+ (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
+ }
return TCL_OK;
}
@@ -1228,7 +2167,7 @@ DupDictUpdateInfo(
dui1Ptr = clientData;
len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
- dui2Ptr = (DictUpdateInfo *) ckalloc(len);
+ dui2Ptr = ckalloc(len);
memcpy(dui2Ptr, dui1Ptr, len);
return dui2Ptr;
}
@@ -1290,6 +2229,7 @@ TclCompileErrorCmd(
* However, we only deal with the case where there is just a message.
*/
Tcl_Token *messageTokenPtr;
+ int savedStackDepth = envPtr->currStackDepth;
DefineLineInformation; /* TIP #280 */
if (parsePtr->numWords != 2) {
@@ -1300,6 +2240,7 @@ TclCompileErrorCmd(
PushLiteral(envPtr, "-code error -level 0", 20);
CompileWord(envPtr, messageTokenPtr, interp, 1);
TclEmitOpcode(INST_RETURN_STK, envPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
return TCL_OK;
}
@@ -1541,6 +2482,39 @@ TclCompileForeachCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr,
+ TCL_EACH_KEEP_NONE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileEachloopCmd --
+ *
+ * Procedure called to compile the "foreach" and "lmap" commands.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "foreach" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileEachloopCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr, /* Holds resulting instructions. */
+ int collect) /* Select collecting or accumulating mode
+ * (TCL_EACH_*) */
+{
Proc *procPtr = envPtr->procPtr;
ForeachInfo *infoPtr; /* Points to the structure describing this
* foreach command. Stored in a AuxData
@@ -1549,6 +2523,9 @@ TclCompileForeachCmd(
* used to point to a value list. */
int loopCtTemp; /* Index of temp var holding the loop's
* iteration count. */
+ int collectVar = -1; /* Index of temp var holding the result var
+ * index. */
+
Tcl_Token *tokenPtr, *bodyTokenPtr;
unsigned char *jumpPc;
JumpFixup jumpFalseFixup;
@@ -1632,7 +2609,7 @@ TclCompileForeachCmd(
*/
Tcl_DStringInit(&varList);
- Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size);
+ TclDStringAppendToken(&varList, &tokenPtr[1]);
code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
&varcList[loopIndex], &varvList[loopIndex]);
Tcl_DStringFree(&varList);
@@ -1664,6 +2641,14 @@ TclCompileForeachCmd(
loopIndex++;
}
+ if (collect == TCL_EACH_COLLECT) {
+ collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1,
+ envPtr);
+ if (collectVar < 0) {
+ return TCL_ERROR;
+ }
+ }
+
/*
* We will compile the foreach command. Reserve (numLists + 1) temporary
* variables:
@@ -1692,8 +2677,8 @@ TclCompileForeachCmd(
* pointing to the ForeachInfo structure.
*/
- infoPtr = (ForeachInfo *) ckalloc((unsigned)
- sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
+ infoPtr = ckalloc(sizeof(ForeachInfo)
+ + numLists * sizeof(ForeachVarList *));
infoPtr->numLists = numLists;
infoPtr->firstValueTemp = firstValueTemp;
infoPtr->loopCtTemp = loopCtTemp;
@@ -1701,8 +2686,8 @@ TclCompileForeachCmd(
ForeachVarList *varListPtr;
numVars = varcList[loopIndex];
- varListPtr = (ForeachVarList *) ckalloc((unsigned)
- sizeof(ForeachVarList) + numVars*sizeof(int));
+ varListPtr = ckalloc(sizeof(ForeachVarList)
+ + numVars * sizeof(int));
varListPtr->numVars = numVars;
for (j = 0; j < numVars; j++) {
const char *varName = varvList[loopIndex][j];
@@ -1733,21 +2718,27 @@ TclCompileForeachCmd(
SetLineInformation(i);
CompileTokens(envPtr, tokenPtr, interp);
tempVar = (firstValueTemp + loopIndex);
- if (tempVar <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr);
- }
- TclEmitOpcode(INST_POP, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, tempVar, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
loopIndex++;
}
}
/*
+ * Create temporary variable to capture return values from loop body.
+ */
+
+ if (collect == TCL_EACH_COLLECT) {
+ PushLiteral(envPtr, "", 0);
+ Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+
+ /*
* Initialize the temporary var that holds the count of loop iterations.
*/
- TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
+ TclEmitInstInt4( INST_FOREACH_START4, infoIndex, envPtr);
/*
* Top of loop code: assign each loop variable and check whether
@@ -1755,7 +2746,7 @@ TclCompileForeachCmd(
*/
ExceptionRangeTarget(envPtr, range, continueOffset);
- TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
+ TclEmitInstInt4( INST_FOREACH_STEP4, infoIndex, envPtr);
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
/*
@@ -1767,7 +2758,11 @@ TclCompileForeachCmd(
CompileBody(envPtr, bodyTokenPtr, interp);
ExceptionRangeEnds(envPtr, range);
envPtr->currStackDepth = savedStackDepth + 1;
- TclEmitOpcode(INST_POP, envPtr);
+
+ if (collect == TCL_EACH_COLLECT) {
+ Emit14Inst( INST_LAPPEND_SCALAR, collectVar,envPtr);
+ }
+ TclEmitOpcode( INST_POP, envPtr);
/*
* Jump back to the test at the top of the loop. Generate a 4 byte jump if
@@ -1817,17 +2812,24 @@ TclCompileForeachCmd(
ExceptionRangeTarget(envPtr, range, breakOffset);
/*
- * The foreach command's result is an empty string.
+ * The command's result is an empty string if not collecting, or the
+ * list of results from evaluating the loop body.
*/
envPtr->currStackDepth = savedStackDepth;
- PushLiteral(envPtr, "", 0);
+ if (collect == TCL_EACH_COLLECT) {
+ Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr);
+ TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( collectVar, envPtr);
+ } else {
+ PushLiteral(envPtr, "", 0);
+ }
envPtr->currStackDepth = savedStackDepth + 1;
done:
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
if (varvList[loopIndex] != NULL) {
- ckfree((char *) varvList[loopIndex]);
+ ckfree(varvList[loopIndex]);
}
}
TclStackFree(interp, (void *)varvList);
@@ -1866,8 +2868,8 @@ DupForeachInfo(
register ForeachVarList *srcListPtr, *dupListPtr;
int numVars, i, j, numLists = srcPtr->numLists;
- dupPtr = (ForeachInfo *) ckalloc((unsigned)
- sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
+ dupPtr = ckalloc(sizeof(ForeachInfo)
+ + numLists * sizeof(ForeachVarList *));
dupPtr->numLists = numLists;
dupPtr->firstValueTemp = srcPtr->firstValueTemp;
dupPtr->loopCtTemp = srcPtr->loopCtTemp;
@@ -1875,8 +2877,8 @@ DupForeachInfo(
for (i = 0; i < numLists; i++) {
srcListPtr = srcPtr->varLists[i];
numVars = srcListPtr->numVars;
- dupListPtr = (ForeachVarList *) ckalloc((unsigned)
- sizeof(ForeachVarList) + numVars*sizeof(int));
+ dupListPtr = ckalloc(sizeof(ForeachVarList)
+ + numVars * sizeof(int));
dupListPtr->numVars = numVars;
for (j = 0; j < numVars; j++) {
dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j];
@@ -1917,9 +2919,9 @@ FreeForeachInfo(
for (i = 0; i < numLists; i++) {
listPtr = infoPtr->varLists[i];
- ckfree((char *) listPtr);
+ ckfree(listPtr);
}
- ckfree((char *) infoPtr);
+ ckfree(infoPtr);
}
/*
@@ -1982,6 +2984,226 @@ PrintForeachInfo(
/*
*----------------------------------------------------------------------
*
+ * TclCompileFormatCmd --
+ *
+ * Procedure called to compile the "format" command. Handles cases that
+ * can be done as constants or simple string concatenation only.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "format" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileFormatCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ Tcl_Obj **objv, *formatObj, *tmpObj;
+ char *bytes, *start;
+ int i, j, len;
+
+ /*
+ * Don't handle any guaranteed-error cases.
+ */
+
+ if (parsePtr->numWords < 2) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check if the argument words are all compile-time-known literals; that's
+ * a case we can handle by compiling to a constant.
+ */
+
+ formatObj = Tcl_NewObj();
+ Tcl_IncrRefCount(formatObj);
+ tokenPtr = TokenAfter(tokenPtr);
+ if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) {
+ Tcl_DecrRefCount(formatObj);
+ return TCL_ERROR;
+ }
+
+ objv = ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *));
+ for (i=0 ; i+2 < parsePtr->numWords ; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ objv[i] = Tcl_NewObj();
+ Tcl_IncrRefCount(objv[i]);
+ if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) {
+ goto checkForStringConcatCase;
+ }
+ }
+
+ /*
+ * Everything is a literal, so the result is constant too (or an error if
+ * the format is broken). Do the format now.
+ */
+
+ tmpObj = Tcl_Format(interp, Tcl_GetString(formatObj),
+ parsePtr->numWords-2, objv);
+ for (; --i>=0 ;) {
+ Tcl_DecrRefCount(objv[i]);
+ }
+ ckfree(objv);
+ Tcl_DecrRefCount(formatObj);
+ if (tmpObj == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Not an error, always a constant result, so just push the result as a
+ * literal. Job done.
+ */
+
+ bytes = Tcl_GetStringFromObj(tmpObj, &len);
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(tmpObj);
+ return TCL_OK;
+
+ checkForStringConcatCase:
+ /*
+ * See if we can generate a sequence of things to concatenate. This
+ * requires that all the % sequences be %s or %%, as everything else is
+ * sufficiently complex that we don't bother.
+ *
+ * First, get the state of the system relatively sensible (cleaning up
+ * after our attempt to spot a literal).
+ */
+
+ for (; --i>=0 ;) {
+ Tcl_DecrRefCount(objv[i]);
+ }
+ ckfree(objv);
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ tokenPtr = TokenAfter(tokenPtr);
+ i = 0;
+
+ /*
+ * Now scan through and check for non-%s and non-%% substitutions.
+ */
+
+ for (bytes = Tcl_GetString(formatObj) ; *bytes ; bytes++) {
+ if (*bytes == '%') {
+ bytes++;
+ if (*bytes == 's') {
+ i++;
+ continue;
+ } else if (*bytes == '%') {
+ continue;
+ }
+ Tcl_DecrRefCount(formatObj);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Check if the number of things to concatenate will fit in a byte.
+ */
+
+ if (i+2 != parsePtr->numWords || i > 125) {
+ Tcl_DecrRefCount(formatObj);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Generate the pushes of the things to concatenate, a sequence of
+ * literals and compiled tokens (of which at least one is non-literal or
+ * we'd have the case in the first half of this function) which we will
+ * concatenate.
+ */
+
+ i = 0; /* The count of things to concat. */
+ j = 2; /* The index into the argument tokens, for
+ * TIP#280 handling. */
+ start = Tcl_GetString(formatObj);
+ /* The start of the currently-scanned literal
+ * in the format string. */
+ tmpObj = Tcl_NewObj(); /* The buffer used to accumulate the literal
+ * being built. */
+ for (bytes = start ; *bytes ; bytes++) {
+ if (*bytes == '%') {
+ Tcl_AppendToObj(tmpObj, start, bytes - start);
+ if (*++bytes == '%') {
+ Tcl_AppendToObj(tmpObj, "%", 1);
+ } else {
+ char *b = Tcl_GetStringFromObj(tmpObj, &len);
+
+ /*
+ * If there is a non-empty literal from the format string,
+ * push it and reset.
+ */
+
+ if (len > 0) {
+ PushLiteral(envPtr, b, len);
+ Tcl_DecrRefCount(tmpObj);
+ tmpObj = Tcl_NewObj();
+ i++;
+ }
+
+ /*
+ * Push the code to produce the string that would be
+ * substituted with %s, except we'll be concatenating
+ * directly.
+ */
+
+ CompileWord(envPtr, tokenPtr, interp, j);
+ tokenPtr = TokenAfter(tokenPtr);
+ j++;
+ i++;
+ }
+ start = bytes + 1;
+ }
+ }
+
+ /*
+ * Handle the case of a trailing literal.
+ */
+
+ Tcl_AppendToObj(tmpObj, start, bytes - start);
+ bytes = Tcl_GetStringFromObj(tmpObj, &len);
+ if (len > 0) {
+ PushLiteral(envPtr, bytes, len);
+ i++;
+ }
+ Tcl_DecrRefCount(tmpObj);
+ Tcl_DecrRefCount(formatObj);
+
+ if (i > 1) {
+ /*
+ * Do the concatenation, which produces the result.
+ */
+
+ TclEmitInstInt1(INST_CONCAT1, i, envPtr);
+ } else {
+ /*
+ * EVIL HACK! Force there to be a string representation in the case
+ * where there's just a "%s" in the format; case covered by the test
+ * format-20.1 (and it is horrible...)
+ */
+
+ TclEmitOpcode(INST_DUP, envPtr);
+ PushLiteral(envPtr, "", 0);
+ TclEmitOpcode(INST_STR_EQ, envPtr);
+ TclEmitOpcode(INST_POP, envPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileGlobalCmd --
*
* Procedure called to compile the "global" command.
@@ -2042,14 +3264,14 @@ TclCompileGlobalCmd(
}
CompileWord(envPtr, varTokenPtr, interp, 1);
- TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
+ TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
}
/*
* Pop the namespace, and set the result to empty
*/
- TclEmitOpcode(INST_POP, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
PushLiteral(envPtr, "", 0);
return TCL_OK;
}
@@ -2448,43 +3670,41 @@ TclCompileIncrCmd(
* Emit the instruction to increment the variable.
*/
- if (simpleVarName) {
- if (isScalar) {
- if (localIndex >= 0) {
- if (haveImmValue) {
- TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
- TclEmitInt1(immValue, envPtr);
- } else {
- TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
- }
+ if (!simpleVarName) {
+ if (haveImmValue) {
+ TclEmitInstInt1( INST_INCR_STK_IMM, immValue, envPtr);
+ } else {
+ TclEmitOpcode( INST_INCR_STK, envPtr);
+ }
+ } else if (isScalar) { /* Simple scalar variable. */
+ if (localIndex >= 0) {
+ if (haveImmValue) {
+ TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
+ TclEmitInt1(immValue, envPtr);
} else {
- if (haveImmValue) {
- TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
- } else {
- TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
- }
+ TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
}
} else {
- if (localIndex >= 0) {
- if (haveImmValue) {
- TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
- TclEmitInt1(immValue, envPtr);
- } else {
- TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
- }
+ if (haveImmValue) {
+ TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
} else {
- if (haveImmValue) {
- TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
- } else {
- TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
- }
+ TclEmitOpcode( INST_INCR_SCALAR_STK, envPtr);
}
}
- } else { /* Non-simple variable name. */
- if (haveImmValue) {
- TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
+ } else { /* Simple array variable. */
+ if (localIndex >= 0) {
+ if (haveImmValue) {
+ TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
+ TclEmitInt1(immValue, envPtr);
+ } else {
+ TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
+ }
} else {
- TclEmitOpcode(INST_INCR_STK, envPtr);
+ if (haveImmValue) {
+ TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
+ } else {
+ TclEmitOpcode( INST_INCR_ARRAY_STK, envPtr);
+ }
}
}
@@ -2494,22 +3714,105 @@ TclCompileIncrCmd(
/*
*----------------------------------------------------------------------
*
- * TclCompileInfoExistsCmd --
+ * TclCompileInfo*Cmd --
*
- * Procedure called to compile the "info exists" subcommand.
+ * Procedures called to compile "info" subcommands.
*
* Results:
* Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
* evaluation to runtime.
*
* Side effects:
- * Instructions are added to envPtr to execute the "info exists"
- * subcommand at runtime.
+ * Instructions are added to envPtr to execute the "info" subcommand at
+ * runtime.
*
*----------------------------------------------------------------------
*/
int
+TclCompileInfoCommandsCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+ Tcl_Obj *objPtr;
+ char *bytes;
+
+ /*
+ * We require one compile-time known argument for the case we can compile.
+ */
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ objPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(objPtr);
+ if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+ goto notCompilable;
+ }
+ bytes = Tcl_GetString(objPtr);
+
+ /*
+ * We require that the argument start with "::" and not have any of "*\[?"
+ * in it. (Theoretically, we should look in only the final component, but
+ * the difference is so slight given current naming practices.)
+ */
+
+ if (bytes[0] != ':' || bytes[1] != ':' || !TclMatchIsTrivial(bytes)) {
+ goto notCompilable;
+ }
+ Tcl_DecrRefCount(objPtr);
+
+ /*
+ * Confirmed as a literal that will not frighten the horses. Compile. Note
+ * that the result needs to be list-ified.
+ */
+
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr);
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_STR_LEN, envPtr);
+ TclEmitInstInt1( INST_JUMP_FALSE1, 7, envPtr);
+ TclEmitInstInt4( INST_LIST, 1, envPtr);
+ return TCL_OK;
+
+ notCompilable:
+ Tcl_DecrRefCount(objPtr);
+ return TCL_ERROR;
+}
+
+int
+TclCompileInfoCoroutineCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ /*
+ * Only compile [info coroutine] without arguments.
+ */
+
+ if (parsePtr->numWords != 1) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Not much to do; we compile to a single instruction...
+ */
+
+ TclEmitOpcode( INST_COROUTINE_NAME, envPtr);
+ return TCL_OK;
+}
+
+int
TclCompileInfoExistsCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
@@ -2542,24 +3845,134 @@ TclCompileInfoExistsCmd(
* Emit instruction to check the variable for existence.
*/
- if (simpleVarName) {
- if (isScalar) {
- if (localIndex < 0) {
- TclEmitOpcode(INST_EXIST_STK, envPtr);
- } else {
- TclEmitInstInt4(INST_EXIST_SCALAR, localIndex, envPtr);
- }
+ if (!simpleVarName) {
+ TclEmitOpcode( INST_EXIST_STK, envPtr);
+ } else if (isScalar) {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_EXIST_STK, envPtr);
} else {
- if (localIndex < 0) {
- TclEmitOpcode(INST_EXIST_ARRAY_STK, envPtr);
- } else {
- TclEmitInstInt4(INST_EXIST_ARRAY, localIndex, envPtr);
- }
+ TclEmitInstInt4( INST_EXIST_SCALAR, localIndex, envPtr);
}
} else {
- TclEmitOpcode(INST_EXIST_STK, envPtr);
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_EXIST_ARRAY_STK, envPtr);
+ } else {
+ TclEmitInstInt4( INST_EXIST_ARRAY, localIndex, envPtr);
+ }
+ }
+
+ return TCL_OK;
+}
+
+int
+TclCompileInfoLevelCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ /*
+ * Only compile [info level] without arguments or with a single argument.
+ */
+
+ if (parsePtr->numWords == 1) {
+ /*
+ * Not much to do; we compile to a single instruction...
+ */
+
+ TclEmitOpcode( INST_INFO_LEVEL_NUM, envPtr);
+ } else if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ } else {
+ DefineLineInformation; /* TIP #280 */
+
+ /*
+ * Compile the argument, then add the instruction to convert it into a
+ * list of arguments.
+ */
+
+ SetLineInformation(1);
+ CompileTokens(envPtr, TokenAfter(parsePtr->tokenPtr), interp);
+ TclEmitOpcode( INST_INFO_LEVEL_ARGS, envPtr);
}
+ return TCL_OK;
+}
+
+int
+TclCompileInfoObjectClassCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ TclEmitOpcode( INST_TCLOO_CLASS, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileInfoObjectIsACmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ /*
+ * We only handle [info object isa object <somevalue>]. The first three
+ * words are compressed to a single token by the ensemble compilation
+ * engine.
+ */
+
+ if (parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size < 1
+ || strncmp(tokenPtr[1].start, "object", tokenPtr[1].size)) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+
+ /*
+ * Issue the code.
+ */
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ TclEmitOpcode( INST_TCLOO_IS_OBJECT, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileInfoObjectNamespaceCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ TclEmitOpcode( INST_TCLOO_NS, envPtr);
return TCL_OK;
}
@@ -2647,26 +4060,20 @@ TclCompileLappendCmd(
* LOAD/STORE instructions.
*/
- if (simpleVarName) {
- if (isScalar) {
- if (localIndex < 0) {
- TclEmitOpcode(INST_LAPPEND_STK, envPtr);
- } else if (localIndex <= 255) {
- TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr);
- }
+ if (!simpleVarName) {
+ TclEmitOpcode( INST_LAPPEND_STK, envPtr);
+ } else if (isScalar) {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_LAPPEND_STK, envPtr);
} else {
- if (localIndex < 0) {
- TclEmitOpcode(INST_LAPPEND_ARRAY_STK, envPtr);
- } else if (localIndex <= 255) {
- TclEmitInstInt1(INST_LAPPEND_ARRAY1, localIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_LAPPEND_ARRAY4, localIndex, envPtr);
- }
+ Emit14Inst( INST_LAPPEND_SCALAR, localIndex, envPtr);
}
} else {
- TclEmitOpcode(INST_LAPPEND_STK, envPtr);
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_LAPPEND_ARRAY_STK, envPtr);
+ } else {
+ Emit14Inst( INST_LAPPEND_ARRAY, localIndex, envPtr);
+ }
}
return TCL_OK;
@@ -2739,50 +4146,44 @@ TclCompileLassignCmd(
* the stack and assign it to the variable.
*/
- if (simpleVarName) {
- if (isScalar) {
- if (localIndex >= 0) {
- TclEmitOpcode(INST_DUP, envPtr);
- TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
- if (localIndex <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1,localIndex,envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4,localIndex,envPtr);
- }
- } else {
- TclEmitInstInt4(INST_OVER, 1, envPtr);
- TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
- TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
- }
+ if (!simpleVarName) {
+ TclEmitInstInt4( INST_OVER, 1, envPtr);
+ TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr);
+ TclEmitOpcode( INST_STORE_STK, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ } else if (isScalar) {
+ if (localIndex >= 0) {
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
} else {
- if (localIndex >= 0) {
- TclEmitInstInt4(INST_OVER, 1, envPtr);
- TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
- if (localIndex <= 255) {
- TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
- }
- } else {
- TclEmitInstInt4(INST_OVER, 2, envPtr);
- TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
- TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
- }
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+ TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
}
} else {
- TclEmitInstInt4(INST_OVER, 1, envPtr);
- TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
- TclEmitOpcode(INST_STORE_STK, envPtr);
+ if (localIndex >= 0) {
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+ Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ } else {
+ TclEmitInstInt4(INST_OVER, 2, envPtr);
+ TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+ TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
}
- TclEmitOpcode(INST_POP, envPtr);
}
/*
* Generate code to leave the rest of the list on the stack.
*/
- TclEmitInstInt4(INST_LIST_RANGE_IMM, idx, envPtr);
- TclEmitInt4(-2, envPtr); /* -2 == "end" */
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
+ TclEmitInt4( -2 /* == "end" */, envPtr);
return TCL_OK;
}
@@ -2838,19 +4239,30 @@ TclCompileLindexCmd(
tmpObj = Tcl_NewStringObj(idxTokenPtr[1].start, idxTokenPtr[1].size);
result = TclGetIntFromObj(NULL, tmpObj, &idx);
+ if (result == TCL_OK) {
+ if (idx < 0) {
+ result = TCL_ERROR;
+ }
+ } else {
+ result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx);
+ if (result == TCL_OK && idx > -2) {
+ result = TCL_ERROR;
+ }
+ }
TclDecrRefCount(tmpObj);
- if (result == TCL_OK && idx >= 0) {
+ if (result == TCL_OK) {
/*
- * All checks have been completed, and we have exactly this
- * construct:
+ * All checks have been completed, and we have exactly one of
+ * these constructs:
* lindex <arbitraryValue> <posInt>
+ * lindex <arbitraryValue> end-<posInt>
* This is best compiled as a push of the arbitrary value followed
* by an "immediate lindex" which is the most efficient variety.
*/
CompileWord(envPtr, valTokenPtr, interp, 1);
- TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+ TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr);
return TCL_OK;
}
@@ -2876,9 +4288,9 @@ TclCompileLindexCmd(
*/
if (numWords == 3) {
- TclEmitOpcode(INST_LIST_INDEX, envPtr);
+ TclEmitOpcode( INST_LIST_INDEX, envPtr);
} else {
- TclEmitInstInt4(INST_LIST_INDEX_MULTI, numWords-1, envPtr);
+ TclEmitInstInt4( INST_LIST_INDEX_MULTI, numWords-1, envPtr);
}
return TCL_OK;
@@ -2912,6 +4324,8 @@ TclCompileListCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
+ Tcl_Token *valueTokenPtr;
+ int i, numWords;
/*
* If we're not in a procedure, don't compile.
@@ -2932,17 +4346,13 @@ TclCompileListCmd(
* Push the all values onto the stack.
*/
- Tcl_Token *valueTokenPtr;
- int i, numWords;
-
numWords = parsePtr->numWords;
-
valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
for (i = 1; i < numWords; i++) {
CompileWord(envPtr, valueTokenPtr, interp, i);
valueTokenPtr = TokenAfter(valueTokenPtr);
}
- TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
+ TclEmitInstInt4( INST_LIST, numWords - 1, envPtr);
}
return TCL_OK;
@@ -2984,7 +4394,227 @@ TclCompileLlengthCmd(
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
CompileWord(envPtr, varTokenPtr, interp, 1);
- TclEmitOpcode(INST_LIST_LENGTH, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLrangeCmd --
+ *
+ * How to compile the "lrange" command. We only bother because we needed
+ * the opcode anyway for "lassign".
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLrangeCmd(
+ Tcl_Interp *interp, /* Tcl interpreter for context. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the
+ * command. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds the resulting instructions. */
+{
+ Tcl_Token *tokenPtr, *listTokenPtr;
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Obj *tmpObj;
+ int idx1, idx2, result;
+
+ if (parsePtr->numWords != 4) {
+ return TCL_ERROR;
+ }
+ listTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ /*
+ * Parse the first index. Will only compile if it is constant and not an
+ * _integer_ less than zero (since we reserve negative indices here for
+ * end-relative indexing).
+ */
+
+ tokenPtr = TokenAfter(listTokenPtr);
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+ tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
+ result = TclGetIntFromObj(NULL, tmpObj, &idx1);
+ if (result == TCL_OK) {
+ if (idx1 < 0) {
+ result = TCL_ERROR;
+ }
+ } else {
+ result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1);
+ if (result == TCL_OK && idx1 > -2) {
+ result = TCL_ERROR;
+ }
+ }
+ TclDecrRefCount(tmpObj);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the second index. Will only compile if it is constant and not an
+ * _integer_ less than zero (since we reserve negative indices here for
+ * end-relative indexing).
+ */
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+ tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
+ result = TclGetIntFromObj(NULL, tmpObj, &idx2);
+ if (result == TCL_OK) {
+ if (idx2 < 0) {
+ result = TCL_ERROR;
+ }
+ } else {
+ result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2);
+ if (result == TCL_OK && idx2 > -2) {
+ result = TCL_ERROR;
+ }
+ }
+ TclDecrRefCount(tmpObj);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Issue instructions. It's not safe to skip doing the LIST_RANGE, as
+ * we've not proved that the 'list' argument is really a list. Not that it
+ * is worth trying to do that given current knowledge.
+ */
+
+ CompileWord(envPtr, listTokenPtr, interp, 1);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
+ TclEmitInt4( idx2, envPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLreplaceCmd --
+ *
+ * How to compile the "lreplace" command. We only bother with the case
+ * where there are no elements to insert and where both the 'first' and
+ * 'last' arguments are constant and one can be deterined to be at the
+ * end of the list. (This is the case that could also be written with
+ * "lrange".)
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLreplaceCmd(
+ Tcl_Interp *interp, /* Tcl interpreter for context. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the
+ * command. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds the resulting instructions. */
+{
+ Tcl_Token *tokenPtr, *listTokenPtr;
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Obj *tmpObj;
+ int idx1, idx2, result, guaranteedDropAll = 0;
+
+ if (parsePtr->numWords != 4) {
+ return TCL_ERROR;
+ }
+ listTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ /*
+ * Parse the first index. Will only compile if it is constant and not an
+ * _integer_ less than zero (since we reserve negative indices here for
+ * end-relative indexing).
+ */
+
+ tokenPtr = TokenAfter(listTokenPtr);
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+ tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
+ result = TclGetIntFromObj(NULL, tmpObj, &idx1);
+ if (result == TCL_OK) {
+ if (idx1 < 0) {
+ result = TCL_ERROR;
+ }
+ } else {
+ result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1);
+ if (result == TCL_OK && idx1 > -2) {
+ result = TCL_ERROR;
+ }
+ }
+ TclDecrRefCount(tmpObj);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the second index. Will only compile if it is constant and not an
+ * _integer_ less than zero (since we reserve negative indices here for
+ * end-relative indexing).
+ */
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+ tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
+ result = TclGetIntFromObj(NULL, tmpObj, &idx2);
+ if (result == TCL_OK) {
+ if (idx2 < 0) {
+ result = TCL_ERROR;
+ }
+ } else {
+ result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2);
+ if (result == TCL_OK && idx2 > -2) {
+ result = TCL_ERROR;
+ }
+ }
+ TclDecrRefCount(tmpObj);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Sanity check: can only issue when we're removing a range at one or
+ * other end of the list. If we're at one end or the other, convert the
+ * indices into the equivalent for an [lrange].
+ */
+
+ if (idx1 == 0) {
+ if (idx2 == -2) {
+ guaranteedDropAll = 1;
+ }
+ idx1 = idx2 + 1;
+ idx2 = -2;
+ } else if (idx2 == -2) {
+ idx2 = idx1 - 1;
+ idx1 = 0;
+ } else {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Issue instructions. It's not safe to skip doing the LIST_RANGE, as
+ * we've not proved that the 'list' argument is really a list. Not that it
+ * is worth trying to do that given current knowledge.
+ */
+
+ CompileWord(envPtr, listTokenPtr, interp, 1);
+ if (guaranteedDropAll) {
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ PushLiteral(envPtr, "", 0);
+ } else {
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
+ TclEmitInt4( idx2, envPtr);
+ }
return TCL_OK;
}
@@ -3090,7 +4720,7 @@ TclCompileLsetCmd(
} else {
tempDepth = parsePtr->numWords - 1;
}
- TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
+ TclEmitInstInt4( INST_OVER, tempDepth, envPtr);
}
/*
@@ -3103,7 +4733,7 @@ TclCompileLsetCmd(
} else {
tempDepth = parsePtr->numWords - 2;
}
- TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
+ TclEmitInstInt4( INST_OVER, tempDepth, envPtr);
}
/*
@@ -3111,22 +4741,18 @@ TclCompileLsetCmd(
*/
if (!simpleVarName) {
- TclEmitOpcode(INST_LOAD_STK, envPtr);
+ TclEmitOpcode( INST_LOAD_STK, envPtr);
} else if (isScalar) {
if (localIndex < 0) {
- TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
- } else if (localIndex < 0x100) {
- TclEmitInstInt1(INST_LOAD_SCALAR1, localIndex, envPtr);
+ TclEmitOpcode( INST_LOAD_SCALAR_STK, envPtr);
} else {
- TclEmitInstInt4(INST_LOAD_SCALAR4, localIndex, envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, localIndex, envPtr);
}
} else {
if (localIndex < 0) {
- TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
- } else if (localIndex < 0x100) {
- TclEmitInstInt1(INST_LOAD_ARRAY1, localIndex, envPtr);
+ TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr);
} else {
- TclEmitInstInt4(INST_LOAD_ARRAY4, localIndex, envPtr);
+ Emit14Inst( INST_LOAD_ARRAY, localIndex, envPtr);
}
}
@@ -3135,9 +4761,9 @@ TclCompileLsetCmd(
*/
if (parsePtr->numWords == 4) {
- TclEmitOpcode(INST_LSET_LIST, envPtr);
+ TclEmitOpcode( INST_LSET_LIST, envPtr);
} else {
- TclEmitInstInt4(INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
+ TclEmitInstInt4( INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
}
/*
@@ -3145,22 +4771,18 @@ TclCompileLsetCmd(
*/
if (!simpleVarName) {
- TclEmitOpcode(INST_STORE_STK, envPtr);
+ TclEmitOpcode( INST_STORE_STK, envPtr);
} else if (isScalar) {
if (localIndex < 0) {
- TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
- } else if (localIndex < 0x100) {
- TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+ TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr);
} else {
- TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
}
} else {
if (localIndex < 0) {
- TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
- } else if (localIndex < 0x100) {
- TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
+ TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr);
} else {
- TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
+ Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr);
}
}
@@ -3170,10 +4792,42 @@ TclCompileLsetCmd(
/*
*----------------------------------------------------------------------
*
- * TclCompileNamespaceCmd --
+ * TclCompileLmapCmd --
*
- * Procedure called to compile the "namespace" command; currently, only
- * the subcommand "namespace upvar" is compiled to bytecodes.
+ * Procedure called to compile the "lmap" command.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "lmap" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLmapCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr,
+ TCL_EACH_COLLECT);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileNamespace*Cmd --
+ *
+ * Procedures called to compile the "namespace" command; currently, only
+ * the subcommands "namespace current" and "namespace upvar" are compiled
+ * to bytecodes, and the latter only inside a procedure(-like) context.
*
* Results:
* Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
@@ -3187,7 +4841,7 @@ TclCompileLsetCmd(
*/
int
-TclCompileNamespaceCmd(
+TclCompileNamespaceCurrentCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
@@ -3195,30 +4849,168 @@ TclCompileNamespaceCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
- int simpleVarName, isScalar, localIndex, numWords, i;
+ /*
+ * Only compile [namespace current] without arguments.
+ */
+
+ if (parsePtr->numWords != 1) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Not much to do; we compile to a single instruction...
+ */
+
+ TclEmitOpcode( INST_NS_CURRENT, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileNamespaceCodeCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
- if (envPtr->procPtr == NULL) {
+ if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
- * Only compile [namespace upvar ...]: needs an odd number of args, >=5
+ * The specification of [namespace code] is rather shocking, in that it is
+ * supposed to check if the argument is itself the result of [namespace
+ * code] and not apply itself in that case. Which is excessively cautious,
+ * but what the test suite checks for.
*/
- numWords = parsePtr->numWords;
- if (!(numWords%2) || (numWords < 5)) {
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || (tokenPtr[1].size > 20
+ && strncmp(tokenPtr[1].start, "::namespace inscope ", 20) == 0)) {
+ /*
+ * Technically, we could just pass a literal '::namespace inscope '
+ * term through, but that's something which really shouldn't be
+ * occurring as something that the user writes so we'll just punt it.
+ */
+
return TCL_ERROR;
}
/*
- * Check if the second argument is "upvar"
+ * Now we can compile using the same strategy as [namespace code]'s normal
+ * implementation does internally. Note that we can't bind the namespace
+ * name directly here, because TclOO plays complex games with namespaces;
+ * the value needs to be determined at runtime for safety.
*/
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- if ((tokenPtr->size != 5) /* 5 == strlen("upvar") */
- || strncmp(tokenPtr->start, "upvar", 5)) {
+ PushLiteral(envPtr, "::namespace", 11);
+ PushLiteral(envPtr, "inscope", 7);
+ TclEmitOpcode( INST_NS_CURRENT, envPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ TclEmitInstInt4( INST_LIST, 4, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileNamespaceQualifiersCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ DefineLineInformation; /* TIP #280 */
+ int off;
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ PushLiteral(envPtr, "0", 1);
+ PushLiteral(envPtr, "::", 2);
+ TclEmitInstInt4( INST_OVER, 2, envPtr);
+ TclEmitOpcode( INST_STR_FIND_LAST, envPtr);
+ off = CurrentOffset(envPtr);
+ PushLiteral(envPtr, "1", 1);
+ TclEmitOpcode( INST_SUB, envPtr);
+ TclEmitInstInt4( INST_OVER, 2, envPtr);
+ TclEmitInstInt4( INST_OVER, 1, envPtr);
+ TclEmitOpcode( INST_STR_INDEX, envPtr);
+ PushLiteral(envPtr, ":", 1);
+ TclEmitOpcode( INST_STR_EQ, envPtr);
+ off = off - CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_TRUE1, off, envPtr);
+ TclEmitOpcode( INST_STR_RANGE, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileNamespaceTailCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ DefineLineInformation; /* TIP #280 */
+ JumpFixup jumpFixup;
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Take care; only add 2 to found index if the string was actually found.
+ */
+
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ PushLiteral(envPtr, "::", 2);
+ TclEmitInstInt4( INST_OVER, 1, envPtr);
+ TclEmitOpcode( INST_STR_FIND_LAST, envPtr);
+ TclEmitOpcode( INST_DUP, envPtr);
+ PushLiteral(envPtr, "0", 1);
+ TclEmitOpcode( INST_GE, envPtr);
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup);
+ PushLiteral(envPtr, "2", 1);
+ TclEmitOpcode( INST_ADD, envPtr);
+ TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127);
+ PushLiteral(envPtr, "end", 3);
+ TclEmitOpcode( INST_STR_RANGE, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileNamespaceUpvarCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
+ int simpleVarName, isScalar, localIndex, numWords, i;
+ DefineLineInformation; /* TIP #280 */
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Only compile [namespace upvar ...]: needs an even number of args, >=4
+ */
+
+ numWords = parsePtr->numWords;
+ if ((numWords % 2) || (numWords < 4)) {
return TCL_ERROR;
}
@@ -3226,7 +5018,7 @@ TclCompileNamespaceCmd(
* Push the namespace
*/
- tokenPtr = TokenAfter(tokenPtr);
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 1);
/*
@@ -3236,7 +5028,7 @@ TclCompileNamespaceCmd(
*/
localTokenPtr = tokenPtr;
- for (i=4; i<=numWords; i+=2) {
+ for (i=3; i<=numWords; i+=2) {
otherTokenPtr = TokenAfter(localTokenPtr);
localTokenPtr = TokenAfter(otherTokenPtr);
@@ -3247,17 +5039,63 @@ TclCompileNamespaceCmd(
if ((localIndex < 0) || !isScalar) {
return TCL_ERROR;
}
- TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
+ TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
}
/*
* Pop the namespace, and set the result to empty
*/
- TclEmitOpcode(INST_POP, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
PushLiteral(envPtr, "", 0);
return TCL_OK;
}
+
+int
+TclCompileNamespaceWhichCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr, *opt;
+ int idx;
+
+ if (parsePtr->numWords < 2 || parsePtr->numWords > 3) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ idx = 1;
+
+ /*
+ * If there's an option, check that it's "-command". We don't handle
+ * "-variable" (currently) and anything else is an error.
+ */
+
+ if (parsePtr->numWords == 3) {
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+ opt = tokenPtr + 1;
+ if (opt->size < 2 || opt->size > 8
+ || strncmp(opt->start, "-command", opt->size) != 0) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+ idx++;
+ }
+
+ /*
+ * Issue the bytecode.
+ */
+
+ CompileWord(envPtr, tokenPtr, interp, idx);
+ TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr);
+ return TCL_OK;
+}
/*
*----------------------------------------------------------------------
@@ -3405,9 +5243,9 @@ TclCompileRegexpCmd(
if (simple) {
if (exact && !nocase) {
- TclEmitOpcode(INST_STR_EQ, envPtr);
+ TclEmitOpcode( INST_STR_EQ, envPtr);
} else {
- TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
+ TclEmitInstInt1( INST_STR_MATCH, nocase, envPtr);
}
} else {
/*
@@ -3418,7 +5256,7 @@ TclCompileRegexpCmd(
int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);
- TclEmitInstInt1(INST_REGEXP, cflags, envPtr);
+ TclEmitInstInt1( INST_REGEXP, cflags, envPtr);
}
return TCL_OK;
@@ -3427,6 +5265,180 @@ TclCompileRegexpCmd(
/*
*----------------------------------------------------------------------
*
+ * TclCompileRegsubCmd --
+ *
+ * Procedure called to compile the "regsub" command.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "regsub" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileRegsubCmd(
+ Tcl_Interp *interp, /* Tcl interpreter for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the
+ * command. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds the resulting instructions. */
+{
+ /*
+ * We only compile the case with [regsub -all] where the pattern is both
+ * known at compile time and simple (i.e., no RE metacharacters). That is,
+ * the pattern must be translatable into a glob like "*foo*" with no other
+ * glob metacharacters inside it; there must be some "foo" in there too.
+ * The substitution string must also be known at compile time and free of
+ * metacharacters ("\digit" and "&"). Finally, there must not be a
+ * variable mentioned in the [regsub] to write the result back to (because
+ * we can't get the count of substitutions that would be the result in
+ * that case). The key is that these are the conditions under which a
+ * [string map] could be used instead, in particular a [string map] of the
+ * form we can compile to bytecode.
+ *
+ * In short, we look for:
+ *
+ * regsub -all [--] simpleRE string simpleReplacement
+ *
+ * The only optional part is the "--", and no other options are handled.
+ */
+
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr, *stringTokenPtr;
+ Tcl_Obj *patternObj = NULL, *replacementObj = NULL;
+ Tcl_DString pattern;
+ const char *bytes;
+ int len, exact, result = TCL_ERROR;
+
+ if (parsePtr->numWords < 5 || parsePtr->numWords > 6) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the "-all", which must be the first argument (other options not
+ * supported, non-"-all" substitution we can't compile).
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 4
+ || strncmp(tokenPtr[1].start, "-all", 4)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get the pattern into patternObj, checking for "--" in the process.
+ */
+
+ Tcl_DStringInit(&pattern);
+ tokenPtr = TokenAfter(tokenPtr);
+ patternObj = Tcl_NewObj();
+ if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) {
+ goto done;
+ }
+ if (Tcl_GetString(patternObj)[0] == '-') {
+ if (strcmp(Tcl_GetString(patternObj), "--") != 0
+ || parsePtr->numWords == 5) {
+ goto done;
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+ Tcl_DecrRefCount(patternObj);
+ patternObj = Tcl_NewObj();
+ if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) {
+ goto done;
+ }
+ } else if (parsePtr->numWords == 6) {
+ goto done;
+ }
+
+ /*
+ * Identify the code which produces the string to apply the substitution
+ * to (stringTokenPtr), and the replacement string (into replacementObj).
+ */
+
+ stringTokenPtr = TokenAfter(tokenPtr);
+ tokenPtr = TokenAfter(stringTokenPtr);
+ replacementObj = Tcl_NewObj();
+ if (!TclWordKnownAtCompileTime(tokenPtr, replacementObj)) {
+ goto done;
+ }
+
+ /*
+ * Next, higher-level checks. Is the RE a very simple glob? Is the
+ * replacement "simple"?
+ */
+
+ bytes = Tcl_GetStringFromObj(patternObj, &len);
+ if (TclReToGlob(NULL, bytes, len, &pattern, &exact) != TCL_OK || exact) {
+ goto done;
+ }
+ bytes = Tcl_DStringValue(&pattern);
+ if (*bytes++ != '*') {
+ goto done;
+ }
+ while (1) {
+ switch (*bytes) {
+ case '*':
+ if (bytes[1] == '\0') {
+ /*
+ * OK, we've proved there are no metacharacters except for the
+ * '*' at each end.
+ */
+
+ len = Tcl_DStringLength(&pattern) - 2;
+ if (len > 0) {
+ goto isSimpleGlob;
+ }
+
+ /*
+ * The pattern is "**"! I believe that should be impossible,
+ * but we definitely can't handle that at all.
+ */
+ }
+ case '\0': case '?': case '[': case '\\':
+ goto done;
+ }
+ bytes++;
+ }
+ isSimpleGlob:
+ for (bytes = Tcl_GetString(replacementObj); *bytes; bytes++) {
+ switch (*bytes) {
+ case '\\': case '&':
+ goto done;
+ }
+ }
+
+ /*
+ * Proved the simplicity constraints! Time to issue the code.
+ */
+
+ result = TCL_OK;
+ bytes = Tcl_DStringValue(&pattern) + 1;
+ PushLiteral(envPtr, bytes, len);
+ bytes = Tcl_GetStringFromObj(replacementObj, &len);
+ PushLiteral(envPtr, bytes, len);
+ CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords-2);
+ TclEmitOpcode( INST_STR_MAP, envPtr);
+
+ done:
+ Tcl_DStringFree(&pattern);
+ if (patternObj) {
+ Tcl_DecrRefCount(patternObj);
+ }
+ if (replacementObj) {
+ Tcl_DecrRefCount(replacementObj);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileReturnCmd --
*
* Procedure called to compile the "return" command.
@@ -3459,6 +5471,7 @@ TclCompileReturnCmd(
int numWords = parsePtr->numWords;
int explicitResult = (0 == (numWords % 2));
int numOptionWords = numWords - 1 - explicitResult;
+ int savedStackDepth = envPtr->currStackDepth;
Tcl_Obj *returnOpts, **objv;
Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
DefineLineInformation; /* TIP #280 */
@@ -3481,6 +5494,7 @@ TclCompileReturnCmd(
CompileWord(envPtr, optsTokenPtr, interp, 2);
CompileWord(envPtr, msgTokenPtr, interp, 3);
TclEmitOpcode(INST_RETURN_STK, envPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
return TCL_OK;
}
@@ -3613,9 +5627,10 @@ TclCompileSyntaxError(
int numBytes;
const char *bytes = TclGetStringFromObj(msg, &numBytes);
+ TclErrorStackResetIf(interp, bytes, numBytes);
TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
- Tcl_GetReturnOptions(interp, TCL_ERROR));
+ TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
}
/*
@@ -3715,14 +5730,14 @@ TclCompileUpvarCmd(
if ((localIndex < 0) || !isScalar) {
return TCL_ERROR;
}
- TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
+ TclEmitInstInt4( INST_UPVAR, localIndex, envPtr);
}
/*
* Pop the frame index, and set the result to empty
*/
- TclEmitOpcode(INST_POP, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
PushLiteral(envPtr, "", 0);
return TCL_OK;
}
@@ -3787,7 +5802,7 @@ TclCompileVariableCmd(
}
CompileWord(envPtr, varTokenPtr, interp, 1);
- TclEmitInstInt4(INST_VARIABLE, localIndex, envPtr);
+ TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr);
if (i != numWords) {
/*
@@ -3795,12 +5810,8 @@ TclCompileVariableCmd(
*/
CompileWord(envPtr, valueTokenPtr, interp, 1);
- if (localIndex < 0x100) {
- TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
- }
- TclEmitOpcode(INST_POP, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
}
}
@@ -3908,6 +5919,69 @@ IndexTailVarIfKnown(
return localIndex;
}
+int
+TclCompileObjectSelfCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ /*
+ * We only handle [self] and [self object] (which is the same operation).
+ * These are the only very common operations on [self] for which
+ * bytecoding is at all reasonable.
+ */
+
+ if (parsePtr->numWords == 1) {
+ goto compileSelfObject;
+ } else if (parsePtr->numWords == 2) {
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr), *subcmd;
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size==0) {
+ return TCL_ERROR;
+ }
+
+ subcmd = tokenPtr + 1;
+ if (strncmp(subcmd->start, "object", subcmd->size) == 0) {
+ goto compileSelfObject;
+ } else if (strncmp(subcmd->start, "namespace", subcmd->size) == 0) {
+ goto compileSelfNamespace;
+ }
+ }
+
+ /*
+ * Can't compile; handle with runtime call.
+ */
+
+ return TCL_ERROR;
+
+ compileSelfObject:
+
+ /*
+ * This delegates the entire problem to a single opcode.
+ */
+
+ TclEmitOpcode( INST_TCLOO_SELF, envPtr);
+ return TCL_OK;
+
+ compileSelfNamespace:
+
+ /*
+ * This is formally only correct with TclOO methods as they are currently
+ * implemented; it assumes that the current namespace is invariably when a
+ * TclOO context is present is the object's namespace, and that's
+ * technically only something that's a matter of current policy. But it
+ * avoids creating another opcode, so that's all good!
+ */
+
+ TclEmitOpcode( INST_TCLOO_SELF, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ TclEmitOpcode( INST_NS_CURRENT, envPtr);
+ return TCL_OK;
+}
+
/*
*----------------------------------------------------------------------
*
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 8fef58d..7bead0d 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -13,8 +13,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclCompCmdsSZ.c,v 1.9 2010/05/28 09:11:31 dkf Exp $
*/
#include "tclInt.h"
@@ -135,6 +133,8 @@ const AuxDataType tclJumptableInfoType = {
#define OP(name) TclEmitOpcode(INST_##name, envPtr)
#define OP1(name,val) TclEmitInstInt1(INST_##name,(val),envPtr)
#define OP4(name,val) TclEmitInstInt4(INST_##name,(val),envPtr)
+#define OP14(name,val1,val2) \
+ TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
#define OP44(name,val1,val2) \
TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
#define BODY(token,index) \
@@ -251,18 +251,18 @@ TclCompileSetCmd(
/*
*----------------------------------------------------------------------
*
- * TclCompileStringCmpCmd --
+ * TclCompileString*Cmd --
*
- * Procedure called to compile the simplest and most common form of the
- * "string compare" command.
+ * Procedures called to compile various subcommands of the "string"
+ * command.
*
* Results:
* Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
* evaluation to runtime.
*
* Side effects:
- * Instructions are added to envPtr to execute the "string compare"
- * command at runtime.
+ * Instructions are added to envPtr to execute the "string" command at
+ * runtime.
*
*----------------------------------------------------------------------
*/
@@ -298,25 +298,6 @@ TclCompileStringCmpCmd(
TclEmitOpcode(INST_STR_CMP, envPtr);
return TCL_OK;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileStringEqualCmd --
- *
- * Procedure called to compile the simplest and most common form of the
- * "string equal" command.
- *
- * Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
- *
- * Side effects:
- * Instructions are added to envPtr to execute the "string equal" command
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
int
TclCompileStringEqualCmd(
@@ -349,25 +330,70 @@ TclCompileStringEqualCmd(
TclEmitOpcode(INST_STR_EQ, envPtr);
return TCL_OK;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileStringIndexCmd --
- *
- * Procedure called to compile the simplest and most common form of the
- * "string index" command.
- *
- * Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
- *
- * Side effects:
- * Instructions are added to envPtr to execute the "string index" command
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
+
+int
+TclCompileStringFirstCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+
+ /*
+ * We don't support any flags; the bytecode isn't that sophisticated.
+ */
+
+ if (parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Push the two operands onto the stack and then the test.
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ OP(STR_FIND);
+ return TCL_OK;
+}
+
+int
+TclCompileStringLastCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+
+ /*
+ * We don't support any flags; the bytecode isn't that sophisticated.
+ */
+
+ if (parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Push the two operands onto the stack and then the test.
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ OP(STR_FIND_LAST);
+ return TCL_OK;
+}
int
TclCompileStringIndexCmd(
@@ -396,25 +422,6 @@ TclCompileStringIndexCmd(
TclEmitOpcode(INST_STR_INDEX, envPtr);
return TCL_OK;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileStringMatchCmd --
- *
- * Procedure called to compile the simplest and most common form of the
- * "string match" command.
- *
- * Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
- *
- * Side effects:
- * Instructions are added to envPtr to execute the "string match" command
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
int
TclCompileStringMatchCmd(
@@ -496,25 +503,6 @@ TclCompileStringMatchCmd(
}
return TCL_OK;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileStringLenCmd --
- *
- * Procedure called to compile the simplest and most common form of the
- * "string length" command.
- *
- * Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
- *
- * Side effects:
- * Instructions are added to envPtr to execute the "string length"
- * command at runtime.
- *
- *----------------------------------------------------------------------
- */
int
TclCompileStringLenCmd(
@@ -555,6 +543,158 @@ TclCompileStringLenCmd(
TclDecrRefCount(objPtr);
return TCL_OK;
}
+
+int
+TclCompileStringMapCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *mapTokenPtr, *stringTokenPtr;
+ Tcl_Obj *mapObj, **objv;
+ char *bytes;
+ int len;
+
+ /*
+ * We only handle the case:
+ *
+ * string map {foo bar} $thing
+ *
+ * That is, a literal two-element list (doesn't need to be brace-quoted,
+ * but does need to be compile-time knowable) and any old argument (the
+ * thing to map).
+ */
+
+ if (parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+ mapTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ stringTokenPtr = TokenAfter(mapTokenPtr);
+ mapObj = Tcl_NewObj();
+ Tcl_IncrRefCount(mapObj);
+ if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) {
+ Tcl_DecrRefCount(mapObj);
+ return TCL_ERROR;
+ } else if (Tcl_ListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) {
+ Tcl_DecrRefCount(mapObj);
+ return TCL_ERROR;
+ } else if (len != 2) {
+ Tcl_DecrRefCount(mapObj);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now issue the opcodes. Note that in the case that we know that the
+ * first word is an empty word, we don't issue the map at all. That is the
+ * correct semantics for mapping.
+ */
+
+ bytes = Tcl_GetStringFromObj(objv[0], &len);
+ if (len == 0) {
+ CompileWord(envPtr, stringTokenPtr, interp, 2);
+ } else {
+ PushLiteral(envPtr, bytes, len);
+ bytes = Tcl_GetStringFromObj(objv[1], &len);
+ PushLiteral(envPtr, bytes, len);
+ CompileWord(envPtr, stringTokenPtr, interp, 2);
+ OP(STR_MAP);
+ }
+ Tcl_DecrRefCount(mapObj);
+ return TCL_OK;
+}
+
+int
+TclCompileStringRangeCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr;
+ Tcl_Obj *tmpObj;
+ int idx1, idx2, result;
+
+ if (parsePtr->numWords != 4) {
+ return TCL_ERROR;
+ }
+ stringTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ fromTokenPtr = TokenAfter(stringTokenPtr);
+ toTokenPtr = TokenAfter(fromTokenPtr);
+
+ /*
+ * Parse the first index. Will only compile if it is constant and not an
+ * _integer_ less than zero (since we reserve negative indices here for
+ * end-relative indexing).
+ */
+
+ tmpObj = Tcl_NewObj();
+ result = TCL_ERROR;
+ if (TclWordKnownAtCompileTime(fromTokenPtr, tmpObj)) {
+ if (TclGetIntFromObj(NULL, tmpObj, &idx1) == TCL_OK) {
+ if (idx1 >= 0) {
+ result = TCL_OK;
+ }
+ } else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx1) == TCL_OK) {
+ if (idx1 <= -2) {
+ result = TCL_OK;
+ }
+ }
+ }
+ TclDecrRefCount(tmpObj);
+ if (result != TCL_OK) {
+ goto nonConstantIndices;
+ }
+
+ /*
+ * Parse the second index. Will only compile if it is constant and not an
+ * _integer_ less than zero (since we reserve negative indices here for
+ * end-relative indexing).
+ */
+
+ tmpObj = Tcl_NewObj();
+ result = TCL_ERROR;
+ if (TclWordKnownAtCompileTime(toTokenPtr, tmpObj)) {
+ if (TclGetIntFromObj(NULL, tmpObj, &idx2) == TCL_OK) {
+ if (idx2 >= 0) {
+ result = TCL_OK;
+ }
+ } else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx2) == TCL_OK) {
+ if (idx2 <= -2) {
+ result = TCL_OK;
+ }
+ }
+ }
+ TclDecrRefCount(tmpObj);
+ if (result != TCL_OK) {
+ goto nonConstantIndices;
+ }
+
+ /*
+ * Push the operand onto the stack and then the substring operation.
+ */
+
+ CompileWord(envPtr, stringTokenPtr, interp, 1);
+ OP44( STR_RANGE_IMM, idx1, idx2);
+ return TCL_OK;
+
+ /*
+ * Push the operands onto the stack and then the substring operation.
+ */
+
+ nonConstantIndices:
+ CompileWord(envPtr, stringTokenPtr, interp, 1);
+ CompileWord(envPtr, fromTokenPtr, interp, 2);
+ CompileWord(envPtr, toTokenPtr, interp, 3);
+ OP( STR_RANGE);
+ return TCL_OK;
+}
/*
*----------------------------------------------------------------------
@@ -690,19 +830,48 @@ TclSubstCompile(
count++;
continue;
case TCL_TOKEN_BS:
- length = Tcl_UtfBackslash(tokenPtr->start, NULL, buf);
+ length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
+ NULL, buf);
literal = TclRegisterNewLiteral(envPtr, buf, length);
TclEmitPush(literal, envPtr);
count++;
continue;
+ case TCL_TOKEN_VARIABLE:
+ /*
+ * Check for simple variable access; see if we can only generate
+ * TCL_OK or TCL_ERROR from the substituted variable read; if so,
+ * there is no need to generate elaborate exception-management
+ * code. Note that the first component of TCL_TOKEN_VARIABLE is
+ * always TCL_TOKEN_TEXT...
+ */
+
+ if (tokenPtr->numComponents > 1) {
+ int i, foundCommand = 0;
+
+ for (i=2 ; i<=tokenPtr->numComponents ; i++) {
+ if (tokenPtr[i].type == TCL_TOKEN_COMMAND) {
+ foundCommand = 1;
+ break;
+ }
+ }
+ if (foundCommand) {
+ break;
+ }
+ }
+
+ envPtr->line = bline;
+ TclCompileVarSubst(interp, tokenPtr, envPtr);
+ bline = envPtr->line;
+ count++;
+ continue;
}
while (count > 255) {
- TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+ OP1( CONCAT1, 255);
count -= 254;
}
if (count > 1) {
- TclEmitInstInt1(INST_CONCAT1, count, envPtr);
+ OP1( CONCAT1, count);
count = 1;
}
@@ -717,13 +886,13 @@ TclSubstCompile(
/* Start */
if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) {
Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d",
- CurrentOffset(envPtr) - startFixup.codeOffset);
+ (int) (CurrentOffset(envPtr) - startFixup.codeOffset));
}
}
envPtr->line = bline;
catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
- TclEmitInstInt4(INST_BEGIN_CATCH4, catchRange, envPtr);
+ OP4( BEGIN_CATCH4, catchRange);
ExceptionRangeStarts(envPtr, catchRange);
switch (tokenPtr->type) {
@@ -744,20 +913,20 @@ TclSubstCompile(
ExceptionRangeEnds(envPtr, catchRange);
/* Substitution produced TCL_OK */
- TclEmitOpcode(INST_END_CATCH, envPtr);
+ OP( END_CATCH);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup);
/* Exceptional return codes processed here */
ExceptionRangeTarget(envPtr, catchRange, catchOffset);
- TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
- TclEmitOpcode(INST_PUSH_RESULT, envPtr);
- TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
- TclEmitOpcode(INST_END_CATCH, envPtr);
- TclEmitOpcode(INST_RETURN_CODE_BRANCH, envPtr);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( PUSH_RESULT);
+ OP( PUSH_RETURN_CODE);
+ OP( END_CATCH);
+ OP( RETURN_CODE_BRANCH);
/* ERROR -> reraise it */
- TclEmitOpcode(INST_RETURN_STK, envPtr);
- TclEmitOpcode(INST_NOP, envPtr);
+ OP( RETURN_STK);
+ OP( NOP);
/* RETURN */
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &returnFixup);
@@ -774,43 +943,43 @@ TclSubstCompile(
/* BREAK destination */
if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) {
Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d",
- CurrentOffset(envPtr) - breakFixup.codeOffset);
+ (int) (CurrentOffset(envPtr) - breakFixup.codeOffset));
}
- TclEmitOpcode(INST_POP, envPtr);
- TclEmitOpcode(INST_POP, envPtr);
+ OP( POP);
+ OP( POP);
breakJump = CurrentOffset(envPtr) - breakOffset;
if (breakJump > 127) {
- TclEmitInstInt4(INST_JUMP4, -breakJump, envPtr);
+ OP4(JUMP4, -breakJump);
} else {
- TclEmitInstInt1(INST_JUMP1, -breakJump, envPtr);
+ OP1(JUMP1, -breakJump);
}
/* CONTINUE destination */
if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) {
Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d",
- CurrentOffset(envPtr) - continueFixup.codeOffset);
+ (int) (CurrentOffset(envPtr) - continueFixup.codeOffset));
}
- TclEmitOpcode(INST_POP, envPtr);
- TclEmitOpcode(INST_POP, envPtr);
+ OP( POP);
+ OP( POP);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup);
/* RETURN + other destination */
if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) {
Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d",
- CurrentOffset(envPtr) - returnFixup.codeOffset);
+ (int) (CurrentOffset(envPtr) - returnFixup.codeOffset));
}
if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) {
Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d",
- CurrentOffset(envPtr) - otherFixup.codeOffset);
+ (int) (CurrentOffset(envPtr) - otherFixup.codeOffset));
}
/*
* Pull the result to top of stack, discard options dict.
*/
- TclEmitInstInt4(INST_REVERSE, 2, envPtr);
- TclEmitOpcode(INST_POP, envPtr);
+ OP4( REVERSE, 2);
+ OP( POP);
/*
* We've emitted several POP instructions, and the automatic
@@ -826,28 +995,27 @@ TclSubstCompile(
/* OK destination */
if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) {
Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d",
- CurrentOffset(envPtr) - okFixup.codeOffset);
+ (int) (CurrentOffset(envPtr) - okFixup.codeOffset));
}
if (count > 1) {
- TclEmitInstInt1(INST_CONCAT1, count, envPtr);
+ OP1(CONCAT1, count);
count = 1;
}
/* CONTINUE jump to here */
if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) {
Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d",
- CurrentOffset(envPtr) - endFixup.codeOffset);
+ (int) (CurrentOffset(envPtr) - endFixup.codeOffset));
}
bline = envPtr->line;
}
-
while (count > 255) {
- TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+ OP1( CONCAT1, 255);
count -= 254;
}
if (count > 1) {
- TclEmitInstInt1(INST_CONCAT1, count, envPtr);
+ OP1( CONCAT1, count);
}
Tcl_FreeParse(&parse);
@@ -855,6 +1023,7 @@ TclSubstCompile(
if (state != NULL) {
Tcl_RestoreInterpState(interp, state);
TclCompileSyntaxError(interp, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
}
/* Final target of the multi-jump from all BREAKs */
@@ -898,9 +1067,11 @@ TclCompileSwitchCmd(
{
Tcl_Token *tokenPtr; /* Pointer to tokens in command. */
int numWords; /* Number of words in command. */
+
Tcl_Token *valueTokenPtr; /* Token for the value to switch on. */
enum {Switch_Exact, Switch_Glob, Switch_Regexp} mode;
/* What kind of switch are we doing? */
+
Tcl_Token *bodyTokenArray; /* Array of real pattern list items. */
Tcl_Token **bodyToken; /* Array of pointers to pattern list items. */
int *bodyLines; /* Array of line numbers for body list
@@ -908,7 +1079,6 @@ TclCompileSwitchCmd(
int **bodyContLines; /* Array of continuation line info. */
int noCase; /* Has the -nocase flag been given? */
int foundMode = 0; /* Have we seen a mode flag yet? */
- int isListedArms = 0;
int i, valueIndex;
int result = TCL_ERROR;
DefineLineInformation; /* TIP #280 */
@@ -1049,130 +1219,71 @@ TclCompileSwitchCmd(
*/
if (numWords == 1) {
- Tcl_DString bodyList;
- const char **argv = NULL, *tokenStartPtr, *p;
+ const char *bytes;
+ int maxLen, numBytes;
int bline; /* TIP #280: line of the pattern/action list,
* and start of list for when tracking the
* location. This list comes immediately after
* the value we switch on. */
- int isTokenBraced;
-
- /*
- * Test that we've got a suitable body list as a simple (i.e. braced)
- * word, and that the elements of the body are simple words too. This
- * is really rather nasty indeed.
- */
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
+ bytes = tokenPtr[1].start;
+ numBytes = tokenPtr[1].size;
- Tcl_DStringInit(&bodyList);
- Tcl_DStringAppend(&bodyList, tokenPtr[1].start, tokenPtr[1].size);
- if (Tcl_SplitList(NULL, Tcl_DStringValue(&bodyList), &numWords,
- &argv) != TCL_OK) {
- Tcl_DStringFree(&bodyList);
+ /* Allocate enough space to work in. */
+ maxLen = TclMaxListLength(bytes, numBytes, NULL);
+ if (maxLen < 2) {
return TCL_ERROR;
}
- Tcl_DStringFree(&bodyList);
-
- /*
- * Now we know what the switch arms are, we've got to see whether we
- * can synthesize tokens for the arms. First check whether we've got a
- * valid number of arms since we can do that now.
- */
-
- if (numWords == 0 || numWords % 2) {
- ckfree((char *) argv);
- return TCL_ERROR;
- }
-
- isListedArms = 1;
- bodyTokenArray = (Tcl_Token *) ckalloc(sizeof(Tcl_Token) * numWords);
- bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
- bodyLines = (int *) ckalloc(sizeof(int) * numWords);
- bodyContLines = (int **) ckalloc(sizeof(int*) * numWords);
-
- /*
- * Locate the start of the arms within the overall word.
- */
+ bodyTokenArray = ckalloc(sizeof(Tcl_Token) * maxLen);
+ bodyToken = ckalloc(sizeof(Tcl_Token *) * maxLen);
+ bodyLines = ckalloc(sizeof(int) * maxLen);
+ bodyContLines = ckalloc(sizeof(int*) * maxLen);
bline = mapPtr->loc[eclIndex].line[valueIndex+1];
- p = tokenStartPtr = tokenPtr[1].start;
- while (isspace(UCHAR(*tokenStartPtr))) {
- tokenStartPtr++;
- }
- if (*tokenStartPtr == '{') {
- tokenStartPtr++;
- isTokenBraced = 1;
- } else {
- isTokenBraced = 0;
- }
-
- /*
- * TIP #280: Count lines within the literal list.
- */
-
- for (i=0 ; i<numWords ; i++) {
- bodyTokenArray[i].type = TCL_TOKEN_TEXT;
- bodyTokenArray[i].start = tokenStartPtr;
- bodyTokenArray[i].size = strlen(argv[i]);
- bodyTokenArray[i].numComponents = 0;
- bodyToken[i] = bodyTokenArray+i;
- tokenStartPtr += bodyTokenArray[i].size;
+ numWords = 0;
- /*
- * Test to see if we have guessed the end of the word correctly;
- * if not, we can't feed the real string to the sub-compilation
- * engine, and we're then stuck and so have to punt out to doing
- * everything at runtime.
- */
+ while (numBytes > 0) {
+ const char *prevBytes = bytes;
+ int literal;
- if ((isTokenBraced && *(tokenStartPtr++) != '}') ||
- (tokenStartPtr < tokenPtr[1].start+tokenPtr[1].size
- && !isspace(UCHAR(*tokenStartPtr)))) {
- ckfree((char *) argv);
- goto freeTemporaries;
+ if (TCL_OK != TclFindElement(NULL, bytes, numBytes,
+ &(bodyTokenArray[numWords].start), &bytes,
+ &(bodyTokenArray[numWords].size), &literal) || !literal) {
+ goto abort;
}
+ bodyTokenArray[numWords].type = TCL_TOKEN_TEXT;
+ bodyTokenArray[numWords].numComponents = 0;
+ bodyToken[numWords] = bodyTokenArray + numWords;
+
/*
* TIP #280: Now determine the line the list element starts on
* (there is no need to do it earlier, due to the possibility of
* aborting, see above).
*/
- TclAdvanceLines(&bline, p, bodyTokenArray[i].start);
+ TclAdvanceLines(&bline, prevBytes, bodyTokenArray[numWords].start);
TclAdvanceContinuations(&bline, &clNext,
- bodyTokenArray[i].start - envPtr->source);
- bodyLines[i] = bline;
- bodyContLines[i] = clNext;
- p = bodyTokenArray[i].start;
-
- while (isspace(UCHAR(*tokenStartPtr))) {
- tokenStartPtr++;
- if (tokenStartPtr >= tokenPtr[1].start+tokenPtr[1].size) {
- break;
- }
- }
- if (*tokenStartPtr == '{') {
- tokenStartPtr++;
- isTokenBraced = 1;
- } else {
- isTokenBraced = 0;
- }
- }
- ckfree((char *) argv);
-
- /*
- * Check that we've parsed everything we thought we were going to
- * parse. If not, something odd is going on (I believe it is possible
- * to defeat the code above) and we should bail out.
- */
-
- if (tokenStartPtr != tokenPtr[1].start+tokenPtr[1].size) {
- goto freeTemporaries;
+ bodyTokenArray[numWords].start - envPtr->source);
+ bodyLines[numWords] = bline;
+ bodyContLines[numWords] = clNext;
+ TclAdvanceLines(&bline, bodyTokenArray[numWords].start, bytes);
+ TclAdvanceContinuations(&bline, &clNext, bytes - envPtr->source);
+
+ numBytes -= (bytes - prevBytes);
+ numWords++;
+ }
+ if (numWords % 2) {
+ abort:
+ ckfree((char *) bodyToken);
+ ckfree((char *) bodyTokenArray);
+ ckfree((char *) bodyLines);
+ ckfree((char *) bodyContLines);
+ return TCL_ERROR;
}
-
} else if (numWords % 2 || numWords == 0) {
/*
* Odd number of words (>1) available, or no words at all available.
@@ -1188,9 +1299,9 @@ TclCompileSwitchCmd(
* Multi-word definition of patterns & actions.
*/
- bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
- bodyLines = (int *) ckalloc(sizeof(int) * numWords);
- bodyContLines = (int **) ckalloc(sizeof(int*) * numWords);
+ bodyToken = ckalloc(sizeof(Tcl_Token *) * numWords);
+ bodyLines = ckalloc(sizeof(int) * numWords);
+ bodyContLines = ckalloc(sizeof(int*) * numWords);
bodyTokenArray = NULL;
for (i=0 ; i<numWords ; i++) {
/*
@@ -1199,8 +1310,7 @@ TclCompileSwitchCmd(
* traces, etc.
*/
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
- tokenPtr->numComponents != 1) {
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
goto freeTemporaries;
}
bodyToken[i] = tokenPtr+1;
@@ -1233,7 +1343,7 @@ TclCompileSwitchCmd(
* but it handles the most common case well enough.
*/
- if ((isListedArms) && (mode == Switch_Exact) && (!noCase)) {
+ if (mode == Switch_Exact) {
IssueSwitchJumpTable(interp, envPtr, mapPtr, eclIndex, valueIndex,
valueTokenPtr, numWords, bodyToken, bodyLines, bodyContLines);
} else {
@@ -1248,11 +1358,11 @@ TclCompileSwitchCmd(
*/
freeTemporaries:
- ckfree((char *) bodyToken);
- ckfree((char *) bodyLines);
- ckfree((char *) bodyContLines);
+ ckfree(bodyToken);
+ ckfree(bodyLines);
+ ckfree(bodyContLines);
if (bodyTokenArray != NULL) {
- ckfree((char *) bodyTokenArray);
+ ckfree(bodyTokenArray);
}
return result;
}
@@ -1337,14 +1447,14 @@ IssueSwitchChainedTests(
switch (mode) {
case Switch_Exact:
- TclEmitOpcode(INST_DUP, envPtr);
+ OP( DUP);
TclCompileTokens(interp, bodyToken[i], 1, envPtr);
- TclEmitOpcode(INST_STR_EQ, envPtr);
+ OP( STR_EQ);
break;
case Switch_Glob:
TclCompileTokens(interp, bodyToken[i], 1, envPtr);
- TclEmitInstInt4(INST_OVER, 1, envPtr);
- TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr);
+ OP4( OVER, 1);
+ OP1( STR_MATCH, noCase);
break;
case Switch_Regexp:
simple = exact = 0;
@@ -1383,7 +1493,7 @@ IssueSwitchChainedTests(
TclCompileTokens(interp, bodyToken[i], 1, envPtr);
}
- TclEmitInstInt4(INST_OVER, 1, envPtr);
+ OP4( OVER, 1);
if (!simple) {
/*
* Pass correct RE compile flags. We use only Int1
@@ -1395,11 +1505,11 @@ IssueSwitchChainedTests(
int cflags = TCL_REG_ADVANCED
| (noCase ? TCL_REG_NOCASE : 0);
- TclEmitInstInt1(INST_REGEXP, cflags, envPtr);
+ OP1(REGEXP, cflags);
} else if (exact && !noCase) {
- TclEmitOpcode(INST_STR_EQ, envPtr);
+ OP( STR_EQ);
} else {
- TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr);
+ OP1(STR_MATCH, noCase);
}
break;
default:
@@ -1464,7 +1574,7 @@ IssueSwitchChainedTests(
* pattern.
*/
- TclEmitOpcode(INST_POP, envPtr);
+ OP( POP);
envPtr->currStackDepth = savedStackDepth + 1;
envPtr->line = bodyLines[i+1]; /* TIP #280 */
envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */
@@ -1486,7 +1596,7 @@ IssueSwitchChainedTests(
*/
if (!foundDefault) {
- TclEmitOpcode(INST_POP, envPtr);
+ OP( POP);
PushLiteral(envPtr, "", 0);
}
@@ -1558,6 +1668,7 @@ IssueSwitchJumpTable(
int **bodyContLines) /* Array of continuation line info. */
{
JumptableInfo *jtPtr;
+ int savedStackDepth = envPtr->currStackDepth;
int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
int mustGenerate, foundDefault, jumpToDefault, i;
Tcl_DString buffer;
@@ -1580,7 +1691,7 @@ IssueSwitchJumpTable(
* Start by allocating the jump table itself, plus some workspace.
*/
- jtPtr = (JumptableInfo *) ckalloc(sizeof(JumptableInfo));
+ jtPtr = ckalloc(sizeof(JumptableInfo));
Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
finalFixups = TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2));
@@ -1597,9 +1708,9 @@ IssueSwitchJumpTable(
*/
jumpLocation = CurrentOffset(envPtr);
- TclEmitInstInt4(INST_JUMP_TABLE, infoIndex, envPtr);
+ OP4( JUMP_TABLE, infoIndex);
jumpToDefault = CurrentOffset(envPtr);
- TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+ OP4( JUMP4, 0);
for (i=0 ; i<numBodyTokens ; i+=2) {
/*
@@ -1618,8 +1729,7 @@ IssueSwitchJumpTable(
*/
Tcl_DStringInit(&buffer);
- Tcl_DStringAppend(&buffer, bodyToken[i]->start,
- bodyToken[i]->size);
+ TclDStringAppendToken(&buffer, bodyToken[i]);
hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable,
Tcl_DStringValue(&buffer), &isNew);
if (isNew) {
@@ -1671,6 +1781,7 @@ IssueSwitchJumpTable(
* Compile the body of the arm.
*/
+ envPtr->currStackDepth = savedStackDepth;
envPtr->line = bodyLines[i+1]; /* TIP #280 */
envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */
TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
@@ -1691,7 +1802,7 @@ IssueSwitchJumpTable(
* rewriting when we fixed this all up.
*/
- TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+ OP4( JUMP4, 0);
}
}
@@ -1702,6 +1813,7 @@ IssueSwitchJumpTable(
*/
if (!foundDefault) {
+ envPtr->currStackDepth = savedStackDepth;
TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
envPtr->codeStart+jumpToDefault+1);
PushLiteral(envPtr, "", 0);
@@ -1722,6 +1834,7 @@ IssueSwitchJumpTable(
*/
TclStackFree(interp, finalFixups);
+ envPtr->currStackDepth = savedStackDepth + 1;
}
/*
@@ -1750,8 +1863,7 @@ DupJumptableInfo(
ClientData clientData)
{
JumptableInfo *jtPtr = clientData;
- JumptableInfo *newJtPtr = (JumptableInfo *)
- ckalloc(sizeof(JumptableInfo));
+ JumptableInfo *newJtPtr = ckalloc(sizeof(JumptableInfo));
Tcl_HashEntry *hPtr, *newHPtr;
Tcl_HashSearch search;
int isNew;
@@ -1773,7 +1885,7 @@ FreeJumptableInfo(
JumptableInfo *jtPtr = clientData;
Tcl_DeleteHashTable(&jtPtr->hashTable);
- ckfree((char *) jtPtr);
+ ckfree(jtPtr);
}
static void
@@ -1808,6 +1920,50 @@ PrintJumptableInfo(
/*
*----------------------------------------------------------------------
*
+ * TclCompileTailcallCmd --
+ *
+ * Procedure called to compile the "tailcall" command.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "tailcall" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileTailcallCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ int i;
+
+ if (parsePtr->numWords < 2 || parsePtr->numWords > 256
+ || envPtr->procPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ for (i=1 ; i<parsePtr->numWords ; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+ TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords-1, envPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileThrowCmd --
*
* Procedure called to compile the "throw" command.
@@ -1834,6 +1990,7 @@ TclCompileThrowCmd(
{
DefineLineInformation; /* TIP #280 */
int numWords = parsePtr->numWords;
+ int savedStackDepth = envPtr->currStackDepth;
Tcl_Token *codeToken, *msgToken;
Tcl_Obj *objPtr;
@@ -1863,6 +2020,8 @@ TclCompileThrowCmd(
CompileWord(envPtr, msgToken, interp, 2);
TclCompileSyntaxError(interp, envPtr);
+ Tcl_DecrRefCount(objPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
return TCL_OK;
}
if (len == 0) {
@@ -1883,6 +2042,7 @@ TclCompileThrowCmd(
PushLiteral(envPtr, string, len);
TclDecrRefCount(dictPtr);
OP44( RETURN_IMM, 1, 0);
+ envPtr->currStackDepth = savedStackDepth + 1;
} else {
/*
* When the code token is not known at compilation time, we need to do
@@ -1911,6 +2071,7 @@ TclCompileThrowCmd(
PUSH( "");
OP44( RETURN_IMM, 1, 0);
}
+ envPtr->currStackDepth = savedStackDepth + 1;
TclDecrRefCount(objPtr);
return TCL_OK;
}
@@ -2178,6 +2339,7 @@ IssueTryInstructions(
{
DefineLineInformation; /* TIP #280 */
int range, resultVar, optionsVar;
+ int savedStackDepth = envPtr->currStackDepth;
int i, j, len, forwardsNeedFixing = 0;
int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
char buf[TCL_INTEGER_SPACE];
@@ -2239,6 +2401,7 @@ IssueTryInstructions(
LOAD( optionsVar);
PUSH( "-errorcode");
OP4( DICT_GET, 1);
+ TclAdjustStackDepth(-1, envPtr);
OP44( LIST_RANGE_IMM, 0, len-1);
PUSH( TclGetString(matchClauses[i]));
OP( STR_EQ);
@@ -2279,6 +2442,7 @@ IssueTryInstructions(
forwardsToFix[j] = -1;
}
}
+ envPtr->currStackDepth = savedStackDepth;
BODY( handlerTokens[i], 5+i*4);
}
@@ -2310,6 +2474,7 @@ IssueTryInstructions(
}
TclStackFree(interp, forwardsToFix);
TclStackFree(interp, addrsToFix);
+ envPtr->currStackDepth = savedStackDepth + 1;
return TCL_OK;
}
@@ -2346,6 +2511,7 @@ IssueTryFinallyInstructions(
range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
OP4( BEGIN_CATCH4, range);
ExceptionRangeStarts(envPtr, range);
+ envPtr->currStackDepth = savedStackDepth;
BODY( bodyToken, 1);
ExceptionRangeEnds(envPtr, range);
PUSH( "0");
@@ -2390,6 +2556,7 @@ IssueTryFinallyInstructions(
LOAD( optionsVar);
PUSH( "-errorcode");
OP4( DICT_GET, 1);
+ TclAdjustStackDepth(-1, envPtr);
OP44( LIST_RANGE_IMM, 0, len-1);
PUSH( TclGetString(matchClauses[i]));
OP( STR_EQ);
@@ -2462,6 +2629,7 @@ IssueTryFinallyInstructions(
}
OP4( BEGIN_CATCH4, range);
}
+ envPtr->currStackDepth = savedStackDepth;
BODY( handlerTokens[i], 5+i*4);
ExceptionRangeEnds(envPtr, range);
OP( PUSH_RETURN_OPTIONS);
@@ -2513,7 +2681,6 @@ IssueTryFinallyInstructions(
*/
OP( POP);
- envPtr->currStackDepth = savedStackDepth;
/*
* Process the finally clause (at last!) Note that we do not wrap this in
@@ -2523,11 +2690,13 @@ IssueTryFinallyInstructions(
* next command (or some inter-command manipulation).
*/
+ envPtr->currStackDepth = savedStackDepth;
BODY( finallyToken, 3 + 4*numHandlers);
OP( POP);
LOAD( optionsVar);
LOAD( resultVar);
OP( RETURN_STK);
+ envPtr->currStackDepth = savedStackDepth + 1;
return TCL_OK;
}
@@ -2586,6 +2755,7 @@ TclCompileUnsetCmd(
* evaluation with reasonable effort, so spill to interpreted version.
*/
+ TclDecrRefCount(leadingWord);
return TCL_ERROR;
}
TclDecrRefCount(leadingWord);
@@ -2607,20 +2777,18 @@ TclCompileUnsetCmd(
*/
if (!simpleVarName) {
- TclEmitInstInt1( INST_UNSET_STK, flags, envPtr);
+ OP1( UNSET_STK, flags);
} else if (isScalar) {
if (localIndex < 0) {
- TclEmitInstInt1(INST_UNSET_STK, flags, envPtr);
+ OP1( UNSET_STK, flags);
} else {
- TclEmitInstInt1(INST_UNSET_SCALAR, flags, envPtr);
- TclEmitInt4( localIndex, envPtr);
+ OP14( UNSET_SCALAR, flags, localIndex);
}
} else {
if (localIndex < 0) {
- TclEmitInstInt1(INST_UNSET_ARRAY_STK, flags, envPtr);
+ OP1( UNSET_ARRAY_STK, flags);
} else {
- TclEmitInstInt1(INST_UNSET_ARRAY, flags, envPtr);
- TclEmitInt4( localIndex, envPtr);
+ OP14( UNSET_ARRAY, flags, localIndex);
}
}
@@ -2757,7 +2925,7 @@ TclCompileWhileCmd(
CompileBody(envPtr, bodyTokenPtr, interp);
ExceptionRangeEnds(envPtr, range);
envPtr->currStackDepth = savedStackDepth + 1;
- TclEmitOpcode(INST_POP, envPtr);
+ OP( POP);
/*
* Compile the test expression then emit the conditional jump that
@@ -2812,6 +2980,49 @@ TclCompileWhileCmd(
/*
*----------------------------------------------------------------------
*
+ * TclCompileYieldCmd --
+ *
+ * Procedure called to compile the "yield" command.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "yield" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileYieldCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ if (parsePtr->numWords < 1 || parsePtr->numWords > 2) {
+ return TCL_ERROR;
+ }
+
+ if (parsePtr->numWords == 1) {
+ PushLiteral(envPtr, "", 0);
+ } else {
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ CompileWord(envPtr, valueTokenPtr, interp, 1);
+ }
+ OP( YIELD);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* PushVarName --
*
* Procedure used in the compiling where pushing a variable name is
@@ -3134,7 +3345,7 @@ CompileAssociativeBinaryOpCmd(
* calcuations, including roundoff errors.
*/
- TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
+ OP4( REVERSE, words-1);
}
while (--words > 1) {
TclEmitOpcode(instruction, envPtr);
@@ -3225,31 +3436,19 @@ CompileComparisonOpCmd(
CompileWord(envPtr, tokenPtr, interp, 1);
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 2);
- if (tmpIndex <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
- }
+ STORE(tmpIndex);
TclEmitOpcode(instruction, envPtr);
for (words=3 ; words<parsePtr->numWords ;) {
- if (tmpIndex <= 255) {
- TclEmitInstInt1(INST_LOAD_SCALAR1, tmpIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_LOAD_SCALAR4, tmpIndex, envPtr);
- }
+ LOAD(tmpIndex);
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, words);
if (++words < parsePtr->numWords) {
- if (tmpIndex <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
- }
+ STORE(tmpIndex);
}
TclEmitOpcode(instruction, envPtr);
}
for (; words>3 ; words--) {
- TclEmitOpcode(INST_BITAND, envPtr);
+ OP( BITAND);
}
/*
@@ -3257,13 +3456,7 @@ CompileComparisonOpCmd(
* might be expensive elsewhere.
*/
- PushLiteral(envPtr, "", 0);
- if (tmpIndex <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
- }
- TclEmitOpcode(INST_POP, envPtr);
+ OP14( UNSET_SCALAR, 0, tmpIndex);
}
return TCL_OK;
}
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 672b1cd..890d518 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclCompExpr.c,v 1.106 2010/09/27 19:42:38 msofer Exp $
*/
#include "tclInt.h"
@@ -169,135 +167,135 @@ enum Marks {
/* Leaf lexemes */
-#define NUMBER ( LEAF | 1) /* For literal numbers */
-#define SCRIPT ( LEAF | 2) /* Script substitution; [foo] */
-#define BOOLEAN ( LEAF | BAREWORD) /* For literal booleans */
-#define BRACED ( LEAF | 4) /* Braced string; {foo bar} */
-#define VARIABLE ( LEAF | 5) /* Variable substitution; $x */
-#define QUOTED ( LEAF | 6) /* Quoted string; "foo $bar [soom]" */
-#define EMPTY ( LEAF | 7) /* Used only for an empty argument
- * list to a function. Represents the
- * empty string within parens in the
- * expression: rand() */
+#define NUMBER (LEAF | 1)
+ /* For literal numbers */
+#define SCRIPT (LEAF | 2)
+ /* Script substitution; [foo] */
+#define BOOLEAN (LEAF | BAREWORD)
+ /* For literal booleans */
+#define BRACED (LEAF | 4)
+ /* Braced string; {foo bar} */
+#define VARIABLE (LEAF | 5)
+ /* Variable substitution; $x */
+#define QUOTED (LEAF | 6)
+ /* Quoted string; "foo $bar [soom]" */
+#define EMPTY (LEAF | 7)
+ /* Used only for an empty argument list to a
+ * function. Represents the empty string
+ * within parens in the expression: rand() */
/* Unary operator lexemes */
-#define UNARY_PLUS ( UNARY | PLUS)
-#define UNARY_MINUS ( UNARY | MINUS)
-#define FUNCTION ( UNARY | BAREWORD) /* This is a bit of "creative
- * interpretation" on the part of the
- * parser. A function call is parsed
- * into the parse tree according to
- * the perspective that the function
- * name is a unary operator and its
- * argument list, enclosed in parens,
- * is its operand. The additional
- * requirements not implied generally
- * by treatment as a unary operator --
- * for example, the requirement that
- * the operand be enclosed in parens
- * -- are hard coded in the relevant
- * portions of ParseExpr(). We trade
- * off the need to include such
- * exceptional handling in the code
- * against the need we would otherwise
- * have for more lexeme categories. */
-#define START ( UNARY | 4) /* This lexeme isn't parsed from the
- * expression text at all. It
- * represents the start of the
- * expression and sits at the root of
- * the parse tree where it serves as
- * the start/end point of
- * traversals. */
-#define OPEN_PAREN ( UNARY | 5) /* Another bit of creative
- * interpretation, where we treat "("
- * as a unary operator with the
- * sub-expression between it and its
- * matching ")" as its operand. See
- * CLOSE_PAREN below. */
-#define NOT ( UNARY | 6)
-#define BIT_NOT ( UNARY | 7)
+#define UNARY_PLUS (UNARY | PLUS)
+#define UNARY_MINUS (UNARY | MINUS)
+#define FUNCTION (UNARY | BAREWORD)
+ /* This is a bit of "creative interpretation"
+ * on the part of the parser. A function call
+ * is parsed into the parse tree according to
+ * the perspective that the function name is a
+ * unary operator and its argument list,
+ * enclosed in parens, is its operand. The
+ * additional requirements not implied
+ * generally by treatment as a unary operator
+ * -- for example, the requirement that the
+ * operand be enclosed in parens -- are hard
+ * coded in the relevant portions of
+ * ParseExpr(). We trade off the need to
+ * include such exceptional handling in the
+ * code against the need we would otherwise
+ * have for more lexeme categories. */
+#define START (UNARY | 4)
+ /* This lexeme isn't parsed from the
+ * expression text at all. It represents the
+ * start of the expression and sits at the
+ * root of the parse tree where it serves as
+ * the start/end point of traversals. */
+#define OPEN_PAREN (UNARY | 5)
+ /* Another bit of creative interpretation,
+ * where we treat "(" as a unary operator with
+ * the sub-expression between it and its
+ * matching ")" as its operand. See
+ * CLOSE_PAREN below. */
+#define NOT (UNARY | 6)
+#define BIT_NOT (UNARY | 7)
/* Binary operator lexemes */
-#define BINARY_PLUS ( BINARY | PLUS)
-#define BINARY_MINUS ( BINARY | MINUS)
-#define COMMA ( BINARY | 3) /* The "," operator is a low
- * precedence binary operator that
- * separates the arguments in a
- * function call. The additional
- * constraint that this operator can
- * only legally appear at the right
- * places within a function call
- * argument list are hard coded within
- * ParseExpr(). */
-#define MULT ( BINARY | 4)
-#define DIVIDE ( BINARY | 5)
-#define MOD ( BINARY | 6)
-#define LESS ( BINARY | 7)
-#define GREATER ( BINARY | 8)
-#define BIT_AND ( BINARY | 9)
-#define BIT_XOR ( BINARY | 10)
-#define BIT_OR ( BINARY | 11)
-#define QUESTION ( BINARY | 12) /* These two lexemes make up the */
-#define COLON ( BINARY | 13) /* ternary conditional operator,
- * $x ? $y : $z . We treat them as two
- * binary operators to avoid another
- * lexeme category, and code the
- * additional constraints directly in
- * ParseExpr(). For instance, the
- * right operand of a "?" operator
- * must be a ":" operator. */
-#define LEFT_SHIFT ( BINARY | 14)
-#define RIGHT_SHIFT ( BINARY | 15)
-#define LEQ ( BINARY | 16)
-#define GEQ ( BINARY | 17)
-#define EQUAL ( BINARY | 18)
-#define NEQ ( BINARY | 19)
-#define AND ( BINARY | 20)
-#define OR ( BINARY | 21)
-#define STREQ ( BINARY | 22)
-#define STRNEQ ( BINARY | 23)
-#define EXPON ( BINARY | 24) /* Unlike the other binary operators,
- * EXPON is right associative and this
- * distinction is coded directly in
- * ParseExpr(). */
-#define IN_LIST ( BINARY | 25)
-#define NOT_IN_LIST ( BINARY | 26)
-#define CLOSE_PAREN ( BINARY | 27) /* By categorizing the CLOSE_PAREN
- * lexeme as a BINARY operator, the
- * normal parsing rules for binary
- * operators assure that a close paren
- * will not directly follow another
- * operator, and the machinery already
- * in place to connect operands to
- * operators according to precedence
- * performs most of the work of
- * matching open and close parens for
- * us. In the end though, a close
- * paren is not really a binary
- * operator, and some special coding
- * in ParseExpr() make sure we never
- * put an actual CLOSE_PAREN node in
- * the parse tree. The sub-expression
- * between parens becomes the single
- * argument of the matching OPEN_PAREN
- * unary operator. */
-#define END ( BINARY | 28) /* This lexeme represents the end of
- * the string being parsed. Treating
- * it as a binary operator follows the
- * same logic as the CLOSE_PAREN
- * lexeme and END pairs with START, in
- * the same way that CLOSE_PAREN pairs
- * with OPEN_PAREN. */
+#define BINARY_PLUS (BINARY | PLUS)
+#define BINARY_MINUS (BINARY | MINUS)
+#define COMMA (BINARY | 3)
+ /* The "," operator is a low precedence binary
+ * operator that separates the arguments in a
+ * function call. The additional constraint
+ * that this operator can only legally appear
+ * at the right places within a function call
+ * argument list are hard coded within
+ * ParseExpr(). */
+#define MULT (BINARY | 4)
+#define DIVIDE (BINARY | 5)
+#define MOD (BINARY | 6)
+#define LESS (BINARY | 7)
+#define GREATER (BINARY | 8)
+#define BIT_AND (BINARY | 9)
+#define BIT_XOR (BINARY | 10)
+#define BIT_OR (BINARY | 11)
+#define QUESTION (BINARY | 12)
+ /* These two lexemes make up the */
+#define COLON (BINARY | 13)
+ /* ternary conditional operator, $x ? $y : $z.
+ * We treat them as two binary operators to
+ * avoid another lexeme category, and code the
+ * additional constraints directly in
+ * ParseExpr(). For instance, the right
+ * operand of a "?" operator must be a ":"
+ * operator. */
+#define LEFT_SHIFT (BINARY | 14)
+#define RIGHT_SHIFT (BINARY | 15)
+#define LEQ (BINARY | 16)
+#define GEQ (BINARY | 17)
+#define EQUAL (BINARY | 18)
+#define NEQ (BINARY | 19)
+#define AND (BINARY | 20)
+#define OR (BINARY | 21)
+#define STREQ (BINARY | 22)
+#define STRNEQ (BINARY | 23)
+#define EXPON (BINARY | 24)
+ /* Unlike the other binary operators, EXPON is
+ * right associative and this distinction is
+ * coded directly in ParseExpr(). */
+#define IN_LIST (BINARY | 25)
+#define NOT_IN_LIST (BINARY | 26)
+#define CLOSE_PAREN (BINARY | 27)
+ /* By categorizing the CLOSE_PAREN lexeme as a
+ * BINARY operator, the normal parsing rules
+ * for binary operators assure that a close
+ * paren will not directly follow another
+ * operator, and the machinery already in
+ * place to connect operands to operators
+ * according to precedence performs most of
+ * the work of matching open and close parens
+ * for us. In the end though, a close paren is
+ * not really a binary operator, and some
+ * special coding in ParseExpr() make sure we
+ * never put an actual CLOSE_PAREN node in the
+ * parse tree. The sub-expression between
+ * parens becomes the single argument of the
+ * matching OPEN_PAREN unary operator. */
+#define END (BINARY | 28)
+ /* This lexeme represents the end of the
+ * string being parsed. Treating it as a
+ * binary operator follows the same logic as
+ * the CLOSE_PAREN lexeme and END pairs with
+ * START, in the same way that CLOSE_PAREN
+ * pairs with OPEN_PAREN. */
+
/*
* When ParseExpr() builds the parse tree it must choose which operands to
* connect to which operators. This is done according to operator precedence.
- * The greater an operator's precedence the greater claim it has to link to
- * an available operand. The Precedence enumeration lists the precedence
- * values used by Tcl expression operators, from lowest to highest claim.
- * Each precedence level is commented with the operators that hold that
- * precedence.
+ * The greater an operator's precedence the greater claim it has to link to an
+ * available operand. The Precedence enumeration lists the precedence values
+ * used by Tcl expression operators, from lowest to highest claim. Each
+ * precedence level is commented with the operators that hold that precedence.
*/
enum Precedence {
@@ -322,9 +320,9 @@ enum Precedence {
};
/*
- * Here the same information contained in the comments above is stored
- * in inverted form, so that given a lexeme, one can quickly look up
- * its precedence value.
+ * Here the same information contained in the comments above is stored in
+ * inverted form, so that given a lexeme, one can quickly look up its
+ * precedence value.
*/
static const unsigned char prec[] = {
@@ -438,7 +436,7 @@ static const unsigned char instruction[] = {
* ParseLexeme().
*/
-static unsigned char Lexeme[] = {
+static const unsigned char Lexeme[] = {
INVALID /* NUL */, INVALID /* SOH */,
INVALID /* STX */, INVALID /* ETX */,
INVALID /* EOT */, INVALID /* ENQ */,
@@ -601,12 +599,21 @@ ParseExpr(
* actual leaf at the time the complete tree
* is needed. */
- /* These variables control generation of the error message. */
+ /*
+ * These variables control generation of the error message.
+ */
+
Tcl_Obj *msg = NULL; /* The error message. */
Tcl_Obj *post = NULL; /* In a few cases, an additional postscript
* for the error message, supplying more
* information after the error msg and
* location have been reported. */
+ const char *errCode = NULL; /* The detail word of the errorCode list, or
+ * NULL to indicate that no changes to the
+ * errorCode are to be done. */
+ const char *subErrCode = NULL;
+ /* Extra information for use in generating the
+ * errorCode. */
const char *mark = "_@_"; /* In the portion of the complete error
* message where the error location is
* reported, this "mark" substring is inserted
@@ -623,9 +630,10 @@ ParseExpr(
TclParseInit(interp, start, numBytes, parsePtr);
- nodes = (OpNode *) attemptckalloc(nodesAvailable * sizeof(OpNode));
+ nodes = attemptckalloc(nodesAvailable * sizeof(OpNode));
if (nodes == NULL) {
TclNewLiteralStringObj(msg, "not enough memory to parse expression");
+ errCode = "NOMEM";
goto error;
}
@@ -654,11 +662,6 @@ ParseExpr(
Tcl_Obj *literal; /* Filled by the ParseLexeme() call when a
* literal is parsed that has a Tcl_Obj rep
* worth preserving. */
- const char *lastStart = start - scanned;
- /* Compute where the lexeme parsed the
- * previous pass through the loop began. This
- * is helpful for detecting invalid octals and
- * providing more complete error messages. */
/*
* Each pass through this loop adds up to one more OpNode. Allocate
@@ -670,13 +673,13 @@ ParseExpr(
OpNode *newPtr;
do {
- newPtr = (OpNode *) attemptckrealloc((char *) nodes,
- (unsigned int) size * sizeof(OpNode));
+ newPtr = attemptckrealloc(nodes, size * sizeof(OpNode));
} while ((newPtr == NULL)
&& ((size -= (size - nodesUsed) / 2) > nodesUsed));
if (newPtr == NULL) {
TclNewLiteralStringObj(msg,
"not enough memory to parse expression");
+ errCode = "NOMEM";
goto error;
}
nodesAvailable = size;
@@ -684,23 +687,33 @@ ParseExpr(
}
nodePtr = nodes + nodesUsed;
- /* Skip white space between lexemes. */
+ /*
+ * Skip white space between lexemes.
+ */
+
scanned = TclParseAllWhiteSpace(start, numBytes);
start += scanned;
numBytes -= scanned;
scanned = ParseLexeme(start, numBytes, &lexeme, &literal);
- /* Use context to categorize the lexemes that are ambiguous. */
+ /*
+ * Use context to categorize the lexemes that are ambiguous.
+ */
+
if ((NODE_TYPE & lexeme) == 0) {
+ int b;
+
switch (lexeme) {
case INVALID:
- msg = Tcl_ObjPrintf(
- "invalid character \"%.*s\"", scanned, start);
+ msg = Tcl_ObjPrintf("invalid character \"%.*s\"",
+ scanned, start);
+ errCode = "BADCHAR";
goto error;
case INCOMPLETE:
- msg = Tcl_ObjPrintf(
- "incomplete operator \"%.*s\"", scanned, start);
+ msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"",
+ scanned, start);
+ errCode = "PARTOP";
goto error;
case BAREWORD:
@@ -723,53 +736,57 @@ ParseExpr(
*/
Tcl_ListObjAppendElement(NULL, funcList, literal);
+ } else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) {
+ lexeme = BOOLEAN;
} else {
- int b;
- if (Tcl_GetBooleanFromObj(NULL, literal, &b) == TCL_OK) {
- lexeme = BOOLEAN;
- } else {
- Tcl_DecrRefCount(literal);
- msg = Tcl_ObjPrintf(
- "invalid bareword \"%.*s%s\"",
- (scanned < limit) ? scanned : limit - 3, start,
- (scanned < limit) ? "" : "...");
- post = Tcl_ObjPrintf(
- "should be \"$%.*s%s\" or \"{%.*s%s}\"",
- (scanned < limit) ? scanned : limit - 3,
- start, (scanned < limit) ? "" : "...",
- (scanned < limit) ? scanned : limit - 3,
- start, (scanned < limit) ? "" : "...");
- Tcl_AppendPrintfToObj(post,
- " or \"%.*s%s(...)\" or ...",
- (scanned < limit) ? scanned : limit - 3,
- start, (scanned < limit) ? "" : "...");
- if (NotOperator(lastParsed)) {
- if ((lastStart[0] == '0')
- && ((lastStart[1] == 'o')
- || (lastStart[1] == 'O'))
- && (lastStart[2] >= '0')
- && (lastStart[2] <= '9')) {
- const char *end = lastStart + 2;
- Tcl_Obj *copy;
-
- while (isdigit(UCHAR(*end))) {
- end++;
- }
- copy = Tcl_NewStringObj(lastStart,
- end - lastStart);
- if (TclCheckBadOctal(NULL,
- Tcl_GetString(copy))) {
+ Tcl_DecrRefCount(literal);
+ msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"",
+ (scanned < limit) ? scanned : limit - 3, start,
+ (scanned < limit) ? "" : "...");
+ post = Tcl_ObjPrintf(
+ "should be \"$%.*s%s\" or \"{%.*s%s}\"",
+ (scanned < limit) ? scanned : limit - 3,
+ start, (scanned < limit) ? "" : "...",
+ (scanned < limit) ? scanned : limit - 3,
+ start, (scanned < limit) ? "" : "...");
+ Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...",
+ (scanned < limit) ? scanned : limit - 3,
+ start, (scanned < limit) ? "" : "...");
+ errCode = "BAREWORD";
+ if (start[0] == '0') {
+ const char *stop;
+ TclParseNumber(NULL, NULL, NULL, start, scanned,
+ &stop, TCL_PARSE_NO_WHITESPACE);
+
+ if (isdigit(UCHAR(*stop)) || (stop == start + 1)) {
+ switch (start[1]) {
+ case 'b':
+ Tcl_AppendToObj(post,
+ " (invalid binary number?)", -1);
+ parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
+ errCode = "BADNUMBER";
+ subErrCode = "BINARY";
+ break;
+ case 'o':
+ Tcl_AppendToObj(post,
+ " (invalid octal number?)", -1);
+ parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
+ errCode = "BADNUMBER";
+ subErrCode = "OCTAL";
+ break;
+ default:
+ if (isdigit(UCHAR(start[1]))) {
Tcl_AppendToObj(post,
- "(invalid octal number?)", -1);
+ " (invalid octal number?)", -1);
+ parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
+ errCode = "BADNUMBER";
+ subErrCode = "OCTAL";
}
- Tcl_DecrRefCount(copy);
+ break;
}
- scanned = 0;
- insertMark = 1;
- parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
}
- goto error;
}
+ goto error;
}
break;
case PLUS:
@@ -787,17 +804,19 @@ ParseExpr(
}
} /* Uncategorized lexemes */
- /* Handle lexeme based on its category. */
- switch (NODE_TYPE & lexeme) {
-
/*
- * Each LEAF results in either a literal getting appended to the
- * litList, or a sequence of Tcl_Tokens representing a Tcl word
- * getting appended to the parsePtr->tokens. No OpNode is filled for
- * this lexeme.
+ * Handle lexeme based on its category.
*/
+ switch (NODE_TYPE & lexeme) {
case LEAF: {
+ /*
+ * Each LEAF results in either a literal getting appended to the
+ * litList, or a sequence of Tcl_Tokens representing a Tcl word
+ * getting appended to the parsePtr->tokens. No OpNode is filled
+ * for this lexeme.
+ */
+
Tcl_Token *tokenPtr;
const char *end = start;
int wordIndex;
@@ -810,20 +829,14 @@ ParseExpr(
if (NotOperator(lastParsed)) {
msg = Tcl_ObjPrintf("missing operator at %s", mark);
- if (lastStart[0] == '0') {
- Tcl_Obj *copy = Tcl_NewStringObj(lastStart,
- start + scanned - lastStart);
- if (TclCheckBadOctal(NULL, Tcl_GetString(copy))) {
- TclNewLiteralStringObj(post,
- "looks like invalid octal number");
- }
- Tcl_DecrRefCount(copy);
- }
+ errCode = "MISSING";
scanned = 0;
insertMark = 1;
- parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
- /* Free any literal to avoid a memleak. */
+ /*
+ * Free any literal to avoid a memleak.
+ */
+
if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) {
Tcl_DecrRefCount(literal);
}
@@ -881,7 +894,7 @@ ParseExpr(
case BRACED:
code = Tcl_ParseBraces(NULL, start, numBytes,
- parsePtr, 1, &end);
+ parsePtr, 1, &end);
scanned = end - start;
break;
@@ -896,6 +909,7 @@ ParseExpr(
tokenPtr = parsePtr->tokenPtr + wordIndex + 1;
if (code == TCL_OK && tokenPtr->type != TCL_TOKEN_VARIABLE) {
TclNewLiteralStringObj(msg, "invalid character \"$\"");
+ errCode = "BADCHAR";
goto error;
}
scanned = tokenPtr->size;
@@ -913,7 +927,7 @@ ParseExpr(
end = start + numBytes;
start++;
while (1) {
- code = Tcl_ParseCommand(interp, start, (end - start), 1,
+ code = Tcl_ParseCommand(interp, start, end - start, 1,
nestedPtr);
if (code != TCL_OK) {
parsePtr->term = nestedPtr->term;
@@ -921,10 +935,10 @@ ParseExpr(
parsePtr->incomplete = nestedPtr->incomplete;
break;
}
- start = (nestedPtr->commandStart + nestedPtr->commandSize);
+ start = nestedPtr->commandStart + nestedPtr->commandSize;
Tcl_FreeParse(nestedPtr);
- if ((nestedPtr->term < end) && (*(nestedPtr->term) == ']')
- && !(nestedPtr->incomplete)) {
+ if ((nestedPtr->term < end) && (nestedPtr->term[0] == ']')
+ && !nestedPtr->incomplete) {
break;
}
@@ -934,6 +948,7 @@ ParseExpr(
parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
parsePtr->incomplete = 1;
code = TCL_ERROR;
+ errCode = "UNBALANCED";
break;
}
}
@@ -944,7 +959,7 @@ ParseExpr(
tokenPtr->size = scanned;
parsePtr->numTokens++;
break;
- }
+ } /* SCRIPT case */
}
if (code != TCL_OK) {
/*
@@ -964,6 +979,9 @@ ParseExpr(
start = parsePtr->term;
scanned = parsePtr->incomplete;
+ if (parsePtr->incomplete) {
+ errCode = "UNBALANCED";
+ }
goto error;
}
@@ -1013,10 +1031,14 @@ ParseExpr(
msg = Tcl_ObjPrintf("missing operator at %s", mark);
scanned = 0;
insertMark = 1;
+ errCode = "MISSING";
goto error;
}
- /* Create an OpNode for the unary operator */
+ /*
+ * Create an OpNode for the unary operator.
+ */
+
nodePtr->lexeme = lexeme;
nodePtr->precedence = prec[lexeme];
nodePtr->mark = MARK_RIGHT;
@@ -1071,6 +1093,7 @@ ParseExpr(
msg = Tcl_ObjPrintf("empty subexpression at %s", mark);
scanned = 0;
insertMark = 1;
+ errCode = "EMPTY";
goto error;
}
@@ -1078,30 +1101,34 @@ ParseExpr(
if (nodePtr[-1].lexeme == OPEN_PAREN) {
TclNewLiteralStringObj(msg, "unbalanced open paren");
parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
+ errCode = "UNBALANCED";
} else if (nodePtr[-1].lexeme == COMMA) {
msg = Tcl_ObjPrintf(
"missing function argument at %s", mark);
scanned = 0;
insertMark = 1;
+ errCode = "MISSING";
} else if (nodePtr[-1].lexeme == START) {
TclNewLiteralStringObj(msg, "empty expression");
+ errCode = "EMPTY";
}
- } else {
- if (lexeme == CLOSE_PAREN) {
- TclNewLiteralStringObj(msg, "unbalanced close paren");
- } else if ((lexeme == COMMA)
- && (nodePtr[-1].lexeme == OPEN_PAREN)
- && (nodePtr[-2].lexeme == FUNCTION)) {
- msg = Tcl_ObjPrintf(
- "missing function argument at %s", mark);
- scanned = 0;
- insertMark = 1;
- }
+ } else if (lexeme == CLOSE_PAREN) {
+ TclNewLiteralStringObj(msg, "unbalanced close paren");
+ errCode = "UNBALANCED";
+ } else if ((lexeme == COMMA)
+ && (nodePtr[-1].lexeme == OPEN_PAREN)
+ && (nodePtr[-2].lexeme == FUNCTION)) {
+ msg = Tcl_ObjPrintf("missing function argument at %s",
+ mark);
+ scanned = 0;
+ insertMark = 1;
+ errCode = "UNBALANCED";
}
if (msg == NULL) {
msg = Tcl_ObjPrintf("missing operand at %s", mark);
scanned = 0;
insertMark = 1;
+ errCode = "MISSING";
}
goto error;
}
@@ -1178,6 +1205,7 @@ ParseExpr(
&& (lexeme != CLOSE_PAREN)) {
TclNewLiteralStringObj(msg, "unbalanced open paren");
parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
+ errCode = "UNBALANCED";
goto error;
}
@@ -1185,10 +1213,10 @@ ParseExpr(
if ((incompletePtr->lexeme == QUESTION)
&& (NotOperator(complete)
|| (nodes[complete].lexeme != COLON))) {
- msg = Tcl_ObjPrintf(
- "missing operator \":\" at %s", mark);
+ msg = Tcl_ObjPrintf("missing operator \":\" at %s", mark);
scanned = 0;
insertMark = 1;
+ errCode = "MISSING";
goto error;
}
@@ -1199,6 +1227,7 @@ ParseExpr(
TclNewLiteralStringObj(msg,
"unexpected operator \":\" "
"without preceding \"?\"");
+ errCode = "SURPRISE";
goto error;
}
@@ -1261,6 +1290,7 @@ ParseExpr(
if (lexeme == CLOSE_PAREN) {
if (incompletePtr->lexeme != OPEN_PAREN) {
TclNewLiteralStringObj(msg, "unbalanced close paren");
+ errCode = "UNBALANCED";
goto error;
}
}
@@ -1271,6 +1301,7 @@ ParseExpr(
|| (incompletePtr[-1].lexeme != FUNCTION)) {
TclNewLiteralStringObj(msg,
"unexpected \",\" outside function argument list");
+ errCode = "SURPRISE";
goto error;
}
}
@@ -1279,6 +1310,7 @@ ParseExpr(
if (IsOperator(complete) && (nodes[complete].lexeme == COLON)) {
TclNewLiteralStringObj(msg,
"unexpected operator \":\" without preceding \"?\"");
+ errCode = "SURPRISE";
goto error;
}
@@ -1335,13 +1367,12 @@ ParseExpr(
numBytes -= scanned;
} /* main parsing loop */
- error:
-
/*
* We only get here if there's been an error. Any errors that didn't get a
* suitable parsePtr->errorType, get recorded as syntax errors.
*/
+ error:
if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
parsePtr->errorType = TCL_PARSE_SYNTAX;
}
@@ -1351,7 +1382,7 @@ ParseExpr(
*/
if (nodes != NULL) {
- ckfree((char*) nodes);
+ ckfree(nodes);
}
if (interp == NULL) {
@@ -1363,7 +1394,6 @@ ParseExpr(
Tcl_DecrRefCount(msg);
}
} else {
-
/*
* Construct the complete error message. Start with the simple error
* message, pulled from the interp result if necessary...
@@ -1381,13 +1411,13 @@ ParseExpr(
Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
((start - limit) < parsePtr->string) ? "" : "...",
((start - limit) < parsePtr->string)
- ? (start - parsePtr->string) : limit - 3,
+ ? (int) (start - parsePtr->string) : limit - 3,
((start - limit) < parsePtr->string)
? parsePtr->string : start - limit + 3,
(scanned < limit) ? scanned : limit - 3, start,
(scanned < limit) ? "" : "...", insertMark ? mark : "",
(start + scanned + limit > parsePtr->end)
- ? parsePtr->end - (start + scanned) : limit-3,
+ ? (int) (parsePtr->end - start) - scanned : limit-3,
start + scanned,
(start + scanned + limit > parsePtr->end) ? "" : "...");
@@ -1411,6 +1441,10 @@ ParseExpr(
"\n (parsing expression \"%.*s%s\")",
(numBytes < limit) ? numBytes : limit - 3,
parsePtr->string, (numBytes < limit) ? "" : "..."));
+ if (errCode) {
+ Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode,
+ subErrCode, NULL);
+ }
}
return TCL_ERROR;
@@ -1475,7 +1509,10 @@ ConvertTreeToTokens(
case OT_LITERAL:
- /* Skip any white space that comes before the literal */
+ /*
+ * Skip any white space that comes before the literal.
+ */
+
scanned = TclParseAllWhiteSpace(start, numBytes);
start += scanned;
numBytes -= scanned;
@@ -1558,7 +1595,10 @@ ConvertTreeToTokens(
default:
- /* Advance to the child node, which is an operator. */
+ /*
+ * Advance to the child node, which is an operator.
+ */
+
nodePtr = nodes + next;
/*
@@ -1639,7 +1679,10 @@ ConvertTreeToTokens(
case MARK_RIGHT:
next = nodePtr->right;
- /* Skip any white space that comes before the operator */
+ /*
+ * Skip any white space that comes before the operator.
+ */
+
scanned = TclParseAllWhiteSpace(start, numBytes);
start += scanned;
numBytes -= scanned;
@@ -1656,7 +1699,10 @@ ConvertTreeToTokens(
case COMMA:
case COLON:
- /* No tokens for these lexemes -> nothing to do. */
+ /*
+ * No tokens for these lexemes -> nothing to do.
+ */
+
break;
default:
@@ -1691,7 +1737,10 @@ ConvertTreeToTokens(
case OPEN_PAREN:
- /* Skip past matching close paren. */
+ /*
+ * Skip past matching close paren.
+ */
+
scanned = TclParseAllWhiteSpace(start, numBytes);
start += scanned;
numBytes -= scanned;
@@ -1700,7 +1749,7 @@ ConvertTreeToTokens(
numBytes -= scanned;
break;
- default: {
+ default:
/*
* Before we leave this node/operator/subexpression for the
@@ -1734,7 +1783,6 @@ ConvertTreeToTokens(
subExprTokenIdx = parentIdx;
break;
}
- }
/*
* Since we're returning to parent, skip child handling code.
@@ -1810,7 +1858,7 @@ Tcl_ParseExpr(
Tcl_FreeParse(exprParsePtr);
TclStackFree(interp, exprParsePtr);
- ckfree((char *) opTree);
+ ckfree(opTree);
return code;
}
@@ -1962,14 +2010,55 @@ ParseLexeme(
literal = Tcl_NewObj();
if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
- TclInitStringRep(literal, start, end-start);
- *lexemePtr = NUMBER;
- if (literalPtr) {
- *literalPtr = literal;
+ if (end < start + numBytes && !isalnum(UCHAR(*end))
+ && UCHAR(*end) != '_') {
+
+ number:
+ TclInitStringRep(literal, start, end-start);
+ *lexemePtr = NUMBER;
+ if (literalPtr) {
+ *literalPtr = literal;
+ } else {
+ Tcl_DecrRefCount(literal);
+ }
+ return (end-start);
} else {
- Tcl_DecrRefCount(literal);
+ unsigned char lexeme;
+
+ /*
+ * We have a number followed directly by bareword characters
+ * (alpha, digit, underscore). Is this a number followed by
+ * bareword syntax error? Or should we join into one bareword?
+ * Example: Inf + luence + () becomes a valid function call.
+ * [Bug 3401704]
+ */
+ if (literal->typePtr == &tclDoubleType) {
+ const char *p = start;
+
+ while (p < end) {
+ if (!isalnum(UCHAR(*p++))) {
+ /*
+ * The number has non-bareword characters, so we
+ * must treat it as a number.
+ */
+ goto number;
+ }
+ }
+ }
+ ParseLexeme(end, numBytes-(end-start), &lexeme, NULL);
+ if ((NODE_TYPE & lexeme) == BINARY) {
+ /*
+ * The bareword characters following the number take the
+ * form of an operator (eq, ne, in, ni, ...) so we treat
+ * as number + operator.
+ */
+ goto number;
+ }
+
+ /*
+ * Otherwise, fall through and parse the whole as a bareword.
+ */
}
- return (end-start);
}
if (Tcl_UtfCharComplete(start, numBytes)) {
@@ -1981,7 +2070,7 @@ ParseLexeme(
utfBytes[numBytes] = '\0';
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
}
- if (!isalpha(UCHAR(ch))) {
+ if (!isalnum(UCHAR(ch))) {
*lexemePtr = INVALID;
Tcl_DecrRefCount(literal);
return scanned;
@@ -2069,7 +2158,7 @@ TclCompileExpr(
TclStackFree(interp, parsePtr);
Tcl_DecrRefCount(funcList);
Tcl_DecrRefCount(litList);
- ckfree((char *) opTree);
+ ckfree(opTree);
}
/*
@@ -2101,7 +2190,7 @@ ExecConstantExprTree(
ByteCode *byteCodePtr;
int code;
Tcl_Obj *byteCodeObj = Tcl_NewObj();
- TEOV_callback *rootPtr = TOP_CB(interp);
+ NRE_callback *rootPtr = TOP_CB(interp);
/*
* Note we are compiling an expression with literal arguments. This means
@@ -2118,7 +2207,7 @@ ExecConstantExprTree(
TclInitByteCodeObj(byteCodeObj, envPtr);
TclFreeCompileEnv(envPtr);
TclStackFree(interp, envPtr);
- byteCodePtr = (ByteCode *) byteCodeObj->internalRep.otherValuePtr;
+ byteCodePtr = byteCodeObj->internalRep.otherValuePtr;
TclNRExecuteByteCode(interp, byteCodePtr);
code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
Tcl_DecrRefCount(byteCodeObj);
@@ -2207,7 +2296,7 @@ CompileExprTree(
int length;
Tcl_DStringInit(&cmdName);
- Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
+ TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
p = TclGetStringFromObj(*funcObjv, &length);
funcObjv++;
Tcl_DStringAppend(&cmdName, p, length);
@@ -2228,22 +2317,22 @@ CompileExprTree(
break;
}
case QUESTION:
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
break;
case COLON:
CLANG_ASSERT(jumpPtr);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
- &(jumpPtr->next->jump));
+ &jumpPtr->next->jump);
envPtr->currStackDepth = jumpPtr->depth;
jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
jumpPtr->convert = convert;
convert = 1;
break;
case AND:
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
break;
case OR:
- TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &(jumpPtr->jump));
+ TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpPtr->jump);
break;
}
} else {
@@ -2286,12 +2375,12 @@ CompileExprTree(
break;
case COLON:
CLANG_ASSERT(jumpPtr);
- if (TclFixupForwardJump(envPtr, &(jumpPtr->next->jump),
+ if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump,
(envPtr->codeNext - envPtr->codeStart)
- jumpPtr->next->jump.codeOffset, 127)) {
jumpPtr->offset += 3;
}
- TclFixupForwardJump(envPtr, &(jumpPtr->jump),
+ TclFixupForwardJump(envPtr, &jumpPtr->jump,
jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
convert |= jumpPtr->convert;
envPtr->currStackDepth = jumpPtr->depth + 1;
@@ -2307,18 +2396,18 @@ CompileExprTree(
CLANG_ASSERT(jumpPtr);
TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
? TCL_FALSE_JUMP : TCL_TRUE_JUMP,
- &(jumpPtr->next->jump));
+ &jumpPtr->next->jump);
TclEmitPush(TclRegisterNewLiteral(envPtr,
(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
- &(jumpPtr->next->next->jump));
- TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->jump), 127);
- if (TclFixupForwardJumpToHere(envPtr, &(jumpPtr->jump), 127)) {
+ &jumpPtr->next->next->jump);
+ TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->jump, 127);
+ if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
jumpPtr->next->next->jump.codeOffset += 3;
}
TclEmitPush(TclRegisterNewLiteral(envPtr,
(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
- TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->next->jump),
+ TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->next->jump,
127);
convert = 0;
envPtr->currStackDepth = jumpPtr->depth + 1;
@@ -2338,8 +2427,8 @@ CompileExprTree(
break;
}
if (nodePtr == rootPtr) {
-
/* We're done */
+
return;
}
nodePtr = nodes + nodePtr->p.parent;
@@ -2409,8 +2498,34 @@ CompileExprTree(
if (ExecConstantExprTree(interp, nodes, next, litObjvPtr)
== TCL_OK) {
- TclEmitPush(TclAddLiteralObj(envPtr,
- Tcl_GetObjResult(interp), NULL), envPtr);
+ int index;
+ Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
+
+ /*
+ * Don't generate a string rep, but if we have one
+ * already, then use it to share via the literal table.
+ */
+
+ if (objPtr->bytes) {
+ Tcl_Obj *tableValue;
+
+ index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
+ objPtr->length);
+ tableValue = envPtr->literalArrayPtr[index].objPtr;
+ if ((tableValue->typePtr == NULL) &&
+ (objPtr->typePtr != NULL)) {
+ /*
+ * Same intrep surgery as for OT_LITERAL.
+ */
+
+ tableValue->typePtr = objPtr->typePtr;
+ tableValue->internalRep = objPtr->internalRep;
+ objPtr->typePtr = NULL;
+ }
+ } else {
+ index = TclAddLiteralObj(envPtr, objPtr, NULL);
+ }
+ TclEmitPush(index, envPtr);
} else {
TclCompileSyntaxError(interp, envPtr);
}
@@ -2427,6 +2542,7 @@ CompileExprTree(
*----------------------------------------------------------------------
*
* TclSingleOpCmd --
+ *
* Implements the commands: ~, !, <<, >>, %, !=, ne, in, ni
* in the ::tcl::mathop namespace. These commands have no
* extension to arbitrary arguments; they accept only exactly one
@@ -2453,7 +2569,7 @@ TclSingleOpCmd(
OpNode nodes[2];
Tcl_Obj *const *litObjv = objv + 1;
- if (objc != 1+occdPtr->i.numArgs) {
+ if (objc != 1 + occdPtr->i.numArgs) {
Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
return TCL_ERROR;
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index a34966d..309682d 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclCompile.c,v 1.188 2010/09/27 19:42:38 msofer Exp $
*/
#include "tclInt.h"
@@ -39,7 +37,7 @@ TCL_DECLARE_MUTEX(tableMutex)
int tclTraceCompile = 0;
static int traceInitialized = 0;
#endif
-
+
/*
* A table describing the Tcl bytecode instructions. Entries in this table
* must correspond to the instruction opcode definitions in tclCompile.h. The
@@ -343,14 +341,16 @@ InstructionDesc const tclInstructionTable[] = {
* Stack: ... key valueToAppend => ... newDict */
{"dictFirst", 5, +2, 1, {OPERAND_LVT4}},
/* Begin iterating over the dictionary, using the local scalar
- * indicated by op4 to hold the iterator state. If doneBool is true,
- * dictDone *must* be called later on.
+ * indicated by op4 to hold the iterator state. The local scalar
+ * should not refer to a named variable as the value is not wholly
+ * managed correctly.
* Stack: ... dict => ... value key doneBool */
{"dictNext", 5, +3, 1, {OPERAND_LVT4}},
/* Get the next iteration from the iterator in op4's local scalar.
* Stack: ... => ... value key doneBool */
{"dictDone", 5, 0, 1, {OPERAND_LVT4}},
- /* Terminate the iterator in op4's local scalar. */
+ /* Terminate the iterator in op4's local scalar. Use unsetScalar
+ * instead (with 0 for flags). */
{"dictUpdateStart", 9, 0, 2, {OPERAND_LVT4, OPERAND_AUX4}},
/* Create the variables (described in the aux data referred to by the
* second immediate argument) to mirror the state of the dictionary in
@@ -372,13 +372,13 @@ InstructionDesc const tclInstructionTable[] = {
* Stack: ... value => ...
* Note that the jump table contains offsets relative to the PC when
* it points to this instruction; the code is relocatable. */
- {"upvar", 5, 0, 1, {OPERAND_LVT4}},
+ {"upvar", 5, -1, 1, {OPERAND_LVT4}},
/* finds level and otherName in stack, links to local variable at
* index op1. Leaves the level on stack. */
- {"nsupvar", 5, 0, 1, {OPERAND_LVT4}},
+ {"nsupvar", 5, -1, 1, {OPERAND_LVT4}},
/* finds namespace and otherName in stack, links to local variable at
* index op1. Leaves the namespace on stack. */
- {"variable", 5, 0, 1, {OPERAND_LVT4}},
+ {"variable", 5, -1, 1, {OPERAND_LVT4}},
/* finds namespace and otherName in stack, links to local variable at
* index op1. Leaves the namespace on stack. */
{"syntax", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}},
@@ -421,6 +421,114 @@ InstructionDesc const tclInstructionTable[] = {
/* Make general variable cease to exist; unparsed variable name is
* stktop; op1 is 1 for errors on problems, 0 otherwise */
+ {"dictExpand", 1, -1, 0, {OPERAND_NONE}},
+ /* Probe into a dict and extract it (or a subdict of it) into
+ * variables with matched names. Produces list of keys bound as
+ * result. Part of [dict with].
+ * Stack: ... dict path => ... keyList */
+ {"dictRecombineStk", 1, -3, 0, {OPERAND_NONE}},
+ /* Map variable contents back into a dictionary in a variable. Part of
+ * [dict with].
+ * Stack: ... dictVarName path keyList => ... */
+ {"dictRecombineImm", 1, -2, 1, {OPERAND_LVT4}},
+ /* Map variable contents back into a dictionary in the local variable
+ * indicated by the LVT index. Part of [dict with].
+ * Stack: ... path keyList => ... */
+ {"dictExists", 5, INT_MIN, 1, {OPERAND_UINT4}},
+ /* The top op4 words (min 1) are a key path into the dictionary just
+ * below the keys on the stack, and all those values are replaced by a
+ * boolean indicating whether it is possible to read out a value from
+ * that key-path (like [dict exists]).
+ * Stack: ... dict key1 ... keyN => ... boolean */
+ {"verifyDict", 1, -1, 0, {OPERAND_NONE}},
+ /* Verifies that the word on the top of the stack is a dictionary,
+ * popping it if it is and throwing an error if it is not.
+ * Stack: ... value => ... */
+
+ {"strmap", 1, -2, 0, {OPERAND_NONE}},
+ /* Simplified version of [string map] that only applies one change
+ * string, and only case-sensitively.
+ * Stack: ... from to string => ... changedString */
+ {"strfind", 1, -1, 0, {OPERAND_NONE}},
+ /* Find the first index of a needle string in a haystack string,
+ * producing the index (integer) or -1 if nothing found.
+ * Stack: ... needle haystack => ... index */
+ {"strrfind", 1, -1, 0, {OPERAND_NONE}},
+ /* Find the last index of a needle string in a haystack string,
+ * producing the index (integer) or -1 if nothing found.
+ * Stack: ... needle haystack => ... index */
+ {"strrangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}},
+ /* String Range: push (string range stktop op4 op4) */
+ {"strrange", 1, -2, 0, {OPERAND_NONE}},
+ /* String Range with non-constant arguments.
+ * Stack: ... string idxA idxB => ... substring */
+
+ {"yield", 1, 0, 0, {OPERAND_NONE}},
+ /* Makes the current coroutine yield the value at the top of the
+ * stack, and places the response back on top of the stack when it
+ * resumes.
+ * Stack: ... valueToYield => ... resumeValue */
+ {"coroName", 1, +1, 0, {OPERAND_NONE}},
+ /* Push the name of the interpreter's current coroutine as an object
+ * on the stack. */
+ {"tailcall", 2, INT_MIN, 1, {OPERAND_UINT1}},
+ /* Do a tailcall with the opnd items on the stack as the thing to
+ * tailcall to; opnd must be greater than 0 for the semantics to work
+ * right. */
+
+ {"currentNamespace", 1, +1, 0, {OPERAND_NONE}},
+ /* Push the name of the interpreter's current namespace as an object
+ * on the stack. */
+ {"infoLevelNumber", 1, +1, 0, {OPERAND_NONE}},
+ /* Push the stack depth (i.e., [info level]) of the interpreter as an
+ * object on the stack. */
+ {"infoLevelArgs", 1, 0, 0, {OPERAND_NONE}},
+ /* Push the argument words to a stack depth (i.e., [info level <n>])
+ * of the interpreter as an object on the stack.
+ * Stack: ... depth => ... argList */
+ {"resolveCmd", 1, 0, 0, {OPERAND_NONE}},
+ /* Resolves the command named on the top of the stack to its fully
+ * qualified version, or produces the empty string if no such command
+ * exists. Never generates errors.
+ * Stack: ... cmdName => ... fullCmdName */
+ {"tclooSelf", 1, +1, 0, {OPERAND_NONE}},
+ /* Push the identity of the current TclOO object (i.e., the name of
+ * its current public access command) on the stack. */
+ {"tclooClass", 1, 0, 0, {OPERAND_NONE}},
+ /* Push the class of the TclOO object named at the top of the stack
+ * onto the stack.
+ * Stack: ... object => ... class */
+ {"tclooNamespace", 1, 0, 0, {OPERAND_NONE}},
+ /* Push the namespace of the TclOO object named at the top of the
+ * stack onto the stack.
+ * Stack: ... object => ... namespace */
+ {"tclooIsObject", 1, 0, 0, {OPERAND_NONE}},
+ /* Push whether the value named at the top of the stack is a TclOO
+ * object (i.e., a boolean). Can corrupt the interpreter result
+ * despite not throwing, so not safe for use in a post-exception
+ * context.
+ * Stack: ... value => ... boolean */
+
+ {"arrayExistsStk", 1, 0, 0, {OPERAND_NONE}},
+ /* Looks up the element on the top of the stack and tests whether it
+ * is an array. Pushes a boolean describing whether this is the
+ * case. Also runs the whole-array trace on the named variable, so can
+ * throw anything.
+ * Stack: ... varName => ... boolean */
+ {"arrayExistsImm", 5, +1, 1, {OPERAND_UINT4}},
+ /* Looks up the variable indexed by opnd and tests whether it is an
+ * array. Pushes a boolean describing whether this is the case. Also
+ * runs the whole-array trace on the named variable, so can throw
+ * anything.
+ * Stack: ... => ... boolean */
+ {"arrayMakeStk", 1, -1, 0, {OPERAND_NONE}},
+ /* Forces the element on the top of the stack to be the name of an
+ * array.
+ * Stack: ... varName => ... */
+ {"arrayMakeImm", 5, 0, 1, {OPERAND_UINT4}},
+ /* Forces the variable indexed by opnd to be an array. Does not touch
+ * the stack. */
+
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
@@ -450,6 +558,8 @@ static int FormatInstruction(ByteCode *codePtr,
const unsigned char *pc, Tcl_Obj *bufferObj);
static void PrintSourceToObj(Tcl_Obj *appendObj,
const char *stringPtr, int maxChars);
+static void UpdateStringOfInstName(Tcl_Obj *objPtr);
+
/*
* TIP #280: Helper for building the per-word line information of all compiled
* commands.
@@ -484,6 +594,19 @@ static const Tcl_ObjType substCodeType = {
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
};
+
+/*
+ * The structure below defines an instruction name Tcl object to allow
+ * reporting of inner contexts in errorstack without string allocation.
+ */
+
+static const Tcl_ObjType tclInstNameType = {
+ "instname", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ UpdateStringOfInstName, /* updateStringProc */
+ NULL, /* setFromAnyProc */
+};
/*
*----------------------------------------------------------------------
@@ -494,12 +617,13 @@ static const Tcl_ObjType substCodeType = {
* generate an byte code internal form for the Tcl object "objPtr" by
* compiling its string representation. This function also takes a hook
* procedure that will be invoked to perform any needed post processing
- * on the compilation results before generating byte codes.
+ * on the compilation results before generating byte codes. interp is
+ * compilation context and may not be NULL.
*
* Results:
* The return value is a standard Tcl object result. If an error occurs
* during compilation, an error message is left in the interpreter's
- * result unless "interp" is NULL.
+ * result.
*
* Side effects:
* Frees the old internal representation. If no error occurs, then the
@@ -657,6 +781,9 @@ SetByteCodeFromAny(
* compiled. Must not be NULL. */
Tcl_Obj *objPtr) /* The object to make a ByteCode object. */
{
+ if (interp == NULL) {
+ return TCL_ERROR;
+ }
TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
return TCL_OK;
}
@@ -714,12 +841,12 @@ FreeByteCodeInternalRep(
{
register ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
+ objPtr->typePtr = NULL;
+ objPtr->internalRep.otherValuePtr = NULL;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
- objPtr->typePtr = NULL;
- objPtr->internalRep.otherValuePtr = NULL;
}
/*
@@ -866,16 +993,16 @@ TclCleanupByteCode(
Tcl_DecrRefCount(eclPtr->path);
}
for (i=0 ; i<eclPtr->nuloc ; i++) {
- ckfree((char *) eclPtr->loc[i].line);
+ ckfree(eclPtr->loc[i].line);
}
if (eclPtr->loc != NULL) {
- ckfree((char *) eclPtr->loc);
+ ckfree(eclPtr->loc);
}
Tcl_DeleteHashTable(&eclPtr->litInfo);
- ckfree((char *) eclPtr);
+ ckfree(eclPtr);
Tcl_DeleteHashEntry(hePtr);
}
}
@@ -885,7 +1012,7 @@ TclCleanupByteCode(
}
TclHandleRelease(codePtr->interpHandle);
- ckfree((char *) codePtr);
+ ckfree(codePtr);
}
/*
@@ -912,7 +1039,7 @@ Tcl_SubstObj(
Tcl_Obj *objPtr, /* The value to be substituted. */
int flags) /* What substitutions to do. */
{
- TEOV_callback *rootPtr = TOP_CB(interp);
+ NRE_callback *rootPtr = TOP_CB(interp);
if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags),
rootPtr) != TCL_OK) {
@@ -986,7 +1113,7 @@ CompileSubstObj(
if (objPtr->typePtr == &substCodeType) {
Namespace *nsPtr = iPtr->varFramePtr->nsPtr;
- codePtr = (ByteCode *) objPtr->internalRep.ptrAndLongRep.ptr;
+ codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
if ((unsigned long)flags != objPtr->internalRep.ptrAndLongRep.value
|| ((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
@@ -1050,12 +1177,12 @@ FreeSubstCodeInternalRep(
{
register ByteCode *codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
+ objPtr->typePtr = NULL;
+ objPtr->internalRep.otherValuePtr = NULL;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
- objPtr->typePtr = NULL;
- objPtr->internalRep.otherValuePtr = NULL;
}
/*
@@ -1130,7 +1257,7 @@ TclInitCompileEnv(
* non-compiling evaluator
*/
- envPtr->extCmdMapPtr = (ExtCmdLoc *) ckalloc(sizeof(ExtCmdLoc));
+ envPtr->extCmdMapPtr = ckalloc(sizeof(ExtCmdLoc));
envPtr->extCmdMapPtr->loc = NULL;
envPtr->extCmdMapPtr->nloc = 0;
envPtr->extCmdMapPtr->nuloc = 0;
@@ -1287,26 +1414,26 @@ TclFreeCompileEnv(
register CompileEnv *envPtr)/* Points to the CompileEnv structure. */
{
if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){
- ckfree((char *) envPtr->localLitTable.buckets);
+ ckfree(envPtr->localLitTable.buckets);
envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
}
if (envPtr->mallocedCodeArray) {
- ckfree((char *) envPtr->codeStart);
+ ckfree(envPtr->codeStart);
}
if (envPtr->mallocedLiteralArray) {
- ckfree((char *) envPtr->literalArrayPtr);
+ ckfree(envPtr->literalArrayPtr);
}
if (envPtr->mallocedExceptArray) {
- ckfree((char *) envPtr->exceptArrayPtr);
+ ckfree(envPtr->exceptArrayPtr);
}
if (envPtr->mallocedCmdMap) {
- ckfree((char *) envPtr->cmdMapPtr);
+ ckfree(envPtr->cmdMapPtr);
}
if (envPtr->mallocedAuxDataArray) {
- ckfree((char *) envPtr->auxDataArrayPtr);
+ ckfree(envPtr->auxDataArrayPtr);
}
if (envPtr->extCmdMapPtr) {
- ckfree((char *) envPtr->extCmdMapPtr);
+ ckfree(envPtr->extCmdMapPtr);
}
/*
@@ -1378,7 +1505,8 @@ TclWordKnownAtCompileTime(
case TCL_TOKEN_BS:
if (tempPtr != NULL) {
char utfBuf[TCL_UTF_MAX];
- int length = Tcl_UtfBackslash(tokenPtr->start, NULL, utfBuf);
+ int length = TclParseBackslash(tokenPtr->start,
+ tokenPtr->size, NULL, utfBuf);
Tcl_AppendToObj(tempPtr, utfBuf, length);
}
@@ -1627,8 +1755,8 @@ TclCompileScript(
* have side effects that rely on the unmodified string.
*/
- Tcl_DStringSetLength(&ds, 0);
- Tcl_DStringAppend(&ds, tokenPtr[1].start,tokenPtr[1].size);
+ TclDStringClear(&ds);
+ TclDStringAppendToken(&ds, &tokenPtr[1]);
cmdPtr = (Command *) Tcl_FindCommand(interp,
Tcl_DStringValue(&ds),
@@ -1639,10 +1767,13 @@ TclCompileScript(
&& !(cmdPtr->nsPtr->flags&NS_SUPPRESS_COMPILATION)
&& !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
&& !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
- int savedNumCmds = envPtr->numCommands;
+ int code, savedNumCmds = envPtr->numCommands;
unsigned savedCodeNext =
envPtr->codeNext - envPtr->codeStart;
- int update = 0, code;
+ int update = 0;
+#ifdef TCL_COMPILE_DEBUG
+ int startStackDepth = envPtr->currStackDepth;
+#endif
/*
* Mark the start of the command; the proper bytecode
@@ -1686,6 +1817,25 @@ TclCompileScript(
envPtr);
if (code == TCL_OK) {
+ /*
+ * Confirm that the command compiler generated a
+ * single value on the stack as its result. This
+ * is only done in debugging mode, as it *should*
+ * be correct and normal users have no reasonable
+ * way to fix it anyway.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+ int diff = envPtr->currStackDepth-startStackDepth;
+
+ if (diff != 1 && (diff != 0 ||
+ *(envPtr->codeNext-1) != INST_DONE)) {
+ Tcl_Panic("bad stack adjustment when compiling"
+ " %.*s (was %d instead of 1)",
+ parsePtr->tokenPtr->size,
+ parsePtr->tokenPtr->start, diff);
+ }
+#endif
if (update) {
/*
* Fix the bytecode length.
@@ -1749,6 +1899,7 @@ TclCompileScript(
* unmodified. We care only if the we are in a context
* which already allows absolute counting.
*/
+
objIndex = TclRegisterNewLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size);
@@ -1797,7 +1948,6 @@ TclCompileScript(
&isnew);
Tcl_SetHashValue(hePtr, INT2PTR(wlineat));
-
if (wordIdx <= 255) {
TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
} else {
@@ -1820,8 +1970,8 @@ TclCompileScript(
* reduced form now
*/
- ckfree((char *) eclPtr->loc[wlineat].line);
- ckfree((char *) eclPtr->loc[wlineat].next);
+ ckfree(eclPtr->loc[wlineat].line);
+ ckfree(eclPtr->loc[wlineat].next);
eclPtr->loc[wlineat].line = wlines;
eclPtr->loc[wlineat].next = NULL;
} /* end if parsePtr->numWords > 0 */
@@ -1854,16 +2004,10 @@ TclCompileScript(
/*
* If the source script yielded no instructions (e.g., if it was empty),
* push an empty string as the command's result.
- *
- * WARNING: push an unshared object! If the script being compiled is a
- * shared empty string, it will otherwise be self-referential and cause
- * difficulties with literal management [Bugs 467523, 983660]. We used to
- * have special code in TclReleaseLiteral to handle this particular
- * self-reference, but now opt for avoiding its creation altogether.
*/
if (envPtr->codeNext == entryCodeNext) {
- TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewObj(), NULL), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
}
envPtr->numSrcBytes = p - script;
@@ -2008,7 +2152,7 @@ TclCompileTokens(
if (isLiteral) {
maxNumCL = NUM_STATIC_POS;
- clPosition = (int *) ckalloc(maxNumCL * sizeof(int));
+ clPosition = ckalloc(maxNumCL * sizeof(int));
}
Tcl_DStringInit(&textBuffer);
@@ -2016,13 +2160,14 @@ TclCompileTokens(
for ( ; count > 0; count--, tokenPtr++) {
switch (tokenPtr->type) {
case TCL_TOKEN_TEXT:
- Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size);
+ TclDStringAppendToken(&textBuffer, tokenPtr);
TclAdvanceLines(&envPtr->line, tokenPtr->start,
tokenPtr->start + tokenPtr->size);
break;
case TCL_TOKEN_BS:
- length = Tcl_UtfBackslash(tokenPtr->start, NULL, buffer);
+ length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
+ NULL, buffer);
Tcl_DStringAppend(&textBuffer, buffer, length);
/*
@@ -2047,8 +2192,8 @@ TclCompileTokens(
if (numCL >= maxNumCL) {
maxNumCL *= 2;
- clPosition = (int *) ckrealloc((char *) clPosition,
- maxNumCL * sizeof(int));
+ clPosition = ckrealloc(clPosition,
+ maxNumCL * sizeof(int));
}
clPosition[numCL] = clPos;
numCL ++;
@@ -2062,9 +2207,7 @@ TclCompileTokens(
*/
if (Tcl_DStringLength(&textBuffer) > 0) {
- int literal = TclRegisterNewLiteral(envPtr,
- Tcl_DStringValue(&textBuffer),
- Tcl_DStringLength(&textBuffer));
+ int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
@@ -2091,9 +2234,7 @@ TclCompileTokens(
if (Tcl_DStringLength(&textBuffer) > 0) {
int literal;
- literal = TclRegisterNewLiteral(envPtr,
- Tcl_DStringValue(&textBuffer),
- Tcl_DStringLength(&textBuffer));
+ literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
Tcl_DStringFree(&textBuffer);
@@ -2116,13 +2257,10 @@ TclCompileTokens(
*/
if (Tcl_DStringLength(&textBuffer) > 0) {
- int literal;
+ int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
- literal = TclRegisterNewLiteral(envPtr, Tcl_DStringValue(&textBuffer),
- Tcl_DStringLength(&textBuffer));
TclEmitPush(literal, envPtr);
numObjsToConcat++;
-
if (numCL) {
TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
numCL, clPosition);
@@ -2157,7 +2295,7 @@ TclCompileTokens(
*/
if (maxNumCL) {
- ckfree((char *) clPosition);
+ ckfree(clPosition);
}
}
@@ -2396,7 +2534,7 @@ TclInitByteCodeObj(
namespacePtr = envPtr->iPtr->globalNsPtr;
}
- p = (unsigned char *) ckalloc((size_t) structureSize);
+ p = ckalloc(structureSize);
codePtr = (ByteCode *) p;
codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
codePtr->compileEpoch = iPtr->compileEpoch;
@@ -2428,7 +2566,27 @@ TclInitByteCodeObj(
p += TCL_ALIGN(codeBytes); /* align object array */
codePtr->objArrayPtr = (Tcl_Obj **) p;
for (i = 0; i < numLitObjects; i++) {
- codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
+ if (objPtr == envPtr->literalArrayPtr[i].objPtr) {
+ /*
+ * Prevent circular reference where the bytecode intrep of
+ * a value contains a literal which is that same value.
+ * If this is allowed to happen, refcount decrements may not
+ * reach zero, and memory may leak. Bugs 467523, 3357771
+ *
+ * NOTE: [Bugs 3392070, 3389764] We make a copy based completely
+ * on the string value, and do not call Tcl_DuplicateObj() so we
+ * can be sure we do not have any lingering cycles hiding in
+ * the intrep.
+ */
+ int numBytes;
+ const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
+
+ codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes);
+ Tcl_IncrRefCount(codePtr->objArrayPtr[i]);
+ Tcl_DecrRefCount(objPtr);
+ } else {
+ codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
+ }
}
p += TCL_ALIGN(objArrayBytes); /* align exception range array */
@@ -2453,7 +2611,7 @@ TclInitByteCodeObj(
#else
nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
if (((size_t)(nextPtr - p)) != cmdLocBytes) {
- Tcl_Panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d", (nextPtr - p), cmdLocBytes);
+ Tcl_Panic("TclInitByteCodeObj: encoded cmd location bytes %lu != expected size %lu", (unsigned long)(nextPtr - p), (unsigned long)cmdLocBytes);
}
#endif
@@ -2588,9 +2746,7 @@ TclFindCompiledLocal(
if (create || (name == NULL)) {
localVar = procPtr->numCompiledLocals;
- localPtr = (CompiledLocal *) ckalloc((unsigned)
- (sizeof(CompiledLocal) - sizeof(localPtr->name)
- + nameBytes + 1));
+ localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameBytes + 1);
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
} else {
@@ -2651,19 +2807,17 @@ TclExpandCodeArray(
*/
size_t currBytes = envPtr->codeNext - envPtr->codeStart;
- size_t newBytes = 2*(envPtr->codeEnd - envPtr->codeStart);
+ size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);
if (envPtr->mallocedCodeArray) {
- envPtr->codeStart = (unsigned char *)
- ckrealloc((char *) envPtr->codeStart, newBytes);
+ envPtr->codeStart = ckrealloc(envPtr->codeStart, newBytes);
} else {
/*
* envPtr->codeStart isn't a ckalloc'd pointer, so we must code a
* ckrealloc equivalent for ourselves.
*/
- unsigned char *newPtr = (unsigned char *)
- ckalloc((unsigned) newBytes);
+ unsigned char *newPtr = ckalloc(newBytes);
memcpy(newPtr, envPtr->codeStart, currBytes);
envPtr->codeStart = newPtr;
@@ -2718,21 +2872,19 @@ EnterCmdStartData(
*/
size_t currElems = envPtr->cmdMapEnd;
- size_t newElems = 2*currElems;
+ size_t newElems = 2 * currElems;
size_t currBytes = currElems * sizeof(CmdLocation);
size_t newBytes = newElems * sizeof(CmdLocation);
if (envPtr->mallocedCmdMap) {
- envPtr->cmdMapPtr = (CmdLocation *)
- ckrealloc((char *) envPtr->cmdMapPtr, newBytes);
+ envPtr->cmdMapPtr = ckrealloc(envPtr->cmdMapPtr, newBytes);
} else {
/*
* envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must code a
* ckrealloc equivalent for ourselves.
*/
- CmdLocation *newPtr = (CmdLocation *)
- ckalloc((unsigned) newBytes);
+ CmdLocation *newPtr = ckalloc(newBytes);
memcpy(newPtr, envPtr->cmdMapPtr, currBytes);
envPtr->cmdMapPtr = newPtr;
@@ -2851,16 +3003,16 @@ EnterCmdWordData(
size_t newElems = (currElems ? 2*currElems : 1);
size_t newBytes = newElems * sizeof(ECL);
- eclPtr->loc = (ECL *) ckrealloc((char *) eclPtr->loc, newBytes);
+ eclPtr->loc = ckrealloc(eclPtr->loc, newBytes);
eclPtr->nloc = newElems;
}
ePtr = &eclPtr->loc[eclPtr->nuloc];
ePtr->srcOffset = srcOffset;
- ePtr->line = (int *) ckalloc(numWords * sizeof(int));
- ePtr->next = (int **) ckalloc(numWords * sizeof(int *));
+ ePtr->line = ckalloc(numWords * sizeof(int));
+ ePtr->next = ckalloc(numWords * sizeof(int *));
ePtr->nline = numWords;
- wwlines = (int *) ckalloc(numWords * sizeof(int));
+ wwlines = ckalloc(numWords * sizeof(int));
last = cmd;
wordLine = line;
@@ -2923,16 +3075,15 @@ TclCreateExceptRange(
size_t newBytes = newElems * sizeof(ExceptionRange);
if (envPtr->mallocedExceptArray) {
- envPtr->exceptArrayPtr = (ExceptionRange *)
- ckrealloc((char *) envPtr->exceptArrayPtr, newBytes);
+ envPtr->exceptArrayPtr =
+ ckrealloc(envPtr->exceptArrayPtr, newBytes);
} else {
/*
* envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must
* code a ckrealloc equivalent for ourselves.
*/
- ExceptionRange *newPtr = (ExceptionRange *)
- ckalloc((unsigned) newBytes);
+ ExceptionRange *newPtr = ckalloc(newBytes);
memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
envPtr->exceptArrayPtr = newPtr;
@@ -3002,15 +3153,15 @@ TclCreateAuxData(
size_t newBytes = newElems * sizeof(AuxData);
if (envPtr->mallocedAuxDataArray) {
- envPtr->auxDataArrayPtr = (AuxData *)
- ckrealloc((char *) envPtr->auxDataArrayPtr, newBytes);
+ envPtr->auxDataArrayPtr =
+ ckrealloc(envPtr->auxDataArrayPtr, newBytes);
} else {
/*
* envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must
* code a ckrealloc equivalent for ourselves.
*/
- AuxData *newPtr = (AuxData *) ckalloc((unsigned) newBytes);
+ AuxData *newPtr = ckalloc(newBytes);
memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes);
envPtr->auxDataArrayPtr = newPtr;
@@ -3078,8 +3229,8 @@ TclInitJumpFixupArray(
void
TclExpandJumpFixupArray(
register JumpFixupArray *fixupArrayPtr)
- /* Points to the JumpFixupArray structure
- * to enlarge. */
+ /* Points to the JumpFixupArray structure to
+ * enlarge. */
{
/*
* The currently allocated jump fixup entries are stored from fixup[0] up
@@ -3092,15 +3243,14 @@ TclExpandJumpFixupArray(
size_t newBytes = newElems * sizeof(JumpFixup);
if (fixupArrayPtr->mallocedArray) {
- fixupArrayPtr->fixup = (JumpFixup *)
- ckrealloc((char *) fixupArrayPtr->fixup, newBytes);
+ fixupArrayPtr->fixup = ckrealloc(fixupArrayPtr->fixup, newBytes);
} else {
/*
* fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must code a
* ckrealloc equivalent for ourselves.
*/
- JumpFixup *newPtr = (JumpFixup *) ckalloc((unsigned) newBytes);
+ JumpFixup *newPtr = ckalloc(newBytes);
memcpy(newPtr, fixupArrayPtr->fixup, currBytes);
fixupArrayPtr->fixup = newPtr;
@@ -3132,7 +3282,7 @@ TclFreeJumpFixupArray(
* free. */
{
if (fixupArrayPtr->mallocedArray) {
- ckfree((char *) fixupArrayPtr->fixup);
+ ckfree(fixupArrayPtr->fixup);
}
}
@@ -3313,6 +3463,70 @@ TclFixupForwardJump(
rangePtr->type);
}
}
+
+ /*
+ * TIP #280: Adjust the mapping from PC values to the per-command
+ * information about arguments and their line numbers.
+ *
+ * Note: We cannot simply remove an out-of-date entry and then reinsert
+ * with the proper PC, because then we might overwrite another entry which
+ * was at that location. Therefore we pull (copy + delete) all effected
+ * entries (beyond the fixed PC) into an array, update them there, and at
+ * last reinsert them all.
+ */
+
+ {
+ ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
+
+ /* A helper structure */
+
+ typedef struct {
+ int pc;
+ int cmd;
+ } MAP;
+
+ /*
+ * And the helper array. At most the whole hashtable is placed into
+ * this.
+ */
+
+ MAP *map = (MAP*) ckalloc (sizeof(MAP) * eclPtr->litInfo.numEntries);
+
+ Tcl_HashSearch hSearch;
+ Tcl_HashEntry* hPtr;
+ int n, k, isnew;
+
+ /*
+ * Phase I: Locate the affected entries, and save them in adjusted
+ * form to the array. This removes them from the hash.
+ */
+
+ for (n = 0, hPtr = Tcl_FirstHashEntry(&eclPtr->litInfo, &hSearch);
+ hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+
+ map [n].cmd = PTR2INT(Tcl_GetHashValue(hPtr));
+ map [n].pc = PTR2INT(Tcl_GetHashKey (&eclPtr->litInfo,hPtr));
+
+ if (map[n].pc >= (jumpFixupPtr->codeOffset + 2)) {
+ Tcl_DeleteHashEntry(hPtr);
+ map [n].pc += 3;
+ n++;
+ }
+ }
+
+ /*
+ * Phase II: Re-insert the modified entries into the hash.
+ */
+
+ for (k=0;k<n;k++) {
+ hPtr = Tcl_CreateHashEntry(&eclPtr->litInfo, INT2PTR(map[k].pc), &isnew);
+ Tcl_SetHashValue(hPtr, INT2PTR(map[k].cmd));
+ }
+
+ ckfree (map);
+ }
+
return 1; /* the jump was grown */
}
@@ -3467,6 +3681,7 @@ TclInitAuxDataTypeTable(void)
TclRegisterAuxDataType(&tclForeachInfoType);
TclRegisterAuxDataType(&tclJumptableInfoType);
+ TclRegisterAuxDataType(&tclDictUpdateInfoType);
}
/*
@@ -4242,6 +4457,173 @@ FormatInstruction(
/*
*----------------------------------------------------------------------
*
+ * TclGetInnerContext --
+ *
+ * If possible, returns a list capturing the inner context. Otherwise
+ * return NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetInnerContext(
+ Tcl_Interp *interp,
+ const unsigned char *pc,
+ Tcl_Obj **tosPtr)
+{
+ int objc = 0, off = 0;
+ Tcl_Obj *result;
+ Interp *iPtr = (Interp *) interp;
+
+ switch (*pc) {
+ case INST_STR_LEN:
+ case INST_LNOT:
+ case INST_BITNOT:
+ case INST_UMINUS:
+ case INST_UPLUS:
+ case INST_TRY_CVT_TO_NUMERIC:
+ case INST_EXPAND_STKTOP:
+ case INST_EXPR_STK:
+ objc = 1;
+ break;
+
+ case INST_LIST_IN:
+ case INST_LIST_NOT_IN: /* Basic list containment operators. */
+ case INST_STR_EQ:
+ case INST_STR_NEQ: /* String (in)equality check */
+ case INST_STR_CMP: /* String compare. */
+ case INST_STR_INDEX:
+ case INST_STR_MATCH:
+ case INST_REGEXP:
+ case INST_EQ:
+ case INST_NEQ:
+ case INST_LT:
+ case INST_GT:
+ case INST_LE:
+ case INST_GE:
+ case INST_MOD:
+ case INST_LSHIFT:
+ case INST_RSHIFT:
+ case INST_BITOR:
+ case INST_BITXOR:
+ case INST_BITAND:
+ case INST_EXPON:
+ case INST_ADD:
+ case INST_SUB:
+ case INST_DIV:
+ case INST_MULT:
+ objc = 2;
+ break;
+
+ case INST_RETURN_STK:
+ /* early pop. TODO: dig out opt dict too :/ */
+ objc = 1;
+ break;
+
+ case INST_SYNTAX:
+ case INST_RETURN_IMM:
+ objc = 2;
+ break;
+
+ case INST_INVOKE_STK4:
+ objc = TclGetUInt4AtPtr(pc+1);
+ break;
+
+ case INST_INVOKE_STK1:
+ objc = TclGetUInt1AtPtr(pc+1);
+ break;
+ }
+
+ result = iPtr->innerContext;
+ if (Tcl_IsShared(result)) {
+ Tcl_DecrRefCount(result);
+ iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
+ Tcl_IncrRefCount(result);
+ } else {
+ int len;
+
+ /*
+ * Reset while keeping the list intrep as much as possible.
+ */
+
+ Tcl_ListObjLength(interp, result, &len);
+ Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
+ }
+ Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
+
+ for (; objc>0 ; objc--) {
+ Tcl_Obj *objPtr;
+
+ objPtr = tosPtr[1 - objc + off];
+ if (!objPtr) {
+ Tcl_Panic("InnerContext: bad tos -- appending null object");
+ }
+ if (objPtr->refCount<=0 || objPtr->refCount==0x61616161) {
+ Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
+ objPtr);
+ }
+ Tcl_ListObjAppendElement(NULL, result, objPtr);
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewInstNameObj --
+ *
+ * Creates a new InstName Tcl_Obj based on the given instruction
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclNewInstNameObj(
+ unsigned char inst)
+{
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ objPtr->typePtr = &tclInstNameType;
+ objPtr->internalRep.longValue = (long) inst;
+ objPtr->bytes = NULL;
+
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfInstName --
+ *
+ * Update the string representation for an instruction name object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfInstName(
+ Tcl_Obj *objPtr)
+{
+ int inst = objPtr->internalRep.longValue;
+ char *s, buf[20];
+ int len;
+
+ if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
+ sprintf(buf, "inst_%d", inst);
+ s = buf;
+ } else {
+ s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
+ }
+ len = strlen(s);
+ objPtr->bytes = ckalloc(len + 1);
+ memcpy(objPtr->bytes, s, len + 1);
+ objPtr->length = len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* PrintSourceToObj --
*
* Appends a quoted representation of a string to a Tcl_Obj.
@@ -4320,7 +4702,13 @@ RecordByteCodeStats(
* to add to accumulated statistics. */
{
Interp *iPtr = (Interp *) *codePtr->interpHandle;
- register ByteCodeStats *statsPtr = &iPtr->stats;
+ register ByteCodeStats *statsPtr;
+
+ if (iPtr == NULL) {
+ /* Avoid segfaulting in case we're called in a deleted interp */
+ return;
+ }
+ statsPtr = &(iPtr->stats);
statsPtr->numCompilations++;
statsPtr->totalSrcBytes += (double) codePtr->numSrcBytes;
@@ -4347,5 +4735,6 @@ RecordByteCodeStats(
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
* End:
*/
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index e6b0411..3302f9b 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclCompile.h,v 1.127 2010/09/27 19:42:38 msofer Exp $
*/
#ifndef _TCLCOMPILATION
@@ -678,8 +676,43 @@ typedef struct ByteCode {
#define INST_UNSET_ARRAY_STK 136
#define INST_UNSET_STK 137
+/* For [dict with], [dict exists], [dict create] and [dict merge] */
+#define INST_DICT_EXPAND 138
+#define INST_DICT_RECOMBINE_STK 139
+#define INST_DICT_RECOMBINE_IMM 140
+#define INST_DICT_EXISTS 141
+#define INST_DICT_VERIFY 142
+
+/* For [string map] and [regsub] compilation */
+#define INST_STR_MAP 143
+#define INST_STR_FIND 144
+#define INST_STR_FIND_LAST 145
+#define INST_STR_RANGE_IMM 146
+#define INST_STR_RANGE 147
+
+/* For operations to do with coroutines and other NRE-manipulators */
+#define INST_YIELD 148
+#define INST_COROUTINE_NAME 149
+#define INST_TAILCALL 150
+
+/* For compilation of basic information operations */
+#define INST_NS_CURRENT 151
+#define INST_INFO_LEVEL_NUM 152
+#define INST_INFO_LEVEL_ARGS 153
+#define INST_RESOLVE_COMMAND 154
+#define INST_TCLOO_SELF 155
+#define INST_TCLOO_CLASS 156
+#define INST_TCLOO_NS 157
+#define INST_TCLOO_IS_OBJECT 158
+
+/* For compilation of [array] subcommands */
+#define INST_ARRAY_EXISTS_STK 159
+#define INST_ARRAY_EXISTS_IMM 160
+#define INST_ARRAY_MAKE_STK 161
+#define INST_ARRAY_MAKE_IMM 162
+
/* The last opcode */
-#define LAST_INST_OPCODE 137
+#define LAST_INST_OPCODE 162
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
@@ -863,8 +896,7 @@ typedef struct {
*----------------------------------------------------------------
*/
-MODULE_SCOPE Tcl_NRPostProc NRCommand;
-MODULE_SCOPE Tcl_ObjCmdProc NRInterpCoroutine;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine;
/*
*----------------------------------------------------------------
@@ -957,6 +989,8 @@ MODULE_SCOPE void TclRegisterAuxDataType(const AuxDataType *typePtr);
MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr,
char *bytes, int length, int flags);
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
+MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
+ const char *name, Namespace *nsPtr);
MODULE_SCOPE int TclSingleOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -975,6 +1009,14 @@ MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr);
#endif
MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
Tcl_Obj *valuePtr);
+MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp,
+ const char *script,
+ const char *command, int length,
+ const unsigned char *pc, Tcl_Obj **tosPtr);
+MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp,
+ const unsigned char *pc, Tcl_Obj **tosPtr);
+MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
+
/*
*----------------------------------------------------------------
@@ -1352,6 +1394,16 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
(envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr)
/*
+ * Macros for making it easier to deal with tokens and DStrings.
+ */
+
+#define TclDStringAppendToken(dsPtr, tokenPtr) \
+ Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size)
+#define TclRegisterDStringLiteral(envPtr, dsPtr) \
+ TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \
+ Tcl_DStringLength(dsPtr), /*flags*/ 0)
+
+/*
* DTrace probe macros (NOPs if DTrace support is not enabled).
*/
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index 0bcd0d8..a4ba71a 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclConfig.c,v 1.25 2009/01/09 11:21:45 dkf Exp $
*/
#include "tclInt.h"
@@ -80,7 +78,7 @@ Tcl_RegisterConfig(
Tcl_DString cmdName;
const Tcl_Config *cfg;
Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding);
- QCCD *cdPtr = (QCCD *) ckalloc(sizeof(QCCD));
+ QCCD *cdPtr = ckalloc(sizeof(QCCD));
cdPtr->interp = interp;
cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);
@@ -157,7 +155,7 @@ Tcl_RegisterConfig(
*/
Tcl_DStringInit(&cmdName);
- Tcl_DStringAppend(&cmdName, "::", -1);
+ TclDStringAppendLiteral(&cmdName, "::");
Tcl_DStringAppend(&cmdName, pkgName, -1);
/*
@@ -175,7 +173,7 @@ Tcl_RegisterConfig(
}
}
- Tcl_DStringAppend(&cmdName, "::pkgconfig", -1);
+ TclDStringAppendLiteral(&cmdName, "::pkgconfig");
if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName),
QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) {
@@ -238,7 +236,9 @@ QueryConfigObjCmd(
* present.
*/
- Tcl_SetResult(interp, "package not known", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
+ Tcl_GetString(pkgName), NULL);
return TCL_ERROR;
}
@@ -249,9 +249,11 @@ QueryConfigObjCmd(
return TCL_ERROR;
}
- if (Tcl_DictObjGet(interp, pkgDict, objv [2], &val) != TCL_OK
+ if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK
|| val == NULL) {
- Tcl_SetResult(interp, "key not known", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
+ Tcl_GetString(objv[2]), NULL);
return TCL_ERROR;
}
@@ -268,25 +270,20 @@ QueryConfigObjCmd(
listPtr = Tcl_NewListObj(n, NULL);
if (!listPtr) {
- Tcl_SetResult(interp, "insufficient memory to create list",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "insufficient memory to create list", -1));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
}
if (n) {
- List *listRepPtr = (List *)
- listPtr->internalRep.twoPtrValue.ptr1;
Tcl_DictSearch s;
- Tcl_Obj *key, **vals;
- int done, i = 0;
-
- listRepPtr->elemCount = n;
- vals = &listRepPtr->elements;
+ Tcl_Obj *key;
+ int done;
for (Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done);
!done; Tcl_DictObjNext(&s, &key, NULL, &done)) {
- vals[i++] = key;
- Tcl_IncrRefCount(key);
+ Tcl_ListObjAppendElement(NULL, listPtr, key);
}
}
@@ -321,12 +318,13 @@ static void
QueryConfigDelete(
ClientData clientData)
{
- QCCD *cdPtr = (QCCD *) clientData;
+ QCCD *cdPtr = clientData;
Tcl_Obj *pkgName = cdPtr->pkg;
Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);
+
Tcl_DictObjRemove(NULL, pDB, pkgName);
Tcl_DecrRefCount(pkgName);
- ckfree((char *)cdPtr);
+ ckfree(cdPtr);
}
/*
diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d
index 535a9ff..360bdff 100644
--- a/generic/tclDTrace.d
+++ b/generic/tclDTrace.d
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclDTrace.d,v 1.4 2008/10/10 04:09:27 das Exp $
*/
typedef struct Tcl_Obj Tcl_Obj;
@@ -27,7 +25,7 @@ provider tcl {
* arg1: number of arguments (int)
* arg2: array of proc argument objects (Tcl_Obj**)
*/
- probe proc__entry(TclDTraceStr name, int objc, Tcl_Obj **objv);
+ probe proc__entry(TclDTraceStr name, int objc, struct Tcl_Obj **objv);
/*
* tcl*:::proc-return probe
* triggered immediately after proc bytecode execution
@@ -44,7 +42,7 @@ provider tcl {
* arg3: proc result object (Tcl_Obj*)
*/
probe proc__result(TclDTraceStr name, int code, TclDTraceStr result,
- Tcl_Obj *resultobj);
+ struct Tcl_Obj *resultobj);
/*
* tcl*:::proc-args probe
* triggered before proc-entry probe, gives access to string
@@ -81,7 +79,7 @@ provider tcl {
* arg1: number of arguments (int)
* arg2: array of command argument objects (Tcl_Obj**)
*/
- probe cmd__entry(TclDTraceStr name, int objc, Tcl_Obj **objv);
+ probe cmd__entry(TclDTraceStr name, int objc, struct Tcl_Obj **objv);
/*
* tcl*:::cmd-return probe
* triggered immediately after commmand execution
@@ -98,7 +96,7 @@ provider tcl {
* arg3: command result object (Tcl_Obj*)
*/
probe cmd__result(TclDTraceStr name, int code, TclDTraceStr result,
- Tcl_Obj *resultobj);
+ struct Tcl_Obj *resultobj);
/*
* tcl*:::cmd-args probe
* triggered before cmd-entry probe, gives access to string
@@ -135,7 +133,7 @@ provider tcl {
* arg1: depth of stack (int)
* arg2: top of stack (Tcl_Obj**)
*/
- probe inst__start(TclDTraceStr name, int depth, Tcl_Obj **stack);
+ probe inst__start(TclDTraceStr name, int depth, struct Tcl_Obj **stack);
/*
* tcl*:::inst-done probe
* triggered immediately after execution of a bytecode
@@ -143,7 +141,7 @@ provider tcl {
* arg1: depth of stack (int)
* arg2: top of stack (Tcl_Obj**)
*/
- probe inst__done(TclDTraceStr name, int depth, Tcl_Obj **stack);
+ probe inst__done(TclDTraceStr name, int depth, struct Tcl_Obj **stack);
/***************************** obj probes ******************************/
/*
@@ -151,13 +149,13 @@ provider tcl {
* triggered immediately after a new Tcl_Obj has been created
* arg0: object created (Tcl_Obj*)
*/
- probe obj__create(Tcl_Obj* obj);
+ probe obj__create(struct Tcl_Obj* obj);
/*
* tcl*:::obj-free probe
* triggered immediately before a Tcl_Obj is freed
* arg0: object to be freed (Tcl_Obj*)
*/
- probe obj__free(Tcl_Obj* obj);
+ probe obj__free(struct Tcl_Obj* obj);
/***************************** tcl probes ******************************/
/*
diff --git a/generic/tclDate.c b/generic/tclDate.c
index 13033f0..14bac51 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -129,7 +129,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
*/
#include "tclInt.h"
@@ -2801,10 +2800,12 @@ TclClockOldscanObjCmd(
if (status == 1) {
Tcl_SetObjResult(interp, dateInfo.messages);
Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
return TCL_ERROR;
} else if (status == 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
} else if (status != 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned "
@@ -2812,6 +2813,7 @@ TclClockOldscanObjCmd(
"report this error as a "
"bug in Tcl.", -1));
Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
return TCL_ERROR;
}
Tcl_DecrRefCount(dateInfo.messages);
@@ -2819,26 +2821,31 @@ TclClockOldscanObjCmd(
if (yyHaveDate > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one date in string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
if (yyHaveTime > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one time of day in string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
if (yyHaveZone > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one time zone in string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
if (yyHaveDay > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one weekday in string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
if (yyHaveOrdinalMonth > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one ordinal month in string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index fc9e082..2801102 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclDecls.h,v 1.187 2010/09/23 21:40:46 nijtmans Exp $
*/
#ifndef _TCLDECLS
@@ -46,7 +44,7 @@ EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
const char *name, const char *version,
int exact, void *clientDataPtr);
/* 2 */
-EXTERN void Tcl_Panic(const char *format, ...);
+EXTERN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 3 */
EXTERN char * Tcl_Alloc(unsigned int size);
/* 4 */
@@ -653,9 +651,9 @@ EXTERN void Tcl_Release(ClientData clientData);
/* 217 */
EXTERN void Tcl_ResetResult(Tcl_Interp *interp);
/* 218 */
-EXTERN int Tcl_ScanElement(const char *str, int *flagPtr);
+EXTERN int Tcl_ScanElement(const char *src, int *flagPtr);
/* 219 */
-EXTERN int Tcl_ScanCountedElement(const char *str, int length,
+EXTERN int Tcl_ScanCountedElement(const char *src, int length,
int *flagPtr);
/* 220 */
EXTERN int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
@@ -1664,10 +1662,10 @@ EXTERN int Tcl_AppendFormatToObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, const char *format,
int objc, Tcl_Obj *const objv[]);
/* 578 */
-EXTERN Tcl_Obj * Tcl_ObjPrintf(const char *format, ...);
+EXTERN Tcl_Obj * Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 579 */
EXTERN void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
- const char *format, ...);
+ const char *format, ...) TCL_FORMAT_PRINTF(2, 3);
/* 580 */
EXTERN int Tcl_CancelEval(Tcl_Interp *interp,
Tcl_Obj *resultObjPtr, ClientData clientData,
@@ -1804,13 +1802,17 @@ EXTERN int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
const char *const symv[], int flags,
void *procPtrs, Tcl_LoadHandle *handlePtr);
/* 628 */
-EXTERN void* Tcl_FindSymbol(Tcl_Interp *interp,
+EXTERN void * Tcl_FindSymbol(Tcl_Interp *interp,
Tcl_LoadHandle handle, const char *symbol);
/* 629 */
EXTERN int Tcl_FSUnloadFile(Tcl_Interp *interp,
Tcl_LoadHandle handlePtr);
+/* 630 */
+EXTERN void Tcl_ZlibStreamSetCompressionDictionary(
+ Tcl_ZlibStream zhandle,
+ Tcl_Obj *compressionDictionaryObj);
-typedef struct TclStubHooks {
+typedef struct {
const struct TclPlatStubs *tclPlatStubs;
const struct TclIntStubs *tclIntStubs;
const struct TclIntPlatStubs *tclIntPlatStubs;
@@ -1818,11 +1820,11 @@ typedef struct TclStubHooks {
typedef struct TclStubs {
int magic;
- const struct TclStubHooks *hooks;
+ const TclStubHooks *hooks;
int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
- void (*tcl_Panic) (const char *format, ...); /* 2 */
+ void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
char * (*tcl_Alloc) (unsigned int size); /* 3 */
void (*tcl_Free) (char *ptr); /* 4 */
char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */
@@ -1832,7 +1834,7 @@ typedef struct TclStubs {
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) /* WIN */
void (*reserved9)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -1841,7 +1843,7 @@ typedef struct TclStubs {
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) /* WIN */
void (*reserved10)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -2006,7 +2008,7 @@ typedef struct TclStubs {
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) /* WIN */
void (*reserved167)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -2062,8 +2064,8 @@ typedef struct TclStubs {
void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */
void (*tcl_Release) (ClientData clientData); /* 216 */
void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
- int (*tcl_ScanElement) (const char *str, int *flagPtr); /* 218 */
- int (*tcl_ScanCountedElement) (const char *str, int length, int *flagPtr); /* 219 */
+ int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
+ int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */
int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
int (*tcl_ServiceAll) (void); /* 221 */
int (*tcl_ServiceEvent) (int flags); /* 222 */
@@ -2422,8 +2424,8 @@ typedef struct TclStubs {
void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis); /* 575 */
Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 576 */
int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */
- Tcl_Obj * (*tcl_ObjPrintf) (const char *format, ...); /* 578 */
- void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, const char *format, ...); /* 579 */
+ Tcl_Obj * (*tcl_ObjPrintf) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 578 */
+ void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 579 */
int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, ClientData clientData, int flags); /* 580 */
int (*tcl_Canceled) (Tcl_Interp *interp, int flags); /* 581 */
int (*tcl_CreatePipe) (Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 582 */
@@ -2472,8 +2474,9 @@ typedef struct TclStubs {
int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
- void* (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
+ void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
+ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
} TclStubs;
#ifdef __cplusplus
@@ -3766,6 +3769,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_FindSymbol) /* 628 */
#define Tcl_FSUnloadFile \
(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
+#define Tcl_ZlibStreamSetCompressionDictionary \
+ (tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
#endif /* defined(USE_TCL_STUBS) */
@@ -3787,8 +3792,12 @@ extern const TclStubs *tclStubsPtr;
# define Tcl_SetVar(interp, varName, newValue, flags) \
(tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags))
#endif
+
#if defined(_WIN32) && defined(UNICODE)
# define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
+# define Tcl_MainEx Tcl_MainExW
+ EXTERN void Tcl_MainExW(int argc, wchar_t **argv,
+ Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
#undef TCL_STORAGE_CLASS
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 6a17b02..eb3625e 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclDictObj.c,v 1.84 2010/08/22 18:53:26 nijtmans Exp $
*/
#include "tclInt.h"
@@ -78,35 +76,39 @@ static int FinalizeDictWith(ClientData data[],
Tcl_Interp *interp, int result);
static int DictForNRCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv);
+static int DictMapNRCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
static int DictForLoopCallback(ClientData data[],
Tcl_Interp *interp, int result);
-
+static int DictMapLoopCallback(ClientData data[],
+ Tcl_Interp *interp, int result);
/*
* Table of dict subcommand names and implementations.
*/
static const EnsembleImplMap implementationMap[] = {
- {"append", DictAppendCmd, TclCompileDictAppendCmd, NULL, NULL },
- {"create", DictCreateCmd, NULL, NULL, NULL },
- {"exists", DictExistsCmd, NULL, NULL, NULL },
- {"filter", DictFilterCmd, NULL, NULL, NULL },
- {"for", NULL, TclCompileDictForCmd, DictForNRCmd, NULL },
- {"get", DictGetCmd, TclCompileDictGetCmd, NULL, NULL },
- {"incr", DictIncrCmd, TclCompileDictIncrCmd, NULL, NULL },
- {"info", DictInfoCmd, NULL, NULL, NULL },
- {"keys", DictKeysCmd, NULL, NULL, NULL },
- {"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL },
- {"merge", DictMergeCmd, NULL, NULL, NULL },
- {"remove", DictRemoveCmd, NULL, NULL, NULL },
- {"replace", DictReplaceCmd, NULL, NULL, NULL },
- {"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL },
- {"size", DictSizeCmd, NULL, NULL, NULL },
- {"unset", DictUnsetCmd, NULL, NULL, NULL },
- {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL },
- {"values", DictValuesCmd, NULL, NULL, NULL },
- {"with", DictWithCmd, NULL, NULL, NULL },
- {NULL, NULL, NULL, NULL, NULL}
+ {"append", DictAppendCmd, TclCompileDictAppendCmd, NULL, NULL, 0 },
+ {"create", DictCreateCmd, TclCompileDictCreateCmd, NULL, NULL, 0 },
+ {"exists", DictExistsCmd, TclCompileDictExistsCmd, NULL, NULL, 0 },
+ {"filter", DictFilterCmd, NULL, NULL, NULL, 0 },
+ {"for", NULL, TclCompileDictForCmd, DictForNRCmd, NULL, 0 },
+ {"get", DictGetCmd, TclCompileDictGetCmd, NULL, NULL, 0 },
+ {"incr", DictIncrCmd, TclCompileDictIncrCmd, NULL, NULL, 0 },
+ {"info", DictInfoCmd, NULL, NULL, NULL, 0 },
+ {"keys", DictKeysCmd, NULL, NULL, NULL, 0 },
+ {"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL, 0 },
+ {"map", NULL, TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
+ {"merge", DictMergeCmd, TclCompileDictMergeCmd, NULL, NULL, 0 },
+ {"remove", DictRemoveCmd, NULL, NULL, NULL, 0 },
+ {"replace", DictReplaceCmd, NULL, NULL, NULL, 0 },
+ {"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 },
+ {"size", DictSizeCmd, NULL, NULL, NULL, 0 },
+ {"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 },
+ {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 },
+ {"values", DictValuesCmd, NULL, NULL, NULL, 0 },
+ {"with", DictWithCmd, TclCompileDictWithCmd, NULL, NULL, 0 },
+ {NULL, NULL, NULL, NULL, NULL, 0}
};
/*
@@ -183,6 +185,23 @@ static const Tcl_HashKeyType chainHashType = {
AllocChainEntry,
TclFreeObjEntry
};
+
+/*
+ * Structure used in implementation of 'dict map' to hold the state that gets
+ * passed between parts of the implementation.
+ */
+
+typedef struct {
+ Tcl_Obj *keyVarObj; /* The name of the variable that will have
+ * keys assigned to it. */
+ Tcl_Obj *valueVarObj; /* The name of the variable that will have
+ * values assigned to it. */
+ Tcl_DictSearch search; /* The dictionary search structure. */
+ Tcl_Obj *scriptObj; /* The script to evaluate each time through
+ * the loop. */
+ Tcl_Obj *accumulatorObj; /* The dictionary used to accumulate the
+ * results. */
+} DictMapStorage;
/***** START OF FUNCTIONS IMPLEMENTING DICT CORE API *****/
@@ -212,8 +231,8 @@ AllocChainEntry(
Tcl_Obj *objPtr = keyPtr;
ChainEntry *cPtr;
- cPtr = (ChainEntry *) ckalloc(sizeof(ChainEntry));
- cPtr->entry.key.oneWordValue = (char *) objPtr;
+ cPtr = ckalloc(sizeof(ChainEntry));
+ cPtr->entry.key.objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
cPtr->entry.clientData = NULL;
cPtr->prevPtr = cPtr->nextPtr = NULL;
@@ -343,7 +362,7 @@ DupDictInternalRep(
Tcl_Obj *copyPtr)
{
Dict *oldDict = srcPtr->internalRep.otherValuePtr;
- Dict *newDict = (Dict *) ckalloc(sizeof(Dict));
+ Dict *newDict = ckalloc(sizeof(Dict));
ChainEntry *cPtr;
/*
@@ -439,7 +458,7 @@ DeleteDict(
Dict *dict)
{
DeleteChainTable(dict);
- ckfree((char *) dict);
+ ckfree(dict);
}
/*
@@ -469,20 +488,28 @@ UpdateStringOfDict(
Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr;
+ int localFlags[LOCAL_SIZE], *flagPtr = NULL;
Dict *dict = dictPtr->internalRep.otherValuePtr;
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
- int numElems, i, length;
+ int i, length, bytesNeeded = 0;
const char *elem;
char *dst;
+ const int maxFlags = UINT_MAX / sizeof(int);
/*
* This field is the most useful one in the whole hash structure, and it
* is not exposed by any API function...
*/
- numElems = dict->table.numEntries * 2;
+ int numElems = dict->table.numEntries * 2;
+
+ /* Handle empty list case first, simplifies what follows */
+ if (numElems == 0) {
+ dictPtr->bytes = tclEmptyStringRep;
+ dictPtr->length = 0;
+ return;
+ }
/*
* Pass 1: estimate space, gather flags.
@@ -490,55 +517,63 @@ UpdateStringOfDict(
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
+ } else if (numElems > maxFlags) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
} else {
- flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
+ flagPtr = ckalloc(numElems * sizeof(int));
}
- dictPtr->length = 1;
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
/*
* Assume that cPtr is never NULL since we know the number of array
* elements already.
*/
+ flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
- dictPtr->length += Tcl_ScanCountedElement(elem, length,
- &flagPtr[i]) + 1;
+ bytesNeeded += TclScanElement(elem, length, flagPtr+i);
+ if (bytesNeeded < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+ flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
valuePtr = Tcl_GetHashValue(&cPtr->entry);
elem = TclGetStringFromObj(valuePtr, &length);
- dictPtr->length += Tcl_ScanCountedElement(elem, length,
- &flagPtr[i+1]) + 1;
+ bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);
+ if (bytesNeeded < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
}
+ if (bytesNeeded > INT_MAX - numElems + 1) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+ bytesNeeded += numElems;
/*
* Pass 2: copy into string rep buffer.
*/
- dictPtr->bytes = ckalloc((unsigned) dictPtr->length);
+ dictPtr->length = bytesNeeded - 1;
+ dictPtr->bytes = ckalloc(bytesNeeded);
dst = dictPtr->bytes;
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
+ flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
- dst += Tcl_ConvertCountedElement(elem, length, dst,
- flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
- *(dst++) = ' ';
+ dst += TclConvertElement(elem, length, dst, flagPtr[i]);
+ *dst++ = ' ';
+ flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
valuePtr = Tcl_GetHashValue(&cPtr->entry);
elem = TclGetStringFromObj(valuePtr, &length);
- dst += Tcl_ConvertCountedElement(elem, length, dst,
- flagPtr[i+1] | TCL_DONT_QUOTE_HASH);
- *(dst++) = ' ';
+ dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
+ *dst++ = ' ';
}
+ dictPtr->bytes[dictPtr->length] = '\0';
+
if (flagPtr != localFlags) {
- ckfree((char *) flagPtr);
- }
- if (dst == dictPtr->bytes) {
- *dst = 0;
- } else {
- *(--dst) = 0;
+ ckfree(flagPtr);
}
- dictPtr->length = dst - dictPtr->bytes;
}
/*
@@ -566,15 +601,11 @@ SetDictFromAny(
Tcl_Interp *interp,
Tcl_Obj *objPtr)
{
- const char *string;
- char *s;
- const char *elemStart, *nextElem;
- int lenRemain, length, elemSize, hasBrace, result, isNew;
- const char *limit; /* Points just after string's last byte. */
- register const char *p;
- register Tcl_Obj *keyPtr, *valuePtr;
- Dict *dict;
Tcl_HashEntry *hPtr;
+ int isNew, result;
+ Dict *dict = ckalloc(sizeof(Dict));
+
+ InitChainTable(dict);
/*
* Since lists and dictionaries have very closely-related string
@@ -586,29 +617,15 @@ SetDictFromAny(
int objc, i;
Tcl_Obj **objv;
- if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
- return TCL_ERROR;
- }
+ /* Cannot fail, we already know the Tcl_ObjType is "list". */
+ TclListObjGetElements(NULL, objPtr, &objc, &objv);
if (objc & 1) {
- if (interp != NULL) {
- Tcl_SetResult(interp, "missing value to go with key",
- TCL_STATIC);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
- }
- return TCL_ERROR;
+ goto missingValue;
}
- /*
- * Build the hash of key/value pairs.
- */
-
- dict = (Dict *) ckalloc(sizeof(Dict));
- InitChainTable(dict);
for (i=0 ; i<objc ; i+=2) {
- /*
- * Store key and value in the hash table we're building.
- */
-
+
+ /* Store key and value in the hash table we're building. */
hPtr = CreateChainEntry(dict, objv[i], &isNew);
if (!isNew) {
Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
@@ -626,112 +643,68 @@ SetDictFromAny(
Tcl_SetHashValue(hPtr, objv[i+1]);
Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
}
-
- /*
- * Share type-setting code with the string-conversion case.
- */
-
- goto installHash;
- }
-
- /*
- * Get the string representation. Make it up-to-date if necessary.
- */
-
- string = TclGetStringFromObj(objPtr, &length);
- limit = (string + length);
-
- /*
- * Allocate a new HashTable that has objects for keys and objects for
- * values.
- */
-
- dict = (Dict *) ckalloc(sizeof(Dict));
- InitChainTable(dict);
- for (p = string, lenRemain = length;
- lenRemain > 0;
- p = nextElem, lenRemain = (limit - nextElem)) {
- result = TclFindElement(interp, p, lenRemain,
- &elemStart, &nextElem, &elemSize, &hasBrace);
- if (result != TCL_OK) {
- if (interp != NULL) {
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+ } else {
+ int length;
+ const char *nextElem = TclGetStringFromObj(objPtr, &length);
+ const char *limit = (nextElem + length);
+
+ while (nextElem < limit) {
+ Tcl_Obj *keyPtr, *valuePtr;
+ const char *elemStart;
+ int elemSize, literal;
+
+ result = TclFindElement(interp, nextElem, (limit - nextElem),
+ &elemStart, &nextElem, &elemSize, &literal);
+ if (result != TCL_OK) {
+ goto errorExit;
}
- goto errorExit;
- }
- if (elemStart >= limit) {
- break;
- }
-
- /*
- * Allocate a Tcl object for the element and initialize it from the
- * "elemSize" bytes starting at "elemStart".
- */
-
- s = ckalloc((unsigned) elemSize + 1);
- if (hasBrace) {
- memcpy(s, elemStart, (size_t) elemSize);
- s[elemSize] = 0;
- } else {
- elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
- }
-
- TclNewObj(keyPtr);
- keyPtr->bytes = s;
- keyPtr->length = elemSize;
-
- p = nextElem;
- lenRemain = (limit - nextElem);
- if (lenRemain <= 0) {
- goto missingKey;
- }
-
- result = TclFindElement(interp, p, lenRemain,
- &elemStart, &nextElem, &elemSize, &hasBrace);
- if (result != TCL_OK) {
- if (interp != NULL) {
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+ if (elemStart == limit) {
+ break;
+ }
+ if (nextElem == limit) {
+ goto missingValue;
}
- TclDecrRefCount(keyPtr);
- goto errorExit;
- }
- if (elemStart >= limit) {
- goto missingKey;
- }
-
- /*
- * Allocate a Tcl object for the element and initialize it from the
- * "elemSize" bytes starting at "elemStart".
- */
- s = ckalloc((unsigned) elemSize + 1);
- if (hasBrace) {
- memcpy(s, elemStart, (size_t) elemSize);
- s[elemSize] = 0;
- } else {
- elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
- }
+ if (literal) {
+ TclNewStringObj(keyPtr, elemStart, elemSize);
+ } else {
+ /* Avoid double copy */
+ TclNewObj(keyPtr);
+ keyPtr->bytes = ckalloc((unsigned) elemSize + 1);
+ keyPtr->length = TclCopyAndCollapse(elemSize, elemStart,
+ keyPtr->bytes);
+ }
- TclNewObj(valuePtr);
- valuePtr->bytes = s;
- valuePtr->length = elemSize;
+ result = TclFindElement(interp, nextElem, (limit - nextElem),
+ &elemStart, &nextElem, &elemSize, &literal);
+ if (result != TCL_OK) {
+ TclDecrRefCount(keyPtr);
+ goto errorExit;
+ }
- /*
- * Store key and value in the hash table we're building.
- */
+ if (literal) {
+ TclNewStringObj(valuePtr, elemStart, elemSize);
+ } else {
+ /* Avoid double copy */
+ TclNewObj(valuePtr);
+ valuePtr->bytes = ckalloc((unsigned) elemSize + 1);
+ valuePtr->length = TclCopyAndCollapse(elemSize, elemStart,
+ valuePtr->bytes);
+ }
- hPtr = CreateChainEntry(dict, keyPtr, &isNew);
- if (!isNew) {
- Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
+ /* Store key and value in the hash table we're building. */
+ hPtr = CreateChainEntry(dict, keyPtr, &isNew);
+ if (!isNew) {
+ Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
- TclDecrRefCount(keyPtr);
- TclDecrRefCount(discardedValue);
+ TclDecrRefCount(keyPtr);
+ TclDecrRefCount(discardedValue);
+ }
+ Tcl_SetHashValue(hPtr, valuePtr);
+ Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */
}
- Tcl_SetHashValue(hPtr, valuePtr);
- Tcl_IncrRefCount(valuePtr); /* Since hash now holds ref to it. */
}
- installHash:
/*
* Free the old internalRep before setting the new one. We do this as late
* as possible to allow the conversion code, in particular
@@ -746,17 +719,20 @@ SetDictFromAny(
objPtr->typePtr = &tclDictType;
return TCL_OK;
- missingKey:
+ missingValue:
if (interp != NULL) {
- Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing value to go with key", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
}
- TclDecrRefCount(keyPtr);
result = TCL_ERROR;
errorExit:
+ if (interp != NULL) {
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+ }
DeleteChainTable(dict);
- ckfree((char *) dict);
+ ckfree(dict);
return result;
}
@@ -825,9 +801,9 @@ TclTraceDictPath(
}
if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) {
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "key \"", TclGetString(keyv[i]),
- "\" not known in dictionary", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "key \"%s\" not known in dictionary",
+ TclGetString(keyv[i])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
TclGetString(keyv[i]), NULL);
}
@@ -999,6 +975,7 @@ Tcl_DictObjGet(
if (dictPtr->typePtr != &tclDictType) {
int result = SetDictFromAny(interp, dictPtr);
if (result != TCL_OK) {
+ *valuePtrPtr = NULL;
return result;
}
}
@@ -1421,7 +1398,7 @@ Tcl_NewDictObj(void)
TclNewObj(dictPtr);
Tcl_InvalidateStringRep(dictPtr);
- dict = (Dict *) ckalloc(sizeof(Dict));
+ dict = ckalloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
@@ -1470,7 +1447,7 @@ Tcl_DbNewDictObj(
TclDbNewObj(dictPtr, file, line);
Tcl_InvalidateStringRep(dictPtr);
- dict = (Dict *) ckalloc(sizeof(Dict));
+ dict = ckalloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
@@ -1617,9 +1594,9 @@ DictGetCmd(
return result;
}
if (valuePtr == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "key \"", TclGetString(objv[objc-1]),
- "\" not known in dictionary", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "key \"%s\" not known in dictionary",
+ TclGetString(objv[objc-1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
TclGetString(objv[objc-1]), NULL);
return TCL_ERROR;
@@ -2028,7 +2005,6 @@ DictExistsCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr;
- int result;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary key ?key ...?");
@@ -2037,18 +2013,13 @@ DictExistsCmd(
dictPtr = TclTraceDictPath(interp, objv[1], objc-3, objv+2,
DICT_PATH_EXISTS);
- if (dictPtr == NULL) {
- return TCL_ERROR;
- }
- if (dictPtr == DICT_PATH_NON_EXISTENT) {
+ if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT
+ || Tcl_DictObjGet(interp, dictPtr, objv[objc-1],
+ &valuePtr) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
- return TCL_OK;
- }
- result = Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr);
- if (result != TCL_OK) {
- return result;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL));
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL));
return TCL_OK;
}
@@ -2079,6 +2050,7 @@ DictInfoCmd(
{
Tcl_Obj *dictPtr;
Dict *dict;
+ char *statsStr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
@@ -2094,7 +2066,9 @@ DictInfoCmd(
}
dict = dictPtr->internalRep.otherValuePtr;
- Tcl_SetResult(interp, Tcl_HashStats(&dict->table), TCL_DYNAMIC);
+ statsStr = Tcl_HashStats(&dict->table);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
+ ckfree(statsStr);
return TCL_OK;
}
@@ -2383,7 +2357,7 @@ DictAppendCmd(
*
* DictForNRCmd --
*
- * This function implements the "dict for" Tcl command. See the user
+ * These functions implement the "dict for" Tcl command. See the user
* documentation for details on what it does, and TIP#111 for the formal
* specification.
*
@@ -2423,8 +2397,8 @@ DictForNRCmd(
return TCL_ERROR;
}
if (varc != 2) {
- Tcl_SetResult(interp, "must have exactly two variable names",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must have exactly two variable names", -1));
return TCL_ERROR;
}
searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
@@ -2458,18 +2432,12 @@ DictForNRCmd(
*/
Tcl_IncrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set key variable: \"",
- TclGetString(keyVarObj), "\"", NULL);
+ if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {
TclDecrRefCount(valueObj);
goto error;
}
TclDecrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set value variable: \"",
- TclGetString(valueVarObj), "\"", NULL);
+ if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
goto error;
}
@@ -2542,19 +2510,15 @@ DictForLoopCallback(
*/
Tcl_IncrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set key variable: \"",
- TclGetString(keyVarObj), "\"", NULL);
+ if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
TclDecrRefCount(valueObj);
result = TCL_ERROR;
goto done;
}
TclDecrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set value variable: \"",
- TclGetString(valueVarObj), "\"", NULL);
+ if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
result = TCL_ERROR;
goto done;
}
@@ -2583,6 +2547,217 @@ DictForLoopCallback(
/*
*----------------------------------------------------------------------
*
+ * DictMapNRCmd --
+ *
+ * These functions implement the "dict map" Tcl command. See the user
+ * documentation for details on what it does, and TIP#405 for the formal
+ * specification.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictMapNRCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj **varv, *keyObj, *valueObj;
+ DictMapStorage *storagePtr;
+ int varc, done;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "{keyVar valueVar} dictionary script");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse arguments.
+ */
+
+ if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (varc != 2) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must have exactly two variable names", -1));
+ return TCL_ERROR;
+ }
+ storagePtr = TclStackAlloc(interp, sizeof(DictMapStorage));
+ if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj,
+ &valueObj, &done) != TCL_OK) {
+ TclStackFree(interp, storagePtr);
+ return TCL_ERROR;
+ }
+ if (done) {
+ /*
+ * Note that this exit leaves an empty value in the result (due to
+ * command calling conventions) but that is OK since an empty value is
+ * an empty dictionary.
+ */
+
+ TclStackFree(interp, storagePtr);
+ return TCL_OK;
+ }
+ TclNewObj(storagePtr->accumulatorObj);
+ TclListObjGetElements(NULL, objv[1], &varc, &varv);
+ storagePtr->keyVarObj = varv[0];
+ storagePtr->valueVarObj = varv[1];
+ storagePtr->scriptObj = objv[3];
+
+ /*
+ * Make sure that these objects (which we need throughout the body of the
+ * loop) don't vanish. Note that the dictionary internal rep is locked
+ * internally so that updates, shimmering, etc are not a problem.
+ */
+
+ Tcl_IncrRefCount(storagePtr->accumulatorObj);
+ Tcl_IncrRefCount(storagePtr->keyVarObj);
+ Tcl_IncrRefCount(storagePtr->valueVarObj);
+ Tcl_IncrRefCount(storagePtr->scriptObj);
+
+ /*
+ * Stop the value from getting hit in any way by any traces on the key
+ * variable.
+ */
+
+ Tcl_IncrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, storagePtr->keyVarObj, NULL, keyObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ TclDecrRefCount(valueObj);
+ goto error;
+ }
+ if (Tcl_ObjSetVar2(interp, storagePtr->valueVarObj, NULL, valueObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ TclDecrRefCount(valueObj);
+ goto error;
+ }
+ TclDecrRefCount(valueObj);
+
+ /*
+ * Run the script.
+ */
+
+ TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
+ return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
+ iPtr->cmdFramePtr, 3);
+
+ /*
+ * For unwinding everything on error.
+ */
+
+ error:
+ TclDecrRefCount(storagePtr->keyVarObj);
+ TclDecrRefCount(storagePtr->valueVarObj);
+ TclDecrRefCount(storagePtr->scriptObj);
+ TclDecrRefCount(storagePtr->accumulatorObj);
+ Tcl_DictObjDone(&storagePtr->search);
+ TclStackFree(interp, storagePtr);
+ return TCL_ERROR;
+}
+
+static int
+DictMapLoopCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ DictMapStorage *storagePtr = data[0];
+ Tcl_Obj *keyObj, *valueObj;
+ int done;
+
+ /*
+ * Process the result from the previous execution of the script body.
+ */
+
+ if (result == TCL_CONTINUE) {
+ result = TCL_OK;
+ } else if (result != TCL_OK) {
+ if (result == TCL_BREAK) {
+ Tcl_ResetResult(interp);
+ result = TCL_OK;
+ } else if (result == TCL_ERROR) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"dict map\" body line %d)",
+ Tcl_GetErrorLine(interp)));
+ }
+ goto done;
+ } else {
+ keyObj = Tcl_ObjGetVar2(interp, storagePtr->keyVarObj, NULL,
+ TCL_LEAVE_ERR_MSG);
+ if (keyObj == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ Tcl_DictObjPut(NULL, storagePtr->accumulatorObj, keyObj,
+ Tcl_GetObjResult(interp));
+ }
+
+ /*
+ * Get the next mapping from the dictionary.
+ */
+
+ Tcl_DictObjNext(&storagePtr->search, &keyObj, &valueObj, &done);
+ if (done) {
+ Tcl_SetObjResult(interp, storagePtr->accumulatorObj);
+ goto done;
+ }
+
+ /*
+ * Stop the value from getting hit in any way by any traces on the key
+ * variable.
+ */
+
+ Tcl_IncrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, storagePtr->keyVarObj, NULL, keyObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ TclDecrRefCount(valueObj);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (Tcl_ObjSetVar2(interp, storagePtr->valueVarObj, NULL, valueObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ TclDecrRefCount(valueObj);
+ result = TCL_ERROR;
+ goto done;
+ }
+ TclDecrRefCount(valueObj);
+
+ /*
+ * Run the script.
+ */
+
+ TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
+ return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
+ iPtr->cmdFramePtr, 3);
+
+ /*
+ * For unwinding everything once the iterating is done.
+ */
+
+ done:
+ TclDecrRefCount(storagePtr->keyVarObj);
+ TclDecrRefCount(storagePtr->valueVarObj);
+ TclDecrRefCount(storagePtr->scriptObj);
+ TclDecrRefCount(storagePtr->accumulatorObj);
+ Tcl_DictObjDone(&storagePtr->search);
+ TclStackFree(interp, storagePtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* DictSetCmd --
*
* This function implements the "dict set" Tcl command. See the user
@@ -2851,8 +3026,8 @@ DictFilterCmd(
return TCL_ERROR;
}
if (varc != 2) {
- Tcl_SetResult(interp, "must have exactly two variable names",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must have exactly two variable names", -1));
return TCL_ERROR;
}
keyVarObj = varv[0];
@@ -2892,16 +3067,19 @@ DictFilterCmd(
if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set key variable: \"",
- TclGetString(keyVarObj), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't set key variable: \"%s\"",
+ TclGetString(keyVarObj)));
result = TCL_ERROR;
goto abnormalResult;
}
if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set value variable: \"",
- TclGetString(valueVarObj), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't set value variable: \"%s\"",
+ TclGetString(valueVarObj)));
+ result = TCL_ERROR;
goto abnormalResult;
}
@@ -3168,9 +3346,7 @@ DictWithCmd(
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *dictPtr, *keysPtr, *keyPtr = NULL, *valPtr = NULL, *pathPtr;
- Tcl_DictSearch s;
- int done;
+ Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
@@ -3185,39 +3361,13 @@ DictWithCmd(
if (dictPtr == NULL) {
return TCL_ERROR;
}
- if (objc > 3) {
- dictPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2,
- DICT_PATH_READ);
- if (dictPtr == NULL) {
- return TCL_ERROR;
- }
- }
-
- /*
- * Go over the list of keys and write each corresponding value to a
- * variable in the current context with the same name. Also keep a copy of
- * the keys so we can write back properly later on even if the dictionary
- * has been structurally modified.
- */
- if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr,
- &done) != TCL_OK) {
+ keysPtr = TclDictWithInit(interp, dictPtr, objc-3, objv+2);
+ if (keysPtr == NULL) {
return TCL_ERROR;
}
-
- TclNewObj(keysPtr);
Tcl_IncrRefCount(keysPtr);
- for (; !done ; Tcl_DictObjNext(&s, &keyPtr, &valPtr, &done)) {
- Tcl_ListObjAppendElement(NULL, keysPtr, keyPtr);
- if (Tcl_ObjSetVar2(interp, keyPtr, NULL, valPtr,
- TCL_LEAVE_ERR_MSG) == NULL) {
- TclDecrRefCount(keysPtr);
- Tcl_DictObjDone(&s);
- return TCL_ERROR;
- }
- }
-
/*
* Execute the body, while making the invoking context available to the
* loop body (TIP#280) and postponing the cleanup until later (NRE).
@@ -3241,55 +3391,200 @@ FinalizeDictWith(
Tcl_Interp *interp,
int result)
{
- Tcl_Obj **keyv, *leafPtr, *dictPtr, *valPtr;
- int keyc, i, allocdict = 0;
+ Tcl_Obj **pathv;
+ int pathc;
Tcl_InterpState state;
Tcl_Obj *varName = data[0];
Tcl_Obj *keysPtr = data[1];
Tcl_Obj *pathPtr = data[2];
+ Var *varPtr, *arrayPtr;
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (body of \"dict with\")");
}
/*
+ * Save the result state; TDWF doesn't guarantee to not modify that on
+ * TCL_OK result.
+ */
+
+ state = Tcl_SaveInterpState(interp, result);
+ if (pathPtr != NULL) {
+ Tcl_ListObjGetElements(NULL, pathPtr, &pathc, &pathv);
+ } else {
+ pathc = 0;
+ pathv = NULL;
+ }
+
+ /*
+ * Pack from local variables back into the dictionary.
+ */
+
+ varPtr = TclObjLookupVarEx(interp, varName, NULL, TCL_LEAVE_ERR_MSG, "set",
+ /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ result = TclDictWithFinish(interp, varPtr, arrayPtr, varName, NULL, -1,
+ pathc, pathv, keysPtr);
+ }
+
+ /*
+ * Tidy up and return the real result (unless we had an error).
+ */
+
+ TclDecrRefCount(varName);
+ TclDecrRefCount(keysPtr);
+ if (pathPtr != NULL) {
+ TclDecrRefCount(pathPtr);
+ }
+ if (result != TCL_OK) {
+ Tcl_DiscardInterpState(state);
+ return TCL_ERROR;
+ }
+ return Tcl_RestoreInterpState(interp, state);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDictWithInit --
+ *
+ * Part of the core of [dict with]. Pokes into a dictionary and converts
+ * the mappings there into assignments to (presumably) local variables.
+ * Returns a list of all the names that were mapped so that removal of
+ * either the variable or the dictionary entry won't surprise us when we
+ * come to stuffing everything back.
+ *
+ * Result:
+ * List of mapped names, or NULL if there was an error.
+ *
+ * Side effects:
+ * Assigns to variables, so potentially legion due to traces.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclDictWithInit(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ int pathc,
+ Tcl_Obj *const pathv[])
+{
+ Tcl_DictSearch s;
+ Tcl_Obj *keyPtr, *valPtr, *keysPtr;
+ int done;
+
+ if (pathc > 0) {
+ dictPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
+ DICT_PATH_READ);
+ if (dictPtr == NULL) {
+ return NULL;
+ }
+ }
+
+ /*
+ * Go over the list of keys and write each corresponding value to a
+ * variable in the current context with the same name. Also keep a copy of
+ * the keys so we can write back properly later on even if the dictionary
+ * has been structurally modified.
+ */
+
+ if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr,
+ &done) != TCL_OK) {
+ return NULL;
+ }
+
+ TclNewObj(keysPtr);
+
+ for (; !done ; Tcl_DictObjNext(&s, &keyPtr, &valPtr, &done)) {
+ Tcl_ListObjAppendElement(NULL, keysPtr, keyPtr);
+ if (Tcl_ObjSetVar2(interp, keyPtr, NULL, valPtr,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ TclDecrRefCount(keysPtr);
+ Tcl_DictObjDone(&s);
+ return NULL;
+ }
+ }
+
+ return keysPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDictWithFinish --
+ *
+ * Part of the core of [dict with]. Reassembles the piece of the dict (in
+ * varName, location given by pathc/pathv) from the variables named in
+ * the keysPtr argument. NB, does not try to preserve errors or manage
+ * argument lifetimes.
+ *
+ * Result:
+ * TCL_OK if we succeeded, or TCL_ERROR if we failed.
+ *
+ * Side effects:
+ * Assigns to a variable, so potentially legion due to traces. Updates
+ * the dictionary in the named variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclDictWithFinish(
+ Tcl_Interp *interp, /* Command interpreter in which variable
+ * exists. Used for state management, traces
+ * and error reporting. */
+ Var *varPtr, /* Reference to the variable holding the
+ * dictionary. */
+ Var *arrayPtr, /* Reference to the array containing the
+ * variable, or NULL if the variable is a
+ * scalar. */
+ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or
+ * the name of a variable. NULL if the 'index'
+ * parameter is >= 0 */
+ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
+ * in the array part1. */
+ int index, /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
+ int pathc, /* The number of elements in the path into the
+ * dictionary. */
+ Tcl_Obj *const pathv[], /* The elements of the path to the subdict. */
+ Tcl_Obj *keysPtr) /* List of keys to be synchronized. This is
+ * the result value from TclDictWithInit. */
+{
+ Tcl_Obj *dictPtr, *leafPtr, *valPtr;
+ int i, allocdict, keyc;
+ Tcl_Obj **keyv;
+
+ /*
* If the dictionary variable doesn't exist, drop everything silently.
*/
- dictPtr = Tcl_ObjGetVar2(interp, varName, NULL, 0);
+ dictPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ TCL_LEAVE_ERR_MSG, index);
if (dictPtr == NULL) {
- TclDecrRefCount(varName);
- TclDecrRefCount(keysPtr);
- if (pathPtr) {
- TclDecrRefCount(pathPtr);
- }
- return result;
+ return TCL_OK;
}
/*
* Double-check that it is still a dictionary.
*/
- state = Tcl_SaveInterpState(interp, result);
if (Tcl_DictObjSize(interp, dictPtr, &i) != TCL_OK) {
- TclDecrRefCount(varName);
- TclDecrRefCount(keysPtr);
- if (pathPtr) {
- TclDecrRefCount(pathPtr);
- }
- Tcl_DiscardInterpState(state);
return TCL_ERROR;
}
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
allocdict = 1;
+ } else {
+ allocdict = 0;
}
- if (pathPtr != NULL) {
- Tcl_Obj **pathv;
- int pathc;
-
+ if (pathc > 0) {
/*
* Want to get to the dictionary which we will update; need to do
* prepare-for-update de-sharing along the path *but* avoid generating
@@ -3299,26 +3594,19 @@ FinalizeDictWith(
* perfectly efficient (but no memory should be leaked).
*/
- Tcl_ListObjGetElements(NULL, pathPtr, &pathc, &pathv);
leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
DICT_PATH_EXISTS | DICT_PATH_UPDATE);
- TclDecrRefCount(pathPtr);
if (leafPtr == NULL) {
- TclDecrRefCount(varName);
- TclDecrRefCount(keysPtr);
if (allocdict) {
TclDecrRefCount(dictPtr);
}
- Tcl_DiscardInterpState(state);
return TCL_ERROR;
}
if (leafPtr == DICT_PATH_NON_EXISTENT) {
- TclDecrRefCount(varName);
- TclDecrRefCount(keysPtr);
if (allocdict) {
TclDecrRefCount(dictPtr);
}
- return Tcl_RestoreInterpState(interp, state);
+ return TCL_OK;
}
} else {
leafPtr = dictPtr;
@@ -3344,14 +3632,13 @@ FinalizeDictWith(
Tcl_DictObjPut(NULL, leafPtr, keyv[i], valPtr);
}
}
- TclDecrRefCount(keysPtr);
/*
* Ensure that none of the dictionaries in the chain still have a string
* rep.
*/
- if (pathPtr != NULL) {
+ if (pathc > 0) {
InvalidateDictChain(leafPtr);
}
@@ -3359,13 +3646,14 @@ FinalizeDictWith(
* Write back the outermost dictionary to the variable.
*/
- if (Tcl_ObjSetVar2(interp, varName, NULL, dictPtr,
- TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_DiscardInterpState(state);
+ if (TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, dictPtr,
+ TCL_LEAVE_ERR_MSG, index) == NULL) {
+ if (allocdict) {
+ TclDecrRefCount(dictPtr);
+ }
return TCL_ERROR;
}
- TclDecrRefCount(varName);
- return Tcl_RestoreInterpState(interp, state);
+ return TCL_OK;
}
/*
@@ -3392,7 +3680,7 @@ TclInitDictCmd(
{
return TclMakeEnsemble(interp, "dict", implementationMap);
}
-
+
/*
* Local Variables:
* mode: c
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 11e0c9c..7a55724 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclEncoding.c,v 1.72 2010/09/16 14:49:37 nijtmans Exp $
*/
#include "tclInt.h"
@@ -594,14 +592,14 @@ TclInitEncodingSubsystem(void)
* code to duplicate the structure of a table encoding here.
*/
- dataPtr = (TableEncodingData *) ckalloc(sizeof(TableEncodingData));
+ dataPtr = ckalloc(sizeof(TableEncodingData));
memset(dataPtr, 0, sizeof(TableEncodingData));
dataPtr->fallback = '?';
size = 256*(sizeof(unsigned short *) + sizeof(unsigned short));
- dataPtr->toUnicode = (unsigned short **) ckalloc(size);
+ dataPtr->toUnicode = ckalloc(size);
memset(dataPtr->toUnicode, 0, size);
- dataPtr->fromUnicode = (unsigned short **) ckalloc(size);
+ dataPtr->fromUnicode = ckalloc(size);
memset(dataPtr->fromUnicode, 0, size);
dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256);
@@ -851,8 +849,8 @@ FreeEncoding(
if (encodingPtr->hPtr != NULL) {
Tcl_DeleteHashEntry(encodingPtr->hPtr);
}
- ckfree((char *) encodingPtr->name);
- ckfree((char *) encodingPtr);
+ ckfree(encodingPtr->name);
+ ckfree(encodingPtr);
}
}
@@ -981,13 +979,13 @@ Tcl_GetEncodingNames(
int
Tcl_SetSystemEncoding(
Tcl_Interp *interp, /* Interp for error reporting, if not NULL. */
- const char *name) /* The name of the desired encoding, or NULL
+ const char *name) /* The name of the desired encoding, or NULL/""
* to reset to default encoding. */
{
Tcl_Encoding encoding;
Encoding *encodingPtr;
- if (name == NULL) {
+ if (!name || !*name) {
Tcl_MutexLock(&encodingMutex);
encoding = defaultEncoding;
encodingPtr = (Encoding *) encoding;
@@ -1056,9 +1054,9 @@ Tcl_CreateEncoding(
encodingPtr->hPtr = NULL;
}
- name = ckalloc((unsigned) strlen(typePtr->encodingName) + 1);
+ name = ckalloc(strlen(typePtr->encodingName) + 1);
- encodingPtr = (Encoding *) ckalloc(sizeof(Encoding));
+ encodingPtr = ckalloc(sizeof(Encoding));
encodingPtr->name = strcpy(name, typePtr->encodingName);
encodingPtr->toUtfProc = typePtr->toUtfProc;
encodingPtr->fromUtfProc = typePtr->fromUtfProc;
@@ -1544,7 +1542,8 @@ OpenEncodingFileChannel(
}
if ((NULL == chan) && (interp != NULL)) {
- Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown encoding \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
}
Tcl_DecrRefCount(fileNameObj);
@@ -1618,7 +1617,8 @@ LoadEncodingFile(
break;
}
if ((encoding == NULL) && (interp != NULL)) {
- Tcl_AppendResult(interp, "invalid encoding file \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid encoding file \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
}
Tcl_Close(NULL, chan);
@@ -1709,7 +1709,7 @@ LoadTableEncoding(
#undef PAGESIZE
#define PAGESIZE (256 * sizeof(unsigned short))
- dataPtr = (TableEncodingData *) ckalloc(sizeof(TableEncodingData));
+ dataPtr = ckalloc(sizeof(TableEncodingData));
memset(dataPtr, 0, sizeof(TableEncodingData));
dataPtr->fallback = fallback;
@@ -1721,7 +1721,7 @@ LoadTableEncoding(
*/
size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
- dataPtr->toUnicode = (unsigned short **) ckalloc(size);
+ dataPtr->toUnicode = ckalloc(size);
memset(dataPtr->toUnicode, 0, size);
pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);
@@ -1779,7 +1779,7 @@ LoadTableEncoding(
}
}
size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
- dataPtr->fromUnicode = (unsigned short **) ckalloc(size);
+ dataPtr->fromUnicode = ckalloc(size);
memset(dataPtr->fromUnicode, 0, size);
pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256);
@@ -1874,9 +1874,9 @@ LoadTableEncoding(
* Read lines from the encoding until EOF.
*/
- for (Tcl_DStringSetLength(&lineString, 0);
+ for (TclDStringClear(&lineString);
(len = Tcl_Gets(chan, &lineString)) >= 0;
- Tcl_DStringSetLength(&lineString, 0)) {
+ TclDStringClear(&lineString)) {
const unsigned char *p;
int to, from;
@@ -2011,17 +2011,17 @@ LoadEscapeEncoding(
Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
}
}
- ckfree((char *) argv);
+ ckfree(argv);
Tcl_DStringFree(&lineString);
}
size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
+ Tcl_DStringLength(&escapeData);
- dataPtr = (EscapeEncodingData *) ckalloc(size);
+ dataPtr = ckalloc(size);
dataPtr->initLen = strlen(init);
- strcpy(dataPtr->init, init);
+ memcpy(dataPtr->init, init, (unsigned) dataPtr->initLen + 1);
dataPtr->finalLen = strlen(final);
- strcpy(dataPtr->final, final);
+ memcpy(dataPtr->final, final, (unsigned) dataPtr->finalLen + 1);
dataPtr->numSubTables =
Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
@@ -2957,9 +2957,9 @@ TableFreeProc(
* Make sure we aren't freeing twice on shutdown. [Bug 219314]
*/
- ckfree((char *) dataPtr->toUnicode);
- ckfree((char *) dataPtr->fromUnicode);
- ckfree((char *) dataPtr);
+ ckfree(dataPtr->toUnicode);
+ ckfree(dataPtr->fromUnicode);
+ ckfree(dataPtr);
}
/*
@@ -3434,7 +3434,7 @@ EscapeFreeProc(
subTablePtr++;
}
}
- ckfree((char *) dataPtr);
+ ckfree(dataPtr);
}
/*
@@ -3572,7 +3572,7 @@ InitializeEncodingSearchPath(
bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes);
*lengthPtr = numBytes;
- *valuePtr = ckalloc((unsigned) numBytes + 1);
+ *valuePtr = ckalloc(numBytes + 1);
memcpy(*valuePtr, bytes, (size_t) numBytes + 1);
Tcl_DecrRefCount(searchPathObj);
}
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index c4750c5..b76c603 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclEnsemble.c,v 1.5 2010/03/05 14:34:04 dkf Exp $
*/
#include "tclInt.h"
@@ -19,6 +17,7 @@
* Declarations for functions local to this file:
*/
+static inline Tcl_Obj * NewNsObj(Tcl_Namespace *namespacePtr);
static inline int EnsembleUnknownCallback(Tcl_Interp *interp,
EnsembleConfig *ensemblePtr, int objc,
Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr);
@@ -80,6 +79,19 @@ const Tcl_ObjType tclEnsembleCmdType = {
NULL /* setFromAnyProc */
};
+static inline Tcl_Obj *
+NewNsObj(
+ Tcl_Namespace *namespacePtr)
+{
+ register Namespace *nsPtr = (Namespace *) namespacePtr;
+
+ if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
+ return Tcl_NewStringObj("::", 2);
+ } else {
+ return Tcl_NewStringObj(nsPtr->fullName, -1);
+ }
+}
+
/*
*----------------------------------------------------------------------
*
@@ -118,18 +130,19 @@ TclNamespaceEnsembleCmd(
if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
if (!Tcl_InterpDeleted(interp)) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"tried to manipulate ensemble of deleted namespace",
- NULL);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
}
return TCL_ERROR;
}
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "subcommand ?arg ...?");
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[2], ensembleSubcommands,
+ if (Tcl_GetIndexFromObj(interp, objv[1], ensembleSubcommands,
"subcommand", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -151,12 +164,12 @@ TclNamespaceEnsembleCmd(
* Check that we've got option-value pairs... [Bug 1558654]
*/
- if ((objc & 1) == 0) {
- Tcl_WrongNumArgs(interp, 3, objv, "?option value ...?");
+ if (objc & 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?option value ...?");
return TCL_ERROR;
}
- objv += 3;
- objc -= 3;
+ objv += 2;
+ objc -= 2;
/*
* Work out what name to use for the command to create. If supplied,
@@ -237,9 +250,11 @@ TclNamespaceEnsembleCmd(
return TCL_ERROR;
}
if (len < 1) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"ensemble subcommand implementations "
- "must be non-empty lists", TCL_STATIC);
+ "must be non-empty lists", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
+ "EMPTY_TARGET", NULL);
Tcl_DictObjDone(&search);
if (patchedDict) {
Tcl_DecrRefCount(patchedDict);
@@ -252,7 +267,7 @@ TclNamespaceEnsembleCmd(
cmd = TclGetString(listv[0]);
if (!(cmd[0] == ':' && cmd[1] == ':')) {
Tcl_Obj *newList = Tcl_NewListObj(len, listv);
- Tcl_Obj *newCmd = Tcl_NewStringObj(nsPtr->fullName,-1);
+ Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace *) nsPtr);
if (nsPtr->parentPtr) {
Tcl_AppendStringsToObj(newCmd, "::", NULL);
@@ -324,29 +339,29 @@ TclNamespaceEnsembleCmd(
}
case ENS_EXISTS:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 3, objv, "cmdname");
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "cmdname");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
- Tcl_FindEnsemble(interp, objv[3], 0) != NULL));
+ Tcl_FindEnsemble(interp, objv[2], 0) != NULL));
return TCL_OK;
case ENS_CONFIG:
- if (objc < 4 || (objc != 5 && objc & 1)) {
- Tcl_WrongNumArgs(interp, 3, objv,
+ if (objc < 3 || (objc != 4 && !(objc & 1))) {
+ Tcl_WrongNumArgs(interp, 2, objv,
"cmdname ?-option value ...? ?arg ...?");
return TCL_ERROR;
}
- token = Tcl_FindEnsemble(interp, objv[3], TCL_LEAVE_ERR_MSG);
+ token = Tcl_FindEnsemble(interp, objv[2], TCL_LEAVE_ERR_MSG);
if (token == NULL) {
return TCL_ERROR;
}
- if (objc == 5) {
+ if (objc == 4) {
Tcl_Obj *resultObj = NULL; /* silence gcc 4 warning */
- if (Tcl_GetIndexFromObj(interp, objv[4], ensembleConfigOptions,
+ if (Tcl_GetIndexFromObj(interp, objv[3], ensembleConfigOptions,
"option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -372,8 +387,7 @@ TclNamespaceEnsembleCmd(
case CONF_NAMESPACE:
namespacePtr = NULL; /* silence gcc 4 warning */
Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
- Tcl_SetResult(interp, ((Namespace *) namespacePtr)->fullName,
- TCL_VOLATILE);
+ Tcl_SetObjResult(interp, NewNsObj(namespacePtr));
break;
case CONF_PREFIX: {
int flags = 0; /* silence gcc 4 warning */
@@ -390,7 +404,7 @@ TclNamespaceEnsembleCmd(
}
break;
}
- } else if (objc == 4) {
+ } else if (objc == 3) {
/*
* Produce list of all information.
*/
@@ -413,9 +427,7 @@ TclNamespaceEnsembleCmd(
-1));
namespacePtr = NULL; /* silence gcc 4 warning */
Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
- Tcl_ListObjAppendElement(NULL, resultObj,
- Tcl_NewStringObj(((Namespace *) namespacePtr)->fullName,
- -1));
+ Tcl_ListObjAppendElement(NULL, resultObj, NewNsObj(namespacePtr));
/* -parameters option */
Tcl_ListObjAppendElement(NULL, resultObj,
@@ -459,8 +471,8 @@ TclNamespaceEnsembleCmd(
Tcl_GetEnsembleFlags(NULL, token, &flags);
permitPrefix = (flags & TCL_ENSEMBLE_PREFIX) != 0;
- objv += 4;
- objc -= 4;
+ objv += 3;
+ objc -= 3;
/*
* Parse the option list, applying type checks as we go. Note that
@@ -517,9 +529,11 @@ TclNamespaceEnsembleCmd(
goto freeMapAndError;
}
if (len < 1) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"ensemble subcommand implementations "
- "must be non-empty lists", TCL_STATIC);
+ "must be non-empty lists", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
+ "EMPTY_TARGET", NULL);
Tcl_DictObjDone(&search);
if (patchedDict) {
Tcl_DecrRefCount(patchedDict);
@@ -529,8 +543,7 @@ TclNamespaceEnsembleCmd(
cmd = TclGetString(listv[0]);
if (!(cmd[0] == ':' && cmd[1] == ':')) {
Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
- Tcl_Obj *newCmd =
- Tcl_NewStringObj(nsPtr->fullName, -1);
+ Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);
if (nsPtr->parentPtr) {
Tcl_AppendStringsToObj(newCmd, "::", NULL);
@@ -556,7 +569,9 @@ TclNamespaceEnsembleCmd(
continue;
}
case CONF_NAMESPACE:
- Tcl_AppendResult(interp, "option -namespace is read-only",
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "option -namespace is read-only", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "READ_ONLY",
NULL);
goto freeMapAndError;
case CONF_PREFIX:
@@ -618,8 +633,7 @@ Tcl_CreateEnsemble(
int flags)
{
Namespace *nsPtr = (Namespace *) namespacePtr;
- EnsembleConfig *ensemblePtr = (EnsembleConfig *)
- ckalloc(sizeof(EnsembleConfig));
+ EnsembleConfig *ensemblePtr = ckalloc(sizeof(EnsembleConfig));
Tcl_Obj *nameObj = NULL;
if (nsPtr == NULL) {
@@ -632,7 +646,7 @@ Tcl_CreateEnsemble(
*/
if (!(name[0] == ':' && name[1] == ':')) {
- nameObj = Tcl_NewStringObj(nsPtr->fullName, -1);
+ nameObj = NewNsObj((Tcl_Namespace *) nsPtr);
if (nsPtr->parentPtr == NULL) {
Tcl_AppendStringsToObj(nameObj, name, NULL);
} else {
@@ -705,7 +719,9 @@ Tcl_SetEnsembleSubcommandList(
Tcl_Obj *oldList;
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (subcmdList != NULL) {
@@ -779,7 +795,9 @@ Tcl_SetEnsembleParameterList(
int length;
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (paramList == NULL) {
@@ -853,7 +871,9 @@ Tcl_SetEnsembleMappingDict(
Tcl_Obj *oldDict;
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (mapDict != NULL) {
@@ -876,9 +896,11 @@ Tcl_SetEnsembleMappingDict(
}
bytes = TclGetString(cmdObjPtr);
if (bytes[0] != ':' || bytes[1] != ':') {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"ensemble target is not a fully-qualified command",
- NULL);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
+ "UNQUALIFIED_TARGET", NULL);
Tcl_DictObjDone(&search);
return TCL_ERROR;
}
@@ -948,7 +970,9 @@ Tcl_SetEnsembleUnknownHandler(
Tcl_Obj *oldList;
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (unknownList != NULL) {
@@ -1012,7 +1036,9 @@ Tcl_SetEnsembleFlags(
int wasCompiled;
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
@@ -1087,7 +1113,9 @@ Tcl_GetEnsembleSubcommandList(
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
}
return TCL_ERROR;
}
@@ -1127,7 +1155,9 @@ Tcl_GetEnsembleParameterList(
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
}
return TCL_ERROR;
}
@@ -1167,7 +1197,9 @@ Tcl_GetEnsembleMappingDict(
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
}
return TCL_ERROR;
}
@@ -1206,7 +1238,9 @@ Tcl_GetEnsembleUnknownHandler(
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
}
return TCL_ERROR;
}
@@ -1245,7 +1279,9 @@ Tcl_GetEnsembleFlags(
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
}
return TCL_ERROR;
}
@@ -1284,7 +1320,9 @@ Tcl_GetEnsembleNamespace(
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
}
return TCL_ERROR;
}
@@ -1340,8 +1378,9 @@ Tcl_FindEnsemble(
if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){
if (flags & TCL_LEAVE_ERR_MSG) {
- Tcl_AppendResult(interp, "\"", TclGetString(cmdNameObj),
- "\" is not an ensemble command", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not an ensemble command",
+ TclGetString(cmdNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
TclGetString(cmdNameObj), NULL);
}
@@ -1417,16 +1456,21 @@ TclMakeEnsemble(
{
Tcl_Command ensemble;
Tcl_Namespace *ns;
- Tcl_DString buf;
+ Tcl_DString buf, hiddenBuf;
const char **nameParts = NULL;
const char *cmdName = NULL;
- int i, nameCount = 0, ensembleFlags = 0;
+ int i, nameCount = 0, ensembleFlags = 0, hiddenLen;
/*
* Construct the path for the ensemble namespace and create it.
*/
Tcl_DStringInit(&buf);
+ Tcl_DStringInit(&hiddenBuf);
+ TclDStringAppendLiteral(&hiddenBuf, "tcl:");
+ Tcl_DStringAppend(&hiddenBuf, name, -1);
+ TclDStringAppendLiteral(&hiddenBuf, ":");
+ hiddenLen = Tcl_DStringLength(&hiddenBuf);
if (name[0] == ':' && name[1] == ':') {
/*
* An absolute name, so use it directly.
@@ -1441,14 +1485,14 @@ TclMakeEnsemble(
* multi-word list differently to a single word.
*/
- Tcl_DStringAppend(&buf, "::tcl", -1);
+ TclDStringAppendLiteral(&buf, "::tcl");
if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) {
Tcl_Panic("invalid ensemble name '%s'", name);
}
for (i = 0; i < nameCount; ++i) {
- Tcl_DStringAppend(&buf, "::", 2);
+ TclDStringAppendLiteral(&buf, "::");
Tcl_DStringAppend(&buf, nameParts[i], -1);
}
}
@@ -1483,7 +1527,7 @@ TclMakeEnsemble(
Tcl_Obj *mapDict, *fromObj, *toObj;
Command *cmdPtr;
- Tcl_DStringAppend(&buf, "::", 2);
+ TclDStringAppendLiteral(&buf, "::");
TclNewObj(mapDict);
for (i=0 ; map[i].name != NULL ; i++) {
fromObj = Tcl_NewStringObj(map[i].name, -1);
@@ -1491,10 +1535,35 @@ TclMakeEnsemble(
Tcl_DStringLength(&buf));
Tcl_AppendToObj(toObj, map[i].name, -1);
Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
+
if (map[i].proc || map[i].nreProc) {
- cmdPtr = (Command *)
- Tcl_NRCreateCommand(interp, TclGetString(toObj),
- map[i].proc, map[i].nreProc, map[i].clientData, NULL);
+ /*
+ * If the command is unsafe, hide it when we're in a safe
+ * interpreter. The code to do this is really hokey! It also
+ * doesn't work properly yet; this function is always
+ * currently called before the safe-interp flag is set so the
+ * Tcl_IsSafe check fails.
+ */
+
+ if (map[i].unsafe && Tcl_IsSafe(interp)) {
+ cmdPtr = (Command *)
+ Tcl_NRCreateCommand(interp, "___tmp", map[i].proc,
+ map[i].nreProc, map[i].clientData, NULL);
+ Tcl_DStringSetLength(&hiddenBuf, hiddenLen);
+ if (Tcl_HideCommand(interp, "___tmp",
+ Tcl_DStringAppend(&hiddenBuf, map[i].name, -1))) {
+ Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
+ }
+ } else {
+ /*
+ * Not hidden, so just create it. Yay!
+ */
+
+ cmdPtr = (Command *)
+ Tcl_NRCreateCommand(interp, TclGetString(toObj),
+ map[i].proc, map[i].nreProc, map[i].clientData,
+ NULL);
+ }
cmdPtr->compileProc = map[i].compileProc;
if (map[i].compileProc != NULL) {
ensembleFlags |= ENSEMBLE_COMPILE;
@@ -1508,6 +1577,7 @@ TclMakeEnsemble(
}
Tcl_DStringFree(&buf);
+ Tcl_DStringFree(&hiddenBuf);
if (nameParts != NULL) {
Tcl_Free((char *) nameParts);
}
@@ -1563,6 +1633,7 @@ NsEnsembleImplementationCmdNR(
* specified but not yet cached command
* names. */
int reparseCount = 0; /* Number of reparses. */
+ Tcl_Obj *errorObj; /* Used for building error messages. */
/*
* Must recheck objc, since numParameters might have changed. Cf. test
@@ -1587,10 +1658,10 @@ NsEnsembleImplementationCmdNR(
Tcl_Panic("List of ensemble parameters is not a list");
}
for (; len>0; len--,elemPtrs++) {
- Tcl_DStringAppend(&buf, Tcl_GetString(*elemPtrs), -1);
- Tcl_DStringAppend(&buf, " ", -1);
+ TclDStringAppendObj(&buf, *elemPtrs);
+ TclDStringAppendLiteral(&buf, " ");
}
- Tcl_DStringAppend(&buf, "subcommand ?arg ...?", -1);
+ TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
Tcl_DStringFree(&buf);
@@ -1603,8 +1674,9 @@ NsEnsembleImplementationCmdNR(
*/
if (!Tcl_InterpDeleted(interp)) {
- Tcl_AppendResult(interp,
- "ensemble activated for deleted namespace", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "ensemble activated for deleted namespace", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
}
return TCL_ERROR;
}
@@ -1795,11 +1867,6 @@ NsEnsembleImplementationCmdNR(
* count both as inserted and removed arguments.
*/
-#if 0
- if (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters, prefixObjc + ensemblePtr->numParameters, objv)) {
- TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
- }
-#else
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
iPtr->ensembleRewrite.sourceObjs = objv;
iPtr->ensembleRewrite.numRemovedObjs =
@@ -1820,14 +1887,13 @@ NsEnsembleImplementationCmdNR(
iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
}
}
-#endif
/*
* Hand off to the target command.
*/
iPtr->evalFlags |= TCL_EVAL_REDIRECT;
- return Tcl_NREvalObj(interp, copyPtr, TCL_EVAL_INVOKE);
+ return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
}
unknownOrAmbiguousSubcommand:
@@ -1858,35 +1924,34 @@ NsEnsembleImplementationCmdNR(
*/
Tcl_ResetResult(interp);
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
if (ensemblePtr->subcommandTable.numEntries == 0) {
- Tcl_AppendResult(interp, "unknown subcommand \"",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown subcommand \"%s\": namespace %s does not"
+ " export any commands",
TclGetString(objv[1+ensemblePtr->numParameters]),
- "\": namespace ", ensemblePtr->nsPtr->fullName,
- " does not export any commands", NULL);
+ ensemblePtr->nsPtr->fullName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
return TCL_ERROR;
}
- Tcl_AppendResult(interp, "unknown ",
- (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? "or ambiguous " : ""),
- "subcommand \"", TclGetString(objv[1+ensemblePtr->numParameters]),
- "\": must be ", NULL);
+ errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
+ (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
+ TclGetString(objv[1+ensemblePtr->numParameters]));
if (ensemblePtr->subcommandTable.numEntries == 1) {
- Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[0], NULL);
+ Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
} else {
int i;
for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
- Tcl_AppendResult(interp,
- ensemblePtr->subcommandArrayPtr[i], ", ", NULL);
+ Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1);
+ Tcl_AppendToObj(errorObj, ", ", 2);
}
- Tcl_AppendResult(interp, "or ",
- ensemblePtr->subcommandArrayPtr[i], NULL);
+ Tcl_AppendPrintfToObj(errorObj, "or %s",
+ ensemblePtr->subcommandArrayPtr[i]);
}
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
- TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
+ Tcl_SetObjResult(interp, errorObj);
return TCL_ERROR;
}
@@ -2012,7 +2077,6 @@ EnsembleUnknownCallback(
{
int paramc, i, result, prefixObjc;
Tcl_Obj **paramv, *unknownCmd, *ensObj;
- char buf[TCL_INTEGER_SPACE];
/*
* Create the unknown command callback to determine what to do.
@@ -2039,9 +2103,12 @@ EnsembleUnknownCallback(
((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
result = Tcl_EvalObjv(interp, paramc, paramv, 0);
if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) {
- Tcl_SetResult(interp,
- "unknown subcommand handler deleted its ensemble",
- TCL_STATIC);
+ if (!Tcl_InterpDeleted(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unknown subcommand handler deleted its ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_DELETED",
+ NULL);
+ }
result = TCL_ERROR;
}
Tcl_Release(ensemblePtr);
@@ -2090,26 +2157,26 @@ EnsembleUnknownCallback(
if (!Tcl_InterpDeleted(interp)) {
if (result != TCL_ERROR) {
Tcl_ResetResult(interp);
- Tcl_SetResult(interp,
- "unknown subcommand handler returned bad code: ",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unknown subcommand handler returned bad code: ", -1));
switch (result) {
case TCL_RETURN:
- Tcl_AppendResult(interp, "return", NULL);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "return", -1);
break;
case TCL_BREAK:
- Tcl_AppendResult(interp, "break", NULL);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "break", -1);
break;
case TCL_CONTINUE:
- Tcl_AppendResult(interp, "continue", NULL);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "continue", -1);
break;
default:
- sprintf(buf, "%d", result);
- Tcl_AppendResult(interp, buf, NULL);
+ Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%d", result);
}
Tcl_AddErrorInfo(interp, "\n result of "
"ensemble unknown subcommand handler: ");
Tcl_AddErrorInfo(interp, TclGetString(unknownCmd));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT",
+ NULL);
} else {
Tcl_AddErrorInfo(interp,
"\n (ensemble unknown subcommand handler)");
@@ -2160,7 +2227,7 @@ MakeCachedEnsembleCommand(
*/
TclFreeIntRep(objPtr);
- ensembleCmd = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep));
+ ensembleCmd = ckalloc(sizeof(EnsembleCmdRep));
objPtr->internalRep.otherValuePtr = ensembleCmd;
objPtr->typePtr = &tclEnsembleCmdType;
}
@@ -2175,7 +2242,7 @@ MakeCachedEnsembleCommand(
ensemblePtr->nsPtr->refCount++;
ensembleCmd->realPrefixObj = prefixObjPtr;
length = strlen(subcommandName)+1;
- ensembleCmd->fullSubcmdName = ckalloc((unsigned) length);
+ ensembleCmd->fullSubcmdName = ckalloc(length);
memcpy(ensembleCmd->fullSubcmdName, subcommandName, (unsigned) length);
Tcl_IncrRefCount(ensembleCmd->realPrefixObj);
}
@@ -2242,7 +2309,7 @@ DeleteEnsembleConfig(
*/
if (ensemblePtr->subcommandTable.numEntries != 0) {
- ckfree((char *) ensemblePtr->subcommandArrayPtr);
+ ckfree(ensemblePtr->subcommandArrayPtr);
}
hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search);
while (hEnt != NULL) {
@@ -2313,7 +2380,7 @@ BuildEnsembleConfig(
* Remove pre-existing table.
*/
- ckfree((char *) ensemblePtr->subcommandArrayPtr);
+ ckfree(ensemblePtr->subcommandArrayPtr);
hPtr = Tcl_FirstHashEntry(hash, &search);
while (hPtr != NULL) {
Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
@@ -2370,7 +2437,7 @@ BuildEnsembleConfig(
* the programmer's responsibility (or [::unknown] of course).
*/
- cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
+ cmdObj = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr);
if (ensemblePtr->nsPtr->parentPtr != NULL) {
Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
} else {
@@ -2468,7 +2535,7 @@ BuildEnsembleConfig(
* the hash too, and vice versa) and running quicksort over the array.
*/
- ensemblePtr->subcommandArrayPtr = (char **)
+ ensemblePtr->subcommandArrayPtr =
ckalloc(sizeof(char *) * hash->numEntries);
/*
@@ -2561,7 +2628,7 @@ FreeEnsembleCmdRep(
Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
ckfree(ensembleCmd->fullSubcmdName);
TclNsDecrRefCount(ensembleCmd->nsPtr);
- ckfree((char *) ensembleCmd);
+ ckfree(ensembleCmd);
objPtr->typePtr = NULL;
}
@@ -2589,8 +2656,7 @@ DupEnsembleCmdRep(
Tcl_Obj *copyPtr)
{
EnsembleCmdRep *ensembleCmd = objPtr->internalRep.otherValuePtr;
- EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)
- ckalloc(sizeof(EnsembleCmdRep));
+ EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
int length = strlen(ensembleCmd->fullSubcmdName);
copyPtr->typePtr = &tclEnsembleCmdType;
@@ -2601,7 +2667,7 @@ DupEnsembleCmdRep(
ensembleCopy->nsPtr->refCount++;
ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj;
Tcl_IncrRefCount(ensembleCopy->realPrefixObj);
- ensembleCopy->fullSubcmdName = ckalloc((unsigned) length+1);
+ ensembleCopy->fullSubcmdName = ckalloc(length + 1);
memcpy(ensembleCopy->fullSubcmdName, ensembleCmd->fullSubcmdName,
(unsigned) length+1);
}
@@ -2631,7 +2697,7 @@ StringOfEnsembleCmdRep(
int length = strlen(ensembleCmd->fullSubcmdName);
objPtr->length = length;
- objPtr->bytes = ckalloc((unsigned) length+1);
+ objPtr->bytes = ckalloc(length + 1);
memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1);
}
@@ -2862,7 +2928,10 @@ TclCompileEnsemble(
Tcl_IncrRefCount(targetCmdObj);
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
TclDecrRefCount(targetCmdObj);
- if (cmdPtr == NULL || cmdPtr->compileProc == NULL) {
+ if (cmdPtr == NULL || cmdPtr->compileProc == NULL
+ || cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION
+ || cmdPtr->flags * CMD_HAS_EXEC_TRACES
+ || ((Interp *)interp)->flags & DONT_COMPILE_CMDS_INLINE) {
/*
* Maps to an undefined command or a command without a compiler.
* Cannot compile.
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index a64d38d..b5ae6ea 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -11,8 +11,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclEnv.c,v 1.43 2010/04/28 11:50:54 nijtmans Exp $
*/
#include "tclInt.h"
@@ -47,11 +45,8 @@ MODULE_SCOPE void TclSetEnv(const char *name, const char *value);
MODULE_SCOPE void TclUnsetEnv(const char *name);
#if defined(__CYGWIN__)
-/* On Cygwin, the environment is imported from the Cygwin DLL. */
- DLLIMPORT extern int cygwin_posix_to_win32_path_list_buf_size(char *value);
- DLLIMPORT extern void cygwin_posix_to_win32_path_list(char *buf, char *value);
-# define putenv TclCygwinPutenv
-static void TclCygwinPutenv(char *string);
+ static void TclCygwinPutenv(char *string);
+# define putenv TclCygwinPutenv
#endif
/*
@@ -163,7 +158,8 @@ TclSetEnv(
const char *value) /* New value for variable (UTF-8). */
{
Tcl_DString envString;
- int index, length, nameLength;
+ unsigned nameLength, valueLength;
+ int index, length;
char *p, *oldValue;
const char *p2;
@@ -185,12 +181,11 @@ TclSetEnv(
*/
if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
- char **newEnviron = (char **)
- ckalloc(((unsigned) length + 5) * sizeof(char *));
+ char **newEnviron = ckalloc((length + 5) * sizeof(char *));
memcpy(newEnviron, environ, length * sizeof(char *));
if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
- ckfree((char *) env.ourEnviron);
+ ckfree(env.ourEnviron);
}
environ = env.ourEnviron = newEnviron;
env.ourEnvironSize = length + 5;
@@ -220,7 +215,7 @@ TclSetEnv(
Tcl_DStringFree(&envString);
oldValue = environ[index];
- nameLength = length;
+ nameLength = (unsigned) length;
}
/*
@@ -229,18 +224,19 @@ TclSetEnv(
* and set the environ array value.
*/
- p = ckalloc((unsigned) nameLength + strlen(value) + 2);
- strcpy(p, name);
+ valueLength = strlen(value);
+ p = ckalloc(nameLength + valueLength + 2);
+ memcpy(p, name, nameLength);
p[nameLength] = '=';
- strcpy(p+nameLength+1, value);
+ memcpy(p+nameLength+1, value, valueLength+1);
p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
/*
* Copy the native string to heap memory.
*/
- p = ckrealloc(p, strlen(p2) + 1);
- strcpy(p, p2);
+ p = ckrealloc(p, Tcl_DStringLength(&envString) + 1);
+ memcpy(p, p2, (unsigned) Tcl_DStringLength(&envString) + 1);
Tcl_DStringFree(&envString);
#ifdef USE_PUTENV
@@ -400,19 +396,20 @@ TclUnsetEnv(
*/
#if defined(__WIN32__) || defined(__CYGWIN__)
- string = ckalloc((unsigned) length+2);
+ string = ckalloc(length + 2);
memcpy(string, name, (size_t) length);
string[length] = '=';
string[length+1] = '\0';
#else
- string = ckalloc((unsigned) length+1);
+ string = ckalloc(length + 1);
memcpy(string, name, (size_t) length);
string[length] = '\0';
#endif /* WIN32 */
Tcl_UtfToExternalDString(NULL, string, -1, &envString);
- string = ckrealloc(string, (unsigned) Tcl_DStringLength(&envString)+1);
- strcpy(string, Tcl_DStringValue(&envString));
+ string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
+ memcpy(string, Tcl_DStringValue(&envString),
+ (unsigned) Tcl_DStringLength(&envString)+1);
Tcl_DStringFree(&envString);
putenv(string);
@@ -645,11 +642,11 @@ ReplaceString(
const int growth = 5;
- env.cache = (char **) ckrealloc((char *) env.cache,
+ env.cache = ckrealloc(env.cache,
(env.cacheSize + growth) * sizeof(char *));
env.cache[env.cacheSize] = newStr;
- (void) memset(env.cache+env.cacheSize+1, (int) 0,
- (size_t) (growth-1) * sizeof(char*));
+ (void) memset(env.cache+env.cacheSize+1, 0,
+ (size_t) (growth-1) * sizeof(char *));
env.cacheSize += growth;
}
}
@@ -684,7 +681,7 @@ TclFinalizeEnvironment(void)
*/
if (env.cache) {
- ckfree((char *) env.cache);
+ ckfree(env.cache);
env.cache = NULL;
env.cacheSize = 0;
#ifndef USE_PUTENV
@@ -701,6 +698,7 @@ TclFinalizeEnvironment(void)
* fork) and the Windows environment (in case the application TCL code calls
* exec, which calls the Windows CreateProcess function).
*/
+DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *);
static void
TclCygwinPutenv(
@@ -754,15 +752,11 @@ TclCygwinPutenv(
*/
if (strcmp(name, "Path") == 0) {
-#ifdef __WIN32__
SetEnvironmentVariableA("PATH", NULL);
-#endif
unsetenv("PATH");
}
-#ifdef __WIN32__
SetEnvironmentVariableA(name, value);
-#endif
} else {
char *buf;
@@ -770,9 +764,7 @@ TclCygwinPutenv(
* Eliminate any Path variable, to prevent any confusion.
*/
-#ifdef __WIN32__
SetEnvironmentVariableA("Path", NULL);
-#endif
unsetenv("Path");
if (value == NULL) {
@@ -780,14 +772,12 @@ TclCygwinPutenv(
} else {
int size;
- size = cygwin_posix_to_win32_path_list_buf_size(value);
+ size = cygwin_conv_path_list(0, value, NULL, 0);
buf = alloca(size + 1);
- cygwin_posix_to_win32_path_list(value, buf);
+ cygwin_conv_path_list(0, value, buf, size);
}
-#ifdef __WIN32__
SetEnvironmentVariableA(name, buf);
-#endif
}
}
#endif /* __CYGWIN__ */
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 4de8f0b..ae79cad 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -11,8 +11,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclEvent.c,v 1.94 2010/09/23 18:08:35 dgp Exp $
*/
#include "tclInt.h"
@@ -121,7 +119,6 @@ static char * VwaitVarProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
static void InvokeExitHandlers(void);
-
/*
*----------------------------------------------------------------------
@@ -162,7 +159,7 @@ Tcl_BackgroundException(
return;
}
- errPtr = (BgError *) ckalloc(sizeof(BgError));
+ errPtr = ckalloc(sizeof(BgError));
errPtr->errorMsg = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(errPtr->errorMsg);
errPtr->returnOpts = Tcl_GetReturnOptions(interp, code);
@@ -229,7 +226,7 @@ HandleBgErrors(
errPtr = assocPtr->firstBgPtr;
Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
- tempObjv = (Tcl_Obj **) ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *));
+ tempObjv = ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *));
memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
tempObjv[prefixObjc] = errPtr->errorMsg;
tempObjv[prefixObjc+1] = errPtr->returnOpts;
@@ -244,8 +241,8 @@ HandleBgErrors(
Tcl_DecrRefCount(errPtr->errorMsg);
Tcl_DecrRefCount(errPtr->returnOpts);
assocPtr->firstBgPtr = errPtr->nextPtr;
- ckfree((char *) errPtr);
- ckfree((char *) tempObjv);
+ ckfree(errPtr);
+ ckfree(tempObjv);
if (code == TCL_BREAK) {
/*
@@ -258,7 +255,7 @@ HandleBgErrors(
assocPtr->firstBgPtr = errPtr->nextPtr;
Tcl_DecrRefCount(errPtr->errorMsg);
Tcl_DecrRefCount(errPtr->returnOpts);
- ckfree((char *) errPtr);
+ ckfree(errPtr);
}
} else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) {
Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
@@ -336,6 +333,7 @@ TclDefaultBgErrorHandlerObjCmd(
if (valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-level\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) {
@@ -348,6 +346,7 @@ TclDefaultBgErrorHandlerObjCmd(
if (valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-code\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) {
@@ -525,7 +524,7 @@ TclSetBgErrorHandler(
* First access: initialize.
*/
- assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));
+ assocPtr = ckalloc(sizeof(ErrAssocData));
assocPtr->interp = interp;
assocPtr->cmdPrefix = NULL;
assocPtr->firstBgPtr = NULL;
@@ -604,7 +603,7 @@ BgErrorDeleteProc(
assocPtr->firstBgPtr = errPtr->nextPtr;
Tcl_DecrRefCount(errPtr->errorMsg);
Tcl_DecrRefCount(errPtr->returnOpts);
- ckfree((char *) errPtr);
+ ckfree(errPtr);
}
Tcl_CancelIdleCall(HandleBgErrors, assocPtr);
Tcl_DecrRefCount(assocPtr->cmdPrefix);
@@ -634,7 +633,7 @@ Tcl_CreateExitHandler(
Tcl_ExitProc *proc, /* Function to invoke. */
ClientData clientData) /* Arbitrary value to pass to proc. */
{
- ExitHandler *exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
+ ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
exitPtr->proc = proc;
exitPtr->clientData = clientData;
@@ -667,7 +666,7 @@ TclCreateLateExitHandler(
Tcl_ExitProc *proc, /* Function to invoke. */
ClientData clientData) /* Arbitrary value to pass to proc. */
{
- ExitHandler *exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
+ ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
exitPtr->proc = proc;
exitPtr->clientData = clientData;
@@ -712,7 +711,7 @@ Tcl_DeleteExitHandler(
} else {
prevPtr->nextPtr = exitPtr->nextPtr;
}
- ckfree((char *) exitPtr);
+ ckfree(exitPtr);
break;
}
}
@@ -755,7 +754,7 @@ TclDeleteLateExitHandler(
} else {
prevPtr->nextPtr = exitPtr->nextPtr;
}
- ckfree((char *) exitPtr);
+ ckfree(exitPtr);
break;
}
}
@@ -789,7 +788,7 @@ Tcl_CreateThreadExitHandler(
ExitHandler *exitPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
+ exitPtr = ckalloc(sizeof(ExitHandler));
exitPtr->proc = proc;
exitPtr->clientData = clientData;
exitPtr->nextPtr = tsdPtr->firstExitPtr;
@@ -831,7 +830,7 @@ Tcl_DeleteThreadExitHandler(
} else {
prevPtr->nextPtr = exitPtr->nextPtr;
}
- ckfree((char *) exitPtr);
+ ckfree(exitPtr);
return;
}
}
@@ -908,8 +907,8 @@ InvokeExitHandlers(void)
firstExitPtr = exitPtr->nextPtr;
Tcl_MutexUnlock(&exitMutex);
- (*exitPtr->proc)(exitPtr->clientData);
- ckfree((char *) exitPtr);
+ exitPtr->proc(exitPtr->clientData);
+ ckfree(exitPtr);
Tcl_MutexLock(&exitMutex);
}
firstExitPtr = NULL;
@@ -954,27 +953,38 @@ Tcl_Exit(
currentAppExitPtr(INT2PTR(status));
Tcl_Panic("AppExitProc returned unexpectedly");
} else {
- /*
- * Use default handling.
- */
- InvokeExitHandlers();
+ if (TclFullFinalizationRequested()) {
- /*
- * Ensure the thread-specific data is initialised as it is used in
- * Tcl_FinalizeThread()
- */
-
- (void) TCL_TSD_INIT(&dataKey);
-
- /*
- * Now finalize the calling thread only (others are not safely
- * reachable). Among other things, this triggers a flush of the
- * Tcl_Channels that may have data enqueued.
- */
-
- Tcl_FinalizeThread();
-
+ /*
+ * Thorough finalization for Valgrind et al.
+ */
+
+ Tcl_Finalize();
+
+ } else {
+
+ /*
+ * Fast and deterministic exit (default behavior)
+ */
+
+ InvokeExitHandlers();
+
+ /*
+ * Ensure the thread-specific data is initialised as it is used in
+ * Tcl_FinalizeThread()
+ */
+
+ (void) TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Now finalize the calling thread only (others are not safely
+ * reachable). Among other things, this triggers a flush of the
+ * Tcl_Channels that may have data enqueued.
+ */
+
+ Tcl_FinalizeThread();
+ }
TclpExit(status);
Tcl_Panic("OS exit failed!");
}
@@ -1124,7 +1134,7 @@ Tcl_Finalize(void)
firstLateExitPtr = exitPtr->nextPtr;
Tcl_MutexUnlock(&exitMutex);
exitPtr->proc(exitPtr->clientData);
- ckfree((char *) exitPtr);
+ ckfree(exitPtr);
Tcl_MutexLock(&exitMutex);
}
firstLateExitPtr = NULL;
@@ -1289,7 +1299,7 @@ Tcl_FinalizeThread(void)
tsdPtr->firstExitPtr = exitPtr->nextPtr;
exitPtr->proc(exitPtr->clientData);
- ckfree((char *) exitPtr);
+ ckfree(exitPtr);
}
TclFinalizeIOSubsystem();
TclFinalizeNotifier();
@@ -1406,7 +1416,7 @@ Tcl_VwaitObjCmd(
}
if (Tcl_LimitExceeded(interp)) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "limit exceeded", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
break;
}
}
@@ -1416,8 +1426,9 @@ Tcl_VwaitObjCmd(
if (!foundEvent) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
- "\": would wait forever", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't wait for variable \"%s\": would wait forever",
+ nameString));
Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL);
return TCL_ERROR;
}
@@ -1487,7 +1498,7 @@ Tcl_UpdateObjCmd(
int optionIndex;
int flags = 0; /* Initialized to avoid compiler warning. */
static const char *const updateOptions[] = {"idletasks", NULL};
- enum updateOptions {REGEXP_IDLETASKS};
+ enum updateOptions {OPT_IDLETASKS};
if (objc == 1) {
flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
@@ -1497,7 +1508,7 @@ Tcl_UpdateObjCmd(
return TCL_ERROR;
}
switch ((enum updateOptions) optionIndex) {
- case REGEXP_IDLETASKS:
+ case OPT_IDLETASKS:
flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
break;
default:
@@ -1514,7 +1525,7 @@ Tcl_UpdateObjCmd(
}
if (Tcl_LimitExceeded(interp)) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "limit exceeded", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
return TCL_ERROR;
}
}
@@ -1555,7 +1566,7 @@ NewThreadProc(
threadProc = cdPtr->proc;
threadClientData = cdPtr->clientData;
- ckfree((char *) clientData); /* Allocated in Tcl_CreateThread() */
+ ckfree(clientData); /* Allocated in Tcl_CreateThread() */
threadProc(threadClientData);
@@ -1592,15 +1603,14 @@ Tcl_CreateThread(
* thread. */
{
#ifdef TCL_THREADS
- ThreadClientData *cdPtr = (ThreadClientData *)
- ckalloc(sizeof(ThreadClientData));
+ ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
int result;
cdPtr->proc = proc;
cdPtr->clientData = clientData;
result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
if (result != TCL_OK) {
- ckfree((char *) cdPtr);
+ ckfree(cdPtr);
}
return result;
#else
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 4e6cb31..2b5f713 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -13,12 +13,11 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclExecute.c,v 1.499 2010/09/27 19:42:38 msofer Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
+#include "tclOOInt.h"
#include "tommath.h"
#include <math.h>
@@ -55,6 +54,8 @@
static int execInitialized = 0;
TCL_DECLARE_MUTEX(execMutex)
+static int cachedInExit = 0;
+
#ifdef TCL_COMPILE_DEBUG
/*
* Variable that controls whether execution tracing is enabled and, if so,
@@ -170,42 +171,46 @@ static BuiltinFunc const tclBuiltinFuncTable[] = {
* Minimal data required to fully reconstruct the execution state.
*/
-typedef struct BottomData {
+typedef struct TEBCdata {
ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
- struct BottomData *expanded;/* NULL if unchanged, pointer to the succesor
- * if it was expanded */
const unsigned char *pc; /* These fields are used on return TO this */
ptrdiff_t *catchTop; /* this level: they record the state when a */
int cleanup; /* new codePtr was received for NR */
Tcl_Obj *auxObjList; /* execution. */
int checkInterp;
-} BottomData;
-
-#define NR_YIELD(invoke) \
- esPtr->tosPtr = tosPtr; \
- BP->pc = pc; \
- BP->cleanup = cleanup; \
- TclNRAddCallback(interp, TEBCresume, BP, \
- INT2PTR(invoke), NULL, NULL)
-
-#define NR_DATA_DIG() \
- pc = BP->pc; \
- cleanup = BP->cleanup; \
- tosPtr = esPtr->tosPtr
-
+ CmdFrame cmdFrame;
+ void *stack[1]; /* Start of the actual combined catch and obj
+ * stacks; the struct will be expanded as
+ * necessary */
+} TEBCdata;
+
+#define TEBC_YIELD() \
+ do { \
+ esPtr->tosPtr = tosPtr; \
+ TD->pc = pc; \
+ TD->cleanup = cleanup; \
+ TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \
+ } while (0)
+
+#define TEBC_DATA_DIG() \
+ do { \
+ pc = TD->pc; \
+ cleanup = TD->cleanup; \
+ tosPtr = esPtr->tosPtr; \
+ } while (0)
#define PUSH_TAUX_OBJ(objPtr) \
do { \
- objPtr->internalRep.twoPtrValue.ptr2 = auxObjList; \
+ objPtr->internalRep.ptrAndLongRep.ptr = auxObjList; \
auxObjList = objPtr; \
} while (0)
#define POP_TAUX_OBJ() \
- do { \
- tmpPtr = auxObjList; \
- auxObjList = (Tcl_Obj *) tmpPtr->internalRep.twoPtrValue.ptr2; \
- Tcl_DecrRefCount(tmpPtr); \
+ do { \
+ tmpPtr = auxObjList; \
+ auxObjList = tmpPtr->internalRep.ptrAndLongRep.ptr; \
+ Tcl_DecrRefCount(tmpPtr); \
} while (0)
/*
@@ -335,7 +340,7 @@ VarHashCreateVar(
#define OBJ_AT_DEPTH(n) *(tosPtr-(n))
-#define CURR_DEPTH (tosPtr - initTosPtr)
+#define CURR_DEPTH ((ptrdiff_t) (tosPtr - initTosPtr))
/*
* Macros used to trace instruction execution. The macros TRACE,
@@ -345,7 +350,7 @@ VarHashCreateVar(
#ifdef TCL_COMPILE_DEBUG
# define TRACE(a) \
- while (traceInstructions) { \
+ while (traceInstructions) { \
fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
(int) CURR_DEPTH, \
(unsigned) (pc - codePtr->codeStart), \
@@ -354,12 +359,12 @@ VarHashCreateVar(
break; \
}
# define TRACE_APPEND(a) \
- while (traceInstructions) { \
+ while (traceInstructions) { \
printf a; \
break; \
}
# define TRACE_WITH_OBJ(a, objPtr) \
- while (traceInstructions) { \
+ while (traceInstructions) { \
fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
(int) CURR_DEPTH, \
(unsigned) (pc - codePtr->codeStart), \
@@ -385,13 +390,13 @@ VarHashCreateVar(
#define TCL_DTRACE_INST_NEXT() \
do { \
if (TCL_DTRACE_INST_DONE_ENABLED()) { \
- if (curInstName) { \
- TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, \
+ if (curInstName) { \
+ TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, \
tosPtr); \
} \
curInstName = tclInstructionTable[*pc].name; \
if (TCL_DTRACE_INST_START_ENABLED()) { \
- TCL_DTRACE_INST_START(curInstName, (int) CURR_DEPTH, \
+ TCL_DTRACE_INST_START(curInstName, (int) CURR_DEPTH, \
tosPtr); \
} \
} else if (TCL_DTRACE_INST_START_ENABLED()) { \
@@ -401,7 +406,7 @@ VarHashCreateVar(
} while (0)
#define TCL_DTRACE_INST_LAST() \
do { \
- if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) { \
+ if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) { \
TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
} \
} while (0)
@@ -513,16 +518,6 @@ VarHashCreateVar(
#else
#define IsErroringNaNType(type) 0
#endif
-
-/*
- * Custom object type only used in this file; values of its type should never
- * be seen by user scripts.
- */
-
-static const Tcl_ObjType dictIteratorType = {
- "dictIterator",
- NULL, NULL, NULL, NULL
-};
/*
* Auxiliary tables used to compute powers of small integers.
@@ -707,13 +702,15 @@ static void FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc,
int catchOnly, ByteCode *codePtr);
static const char * GetSrcInfoForPc(const unsigned char *pc,
- ByteCode *codePtr, int *lengthPtr);
+ ByteCode *codePtr, int *lengthPtr,
+ const unsigned char **pcBeg);
static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth,
int move);
static void IllegalExprOperandType(Tcl_Interp *interp,
const unsigned char *pc, Tcl_Obj *opndPtr);
static void InitByteCodeExecution(Tcl_Interp *interp);
static inline int OFFSET(void *ptr);
+static void ReleaseDictIterator(Tcl_Obj *objPtr);
/* Useful elsewhere, make available in tclInt.h or stubs? */
static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords);
static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords);
@@ -721,7 +718,6 @@ static Tcl_NRPostProc CopyCallback;
static Tcl_NRPostProc ExprObjCallback;
static Tcl_NRPostProc TEBCresume;
-static Tcl_NRPostProc TEBCreturn;
/*
* The structure below defines a bytecode Tcl object type to hold the
@@ -735,6 +731,56 @@ static const Tcl_ObjType exprCodeType = {
NULL, /* updateStringProc */
NULL /* setFromAnyProc */
};
+
+/*
+ * Custom object type only used in this file; values of its type should never
+ * be seen by user scripts.
+ */
+
+static const Tcl_ObjType dictIteratorType = {
+ "dictIterator",
+ ReleaseDictIterator,
+ NULL, NULL, NULL
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReleaseDictIterator --
+ *
+ * This takes apart a dictionary iterator that is stored in the given Tcl
+ * object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Deallocates memory, marks the object as being untyped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReleaseDictIterator(
+ Tcl_Obj *objPtr)
+{
+ Tcl_DictSearch *searchPtr;
+ Tcl_Obj *dictPtr;
+
+ /*
+ * First kill the search, and then release the reference to the dictionary
+ * that we were holding.
+ */
+
+ searchPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_DictObjDone(searchPtr);
+ ckfree(searchPtr);
+
+ dictPtr = objPtr->internalRep.twoPtrValue.ptr2;
+ TclDecrRefCount(dictPtr);
+
+ objPtr->typePtr = NULL;
+}
/*
*----------------------------------------------------------------------
@@ -803,8 +849,8 @@ TclCreateExecEnv(
int size) /* The initial stack size, in number of words
* [sizeof(Tcl_Obj*)] */
{
- ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv));
- ExecStack *esPtr = (ExecStack *) ckalloc(sizeof(ExecStack)
+ ExecEnv *eePtr = ckalloc(sizeof(ExecEnv));
+ ExecStack *esPtr = ckalloc(sizeof(ExecStack)
+ (size_t) (size-1) * sizeof(Tcl_Obj *));
eePtr->execStackPtr = esPtr;
@@ -855,7 +901,7 @@ static void
DeleteExecStack(
ExecStack *esPtr)
{
- if (esPtr->markerPtr) {
+ if (esPtr->markerPtr && !cachedInExit) {
Tcl_Panic("freeing an execStack which is still in use");
}
@@ -865,7 +911,7 @@ DeleteExecStack(
if (esPtr->nextPtr) {
esPtr->nextPtr->prevPtr = esPtr->prevPtr;
}
- ckfree((char *) esPtr);
+ ckfree(esPtr);
}
void
@@ -874,6 +920,8 @@ TclDeleteExecEnv(
{
ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
+ cachedInExit = TclInExit();
+
/*
* Delete all stacks in this exec env.
*/
@@ -889,13 +937,13 @@ TclDeleteExecEnv(
TclDecrRefCount(eePtr->constants[0]);
TclDecrRefCount(eePtr->constants[1]);
- if (eePtr->callbackPtr) {
+ if (eePtr->callbackPtr && !cachedInExit) {
Tcl_Panic("Deleting execEnv with pending TEOV callbacks!");
}
- if (eePtr->corPtr) {
+ if (eePtr->corPtr && !cachedInExit) {
Tcl_Panic("Deleting execEnv with existing coroutine");
}
- ckfree((char *) eePtr);
+ ckfree(eePtr);
}
/*
@@ -1020,14 +1068,14 @@ GrowEvaluationStack(
/*
* Reset move to hold the number of words to be moved to new stack (if
- * any) and growth to hold the complete stack requirements: add the marker
- * and maximal possible offset.
+ * any) and growth to hold the complete stack requirements: add one for
+ * the marker, (WALLOCALIGN-1) for the maximal possible offset.
*/
if (move) {
moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1;
}
- needed = growth + moveWords + WALLOCALIGN - 1;
+ needed = growth + moveWords + WALLOCALIGN;
/*
* Check if there is enough room in the next stack (if there is one, it
@@ -1065,7 +1113,7 @@ GrowEvaluationStack(
newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
oldPtr = esPtr;
- esPtr = (ExecStack *) ckalloc(newBytes);
+ esPtr = ckalloc(newBytes);
oldPtr->nextPtr = esPtr;
esPtr->prevPtr = oldPtr;
@@ -1191,18 +1239,27 @@ TclStackFree(
}
/*
- * Return to previous stack.
+ * Return to previous active stack. Note that repeated expansions or
+ * reallocs could have generated several unused intervening stacks: free
+ * them too.
*/
+ while (esPtr->nextPtr) {
+ esPtr = esPtr->nextPtr;
+ }
esPtr->tosPtr = &esPtr->stackWords[-1];
+ while (esPtr->prevPtr) {
+ ExecStack *tmpPtr = esPtr->prevPtr;
+ if (tmpPtr->tosPtr == &tmpPtr->stackWords[-1]) {
+ DeleteExecStack(tmpPtr);
+ } else {
+ break;
+ }
+ }
if (esPtr->prevPtr) {
eePtr->execStackPtr = esPtr->prevPtr;
- }
- if (esPtr->nextPtr) {
- if (!esPtr->prevPtr) {
- eePtr->execStackPtr = esPtr->nextPtr;
- }
- DeleteExecStack(esPtr);
+ } else {
+ eePtr->execStackPtr = esPtr;
}
}
@@ -1281,7 +1338,7 @@ Tcl_ExprObj(
Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression
* result is stored if no errors occur. */
{
- TEOV_callback *rootPtr = TOP_CB(interp);
+ NRE_callback *rootPtr = TOP_CB(interp);
Tcl_Obj *resultPtr;
TclNewObj(resultPtr);
@@ -1365,7 +1422,6 @@ ExprObjCallback(
if (result == TCL_OK) {
TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp));
- Tcl_IncrRefCount(resultPtr);
Tcl_SetObjResult(interp, saveObjPtr);
}
TclDecrRefCount(saveObjPtr);
@@ -1411,7 +1467,7 @@ CompileExprObj(
if (objPtr->typePtr == &exprCodeType) {
Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.otherValuePtr;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
@@ -1451,7 +1507,7 @@ CompileExprObj(
TclInitByteCodeObj(objPtr, &compEnv);
objPtr->typePtr = &exprCodeType;
TclFreeCompileEnv(&compEnv);
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.otherValuePtr;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1523,14 +1579,14 @@ static void
FreeExprCodeInternalRep(
Tcl_Obj *objPtr)
{
- ByteCode *codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
+ objPtr->typePtr = NULL;
+ objPtr->internalRep.otherValuePtr = NULL;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
- objPtr->typePtr = NULL;
- objPtr->internalRep.otherValuePtr = NULL;
}
/*
@@ -1538,13 +1594,13 @@ FreeExprCodeInternalRep(
*
* TclCompileObj --
*
- * This procedure compiles the script contained in a Tcl_Obj
+ * This procedure compiles the script contained in a Tcl_Obj.
*
* Results:
* A pointer to the corresponding ByteCode, never NULL.
*
* Side effects:
- * The object is shimmered to bytecode type
+ * The object is shimmered to bytecode type.
*
*----------------------------------------------------------------------
*/
@@ -1584,30 +1640,29 @@ TclCompileObj(
* here.
*/
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.otherValuePtr;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
- if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
- if ((Interp *) *codePtr->interpHandle != iPtr) {
- Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
- }
- codePtr->compileEpoch = iPtr->compileEpoch;
- } else {
+ if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
goto recompileObj;
}
+ if ((Interp *) *codePtr->interpHandle != iPtr) {
+ Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
+ }
+ codePtr->compileEpoch = iPtr->compileEpoch;
}
- if (codePtr->procPtr == NULL) {
- /*
- * Check that any compiled locals do refer to the current proc
- * environment! If not, recompile.
- */
+ /*
+ * Check that any compiled locals do refer to the current proc
+ * environment! If not, recompile.
+ */
- if (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr) {
- goto recompileObj;
- }
+ if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED) &&
+ (codePtr->procPtr == NULL) &&
+ (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)){
+ goto recompileObj;
}
/*
@@ -1639,70 +1694,64 @@ TclCompileObj(
* information.
*/
- {
+ if (invoker == NULL) {
+ return codePtr;
+ } else {
Tcl_HashEntry *hePtr =
Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
+ ExtCmdLoc *eclPtr;
+ CmdFrame *ctxCopyPtr;
+ int redo;
- if (hePtr) {
- ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
- int redo = 0;
-
- if (invoker) {
- CmdFrame *ctxPtr = TclStackAlloc(interp,sizeof(CmdFrame));
- *ctxPtr = *invoker;
+ if (!hePtr) {
+ return codePtr;
+ }
- if (invoker->type == TCL_LOCATION_BC) {
- /*
- * Note: Type BC => ctx.data.eval.path is not used.
- * ctx.data.tebc.codePtr used instead
- */
+ eclPtr = Tcl_GetHashValue(hePtr);
+ redo = 0;
+ ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+ *ctxCopyPtr = *invoker;
- TclGetSrcInfoForPc(ctxPtr);
- if (ctxPtr->type == TCL_LOCATION_SOURCE) {
- /*
- * The reference made by 'TclGetSrcInfoForPc' is
- * dead.
- */
+ if (invoker->type == TCL_LOCATION_BC) {
+ /*
+ * Note: Type BC => ctx.data.eval.path is not used.
+ * ctx.data.tebc.codePtr used instead
+ */
- Tcl_DecrRefCount(ctxPtr->data.eval.path);
- ctxPtr->data.eval.path = NULL;
- }
- }
+ TclGetSrcInfoForPc(ctxCopyPtr);
+ if (ctxCopyPtr->type == TCL_LOCATION_SOURCE) {
+ /*
+ * The reference made by 'TclGetSrcInfoForPc' is dead.
+ */
- if (word < ctxPtr->nline) {
- /*
- * Note: We do not care if the line[word] is -1. This
- * is a difference and requires a recompile (location
- * changed from absolute to relative, literal is used
- * fixed and through variable)
- *
- * Example:
- * test info-32.0 using literal of info-24.8
- * (dict with ... vs set body ...).
- */
+ Tcl_DecrRefCount(ctxCopyPtr->data.eval.path);
+ ctxCopyPtr->data.eval.path = NULL;
+ }
+ }
- redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
- && (eclPtr->start != ctxPtr->line[word]))
- || ((eclPtr->type == TCL_LOCATION_BC)
- && (ctxPtr->type == TCL_LOCATION_SOURCE));
- }
+ if (word < ctxCopyPtr->nline) {
+ /*
+ * Note: We do not care if the line[word] is -1. This is a
+ * difference and requires a recompile (location changed from
+ * absolute to relative, literal is used fixed and through
+ * variable)
+ *
+ * Example:
+ * test info-32.0 using literal of info-24.8
+ * (dict with ... vs set body ...).
+ */
- TclStackFree(interp, ctxPtr);
- }
+ redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
+ && (eclPtr->start != ctxCopyPtr->line[word]))
+ || ((eclPtr->type == TCL_LOCATION_BC)
+ && (ctxCopyPtr->type == TCL_LOCATION_SOURCE));
+ }
- if (redo) {
- goto recompileObj;
- }
+ TclStackFree(interp, ctxCopyPtr);
+ if (!redo) {
+ return codePtr;
}
}
-
- /*
- * Increment the code's ref count while it is being executed. If
- * afterwards no references to it remain, free the code.
- */
-
- runCompiledObj:
- return codePtr;
}
recompileObj:
@@ -1717,14 +1766,14 @@ TclCompileObj(
iPtr->invokeCmdFramePtr = invoker;
iPtr->invokeWord = word;
- tclByteCodeType.setFromAnyProc(interp, objPtr);
+ TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
iPtr->invokeCmdFramePtr = NULL;
codePtr = objPtr->internalRep.otherValuePtr;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
}
- goto runCompiledObj;
+ return codePtr;
}
/*
@@ -1871,10 +1920,10 @@ TclIncrObj(
*
*----------------------------------------------------------------------
*/
-#define bcFramePtr ((CmdFrame *) (BP + 1))
-#define initCatchTop (((ptrdiff_t *) (bcFramePtr + 1)) - 1)
+#define bcFramePtr (&TD->cmdFrame)
+#define initCatchTop ((ptrdiff_t *) (&TD->stack[-1]))
#define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
-#define esPtr (iPtr->execEnvPtr->execStackPtr)
+#define esPtr (iPtr->execEnvPtr->execStackPtr)
int
TclNRExecuteByteCode(
@@ -1882,18 +1931,22 @@ TclNRExecuteByteCode(
ByteCode *codePtr) /* The bytecode sequence to interpret. */
{
Interp *iPtr = (Interp *) interp;
- BottomData *BP;
-
+ TEBCdata *TD;
+ int size = sizeof(TEBCdata) - 1
+ + (codePtr->maxStackDepth + codePtr->maxExceptDepth)
+ * sizeof(void *);
+ int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
+
if (iPtr->execEnvPtr->rewind) {
return TCL_ERROR;
}
-
+
codePtr->refCount++;
/*
- * Reserve the stack, setup the BottomPtr and CallFrame
+ * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
*
- * The execution uses a unified stack: first a BottomData, immediately
+ * The execution uses a unified stack: first a TEBCdata, immediately
* above it a CmdFrame, then the catch stack, then the execution stack.
*
* Make sure the catch stack is large enough to hold the maximum number of
@@ -1902,22 +1955,19 @@ TclNRExecuteByteCode(
* execution stack is large enough to execute this ByteCode.
*/
- BP = (BottomData *) GrowEvaluationStack(iPtr->execEnvPtr,
- sizeof(BottomData) + codePtr->maxExceptDepth + sizeof(CmdFrame)
- + codePtr->maxStackDepth, 0);
+ TD = (TEBCdata *) GrowEvaluationStack(iPtr->execEnvPtr, numWords, 0);
esPtr->tosPtr = initTosPtr;
-
- BP->codePtr = codePtr;
- BP->expanded = NULL;
- BP->pc = codePtr->codeStart;
- BP->catchTop = initCatchTop;
- BP->cleanup = 0;
- BP->auxObjList = NULL;
- BP->checkInterp = 0;
-
+
+ TD->codePtr = codePtr;
+ TD->pc = codePtr->codeStart;
+ TD->catchTop = initCatchTop;
+ TD->cleanup = 0;
+ TD->auxObjList = NULL;
+ TD->checkInterp = 0;
+
/*
* TIP #280: Initialize the frame. Do not push it yet: it will be pushed
- * every time that we call out from this BP, popped when we return to it.
+ * every time that we call out from this TD, popped when we return to it.
*/
bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
@@ -1934,53 +1984,20 @@ TclNRExecuteByteCode(
bcFramePtr->cmd.str.cmd = NULL;
bcFramePtr->cmd.str.len = 0;
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceExec >= 2) {
- PrintByteCodeInfo(codePtr);
- fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH);
- fflush(stdout);
- }
-#endif
-
#ifdef TCL_COMPILE_STATS
iPtr->stats.numExecutions++;
#endif
/*
- * Push the callbacks for
- * - exception handling and cleanup
- * - bytecode execution
+ * Push the callback for bytecode execution
*/
-
- TclNRAddCallback(interp, TEBCreturn, BP, NULL,
+
+ TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0),
NULL, NULL);
- TclNRAddCallback(interp, TEBCresume, BP,
- /*resume*/ INT2PTR(0), NULL, NULL);
-
return TCL_OK;
}
static int
-TEBCreturn(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- BottomData *BP = data[0];
- ByteCode *codePtr = BP->codePtr;
-
- if (--codePtr->refCount <= 0) {
- TclCleanupByteCode(codePtr);
- }
- while (BP->expanded) {
- BP = BP->expanded;
- }
- TclStackFree(interp, BP); /* free my stack */
-
- return result;
-}
-
-static int
TEBCresume(
ClientData data[],
Tcl_Interp *interp,
@@ -2003,7 +2020,6 @@ TEBCresume(
/*
* Bottom of allocated stack holds the NR data
*/
- /* NR_TEBC */
/*
* Constants: variables that do not change during the execution, used
@@ -2017,33 +2033,33 @@ TEBCresume(
int traceInstructions; /* Whether we are doing instruction-level
* tracing or not. */
#endif
-#define LOCAL(i) (&iPtr->varFramePtr->compiledLocals[(i)])
-#define TCONST(i) (iPtr->execEnvPtr->constants[(i)])
+
+ Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
+ Tcl_Obj **constants = &iPtr->execEnvPtr->constants[0];
+
+#define LOCAL(i) (&compiledLocals[(i)])
+#define TCONST(i) (constants[(i)])
/*
* These macros are just meant to save some global variables that are not
* used too frequently
*/
- BottomData *BP = data[0];
-#define auxObjList (BP->auxObjList)
-#define catchTop (BP->catchTop)
-#define codePtr (BP->codePtr)
-#define checkInterp (BP->checkInterp)
- /* Indicates when a check of interp readyness
- * is necessary. Set by CACHE_STACK_INFO() */
+ TEBCdata *TD = data[0];
+#define auxObjList (TD->auxObjList)
+#define catchTop (TD->catchTop)
+#define codePtr (TD->codePtr)
+#define checkInterp (TD->checkInterp)
+ /* Indicates when a check of interp readyness is
+ * necessary. Set by CACHE_STACK_INFO() */
/*
* Globals: variables that store state, must remain valid at all times.
*/
- Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation
- * stack. */
- const unsigned char *pc; /* The current program counter. */
-
-#ifdef TCL_COMPILE_DEBUG
- traceInstructions = (tclTraceExec == 3);
-#endif
+ Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation
+ * stack. */
+ const unsigned char *pc; /* The current program counter. */
/*
* Transfer variables - needed only between opcodes, but not while
@@ -2061,23 +2077,36 @@ TEBCresume(
Tcl_Obj *objPtr, *valuePtr, *value2Ptr, *part1Ptr, *part2Ptr, *tmpPtr;
Tcl_Obj **objv;
- int opnd, objc, length, pcAdjustment;
+ int objc = 0;
+ int opnd, length, pcAdjustment;
Var *varPtr, *arrayPtr;
#ifdef TCL_COMPILE_DEBUG
char cmdNameBuf[21];
#endif
- NR_DATA_DIG();
+#ifdef TCL_COMPILE_DEBUG
+ traceInstructions = (tclTraceExec == 3);
+#endif
+
+ TEBC_DATA_DIG();
+
+#ifdef TCL_COMPILE_DEBUG
+ if (!data[1] && (tclTraceExec >= 2)) {
+ PrintByteCodeInfo(codePtr);
+ fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH);
+ fflush(stdout);
+ }
+#endif
if (data[1] /* resume from invocation */) {
if (iPtr->execEnvPtr->rewind) {
result = TCL_ERROR;
}
NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
- NRE_ASSERT(TOP_CB(interp)->procPtr == TEBCreturn);
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
- TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
-
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
+ TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
+ }
if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
iPtr->flags |= ERR_ALREADY_LOGGED;
codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
@@ -2091,39 +2120,37 @@ TEBCresume(
}
#endif
/*
- * Push the call's object result and continue execution with
- * the next instruction.
+ * Push the call's object result and continue execution with the
+ * next instruction.
*/
-
+
TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
- objc, cmdNameBuf), Tcl_GetObjResult(interp));
-
+ objc, cmdNameBuf), Tcl_GetObjResult(interp));
+
objResultPtr = Tcl_GetObjResult(interp);
-
+
/*
* Reset the interp's result to avoid possible duplications of
- * large 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 manipulate the interp's object
- * result directly.
+ * large 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 manipulate the interp's object result directly.
*
- * Note that the result object is now in objResultPtr, it
- * keeps the refCount it had in its role of
- * iPtr->objResultPtr.
+ * Note that the result object is now in objResultPtr, it keeps
+ * the refCount it had in its role of iPtr->objResultPtr.
*/
-
+
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
iPtr->objResultPtr = objPtr;
- NEXT_INST_V(0, cleanup, -1);
+ NEXT_INST_V(0, cleanup, -1);
}
-
+
/*
* Result not TCL_OK: fall through
*/
}
-
+
if (iPtr->execEnvPtr->rewind) {
result = TCL_ERROR;
goto abnormalReturn;
@@ -2232,9 +2259,11 @@ TEBCresume(
}
}
- if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
- CACHE_STACK_INFO();
- goto gotError;
+ if (TclCanceled(iPtr)) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
}
if (TclLimitReady(iPtr->limit)) {
@@ -2303,6 +2332,101 @@ TEBCresume(
cleanup = 1;
goto processExceptionReturn;
+ case INST_YIELD: {
+ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+
+ TRACE(("%.30s => ", O2S(OBJ_AT_TOS)));
+ if (!corPtr) {
+ TRACE_APPEND(("ERROR: yield outside coroutine\n"));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yield can only be called in a coroutine", -1));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
+ NULL);
+ goto gotError;
+ }
+
+#ifdef TCL_COMPILE_DEBUG
+ TRACE_WITH_OBJ(("yield, result="), iPtr->objResultPtr);
+ if (traceInstructions) {
+ fprintf(stdout, "\n");
+ }
+#endif
+ /* TIP #280: Record the last piece of info needed by
+ * 'TclGetSrcInfoForPc', and push the frame.
+ */
+
+ bcFramePtr->data.tebc.pc = (char *) pc;
+ iPtr->cmdFramePtr = bcFramePtr;
+
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
+ TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
+ codePtr, bcFramePtr, pc - codePtr->codeStart);
+ }
+
+ pc++;
+ cleanup = 1;
+ TEBC_YIELD();
+
+ Tcl_SetObjResult(interp, OBJ_AT_TOS);
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
+ INT2PTR(0), NULL, NULL);
+
+ return TCL_OK;
+ }
+
+ case INST_TAILCALL: {
+ Tcl_Obj *listPtr, *nsObjPtr;
+ NRE_callback *tailcallPtr;
+
+ opnd = TclGetUInt1AtPtr(pc+1);
+
+ if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
+ TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "tailcall can only be called from a proc or lambda", -1));
+ Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
+ goto gotError;
+ }
+
+#ifdef TCL_COMPILE_DEBUG
+ {
+ register int i;
+
+ TRACE(("%d [", opnd));
+ for (i=opnd-1 ; i>=0 ; i--) {
+ TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i))));
+ if (i > 0) {
+ TRACE_APPEND((" "));
+ }
+ }
+ TRACE_APPEND(("] => RETURN..."));
+ }
+#endif
+
+ /*
+ * Push the evaluation of the called command into the NR callback
+ * stack.
+ */
+
+ listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
+ nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1);
+ Tcl_IncrRefCount(listPtr);
+ Tcl_IncrRefCount(nsObjPtr);
+ TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr,
+ NULL, NULL);
+
+ /*
+ * Unstitch ourselves and do a [return].
+ */
+
+ tailcallPtr = TOP_CB(interp);
+ TOP_CB(interp) = tailcallPtr->nextPtr;
+ iPtr->varFramePtr->tailcallPtr = tailcallPtr;
+ result = TCL_RETURN;
+ cleanup = opnd;
+ goto processExceptionReturn;
+ }
+
case INST_DONE:
if (tosPtr > initTosPtr) {
/*
@@ -2403,7 +2527,7 @@ TEBCresume(
}
codePtr->flags |= TCL_BYTECODE_RECOMPILE;
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
+ bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL);
opnd = TclGetUInt4AtPtr(pc+1);
pc += (opnd-1);
PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
@@ -2523,7 +2647,6 @@ TEBCresume(
#if !TCL_COMPILE_DEBUG
if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) {
TclFreeIntRep(objResultPtr);
- objResultPtr->typePtr = NULL;
objResultPtr->bytes = ckrealloc(bytes, length+appendLen+1);
objResultPtr->length = length + appendLen;
p = TclGetString(objResultPtr) + length;
@@ -2531,7 +2654,7 @@ TEBCresume(
} else
#endif
{
- p = (char *) ckalloc((unsigned) (length + appendLen + 1));
+ p = ckalloc(length + appendLen + 1);
TclNewObj(objResultPtr);
objResultPtr->bytes = p;
objResultPtr->length = length + appendLen;
@@ -2605,7 +2728,7 @@ TEBCresume(
*/
TclNewObj(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = (void *) CURR_DEPTH;
+ objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
PUSH_TAUX_OBJ(objPtr);
NEXT_INST_F(1, 0, 0);
@@ -2637,17 +2760,16 @@ TEBCresume(
length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1));
DECACHE_STACK_INFO();
moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1)
- - (Tcl_Obj **) BP;
+ - (Tcl_Obj **) TD;
if (moved) {
/*
* Change the global data to point to the new stack: move the
- * bottomPtr, recompute the position of every other
+ * TEBCdataPtr TD, recompute the position of every other
* stack-allocated parameter, update the stack pointers.
*/
esPtr = iPtr->execEnvPtr->execStackPtr;
- BP->expanded = (BottomData *) (((Tcl_Obj **)BP) + moved);
- BP = BP->expanded;
+ TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);
catchTop += moved;
tosPtr += moved;
@@ -2676,7 +2798,7 @@ TEBCresume(
CACHE_STACK_INFO();
cleanup = 1;
pc++;
- NR_YIELD(1);
+ TEBC_YIELD();
return TclNRExecuteByteCode(interp, newCodePtr);
}
@@ -2691,13 +2813,12 @@ TEBCresume(
cleanup = 1;
pc += 1;
- NR_YIELD(1);
+ TEBC_YIELD();
return TclNREvalObjEx(interp, OBJ_AT_TOS, 0, NULL, 0);
case INST_INVOKE_EXPANDED:
CLANG_ASSERT(auxObjList);
- objc = CURR_DEPTH
- - (ptrdiff_t) auxObjList->internalRep.twoPtrValue.ptr1;
+ objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
POP_TAUX_OBJ();
if (objc) {
pcAdjustment = 1;
@@ -2754,13 +2875,15 @@ TEBCresume(
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
- TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
- codePtr, bcFramePtr, pc - codePtr->codeStart);
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
+ TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
+ codePtr, bcFramePtr, pc - codePtr->codeStart);
+ }
DECACHE_STACK_INFO();
pc += pcAdjustment;
- NR_YIELD(1);
+ TEBC_YIELD();
return TclNREvalObjv(interp, objc, objv,
TCL_EVAL_NOERR, NULL);
@@ -3730,11 +3853,132 @@ TEBCresume(
CACHE_STACK_INFO();
TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
goto gotError;
+
+ /*
+ * This is really an unset operation these days. Do not issue.
+ */
+
+ case INST_DICT_DONE:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ TRACE(("%u\n", opnd));
+ varPtr = LOCAL(opnd);
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
+ if (!TclIsVarUndefined(varPtr)) {
+ TclDecrRefCount(varPtr->value.objPtr);
+ }
+ varPtr->value.objPtr = NULL;
+ } else {
+ DECACHE_STACK_INFO();
+ TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
+ CACHE_STACK_INFO();
+ }
+ NEXT_INST_F(5, 0, 0);
}
/*
* End of INST_UNSET instructions.
* -----------------------------------------------------------------
+ * Start of INST_ARRAY instructions.
+ */
+
+ case INST_ARRAY_EXISTS_IMM:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ cleanup = 0;
+ part1Ptr = NULL;
+ arrayPtr = NULL;
+ TRACE(("%u => ", opnd));
+ varPtr = LOCAL(opnd);
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ goto doArrayExists;
+ case INST_ARRAY_EXISTS_STK:
+ opnd = -1;
+ pcAdjustment = 1;
+ cleanup = 1;
+ part1Ptr = OBJ_AT_TOS;
+ TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
+ varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL,
+ /*createPart1*/0, /*createPart2*/0, &arrayPtr);
+ doArrayExists:
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ DECACHE_STACK_INFO();
+ result = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,
+ NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|
+ TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd);
+ CACHE_STACK_INFO();
+ if (result == TCL_ERROR) {
+ TRACE_APPEND(("ERROR: %.30s\n",
+ O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ }
+ if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+ objResultPtr = TCONST(1);
+ } else {
+ objResultPtr = TCONST(0);
+ }
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
+
+ case INST_ARRAY_MAKE_IMM:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ cleanup = 0;
+ part1Ptr = NULL;
+ arrayPtr = NULL;
+ TRACE(("%u => ", opnd));
+ varPtr = LOCAL(opnd);
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ goto doArrayMake;
+ case INST_ARRAY_MAKE_STK:
+ opnd = -1;
+ pcAdjustment = 1;
+ cleanup = 1;
+ part1Ptr = OBJ_AT_TOS;
+ TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
+ varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG,
+ "set", /*createPart1*/1, /*createPart2*/0, &arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ doArrayMake:
+ if (varPtr && !TclIsVarArray(varPtr)) {
+ if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
+ /*
+ * Either an array element, or a scalar: lose!
+ */
+
+ TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
+ "variable isn't array", opnd);
+ Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+ TRACE_APPEND(("ERROR: bad array ref: %.30s\n",
+ O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ TclSetVarArray(varPtr);
+ varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
+ TclInitVarHashTable(varPtr->value.tablePtr,
+ TclGetVarNsPtr(varPtr));
+#ifdef TCL_COMPILE_DEBUG
+ TRACE_APPEND(("done\n"));
+ } else {
+ TRACE_APPEND(("nothing to do\n"));
+#endif
+ }
+ NEXT_INST_V(pcAdjustment, cleanup, 0);
+
+ /*
+ * End of INST_ARRAY instructions.
+ * -----------------------------------------------------------------
* Start of variable linking instructions.
*/
@@ -3970,7 +4214,7 @@ TEBCresume(
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
- CACHE_STACK_INFO();
+ CACHE_STACK_INFO();
goto gotError;
}
@@ -3979,7 +4223,7 @@ TEBCresume(
(value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, value2Ptr);
- CACHE_STACK_INFO();
+ CACHE_STACK_INFO();
goto gotError;
}
@@ -3995,6 +4239,136 @@ TEBCresume(
/*
* -----------------------------------------------------------------
+ * Start of general introspector instructions.
+ */
+
+ case INST_NS_CURRENT: {
+ Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+
+ if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
+ TclNewLiteralStringObj(objResultPtr, "::");
+ } else {
+ TclNewStringObj(objResultPtr, currNsPtr->fullName,
+ strlen(currNsPtr->fullName));
+ }
+ TRACE_WITH_OBJ(("=> "), objResultPtr);
+ NEXT_INST_F(1, 0, 1);
+ }
+ case INST_COROUTINE_NAME: {
+ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+
+ TclNewObj(objResultPtr);
+ if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) {
+ Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr,
+ objResultPtr);
+ }
+ TRACE_WITH_OBJ(("=> "), objResultPtr);
+ NEXT_INST_F(1, 0, 1);
+ }
+ case INST_INFO_LEVEL_NUM:
+ TclNewIntObj(objResultPtr, iPtr->varFramePtr->level);
+ TRACE_WITH_OBJ(("=> "), objResultPtr);
+ NEXT_INST_F(1, 0, 1);
+ case INST_INFO_LEVEL_ARGS: {
+ int level;
+ register CallFrame *framePtr = iPtr->varFramePtr;
+ register CallFrame *rootFramePtr = iPtr->rootFramePtr;
+
+ valuePtr = OBJ_AT_TOS;
+ if (TclGetIntFromObj(interp, valuePtr, &level) != TCL_OK) {
+ TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
+ Tcl_GetObjResult(interp));
+ goto gotError;
+ }
+ TRACE(("%d => ", level));
+ if (level <= 0) {
+ level += framePtr->level;
+ }
+ for (; (framePtr->level!=level) && (framePtr!=rootFramePtr) ;
+ framePtr = framePtr->callerVarPtr) {
+ /* Empty loop body */
+ }
+ if (framePtr == rootFramePtr) {
+ Tcl_AppendResult(interp, "bad level \"", TclGetString(valuePtr),
+ "\"", NULL);
+ TRACE_APPEND(("ERROR: bad level\n"));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
+ TclGetString(valuePtr), NULL);
+ goto gotError;
+ }
+ objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ }
+ case INST_RESOLVE_COMMAND: {
+ Tcl_Command cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
+
+ TclNewObj(objResultPtr);
+ if (cmd != NULL) {
+ Tcl_GetCommandFullName(interp, cmd, objResultPtr);
+ }
+ TRACE_WITH_OBJ(("\"%.20s\" => ", O2S(OBJ_AT_TOS)), objResultPtr);
+ NEXT_INST_F(1, 1, 1);
+ }
+ case INST_TCLOO_SELF: {
+ CallFrame *framePtr = iPtr->varFramePtr;
+ CallContext *contextPtr;
+
+ if (framePtr == NULL ||
+ !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+ TRACE(("=> ERROR: no TclOO call context\n"));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "self may only be called from inside a method",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ goto gotError;
+ }
+ contextPtr = framePtr->clientData;
+
+ /*
+ * Call out to get the name; it's expensive to compute but cached.
+ */
+
+ objResultPtr = TclOOObjectName(interp, contextPtr->oPtr);
+ TRACE_WITH_OBJ(("=> "), objResultPtr);
+ NEXT_INST_F(1, 0, 1);
+ }
+ {
+ Object *oPtr;
+
+ case INST_TCLOO_IS_OBJECT:
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
+ objResultPtr = TCONST(oPtr != NULL ? 1 : 0);
+ TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr);
+ NEXT_INST_F(1, 1, 1);
+ case INST_TCLOO_CLASS:
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
+ if (oPtr == NULL) {
+ TRACE(("%.30s => ERROR: not object\n", O2S(OBJ_AT_TOS)));
+ goto gotError;
+ }
+ objResultPtr = TclOOObjectName(interp, oPtr->selfCls->thisPtr);
+ TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr);
+ NEXT_INST_F(1, 1, 1);
+ case INST_TCLOO_NS:
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
+ if (oPtr == NULL) {
+ TRACE(("%.30s => ERROR: not object\n", O2S(OBJ_AT_TOS)));
+ goto gotError;
+ }
+
+ /*
+ * TclOO objects *never* have the global namespace as their NS.
+ */
+
+ TclNewStringObj(objResultPtr, oPtr->namespacePtr->fullName,
+ strlen(oPtr->namespacePtr->fullName));
+ TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr);
+ NEXT_INST_F(1, 1, 1);
+ }
+
+ /*
+ * -----------------------------------------------------------------
* Start of INST_LIST and related instructions.
*/
@@ -4260,12 +4634,33 @@ TEBCresume(
*/
if (fromIdx<=toIdx && fromIdx<objc && toIdx>=0) {
- if (fromIdx<0) {
+ if (fromIdx < 0) {
fromIdx = 0;
}
if (toIdx >= objc) {
toIdx = objc-1;
}
+ if (fromIdx == 0 && toIdx != objc-1 && !Tcl_IsShared(valuePtr)) {
+ /*
+ * BEWARE! This is looking inside the implementation of the
+ * list type.
+ */
+
+ List *listPtr = valuePtr->internalRep.twoPtrValue.ptr1;
+
+ if (listPtr->refCount == 1) {
+ TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr),
+ TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)));
+ for (index=toIdx+1 ; index<objc-1 ; index++) {
+ TclDecrRefCount(objv[index]);
+ }
+ listPtr->elemCount = toIdx+1;
+ listPtr->canonicalFlag = 1;
+ TclInvalidateStringRep(valuePtr);
+ TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
+ NEXT_INST_F(9, 0, 0);
+ }
+ }
objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
} else {
TclNewObj(objResultPtr);
@@ -4359,6 +4754,7 @@ TEBCresume(
* strings. We can use memcmp in all (n)eq cases because we
* don't need to worry about lexical LE/BE variance.
*/
+
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
memCmpFn_t memCmpFn;
int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
@@ -4370,7 +4766,7 @@ TEBCresume(
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
} else if (((valuePtr->typePtr == &tclStringType)
- && (value2Ptr->typePtr == &tclStringType))) {
+ && (value2Ptr->typePtr == &tclStringType))) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
@@ -4520,6 +4916,176 @@ TEBCresume(
O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
+ case INST_STR_RANGE:
+ TRACE(("\"%.20s\" %s %s =>",
+ O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
+ length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
+ if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
+ &fromIdx) != TCL_OK
+ || TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
+ &toIdx) != TCL_OK) {
+ goto gotError;
+ }
+
+ if (fromIdx < 0) {
+ fromIdx = 0;
+ }
+ if (toIdx >= length) {
+ toIdx = length;
+ }
+ if (toIdx >= fromIdx) {
+ objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx);
+ } else {
+ TclNewObj(objResultPtr);
+ }
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_V(1, 3, 1);
+
+ case INST_STR_RANGE_IMM:
+ valuePtr = OBJ_AT_TOS;
+ fromIdx = TclGetInt4AtPtr(pc+1);
+ toIdx = TclGetInt4AtPtr(pc+5);
+ length = Tcl_GetCharLength(valuePtr);
+ TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx));
+
+ /*
+ * Adjust indices for end-based indexing.
+ */
+
+ if (fromIdx < -1) {
+ fromIdx += 1 + length;
+ if (fromIdx < 0) {
+ fromIdx = 0;
+ }
+ } else if (fromIdx >= length) {
+ fromIdx = length;
+ }
+ if (toIdx < -1) {
+ toIdx += 1 + length;
+ } else if (toIdx >= length) {
+ toIdx = length - 1;
+ }
+
+ /*
+ * Check if we can do a sane substring.
+ */
+
+ if (fromIdx <= toIdx) {
+ objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
+ } else {
+ TclNewObj(objResultPtr);
+ }
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(9, 1, 1);
+
+ {
+ Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
+ int length3;
+ Tcl_Obj *value3Ptr;
+
+ case INST_STR_MAP:
+ valuePtr = OBJ_AT_TOS; /* "Main" string. */
+ value3Ptr = OBJ_UNDER_TOS; /* "Target" string. */
+ value2Ptr = OBJ_AT_DEPTH(2); /* "Source" string. */
+ if (value3Ptr == value2Ptr) {
+ objResultPtr = valuePtr;
+ NEXT_INST_V(1, 3, 1);
+ } else if (valuePtr == value2Ptr) {
+ objResultPtr = value3Ptr;
+ NEXT_INST_V(1, 3, 1);
+ }
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+ if (length == 0) {
+ objResultPtr = valuePtr;
+ NEXT_INST_V(1, 3, 1);
+ }
+ ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
+ if (length2 > length || length2 == 0) {
+ objResultPtr = valuePtr;
+ NEXT_INST_V(1, 3, 1);
+ } else if (length2 == length) {
+ if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
+ objResultPtr = valuePtr;
+ } else {
+ objResultPtr = value3Ptr;
+ }
+ NEXT_INST_V(1, 3, 1);
+ }
+ ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);
+
+ objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
+ p = ustring1;
+ end = ustring1 + length;
+ for (; ustring1 < end; ustring1++) {
+ if ((*ustring1 == *ustring2) && (length2==1 ||
+ memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
+ == 0)) {
+ if (p != ustring1) {
+ Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p);
+ p = ustring1 + length2;
+ } else {
+ p += length2;
+ }
+ ustring1 = p - 1;
+
+ Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3);
+ }
+ }
+ if (p != ustring1) {
+ /*
+ * Put the rest of the unmapped chars onto result.
+ */
+
+ Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
+ }
+ TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
+ O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
+ NEXT_INST_V(1, 3, 1);
+
+ case INST_STR_FIND:
+ ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */
+ ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */
+
+ match = -1;
+ if (length2 > 0 && length2 <= length) {
+ end = ustring1 + length - length2 + 1;
+ for (p=ustring1 ; p<end ; p++) {
+ if ((*p == *ustring2) &&
+ memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
+ match = p - ustring1;
+ break;
+ }
+ }
+ }
+
+ TRACE(("%.20s %.20s => %d\n",
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
+
+ TclNewIntObj(objResultPtr, match);
+ NEXT_INST_F(1, 2, 1);
+
+ case INST_STR_FIND_LAST:
+ ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */
+ ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */
+
+ match = -1;
+ if (length2 > 0 && length2 <= length) {
+ for (p=ustring1+length-length2 ; p>=ustring1 ; p--) {
+ if ((*p == *ustring2) &&
+ memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
+ match = p - ustring1;
+ break;
+ }
+ }
+ }
+
+ TRACE(("%.20s %.20s => %d\n",
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
+
+ TclNewIntObj(objResultPtr, match);
+ NEXT_INST_F(1, 2, 1);
+ }
+
case INST_STR_MATCH:
nocase = TclGetInt1AtPtr(pc+1);
valuePtr = OBJ_AT_TOS; /* String */
@@ -4824,8 +5390,8 @@ TEBCresume(
case INST_RSHIFT:
if (l2 < 0) {
- Tcl_SetResult(interp, "negative shift argument",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "negative shift argument", -1));
#if 0
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
@@ -4872,8 +5438,8 @@ TEBCresume(
case INST_LSHIFT:
if (l2 < 0) {
- Tcl_SetResult(interp, "negative shift argument",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "negative shift argument", -1));
#if 0
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
@@ -4895,9 +5461,8 @@ TEBCresume(
* good place to draw the line.
*/
- Tcl_SetResult(interp,
- "integer value too large to represent",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "integer value too large to represent", -1));
#if 0
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
@@ -5165,7 +5730,7 @@ TEBCresume(
NEXT_INST_F(1, 1, 1);
}
- case INST_BITNOT:
+ case INST_BITNOT:
valuePtr = OBJ_AT_TOS;
if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
@@ -5572,46 +6137,78 @@ TEBCresume(
{
int opnd2, allocateDict, done, i, allocdict;
- Tcl_Obj *dictPtr, *statePtr, *keyPtr;
+ Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr;
Tcl_Obj *emptyPtr, **keyPtrPtr;
Tcl_DictSearch *searchPtr;
DictUpdateInfo *duiPtr;
+ case INST_DICT_VERIFY:
+ dictPtr = OBJ_AT_TOS;
+ TRACE(("=> "));
+ if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) {
+ TRACE_APPEND(("ERROR verifying dictionary nature of \"%s\": %s\n",
+ O2S(OBJ_AT_DEPTH(opnd)), O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ TRACE_APPEND(("OK\n"));
+ NEXT_INST_F(1, 1, 0);
+
case INST_DICT_GET:
+ case INST_DICT_EXISTS: {
+ register Tcl_Interp *interp2 = interp;
+
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
dictPtr = OBJ_AT_DEPTH(opnd);
+ if (*pc == INST_DICT_EXISTS) {
+ interp2 = NULL;
+ }
if (opnd > 1) {
- dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
+ dictPtr = TclTraceDictPath(interp2, dictPtr, opnd-1,
&OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
if (dictPtr == NULL) {
+ if (*pc == INST_DICT_EXISTS) {
+ goto dictNotExists;
+ }
TRACE_WITH_OBJ((
- "%u => ERROR tracing dictionary path into \"%s\": ",
- opnd, O2S(OBJ_AT_DEPTH(opnd))),
+ "ERROR tracing dictionary path into \"%s\": ",
+ O2S(OBJ_AT_DEPTH(opnd))),
Tcl_GetObjResult(interp));
goto gotError;
}
}
- if (Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS,
+ if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS,
&objResultPtr) == TCL_OK) {
+ if (*pc == INST_DICT_EXISTS) {
+ objResultPtr = TCONST(objResultPtr ? 1 : 0);
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(5, opnd+1, 1);
+ }
if (objResultPtr) {
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_V(5, opnd+1, 1);
}
DECACHE_STACK_INFO();
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "key \"", TclGetString(OBJ_AT_TOS),
- "\" not known in dictionary", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "key \"%s\" not known in dictionary",
+ TclGetString(OBJ_AT_TOS)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
TclGetString(OBJ_AT_TOS), NULL);
CACHE_STACK_INFO();
TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
} else {
+ if (*pc == INST_DICT_EXISTS) {
+ dictNotExists:
+ objResultPtr = TCONST(0);
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(5, opnd+1, 1);
+ }
TRACE_WITH_OBJ((
"%u => ERROR reading leaf dictionary key \"%s\": ",
opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
}
goto gotError;
+ }
case INST_DICT_SET:
case INST_DICT_UNSET:
@@ -5665,7 +6262,7 @@ TEBCresume(
}
result = TclIncrObj(interp, valuePtr, value2Ptr);
if (result == TCL_OK) {
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
}
TclDecrRefCount(value2Ptr);
}
@@ -5769,6 +6366,16 @@ TEBCresume(
Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
} else {
Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS);
+
+ /*
+ * Must invalidate the string representation of dictionary
+ * here because we have directly updated the internal
+ * representation; if we don't, callers could see the wrong
+ * string rep despite the internal version of the dictionary
+ * having the correct value. [Bug 3079830]
+ */
+
+ TclInvalidateStringRep(dictPtr);
}
break;
case INST_DICT_LAPPEND:
@@ -5799,6 +6406,16 @@ TEBCresume(
}
goto gotError;
}
+
+ /*
+ * Must invalidate the string representation of dictionary
+ * here because we have directly updated the internal
+ * representation; if we don't, callers could see the wrong
+ * string rep despite the internal version of the dictionary
+ * having the correct value. [Bug 3079830]
+ */
+
+ TclInvalidateStringRep(dictPtr);
}
break;
default:
@@ -5840,10 +6457,10 @@ TEBCresume(
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
dictPtr = POP_OBJECT();
- searchPtr = (Tcl_DictSearch *) ckalloc(sizeof(Tcl_DictSearch));
+ searchPtr = ckalloc(sizeof(Tcl_DictSearch));
if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
&valuePtr, &done) != TCL_OK) {
- ckfree((char *) searchPtr);
+ ckfree(searchPtr);
goto gotError;
}
TclNewObj(statePtr);
@@ -5910,39 +6527,6 @@ TEBCresume(
/* TODO: consider opt like INST_FOREACH_STEP4 */
NEXT_INST_F(5, 0, 1);
- case INST_DICT_DONE:
- opnd = TclGetUInt4AtPtr(pc+1);
- TRACE(("%u => ", opnd));
- statePtr = (*LOCAL(opnd)).value.objPtr;
- if (statePtr == NULL) {
- Tcl_Panic("mis-issued dictDone!");
- }
-
- if (statePtr->typePtr == &dictIteratorType) {
- /*
- * First kill the search, and then release the reference to the
- * dictionary that we were holding.
- */
-
- searchPtr = statePtr->internalRep.twoPtrValue.ptr1;
- Tcl_DictObjDone(searchPtr);
- ckfree((char *) searchPtr);
-
- dictPtr = statePtr->internalRep.twoPtrValue.ptr2;
- TclDecrRefCount(dictPtr);
-
- /*
- * Set the internal variable to an empty object to signify that we
- * don't hold an iterator.
- */
-
- TclDecrRefCount(statePtr);
- TclNewObj(emptyPtr);
- (*LOCAL(opnd)).value.objPtr = emptyPtr;
- Tcl_IncrRefCount(emptyPtr);
- }
- NEXT_INST_F(5, 0, 0);
-
case INST_DICT_UPDATE_START:
opnd = TclGetUInt4AtPtr(pc+1);
opnd2 = TclGetUInt4AtPtr(pc+5);
@@ -6022,6 +6606,9 @@ TEBCresume(
if (allocdict) {
dictPtr = Tcl_DuplicateObj(dictPtr);
}
+ if (length > 0) {
+ TclInvalidateStringRep(dictPtr);
+ }
for (i=0 ; i<length ; i++) {
Var *var2Ptr = LOCAL(duiPtr->varIndices[i]);
@@ -6062,6 +6649,78 @@ TEBCresume(
}
}
NEXT_INST_F(9, 1, 0);
+
+ case INST_DICT_EXPAND:
+ dictPtr = OBJ_UNDER_TOS;
+ listPtr = OBJ_AT_TOS;
+ if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+ TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
+ O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
+ goto gotError;
+ }
+ objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv);
+ if (objResultPtr == NULL) {
+ TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
+ O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
+ goto gotError;
+ }
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
+
+ case INST_DICT_RECOMBINE_STK:
+ keysPtr = POP_OBJECT();
+ varNamePtr = OBJ_UNDER_TOS;
+ listPtr = OBJ_AT_TOS;
+ TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
+ O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr)));
+ if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TclDecrRefCount(keysPtr);
+ goto gotError;
+ }
+ varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
+ TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TclDecrRefCount(keysPtr);
+ goto gotError;
+ }
+ DECACHE_STACK_INFO();
+ result = TclDictWithFinish(interp, varPtr,arrayPtr,varNamePtr,NULL,-1,
+ objc, objv, keysPtr);
+ CACHE_STACK_INFO();
+ TclDecrRefCount(keysPtr);
+ if (result != TCL_OK) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ TRACE_APPEND(("OK\n"));
+ NEXT_INST_F(1, 2, 0);
+
+ case INST_DICT_RECOMBINE_IMM:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ listPtr = OBJ_UNDER_TOS;
+ keysPtr = OBJ_AT_TOS;
+ varPtr = LOCAL(opnd);
+ TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr),
+ O2S(keysPtr)));
+ if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ DECACHE_STACK_INFO();
+ result = TclDictWithFinish(interp, varPtr, NULL, NULL, NULL, opnd,
+ objc, objv, keysPtr);
+ CACHE_STACK_INFO();
+ if (result != TCL_OK) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ TRACE_APPEND(("OK\n"));
+ NEXT_INST_F(5, 2, 0);
}
/*
@@ -6169,10 +6828,10 @@ TEBCresume(
*/
divideByZero:
- DECACHE_STACK_INFO();
- Tcl_SetResult(interp, "divide by zero", TCL_STATIC);
+ DECACHE_STACK_INFO();
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
- CACHE_STACK_INFO();
+ CACHE_STACK_INFO();
goto gotError;
/*
@@ -6181,9 +6840,9 @@ TEBCresume(
*/
exponOfZero:
- DECACHE_STACK_INFO();
- Tcl_SetResult(interp, "exponentiation of zero by negative power",
- TCL_STATIC);
+ DECACHE_STACK_INFO();
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "exponentiation of zero by negative power", -1));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"exponentiation of zero by negative power", NULL);
CACHE_STACK_INFO();
@@ -6209,9 +6868,12 @@ TEBCresume(
goto abnormalReturn;
}
if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
+ const unsigned char *pcBeg;
+
+ bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg);
DECACHE_STACK_INFO();
- Tcl_LogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0);
+ TclLogCommandInfo(interp, codePtr->source, bytes,
+ bytes ? length : 0, pcBeg, tosPtr);
CACHE_STACK_INFO();
}
iPtr->flags &= ~ERR_ALREADY_LOGGED;
@@ -6222,8 +6884,9 @@ TEBCresume(
*/
while (auxObjList) {
- if ((catchTop != initCatchTop) && (*catchTop >
- (ptrdiff_t) auxObjList->internalRep.twoPtrValue.ptr1)) {
+ if ((catchTop != initCatchTop)
+ && (*catchTop > (ptrdiff_t)
+ auxObjList->internalRep.ptrAndLongRep.value)) {
break;
}
POP_TAUX_OBJ();
@@ -6238,7 +6901,7 @@ TEBCresume(
* already be set prior to vectoring down to this point in the code.
*/
- if (Tcl_Canceled(interp, 0) == TCL_ERROR) {
+ if (TclCanceled(iPtr) && (Tcl_Canceled(interp, 0) == TCL_ERROR)) {
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
fprintf(stdout, " ... cancel with unwind, returning %s\n",
@@ -6352,15 +7015,15 @@ TEBCresume(
CLANG_ASSERT(bcFramePtr);
}
- /*
- * Store the previous bottomPtr for returning to it, then free all
- * resources used by this bytecode and process callbacks until you return
- * to the previous bytecode (if any).
- */
-
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
+ if (--codePtr->refCount <= 0) {
+ TclCleanupByteCode(codePtr);
+ }
+ TclStackFree(interp, TD); /* free my stack */
+
return result;
}
+
#undef codePtr
#undef iPtr
#undef bcFramePtr
@@ -6555,7 +7218,8 @@ ExecuteExtendedBinaryMathOp(
invalid = 0;
}
if (invalid) {
- Tcl_SetResult(interp, "negative shift argument", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "negative shift argument", -1));
return GENERAL_ARITHMETIC_ERROR;
}
@@ -6585,8 +7249,8 @@ ExecuteExtendedBinaryMathOp(
* place to draw the line.
*/
- Tcl_SetResult(interp, "integer value too large to represent",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "integer value too large to represent", -1));
return GENERAL_ARITHMETIC_ERROR;
}
shift = (int)(*((const long *)ptr2));
@@ -6987,7 +7651,8 @@ ExecuteExtendedBinaryMathOp(
*/
if (type2 != TCL_NUMBER_LONG) {
- Tcl_SetResult(interp, "exponent too large", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "exponent too large", -1));
return GENERAL_ARITHMETIC_ERROR;
}
@@ -7225,7 +7890,8 @@ ExecuteExtendedBinaryMathOp(
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
if (big2.used > 1) {
mp_clear(&big2);
- Tcl_SetResult(interp, "exponent too large", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "exponent too large", -1));
return GENERAL_ARITHMETIC_ERROR;
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
@@ -7844,7 +8510,7 @@ ValidatePcAndStackTop(
if (checkStack &&
((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
int numChars;
- const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
+ const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL);
fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min %i, max %i)",
stackTop, relativePc, stackLowerBound, stackUpperBound);
@@ -7958,7 +8624,7 @@ TclGetSrcInfoForCmd(
ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
- codePtr, lenPtr);
+ codePtr, lenPtr, NULL);
}
void
@@ -7970,7 +8636,7 @@ TclGetSrcInfoForPc(
if (cfPtr->cmd.str.cmd == NULL) {
cfPtr->cmd.str.cmd = GetSrcInfoForPc(
(unsigned char *) cfPtr->data.tebc.pc, codePtr,
- &cfPtr->cmd.str.len);
+ &cfPtr->cmd.str.len, NULL);
}
if (cfPtr->cmd.str.cmd != NULL) {
@@ -8021,15 +8687,18 @@ TclGetSrcInfoForPc(
static const char *
GetSrcInfoForPc(
- const unsigned char *pc, /* The program counter value for which to
+ const unsigned char *pc, /* The program counter value for which to
* return the closest command's source info.
- * This points to a bytecode instruction in
- * codePtr's code. */
+ * This points within a bytecode instruction
+ * in codePtr's code. */
ByteCode *codePtr, /* The bytecode sequence in which to look up
* the command source for the pc. */
- int *lengthPtr) /* If non-NULL, the location where the length
+ int *lengthPtr, /* If non-NULL, the location where the length
* of the command's source should be stored.
* If NULL, no length is stored. */
+ const unsigned char **pcBeg)/* If non-NULL, the bytecode location
+ * where the current instruction starts.
+ * If NULL; no pointer is stored. */
{
register int pcOffset = (pc - codePtr->codeStart);
int numCmds = codePtr->numCommands;
@@ -8041,6 +8710,7 @@ GetSrcInfoForPc(
int bestSrcLength = -1; /* Initialized to avoid compiler warning. */
if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
+ if (pcBeg != NULL) *pcBeg = NULL;
return NULL;
}
@@ -8109,6 +8779,23 @@ GetSrcInfoForPc(
}
}
+ if (pcBeg != NULL) {
+ const unsigned char *curr, *prev;
+
+ /*
+ * Walk from beginning of command or BC to pc, by complete
+ * instructions. Stop when crossing pc; keep previous.
+ */
+
+ curr = ((bestDist == INT_MAX) ? codePtr->codeStart : pc - bestDist);
+ prev = curr;
+ while (curr <= pc) {
+ prev = curr;
+ curr += tclInstructionTable[*curr].numBytes;
+ }
+ *pcBeg = prev;
+ }
+
if (bestDist == INT_MAX) {
return NULL;
}
@@ -8116,6 +8803,7 @@ GetSrcInfoForPc(
if (lengthPtr != NULL) {
*lengthPtr = bestSrcLength;
}
+
return (codePtr->source + bestSrcOffset);
}
@@ -8338,9 +9026,13 @@ EvalStatsCmd(
int decadeHigh, minSizeDecade, maxSizeDecade, length, i;
char *litTableStats;
LiteralEntry *entryPtr;
+ Tcl_Obj *objPtr;
#define Percent(a,b) ((a) * 100.0 / (b))
+ objPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(objPtr);
+
numInstructions = 0.0;
for (i = 0; i < 256; i++) {
if (statsPtr->instructionCount[i] != 0) {
@@ -8371,65 +9063,65 @@ EvalStatsCmd(
* Summary statistics, total and current source and ByteCode sizes.
*/
- fprintf(stdout, "\n----------------------------------------------------------------\n");
- fprintf(stdout,
- "Compilation and execution statistics for interpreter 0x%p\n",
- iPtr);
+ Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
+ Tcl_AppendPrintfToObj(objPtr,
+ "Compilation and execution statistics for interpreter %#lx\n",
+ (long int)iPtr);
- fprintf(stdout, "\nNumber ByteCodes executed\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%ld\n",
statsPtr->numExecutions);
- fprintf(stdout, "Number ByteCodes compiled\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%ld\n",
statsPtr->numCompilations);
- fprintf(stdout, " Mean executions/compile\t%.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean executions/compile\t%.1f\n",
statsPtr->numExecutions / (float)statsPtr->numCompilations);
- fprintf(stdout, "\nInstructions executed\t\t%.0f\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nInstructions executed\t\t%.0f\n",
numInstructions);
- fprintf(stdout, " Mean inst/compile\t\t%.0f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean inst/compile\t\t%.0f\n",
numInstructions / statsPtr->numCompilations);
- fprintf(stdout, " Mean inst/execution\t\t%.0f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean inst/execution\t\t%.0f\n",
numInstructions / statsPtr->numExecutions);
- fprintf(stdout, "\nTotal ByteCodes\t\t\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%ld\n",
statsPtr->numCompilations);
- fprintf(stdout, " Source bytes\t\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n",
statsPtr->totalSrcBytes);
- fprintf(stdout, " Code bytes\t\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Code bytes\t\t\t%.6g\n",
totalCodeBytes);
- fprintf(stdout, " ByteCode bytes\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " ByteCode bytes\t\t%.6g\n",
statsPtr->totalByteCodeBytes);
- fprintf(stdout, " Literal bytes\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n",
totalLiteralBytes);
- fprintf(stdout, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
(unsigned long) sizeof(LiteralTable),
(unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
(unsigned long) (statsPtr->numLiteralsCreated * sizeof(LiteralEntry)),
(unsigned long) (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj)),
statsPtr->totalLitStringBytes);
- fprintf(stdout, " Mean code/compile\t\t%.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean code/compile\t\t%.1f\n",
totalCodeBytes / statsPtr->numCompilations);
- fprintf(stdout, " Mean code/source\t\t%.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n",
totalCodeBytes / statsPtr->totalSrcBytes);
- fprintf(stdout, "\nCurrent (active) ByteCodes\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%ld\n",
numCurrentByteCodes);
- fprintf(stdout, " Source bytes\t\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n",
statsPtr->currentSrcBytes);
- fprintf(stdout, " Code bytes\t\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Code bytes\t\t\t%.6g\n",
currentCodeBytes);
- fprintf(stdout, " ByteCode bytes\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " ByteCode bytes\t\t%.6g\n",
statsPtr->currentByteCodeBytes);
- fprintf(stdout, " Literal bytes\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n",
currentLiteralBytes);
- fprintf(stdout, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
(unsigned long) sizeof(LiteralTable),
(unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
(unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)),
(unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)),
statsPtr->currentLitStringBytes);
- fprintf(stdout, " Mean code/source\t\t%.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n",
currentCodeBytes / statsPtr->currentSrcBytes);
- fprintf(stdout, " Code + source bytes\t\t%.6g (%0.1f mean code/src)\n",
+ Tcl_AppendPrintfToObj(objPtr, " Code + source bytes\t\t%.6g (%0.1f mean code/src)\n",
(currentCodeBytes + statsPtr->currentSrcBytes),
(currentCodeBytes / statsPtr->currentSrcBytes) + 1.0);
@@ -8441,18 +9133,18 @@ EvalStatsCmd(
*/
numSharedMultX = 0;
- fprintf(stdout, "\nTcl_IsShared object check (all objects):\n");
- fprintf(stdout, " Object had refcount <=1 (not shared)\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n");
+ Tcl_AppendPrintfToObj(objPtr, " Object had refcount <=1 (not shared)\t%ld\n",
tclObjsShared[1]);
for (i = 2; i < TCL_MAX_SHARED_OBJ_STATS; i++) {
- fprintf(stdout, " refcount ==%d\t\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, " refcount ==%d\t\t%ld\n",
i, tclObjsShared[i]);
numSharedMultX += tclObjsShared[i];
}
- fprintf(stdout, " refcount >=%d\t\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, " refcount >=%d\t\t%ld\n",
i, tclObjsShared[0]);
numSharedMultX += tclObjsShared[0];
- fprintf(stdout, " Total shared objects\t\t\t%d\n",
+ Tcl_AppendPrintfToObj(objPtr, " Total shared objects\t\t\t%d\n",
numSharedMultX);
/*
@@ -8489,48 +9181,48 @@ EvalStatsCmd(
sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared)
- currentLiteralBytes;
- fprintf(stdout, "\nTotal objects (all interps)\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%ld\n",
tclObjsAlloced);
- fprintf(stdout, "Current objects\t\t\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%ld\n",
(tclObjsAlloced - tclObjsFreed));
- fprintf(stdout, "Total literal objects\t\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%ld\n",
statsPtr->numLiteralsCreated);
- fprintf(stdout, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n",
globalTablePtr->numEntries,
Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
- fprintf(stdout, " ByteCode literals\t\t%ld (%0.1f%% of current literals)\n",
+ Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%ld (%0.1f%% of current literals)\n",
numByteCodeLits,
Percent(numByteCodeLits, globalTablePtr->numEntries));
- fprintf(stdout, " Literals reused > 1x\t\t%d\n",
+ Tcl_AppendPrintfToObj(objPtr, " Literals reused > 1x\t\t%d\n",
numSharedMultX);
- fprintf(stdout, " Mean reference count\t\t%.2f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean reference count\t\t%.2f\n",
((double) refCountSum) / globalTablePtr->numEntries);
- fprintf(stdout, " Mean len, str reused >1x \t%.2f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean len, str reused >1x \t%.2f\n",
(numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0));
- fprintf(stdout, " Mean len, str used 1x\t\t%.2f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean len, str used 1x\t\t%.2f\n",
(numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0));
- fprintf(stdout, " Total sharing savings\t\t%.6g (%0.1f%% of bytes if no sharing)\n",
+ Tcl_AppendPrintfToObj(objPtr, " Total sharing savings\t\t%.6g (%0.1f%% of bytes if no sharing)\n",
sharingBytesSaved,
Percent(sharingBytesSaved, objBytesIfUnshared+strBytesIfUnshared));
- fprintf(stdout, " Bytes with sharing\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Bytes with sharing\t\t%.6g\n",
currentLiteralBytes);
- fprintf(stdout, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
(unsigned long) sizeof(LiteralTable),
(unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
(unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)),
(unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)),
statsPtr->currentLitStringBytes);
- fprintf(stdout, " Bytes if no sharing\t\t%.6g = objects %.6g + strings %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Bytes if no sharing\t\t%.6g = objects %.6g + strings %.6g\n",
(objBytesIfUnshared + strBytesIfUnshared),
objBytesIfUnshared, strBytesIfUnshared);
- fprintf(stdout, " String sharing savings \t%.6g = unshared %.6g - shared %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " String sharing savings \t%.6g = unshared %.6g - shared %.6g\n",
(strBytesIfUnshared - statsPtr->currentLitStringBytes),
strBytesIfUnshared, statsPtr->currentLitStringBytes);
- fprintf(stdout, " Literal mgmt overhead\t\t%ld (%0.1f%% of bytes with sharing)\n",
+ Tcl_AppendPrintfToObj(objPtr, " Literal mgmt overhead\t\t%ld (%0.1f%% of bytes with sharing)\n",
literalMgmtBytes,
Percent(literalMgmtBytes, currentLiteralBytes));
- fprintf(stdout, " table %lu + buckets %lu + entries %lu\n",
+ Tcl_AppendPrintfToObj(objPtr, " table %lu + buckets %lu + entries %lu\n",
(unsigned long) sizeof(LiteralTable),
(unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
(unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)));
@@ -8539,33 +9231,33 @@ EvalStatsCmd(
* Breakdown of current ByteCode space requirements.
*/
- fprintf(stdout, "\nBreakdown of current ByteCode requirements:\n");
- fprintf(stdout, " Bytes Pct of Avg per\n");
- fprintf(stdout, " total ByteCode\n");
- fprintf(stdout, "Total %12.6g 100.00%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nBreakdown of current ByteCode requirements:\n");
+ Tcl_AppendPrintfToObj(objPtr, " Bytes Pct of Avg per\n");
+ Tcl_AppendPrintfToObj(objPtr, " total ByteCode\n");
+ Tcl_AppendPrintfToObj(objPtr, "Total %12.6g 100.00%% %8.1f\n",
statsPtr->currentByteCodeBytes,
statsPtr->currentByteCodeBytes / numCurrentByteCodes);
- fprintf(stdout, "Header %12.6g %8.1f%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "Header %12.6g %8.1f%% %8.1f\n",
currentHeaderBytes,
Percent(currentHeaderBytes, statsPtr->currentByteCodeBytes),
currentHeaderBytes / numCurrentByteCodes);
- fprintf(stdout, "Instructions %12.6g %8.1f%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "Instructions %12.6g %8.1f%% %8.1f\n",
statsPtr->currentInstBytes,
Percent(statsPtr->currentInstBytes,statsPtr->currentByteCodeBytes),
statsPtr->currentInstBytes / numCurrentByteCodes);
- fprintf(stdout, "Literal ptr array %12.6g %8.1f%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "Literal ptr array %12.6g %8.1f%% %8.1f\n",
statsPtr->currentLitBytes,
Percent(statsPtr->currentLitBytes,statsPtr->currentByteCodeBytes),
statsPtr->currentLitBytes / numCurrentByteCodes);
- fprintf(stdout, "Exception table %12.6g %8.1f%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "Exception table %12.6g %8.1f%% %8.1f\n",
statsPtr->currentExceptBytes,
Percent(statsPtr->currentExceptBytes,statsPtr->currentByteCodeBytes),
statsPtr->currentExceptBytes / numCurrentByteCodes);
- fprintf(stdout, "Auxiliary data %12.6g %8.1f%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "Auxiliary data %12.6g %8.1f%% %8.1f\n",
statsPtr->currentAuxBytes,
Percent(statsPtr->currentAuxBytes,statsPtr->currentByteCodeBytes),
statsPtr->currentAuxBytes / numCurrentByteCodes);
- fprintf(stdout, "Command map %12.6g %8.1f%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "Command map %12.6g %8.1f%% %8.1f\n",
statsPtr->currentCmdMapBytes,
Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes),
statsPtr->currentCmdMapBytes / numCurrentByteCodes);
@@ -8574,8 +9266,8 @@ EvalStatsCmd(
* Detailed literal statistics.
*/
- fprintf(stdout, "\nLiteral string sizes:\n");
- fprintf(stdout, "\t Up to length\t\tPercentage\n");
+ Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n");
+ Tcl_AppendPrintfToObj(objPtr, "\t Up to length\t\tPercentage\n");
maxSizeDecade = 0;
for (i = 31; i >= 0; i--) {
if (statsPtr->literalCount[i] > 0) {
@@ -8587,21 +9279,21 @@ EvalStatsCmd(
for (i = 0; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->literalCount[i];
- fprintf(stdout, "\t%10d\t\t%8.0f%%\n",
+ Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
}
litTableStats = TclLiteralStats(globalTablePtr);
- fprintf(stdout, "\nCurrent literal table statistics:\n%s\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
litTableStats);
- ckfree((char *) litTableStats);
+ ckfree(litTableStats);
/*
* Source and ByteCode size distributions.
*/
- fprintf(stdout, "\nSource sizes:\n");
- fprintf(stdout, "\t Up to size\t\tPercentage\n");
+ Tcl_AppendPrintfToObj(objPtr, "\nSource sizes:\n");
+ Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
if (statsPtr->srcCount[i] > 0) {
@@ -8619,12 +9311,12 @@ EvalStatsCmd(
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->srcCount[i];
- fprintf(stdout, "\t%10d\t\t%8.0f%%\n",
+ Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numCompilations));
}
- fprintf(stdout, "\nByteCode sizes:\n");
- fprintf(stdout, "\t Up to size\t\tPercentage\n");
+ Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n");
+ Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
if (statsPtr->byteCodeCount[i] > 0) {
@@ -8642,12 +9334,12 @@ EvalStatsCmd(
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->byteCodeCount[i];
- fprintf(stdout, "\t%10d\t\t%8.0f%%\n",
+ Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numCompilations));
}
- fprintf(stdout, "\nByteCode longevity (excludes Current ByteCodes):\n");
- fprintf(stdout, "\t Up to ms\t\tPercentage\n");
+ Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n");
+ Tcl_AppendPrintfToObj(objPtr, "\t Up to ms\t\tPercentage\n");
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
if (statsPtr->lifetimeCount[i] > 0) {
@@ -8665,7 +9357,7 @@ EvalStatsCmd(
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->lifetimeCount[i];
- fprintf(stdout, "\t%12.3f\t\t%8.0f%%\n",
+ Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
}
@@ -8673,28 +9365,46 @@ EvalStatsCmd(
* Instruction counts.
*/
- fprintf(stdout, "\nInstruction counts:\n");
+ Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
for (i = 0; i <= LAST_INST_OPCODE; i++) {
- if (statsPtr->instructionCount[i] == 0) {
- fprintf(stdout, "%20s %8ld %6.1f%%\n",
- tclInstructionTable[i].name,
- statsPtr->instructionCount[i],
+ Tcl_AppendPrintfToObj(objPtr, "%20s %8ld ",
+ tclInstructionTable[i].name, statsPtr->instructionCount[i]);
+ if (statsPtr->instructionCount[i]) {
+ Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n",
Percent(statsPtr->instructionCount[i], numInstructions));
- }
- }
-
- fprintf(stdout, "\nInstructions NEVER executed:\n");
- for (i = 0; i <= LAST_INST_OPCODE; i++) {
- if (statsPtr->instructionCount[i] == 0) {
- fprintf(stdout, "%20s\n", tclInstructionTable[i].name);
+ } else {
+ Tcl_AppendPrintfToObj(objPtr, "0\n");
}
}
#ifdef TCL_MEM_DEBUG
- fprintf(stdout, "\nHeap Statistics:\n");
- TclDumpMemoryInfo(stdout);
+ Tcl_AppendPrintfToObj(objPtr, "\nHeap Statistics:\n");
+ TclDumpMemoryInfo((ClientData) objPtr, 1);
#endif
- fprintf(stdout, "\n----------------------------------------------------------------\n");
+ Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
+
+ if (objc == 1) {
+ Tcl_SetObjResult(interp, objPtr);
+ } else {
+ Tcl_Channel outChan;
+ char *str = Tcl_GetStringFromObj(objv[1], &length);
+
+ if (length) {
+ if (strcmp(str, "stdout") == 0) {
+ outChan = Tcl_GetStdChannel(TCL_STDOUT);
+ } else if (strcmp(str, "stderr") == 0) {
+ outChan = Tcl_GetStdChannel(TCL_STDERR);
+ } else {
+ outChan = Tcl_OpenFileChannel(NULL, str, "w", 0664);
+ }
+ } else {
+ outChan = Tcl_GetStdChannel(TCL_STDOUT);
+ }
+ if (outChan != NULL) {
+ Tcl_WriteObj(outChan, objPtr);
+ }
+ }
+ Tcl_DecrRefCount(objPtr);
return TCL_OK;
}
#endif /* TCL_COMPILE_STATS */
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 8ff6e39..33c1496 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -8,11 +8,10 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclFCmd.c,v 1.51 2010/02/24 10:32:17 dkf Exp $
*/
#include "tclInt.h"
+#include "tclFileSystem.h"
/*
* Declarations for local functions defined in this file:
@@ -48,6 +47,7 @@ static int FileForceOption(Tcl_Interp *interp,
int
TclFileRenameCmd(
+ ClientData clientData, /* Unused */
Tcl_Interp *interp, /* Interp for error reporting or recursive
* calls in the case of a tricky rename. */
int objc, /* Number of arguments. */
@@ -76,6 +76,7 @@ TclFileRenameCmd(
int
TclFileCopyCmd(
+ ClientData clientData, /* Unused */
Tcl_Interp *interp, /* Used for error reporting or recursive calls
* in the case of a tricky copy. */
int objc, /* Number of arguments. */
@@ -113,22 +114,20 @@ FileCopyRename(
Tcl_StatBuf statBuf;
Tcl_Obj *target;
- i = FileForceOption(interp, objc - 2, objv + 2, &force);
+ i = FileForceOption(interp, objc - 1, objv + 1, &force);
if (i < 0) {
return TCL_ERROR;
}
- i += 2;
+ i++;
if ((objc - i) < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- TclGetString(objv[0]), " ", TclGetString(objv[1]),
- " ?-option value ...? source ?source ...? target\"", NULL);
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-option value ...? source ?source ...? target");
return TCL_ERROR;
}
/*
- * If target doesn't exist or isn't a directory, try the copy/rename.
- * More than 2 arguments is only valid if the target is an existing
- * directory.
+ * If target doesn't exist or isn't a directory, try the copy/rename. More
+ * than 2 arguments is only valid if the target is an existing directory.
*/
target = objv[objc - 1];
@@ -148,9 +147,9 @@ FileCopyRename(
if ((objc - i) > 2) {
errno = ENOTDIR;
Tcl_PosixError(interp);
- Tcl_AppendResult(interp, "error ",
- (copyFlag ? "copying" : "renaming"), ": target \"",
- TclGetString(target), "\" is not a directory", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error %s: target \"%s\" is not a directory",
+ (copyFlag?"copying":"renaming"), TclGetString(target)));
result = TCL_ERROR;
} else {
/*
@@ -173,7 +172,6 @@ FileCopyRename(
for ( ; i<objc-1 ; i++) {
Tcl_Obj *jargv[2];
Tcl_Obj *source, *newFileName;
- Tcl_Obj *temp;
source = FileBasename(interp, objv[i]);
if (source == NULL) {
@@ -182,13 +180,11 @@ FileCopyRename(
}
jargv[0] = objv[objc - 1];
jargv[1] = source;
- temp = Tcl_NewListObj(2, jargv);
- newFileName = Tcl_FSJoinPath(temp, -1);
+ newFileName = TclJoinPath(2, jargv);
Tcl_IncrRefCount(newFileName);
result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,
force);
Tcl_DecrRefCount(newFileName);
- Tcl_DecrRefCount(temp);
Tcl_DecrRefCount(source);
if (result == TCL_ERROR) {
@@ -218,26 +214,25 @@ FileCopyRename(
int
TclFileMakeDirsCmd(
+ ClientData clientData, /* Unused */
Tcl_Interp *interp, /* Used for error reporting. */
int objc, /* Number of arguments */
Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
- Tcl_Obj *errfile;
+ Tcl_Obj *errfile = NULL;
int result, i, j, pobjc;
Tcl_Obj *split = NULL;
Tcl_Obj *target = NULL;
Tcl_StatBuf statBuf;
- errfile = NULL;
-
result = TCL_OK;
- for (i = 2; i < objc; i++) {
+ for (i = 1; i < objc; i++) {
if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
result = TCL_ERROR;
break;
}
- split = Tcl_FSSplitPath(objv[i],&pobjc);
+ split = Tcl_FSSplitPath(objv[i], &pobjc);
Tcl_IncrRefCount(split);
if (pobjc == 0) {
errno = ENOENT;
@@ -274,19 +269,17 @@ TclFileMakeDirsCmd(
* subdirectory.
*/
- if (errno == EEXIST) {
- if ((Tcl_FSStat(target, &statBuf) == 0)
- && S_ISDIR(statBuf.st_mode)) {
- /*
- * It is a directory that wasn't there before, so keep
- * going without error.
- */
-
- Tcl_ResetResult(interp);
- } else {
- errfile = target;
- goto done;
- }
+ if (errno != EEXIST) {
+ errfile = target;
+ goto done;
+ } else if ((Tcl_FSStat(target, &statBuf) == 0)
+ && S_ISDIR(statBuf.st_mode)) {
+ /*
+ * It is a directory that wasn't there before, so keep
+ * going without error.
+ */
+
+ Tcl_ResetResult(interp);
} else {
errfile = target;
goto done;
@@ -306,8 +299,9 @@ TclFileMakeDirsCmd(
done:
if (errfile != NULL) {
- Tcl_AppendResult(interp, "can't create directory \"",
- TclGetString(errfile), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create directory \"%s\": %s",
+ TclGetString(errfile), Tcl_PosixError(interp)));
result = TCL_ERROR;
}
if (split != NULL) {
@@ -338,6 +332,7 @@ TclFileMakeDirsCmd(
int
TclFileDeleteCmd(
+ ClientData clientData, /* Unused */
Tcl_Interp *interp, /* Used for error reporting */
int objc, /* Number of arguments */
Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */
@@ -346,16 +341,15 @@ TclFileDeleteCmd(
Tcl_Obj *errfile;
Tcl_Obj *errorBuffer = NULL;
- i = FileForceOption(interp, objc - 2, objv + 2, &force);
+ i = FileForceOption(interp, objc - 1, objv + 1, &force);
if (i < 0) {
return TCL_ERROR;
}
- i += 2;
errfile = NULL;
result = TCL_OK;
- for ( ; i < objc; i++) {
+ for (i++ ; i < objc; i++) {
Tcl_StatBuf statBuf;
errfile = objv[i];
@@ -386,9 +380,9 @@ TclFileDeleteCmd(
result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
if (result != TCL_OK) {
if ((force == 0) && (errno == EEXIST)) {
- Tcl_AppendResult(interp, "error deleting \"",
- TclGetString(objv[i]), "\": directory not empty",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error deleting \"%s\": directory not empty",
+ TclGetString(objv[i])));
Tcl_PosixError(interp);
goto done;
}
@@ -428,12 +422,13 @@ TclFileDeleteCmd(
* We try to accomodate poor error results from our Tcl_FS calls.
*/
- Tcl_AppendResult(interp, "error deleting unknown file: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error deleting unknown file: %s",
+ Tcl_PosixError(interp)));
} else {
- Tcl_AppendResult(interp, "error deleting \"",
- TclGetString(errfile), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error deleting \"%s\": %s",
+ TclGetString(errfile), Tcl_PosixError(interp)));
}
}
@@ -522,7 +517,7 @@ CopyRenameOneFile(
* 16 bits and we get collisions. See bug #2015723.
*/
-#ifndef WIN32
+#if !defined(WIN32) && !defined(__CYGWIN__)
if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
(sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
@@ -542,17 +537,17 @@ CopyRenameOneFile(
if (S_ISDIR(sourceStatBuf.st_mode)
&& !S_ISDIR(targetStatBuf.st_mode)) {
errno = EISDIR;
- Tcl_AppendResult(interp, "can't overwrite file \"",
- TclGetString(target), "\" with directory \"",
- TclGetString(source), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't overwrite file \"%s\" with directory \"%s\"",
+ TclGetString(target), TclGetString(source)));
goto done;
}
if (!S_ISDIR(sourceStatBuf.st_mode)
&& S_ISDIR(targetStatBuf.st_mode)) {
errno = EISDIR;
- Tcl_AppendResult(interp, "can't overwrite directory \"",
- TclGetString(target), "\" with file \"",
- TclGetString(source), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't overwrite directory \"%s\" with file \"%s\"",
+ TclGetString(target), TclGetString(source)));
goto done;
}
@@ -583,10 +578,10 @@ CopyRenameOneFile(
}
if (errno == EINVAL) {
- Tcl_AppendResult(interp, "error renaming \"",
- TclGetString(source), "\" to \"", TclGetString(target),
- "\": trying to rename a volume or "
- "move a directory into itself", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error renaming \"%s\" to \"%s\": trying to rename a"
+ " volume or move a directory into itself",
+ TclGetString(source), TclGetString(target)));
goto done;
} else if (errno != EXDEV) {
errfile = target;
@@ -630,8 +625,9 @@ CopyRenameOneFile(
* Actual file doesn't exist.
*/
- Tcl_AppendResult(interp, "error copying \"", TclGetString(source),
- "\": the target of this link doesn't exist", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error copying \"%s\": the target of this link doesn't"
+ " exist", TclGetString(source)));
goto done;
} else {
int counter = 0;
@@ -766,23 +762,27 @@ CopyRenameOneFile(
}
}
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "can't unlink \"", TclGetString(errfile),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't unlink \"%s\": %s",
+ TclGetString(errfile), Tcl_PosixError(interp)));
errfile = NULL;
}
}
done:
if (errfile != NULL) {
- Tcl_AppendResult(interp, "error ", (copyFlag ? "copying" : "renaming"),
- " \"", TclGetString(source), NULL);
+ Tcl_Obj *errorMsg = Tcl_ObjPrintf("error %s \"%s\"",
+ (copyFlag ? "copying" : "renaming"), TclGetString(source));
+
if (errfile != source) {
- Tcl_AppendResult(interp, "\" to \"", TclGetString(target), NULL);
+ Tcl_AppendPrintfToObj(errorMsg, " to \"%s\"",
+ TclGetString(target));
if (errfile != target) {
- Tcl_AppendResult(interp, "\": \"", TclGetString(errfile),NULL);
+ Tcl_AppendPrintfToObj(errorMsg, ": \"%s\"",
+ TclGetString(errfile));
}
}
- Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_AppendPrintfToObj(errorMsg, ": %s", Tcl_PosixError(interp));
+ Tcl_SetObjResult(interp, errorMsg);
}
if (errorBuffer != NULL) {
Tcl_DecrRefCount(errorBuffer);
@@ -821,22 +821,25 @@ FileForceOption(
int *forcePtr) /* If the "-force" was specified, *forcePtr is
* filled with 1, otherwise with 0. */
{
- int force, i;
+ int force, i, idx;
+ static const char *const options[] = {
+ "-force", "--", NULL
+ };
force = 0;
for (i = 0; i < objc; i++) {
if (TclGetString(objv[i])[0] != '-') {
break;
}
- if (strcmp(TclGetString(objv[i]), "-force") == 0) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
+ &idx) != TCL_OK) {
+ return -1;
+ }
+ if (idx == 0 /* -force */) {
force = 1;
- } else if (strcmp(TclGetString(objv[i]), "--") == 0) {
+ } else { /* -- */
i++;
break;
- } else {
- Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[i]),
- "\": should be -force or --", NULL);
- return -1;
}
}
*forcePtr = force;
@@ -940,6 +943,7 @@ FileBasename(
int
TclFileAttrsCmd(
+ ClientData clientData, /* Unused */
Tcl_Interp *interp, /* The interpreter for error reporting. */
int objc, /* Number of command line arguments. */
Tcl_Obj *const objv[]) /* The command line objects. */
@@ -951,22 +955,25 @@ TclFileAttrsCmd(
int numObjStrings = -1;
Tcl_Obj *filePtr;
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "name ?-option value ...?");
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?");
return TCL_ERROR;
}
- filePtr = objv[2];
+ filePtr = objv[1];
if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
return TCL_ERROR;
}
- objc -= 3;
- objv += 3;
+ objc -= 2;
+ objv += 2;
result = TCL_ERROR;
Tcl_SetErrno(0);
+ /*
+ * Get the set of attribute names from the filesystem.
+ */
+
attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings);
if (attributeStrings == NULL) {
int index;
@@ -978,12 +985,12 @@ TclFileAttrsCmd(
* There was an error, probably that the filePtr is not
* accepted by any filesystem
*/
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(filePtr), "\": ", Tcl_PosixError(interp),
- NULL);
- return TCL_ERROR;
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(filePtr), Tcl_PosixError(interp)));
}
- goto end;
+ return TCL_ERROR;
}
/*
@@ -1007,7 +1014,16 @@ TclFileAttrsCmd(
}
attributeStringsAllocated[index] = NULL;
attributeStrings = attributeStringsAllocated;
+ } else if (objStrings != NULL) {
+ Tcl_Panic("must not update objPtrRef's variable and return non-NULL");
}
+
+ /*
+ * Process the attributes to produce a list of all of them, the value of a
+ * particular attribute, or to set one or more attributes (depending on
+ * the number of arguments).
+ */
+
if (objc == 0) {
/*
* Get all attributes.
@@ -1058,9 +1074,10 @@ TclFileAttrsCmd(
Tcl_Obj *objPtr = NULL;
if (numObjStrings == 0) {
- Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
- "\", there are no file attributes in this filesystem.",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\", there are no file attributes in this"
+ " filesystem", TclGetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
goto end;
}
@@ -1068,6 +1085,9 @@ TclFileAttrsCmd(
"option", 0, &index) != TCL_OK) {
goto end;
}
+ if (attributeStringsAllocated != NULL) {
+ TclFreeIntRep(objv[0]);
+ }
if (Tcl_FSFileAttrsGet(interp, index, filePtr,
&objPtr) != TCL_OK) {
goto end;
@@ -1081,9 +1101,10 @@ TclFileAttrsCmd(
int i, index;
if (numObjStrings == 0) {
- Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
- "\", there are no file attributes in this filesystem.",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\", there are no file attributes in this"
+ " filesystem", TclGetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
goto end;
}
@@ -1092,9 +1113,14 @@ TclFileAttrsCmd(
"option", 0, &index) != TCL_OK) {
goto end;
}
+ if (attributeStringsAllocated != NULL) {
+ TclFreeIntRep(objv[i]);
+ }
if (i + 1 == objc) {
- Tcl_AppendResult(interp, "value for \"",
- TclGetString(objv[i]), "\" missing", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", TclGetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
+ "NOVALUE", NULL);
goto end;
}
if (Tcl_FSFileAttrsSet(interp, index, filePtr,
@@ -1105,23 +1131,380 @@ TclFileAttrsCmd(
}
result = TCL_OK;
+ /*
+ * Free up the array we allocated and drop our reference to any list of
+ * attribute names issued by the filesystem.
+ */
+
end:
if (attributeStringsAllocated != NULL) {
+ TclStackFree(interp, (void *) attributeStringsAllocated);
+ }
+ if (objStrings != NULL) {
+ Tcl_DecrRefCount(objStrings);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFileLinkCmd --
+ *
+ * This function is invoked to process the "file link" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * May create a new link.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFileLinkCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *contents;
+ int index;
+
+ if (objc < 2 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-linktype? linkname ?target?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Index of the 'source' argument.
+ */
+
+ if (objc == 4) {
+ index = 2;
+ } else {
+ index = 1;
+ }
+
+ if (objc > 2) {
+ int linkAction;
+
+ if (objc == 4) {
+ /*
+ * We have a '-linktype' argument.
+ */
+
+ static const char *const linkTypes[] = {
+ "-symbolic", "-hard", NULL
+ };
+ if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "switch", 0,
+ &linkAction) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (linkAction == 0) {
+ linkAction = TCL_CREATE_SYMBOLIC_LINK;
+ } else {
+ linkAction = TCL_CREATE_HARD_LINK;
+ }
+ } else {
+ linkAction = TCL_CREATE_SYMBOLIC_LINK | TCL_CREATE_HARD_LINK;
+ }
+ if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
/*
- * Free up the array we allocated.
+ * Create link from source to target.
*/
- TclStackFree(interp, (void *) attributeStringsAllocated);
+ contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
+ if (contents == NULL) {
+ /*
+ * We handle three common error cases specially, and for all other
+ * errors, we use the standard posix error message.
+ */
+
+ if (errno == EEXIST) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not create new link \"%s\": that path already"
+ " exists", TclGetString(objv[index])));
+ Tcl_PosixError(interp);
+ } else if (errno == ENOENT) {
+ /*
+ * There are two cases here: either the target doesn't exist,
+ * or the directory of the src doesn't exist.
+ */
+
+ int access;
+ Tcl_Obj *dirPtr = TclPathPart(interp, objv[index],
+ TCL_PATH_DIRNAME);
+
+ if (dirPtr == NULL) {
+ return TCL_ERROR;
+ }
+ access = Tcl_FSAccess(dirPtr, F_OK);
+ Tcl_DecrRefCount(dirPtr);
+ if (access != 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not create new link \"%s\": no such file"
+ " or directory", TclGetString(objv[index])));
+ Tcl_PosixError(interp);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not create new link \"%s\": target \"%s\" "
+ "doesn't exist", TclGetString(objv[index]),
+ TclGetString(objv[index+1])));
+ errno = ENOENT;
+ Tcl_PosixError(interp);
+ }
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not create new link \"%s\" pointing to \"%s\": %s",
+ TclGetString(objv[index]),
+ TclGetString(objv[index+1]), Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
+ return TCL_ERROR;
+ }
/*
- * We don't need this object that was passed to us any more.
+ * Read link
*/
- if (objStrings != NULL) {
- Tcl_DecrRefCount(objStrings);
+ contents = Tcl_FSLink(objv[index], NULL, 0);
+ if (contents == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read link \"%s\": %s",
+ TclGetString(objv[index]), Tcl_PosixError(interp)));
+ return TCL_ERROR;
}
}
- return result;
+ Tcl_SetObjResult(interp, contents);
+ if (objc == 2) {
+ /*
+ * If we are reading a link, we need to free this result refCount. If
+ * we are creating a link, this will just be objv[index+1], and so we
+ * don't own it.
+ */
+
+ Tcl_DecrRefCount(contents);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFileReadLinkCmd --
+ *
+ * This function is invoked to process the "file readlink" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFileReadLinkCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *contents;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ contents = Tcl_FSLink(objv[1], NULL, 0);
+
+ if (contents == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read link \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, contents);
+ Tcl_DecrRefCount(contents);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclFileTemporaryCmd
+ *
+ * This function implements the "tempfile" subcommand of the "file"
+ * command.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Creates a temporary file. Opens a channel to that file and puts the
+ * name of that channel in the result. *Might* register suitable exit
+ * handlers to ensure that the temporary file gets deleted. Might write
+ * to a variable, so reentrancy is a potential issue.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclFileTemporaryCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *nameVarObj = NULL; /* Variable to store the name of the temporary
+ * file in. */
+ Tcl_Obj *nameObj = NULL; /* Object that will contain the filename. */
+ Tcl_Channel chan; /* The channel opened (RDWR) on the temporary
+ * file, or NULL if there's an error. */
+ Tcl_Obj *tempDirObj = NULL, *tempBaseObj = NULL, *tempExtObj = NULL;
+ /* Pieces of template. Each piece is NULL if
+ * it is omitted. The platform temporary file
+ * engine might ignore some pieces. */
+
+ if (objc < 1 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?nameVar? ?template?");
+ return TCL_ERROR;
+ }
+
+ if (objc > 1) {
+ nameVarObj = objv[1];
+ TclNewObj(nameObj);
+ }
+ if (objc > 2) {
+ int length;
+ Tcl_Obj *templateObj = objv[2];
+ const char *string = TclGetStringFromObj(templateObj, &length);
+
+ /*
+ * Treat an empty string as if it wasn't there.
+ */
+
+ if (length == 0) {
+ goto makeTemporary;
+ }
+
+ /*
+ * The template only gives a directory if there is a directory
+ * separator in it.
+ */
+
+ if (strchr(string, '/') != NULL
+ || (tclPlatform == TCL_PLATFORM_WINDOWS
+ && strchr(string, '\\') != NULL)) {
+ tempDirObj = TclPathPart(interp, templateObj, TCL_PATH_DIRNAME);
+
+ /*
+ * Only allow creation of temporary files in the native filesystem
+ * since they are frequently used for integration with external
+ * tools or system libraries. [Bug 2388866]
+ */
+
+ if (tempDirObj != NULL && Tcl_FSGetFileSystemForPath(tempDirObj)
+ != &tclNativeFilesystem) {
+ TclDecrRefCount(tempDirObj);
+ tempDirObj = NULL;
+ }
+ }
+
+ /*
+ * The template only gives the filename if the last character isn't a
+ * directory separator.
+ */
+
+ if (string[length-1] != '/' && (tclPlatform != TCL_PLATFORM_WINDOWS
+ || string[length-1] != '\\')) {
+ Tcl_Obj *tailObj = TclPathPart(interp, templateObj,
+ TCL_PATH_TAIL);
+
+ if (tailObj != NULL) {
+ tempBaseObj = TclPathPart(interp, tailObj, TCL_PATH_ROOT);
+ tempExtObj = TclPathPart(interp, tailObj, TCL_PATH_EXTENSION);
+ TclDecrRefCount(tailObj);
+ }
+ }
+ }
+
+ /*
+ * Convert empty parts of the template into unspecified parts.
+ */
+
+ if (tempDirObj && !TclGetString(tempDirObj)[0]) {
+ TclDecrRefCount(tempDirObj);
+ tempDirObj = NULL;
+ }
+ if (tempBaseObj && !TclGetString(tempBaseObj)[0]) {
+ TclDecrRefCount(tempBaseObj);
+ tempBaseObj = NULL;
+ }
+ if (tempExtObj && !TclGetString(tempExtObj)[0]) {
+ TclDecrRefCount(tempExtObj);
+ tempExtObj = NULL;
+ }
+
+ /*
+ * Create and open the temporary file.
+ */
+
+ makeTemporary:
+ chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj);
+
+ /*
+ * If we created pieces of template, get rid of them now.
+ */
+
+ if (tempDirObj) {
+ TclDecrRefCount(tempDirObj);
+ }
+ if (tempBaseObj) {
+ TclDecrRefCount(tempBaseObj);
+ }
+ if (tempExtObj) {
+ TclDecrRefCount(tempExtObj);
+ }
+
+ /*
+ * Deal with results.
+ */
+
+ if (chan == NULL) {
+ if (nameVarObj) {
+ TclDecrRefCount(nameObj);
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create temporary file: %s", Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+ Tcl_RegisterChannel(interp, chan);
+ if (nameVarObj != NULL) {
+ if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ Tcl_UnregisterChannel(interp, chan);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
+ return TCL_OK;
}
/*
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 7c4a360..5d4702b 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclFileName.c,v 1.103 2010/05/19 08:23:09 nijtmans Exp $
*/
#include "tclInt.h"
@@ -74,9 +72,9 @@ SetResultLength(
{
Tcl_DStringSetLength(resultPtr, offset);
if (extended == 2) {
- Tcl_DStringAppend(resultPtr, "//?/UNC/", 8);
+ TclDStringAppendLiteral(resultPtr, "//?/UNC/");
} else if (extended == 1) {
- Tcl_DStringAppend(resultPtr, "//?/", 4);
+ TclDStringAppendLiteral(resultPtr, "//?/");
}
}
@@ -133,7 +131,7 @@ ExtractWinRoot(
if (path[1] != '/' && path[1] != '\\') {
SetResultLength(resultPtr, offset, extended);
*typePtr = TCL_PATH_VOLUME_RELATIVE;
- Tcl_DStringAppend(resultPtr, "/", 1);
+ TclDStringAppendLiteral(resultPtr, "/");
return &path[1];
}
host = &path[2];
@@ -163,7 +161,7 @@ ExtractWinRoot(
*/
*typePtr = TCL_PATH_VOLUME_RELATIVE;
- Tcl_DStringAppend(resultPtr, "/", 1);
+ TclDStringAppendLiteral(resultPtr, "/");
return &path[2];
}
SetResultLength(resultPtr, offset, extended);
@@ -182,9 +180,9 @@ ExtractWinRoot(
break;
}
}
- Tcl_DStringAppend(resultPtr, "//", 2);
+ TclDStringAppendLiteral(resultPtr, "//");
Tcl_DStringAppend(resultPtr, host, hlen);
- Tcl_DStringAppend(resultPtr, "/", 1);
+ TclDStringAppendLiteral(resultPtr, "/");
Tcl_DStringAppend(resultPtr, share, slen);
tail = &share[slen];
@@ -223,7 +221,7 @@ ExtractWinRoot(
*typePtr = TCL_PATH_ABSOLUTE;
Tcl_DStringAppend(resultPtr, path, 2);
- Tcl_DStringAppend(resultPtr, "/", 1);
+ TclDStringAppendLiteral(resultPtr, "/");
return tail;
}
@@ -413,25 +411,36 @@ TclpGetNativePathType(
* Paths that begin with / are absolute.
*/
-#ifdef __QNX__
- /*
- * Check for QNX //<node id> prefix
- */
- if (*path && (pathLen > 3) && (path[0] == '/')
- && (path[1] == '/') && isdigit(UCHAR(path[2]))) {
- path += 3;
- while (isdigit(UCHAR(*path))) {
- path++;
+ if (path[0] == '/') {
+ ++path;
+#if defined(__CYGWIN__) || defined(__QNX__)
+ /*
+ * Check for "//" network path prefix
+ */
+ if ((*path == '/') && path[1] && (path[1] != '/')) {
+ path += 2;
+ while (*path && *path != '/') {
+ ++path;
+ }
+#if defined(__CYGWIN__)
+ /* UNC paths need to be followed by a share name */
+ if (*path++ && (*path && *path != '/')) {
+ ++path;
+ while (*path && *path != '/') {
+ ++path;
+ }
+ } else {
+ path = origPath + 1;
+ }
+#endif
}
- }
#endif
- if (path[0] == '/') {
if (driveNameLengthPtr != NULL) {
/*
- * We need this addition in case the QNX code was used.
+ * We need this addition in case the QNX or Cygwin code was used.
*/
- *driveNameLengthPtr = (1 + path - origPath);
+ *driveNameLengthPtr = (path - origPath);
}
} else {
type = TCL_PATH_RELATIVE;
@@ -447,8 +456,7 @@ TclpGetNativePathType(
if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
*driveNameLengthPtr = rootEnd - path;
if (driveNameRef != NULL) {
- *driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
+ *driveNameRef = TclDStringToObj(&ds);
Tcl_IncrRefCount(*driveNameRef);
}
}
@@ -579,8 +587,7 @@ Tcl_SplitPath(
* plus the argv pointers and the terminating NULL pointer.
*/
- *argvPtr = (const char **) ckalloc((unsigned)
- ((((*argcPtr) + 1) * sizeof(char *)) + size));
+ *argvPtr = ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size);
/*
* Position p after the last argv pointer and copy the contents of the
@@ -636,32 +643,43 @@ SplitUnixPath(
const char *path) /* Pointer to string containing a path. */
{
int length;
- const char *p, *elementStart;
+ const char *origPath = path, *elementStart;
Tcl_Obj *result = Tcl_NewObj();
/*
* Deal with the root directory as a special case.
*/
-#ifdef __QNX__
- /*
- * Check for QNX //<node id> prefix
- */
-
- if ((path[0] == '/') && (path[1] == '/')
- && isdigit(UCHAR(path[2]))) { /* INTL: digit */
- path += 3;
- while (isdigit(UCHAR(*path))) { /* INTL: digit */
- path++;
+ if (*path == '/') {
+ Tcl_Obj *rootElt;
+ ++path;
+#if defined(__CYGWIN__) || defined(__QNX__)
+ /*
+ * Check for "//" network path prefix
+ */
+ if ((*path == '/') && path[1] && (path[1] != '/')) {
+ path += 2;
+ while (*path && *path != '/') {
+ ++path;
+ }
+#if defined(__CYGWIN__)
+ /* UNC paths need to be followed by a share name */
+ if (*path++ && (*path && *path != '/')) {
+ ++path;
+ while (*path && *path != '/') {
+ ++path;
+ }
+ } else {
+ path = origPath + 1;
+ }
+#endif
}
- }
#endif
-
- if (path[0] == '/') {
- Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("/",1));
- p = path+1;
- } else {
- p = path;
+ rootElt = Tcl_NewStringObj(origPath, path - origPath);
+ Tcl_ListObjAppendElement(NULL, result, rootElt);
+ while (*path == '/') {
+ ++path;
+ }
}
/*
@@ -670,14 +688,14 @@ SplitUnixPath(
*/
for (;;) {
- elementStart = p;
- while ((*p != '\0') && (*p != '/')) {
- p++;
+ elementStart = path;
+ while ((*path != '\0') && (*path != '/')) {
+ path++;
}
- length = p - elementStart;
+ length = path - elementStart;
if (length > 0) {
Tcl_Obj *nextElt;
- if ((elementStart[0] == '~') && (elementStart != path)) {
+ if ((elementStart[0] == '~') && (elementStart != origPath)) {
TclNewLiteralStringObj(nextElt, "./");
Tcl_AppendToObj(nextElt, elementStart, length);
} else {
@@ -685,7 +703,7 @@ SplitUnixPath(
}
Tcl_ListObjAppendElement(NULL, result, nextElt);
}
- if (*p++ == '\0') {
+ if (*path++ == '\0') {
break;
}
}
@@ -727,8 +745,7 @@ SplitWinPath(
*/
if (p != path) {
- Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(
- Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)));
+ Tcl_ListObjAppendElement(NULL, result, TclDStringToObj(&buf));
}
Tcl_DStringFree(&buf);
@@ -790,32 +807,28 @@ Tcl_FSJoinToPath(
int objc, /* Number of array elements to join */
Tcl_Obj *const objv[]) /* Path elements to join. */
{
- int i;
- Tcl_Obj *lobj, *ret;
-
if (pathPtr == NULL) {
- lobj = Tcl_NewListObj(0, NULL);
- } else {
- lobj = Tcl_NewListObj(1, &pathPtr);
+ return TclJoinPath(objc, objv);
}
-
- for (i = 0; i<objc;i++) {
- Tcl_ListObjAppendElement(NULL, lobj, objv[i]);
+ if (objc == 0) {
+ return TclJoinPath(1, &pathPtr);
}
- ret = Tcl_FSJoinPath(lobj, -1);
-
- /*
- * It is possible that 'ret' is just a member of the list and is therefore
- * going to be freed here. Therefore we must adjust the refCount manually.
- * (It would be better if we changed the documentation of this function
- * and Tcl_FSJoinPath so that the returned object already has a refCount
- * for the caller, hence avoiding these subtleties (and code ugliness)).
- */
+ if (objc == 1) {
+ Tcl_Obj *pair[2];
- Tcl_IncrRefCount(ret);
- Tcl_DecrRefCount(lobj);
- ret->refCount--;
- return ret;
+ pair[0] = pathPtr;
+ pair[1] = objv[0];
+ return TclJoinPath(2, pair);
+ } else {
+ int elemc = objc + 1;
+ Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj **));
+
+ elemv[0] = pathPtr;
+ memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj **));
+ ret = TclJoinPath(elemc, elemv);
+ ckfree(elemv);
+ return ret;
+ }
}
/*
@@ -872,7 +885,7 @@ TclpNativeJoinPath(
if (length > 0 && (start[length-1] != '/')) {
Tcl_AppendToObj(prefix, "/", 1);
- length++;
+ Tcl_GetStringFromObj(prefix, &length);
}
needsSep = 0;
@@ -908,7 +921,7 @@ TclpNativeJoinPath(
if ((length > 0) &&
(start[length-1] != '/') && (start[length-1] != ':')) {
Tcl_AppendToObj(prefix, "/", 1);
- length++;
+ Tcl_GetStringFromObj(prefix, &length);
}
needsSep = 0;
@@ -1049,7 +1062,7 @@ Tcl_TranslateFileName(
}
Tcl_DStringInit(bufferPtr);
- Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1);
+ TclDStringAppendObj(bufferPtr, transPtr);
Tcl_DecrRefCount(path);
Tcl_DecrRefCount(transPtr);
@@ -1166,9 +1179,10 @@ DoTildeSubst(
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't find HOME environment "
- "variable to expand path", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't find HOME environment "
+ "variable to expand path", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL);
}
return NULL;
}
@@ -1177,8 +1191,9 @@ DoTildeSubst(
} else if (TclpGetUserHome(user, resultPtr) == NULL) {
if (interp) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "user \"%s\" doesn't exist", user));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL);
}
return NULL;
}
@@ -1213,7 +1228,7 @@ Tcl_GlobObjCmd(
int index, i, globFlags, length, join, dir, result;
char *string;
const char *separators;
- Tcl_Obj *typePtr, *resultPtr, *look;
+ Tcl_Obj *typePtr, *look;
Tcl_Obj *pathOrDir = NULL;
Tcl_DString prefix;
static const char *const options[] = {
@@ -1261,11 +1276,14 @@ Tcl_GlobObjCmd(
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-directory\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
if (dir != PATH_NONE) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-directory\" cannot be used with \"-path\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
+ "BADOPTIONCOMBINATION", NULL);
return TCL_ERROR;
}
dir = PATH_DIR;
@@ -1283,11 +1301,14 @@ Tcl_GlobObjCmd(
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-path\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
if (dir != PATH_NONE) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-path\" cannot be used with \"-directory\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
+ "BADOPTIONCOMBINATION", NULL);
return TCL_ERROR;
}
dir = PATH_GENERAL;
@@ -1298,6 +1319,7 @@ Tcl_GlobObjCmd(
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-types\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
typePtr = objv[i+1];
@@ -1314,9 +1336,11 @@ Tcl_GlobObjCmd(
endOfForLoop:
if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-tails\" must be used with either "
- "\"-directory\" or \"-path\"", NULL);
+ "\"-directory\" or \"-path\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
+ "BADOPTIONCOMBINATION", NULL);
return TCL_ERROR;
}
@@ -1396,7 +1420,7 @@ Tcl_GlobObjCmd(
search = Tcl_DStringValue(&pref);
while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) {
Tcl_DStringAppend(&prefix, search, find-search);
- Tcl_DStringAppend(&prefix, "\\", 1);
+ TclDStringAppendLiteral(&prefix, "\\");
Tcl_DStringAppend(&prefix, find, 1);
search = find+1;
if (*search == '\0') {
@@ -1491,8 +1515,8 @@ Tcl_GlobObjCmd(
} else {
Tcl_Obj *item;
- if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) &&
- (len == 3)) {
+ if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK)
+ && (len == 3)) {
Tcl_ListObjIndex(interp, look, 0, &item);
if (!strcmp("macintosh", Tcl_GetString(item))) {
Tcl_ListObjIndex(interp, look, 1, &item);
@@ -1522,10 +1546,10 @@ Tcl_GlobObjCmd(
*/
badTypesArg:
- TclNewObj(resultPtr);
- Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
- Tcl_AppendObjToObj(resultPtr, look);
- Tcl_SetObjResult(interp, resultPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad argument to \"-types\": %s",
+ Tcl_GetString(look)));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
result = TCL_ERROR;
join = 0;
goto endOfGlob;
@@ -1535,6 +1559,7 @@ Tcl_GlobObjCmd(
"only one MacOS type or creator argument"
" to \"-types\" allowed", -1));
result = TCL_ERROR;
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
join = 0;
goto endOfGlob;
}
@@ -1557,8 +1582,7 @@ Tcl_GlobObjCmd(
Tcl_DStringInit(&prefix);
}
for (i = 0; i < objc; i++) {
- string = Tcl_GetStringFromObj(objv[i], &length);
- Tcl_DStringAppend(&prefix, string, length);
+ TclDStringAppendObj(&prefix, objv[i]);
if (i != objc -1) {
Tcl_DStringAppend(&prefix, separators, 1);
}
@@ -1574,11 +1598,9 @@ Tcl_GlobObjCmd(
for (i = 0; i < objc; i++) {
Tcl_DStringInit(&str);
if (dir == PATH_GENERAL) {
- Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix),
- Tcl_DStringLength(&prefix));
+ TclDStringAppendDString(&str, &prefix);
}
- string = Tcl_GetStringFromObj(objv[i], &length);
- Tcl_DStringAppend(&str, string, length);
+ TclDStringAppendObj(&str, objv[i]);
if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags,
globTypes) != TCL_OK) {
result = TCL_ERROR;
@@ -1610,19 +1632,25 @@ Tcl_GlobObjCmd(
}
if (length == 0) {
- Tcl_AppendResult(interp, "no files matched glob pattern",
- (join || (objc == 1)) ? " \"" : "s \"", NULL);
+ Tcl_Obj *errorMsg =
+ Tcl_ObjPrintf("no files matched glob pattern%s \"",
+ (join || (objc == 1)) ? "" : "s");
+
if (join) {
- Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL);
+ Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1);
} else {
const char *sep = "";
+
for (i = 0; i < objc; i++) {
- string = Tcl_GetString(objv[i]);
- Tcl_AppendResult(interp, sep, string, NULL);
+ Tcl_AppendPrintfToObj(errorMsg, "%s%s",
+ sep, Tcl_GetString(objv[i]));
sep = " ";
}
}
- Tcl_AppendResult(interp, "\"", NULL);
+ Tcl_AppendToObj(errorMsg, "\"", -1);
+ Tcl_SetObjResult(interp, errorMsg);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
+ NULL);
result = TCL_ERROR;
}
}
@@ -1745,8 +1773,7 @@ TclGlob(
if (head != Tcl_DStringValue(&buffer)) {
Tcl_DStringAppend(&buffer, head, -1);
}
- pathPrefix = Tcl_NewStringObj(Tcl_DStringValue(&buffer),
- Tcl_DStringLength(&buffer));
+ pathPrefix = TclDStringToObj(&buffer);
Tcl_IncrRefCount(pathPrefix);
globFlags |= TCL_GLOBMODE_DIR;
if (c != '\0') {
@@ -2154,67 +2181,6 @@ DoGlob(
}
/*
- * This block of code is not exercised by the Tcl test suite as of Tcl
- * 8.5a0. Simplifications to the calling paths suggest it may not be
- * necessary any more, since path separators are handled elsewhere. It is
- * left in place in case new bugs are reported.
- */
-
-#if 0 /* PROBABLY_OBSOLETE */
- /*
- * Deal with path separators.
- */
-
- if (pathPtr == NULL) {
- /*
- * Length used to be the length of the prefix, and lastChar the
- * lastChar of the prefix. But, none of this is used any more.
- */
-
- int length = 0;
- char lastChar = 0;
-
- switch (tclPlatform) {
- case TCL_PLATFORM_WINDOWS:
- /*
- * If this is a drive relative path, add the colon and the
- * trailing slash if needed. Otherwise add the slash if this is
- * the first absolute element, or a later relative element. Add an
- * extra slash if this is a UNC path.
- */
-
- if (*name == ':') {
- Tcl_DStringAppend(&append, ":", 1);
- if (count > 1) {
- Tcl_DStringAppend(&append, "/", 1);
- }
- } else if ((*pattern != '\0') && (((length > 0)
- && (strchr(separators, lastChar) == NULL))
- || ((length == 0) && (count > 0)))) {
- Tcl_DStringAppend(&append, "/", 1);
- if ((length == 0) && (count > 1)) {
- Tcl_DStringAppend(&append, "/", 1);
- }
- }
-
- break;
- case TCL_PLATFORM_UNIX:
- /*
- * Add a separator if this is the first absolute element, or a
- * later relative element.
- */
-
- if ((*pattern != '\0') && (((length > 0)
- && (strchr(separators, lastChar) == NULL))
- || ((length == 0) && (count > 0)))) {
- Tcl_DStringAppend(&append, "/", 1);
- }
- break;
- }
- }
-#endif /* PROBABLY_OBSOLETE */
-
- /*
* Look for the first matching pair of braces or the first directory
* separator that is not inside a pair of braces.
*/
@@ -2251,13 +2217,17 @@ DoGlob(
closeBrace = p;
break;
}
- Tcl_SetResult(interp, "unmatched open-brace in file name",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unmatched open-brace in file name", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
+ NULL);
return TCL_ERROR;
} else if (*p == '}') {
- Tcl_SetResult(interp, "unmatched close-brace in file name",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unmatched close-brace in file name", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
+ NULL);
return TCL_ERROR;
}
}
@@ -2268,8 +2238,8 @@ DoGlob(
if (openBrace != NULL) {
char *element;
-
Tcl_DString newName;
+
Tcl_DStringInit(&newName);
/*
@@ -2318,12 +2288,13 @@ DoGlob(
*/
if (*p != '\0') {
+ char savedChar = *p;
+
/*
* Note that we are modifying the string in place. This won't work if
* the string is a static.
*/
- char savedChar = *p;
*p = '\0';
firstSpecialChar = strpbrk(pattern, "*[]?\\");
*p = savedChar;
@@ -2388,6 +2359,7 @@ DoGlob(
const char *bytes;
int numBytes;
Tcl_Obj *fixme, *newObj;
+
Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
bytes = Tcl_GetStringFromObj(fixme, &numBytes);
newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
@@ -2408,6 +2380,9 @@ DoGlob(
*/
if (*p == '\0') {
+ int length;
+ Tcl_DString append;
+
/*
* This is the code path reached by a command like 'glob foo'.
*
@@ -2420,9 +2395,6 @@ DoGlob(
* approach).
*/
- int length;
- Tcl_DString append;
-
Tcl_DStringInit(&append);
Tcl_DStringAppend(&append, pattern, p-pattern);
@@ -2437,41 +2409,22 @@ DoGlob(
if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
if (((*name == '\\') && (name[1] == '/' ||
name[1] == '\\')) || (*name == '/')) {
- Tcl_DStringAppend(&append, "/", 1);
+ TclDStringAppendLiteral(&append, "/");
} else {
- Tcl_DStringAppend(&append, ".", 1);
+ TclDStringAppendLiteral(&append, ".");
}
}
-#if defined(__CYGWIN__) && defined(__WIN32__)
- {
- char winbuf[MAX_PATH+1];
-
- cygwin_conv_to_win32_path(Tcl_DStringValue(&append), winbuf);
- Tcl_DStringFree(&append);
- Tcl_DStringAppend(&append, winbuf, -1);
- }
-#endif /* __CYGWIN__ && __WIN32__ */
break;
case TCL_PLATFORM_UNIX:
if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
- Tcl_DStringAppend(&append, "/", 1);
+ TclDStringAppendLiteral(&append, "/");
} else {
- Tcl_DStringAppend(&append, ".", 1);
+ TclDStringAppendLiteral(&append, ".");
}
}
-#if defined(__CYGWIN__) && !defined(__WIN32__)
- DLLIMPORT extern int cygwin_conv_to_posix_path(const char *, char *);
- {
- char winbuf[MAXPATHLEN+1];
-
- cygwin_conv_to_posix_path(Tcl_DStringValue(&append), winbuf);
- Tcl_DStringFree(&append);
- Tcl_DStringAppend(&append, winbuf, -1);
- }
-#endif /* __CYGWIN__ && __WIN32__ */
break;
}
@@ -2480,8 +2433,7 @@ DoGlob(
*/
if (pathPtr == NULL) {
- joinedPtr = Tcl_NewStringObj(Tcl_DStringValue(&append),
- Tcl_DStringLength(&append));
+ joinedPtr = TclDStringToObj(&append);
} else if (flags) {
joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
Tcl_DStringLength(&append));
@@ -2570,7 +2522,7 @@ DoGlob(
Tcl_StatBuf *
Tcl_AllocStatBuf(void)
{
- return (Tcl_StatBuf *) ckalloc(sizeof(Tcl_StatBuf));
+ return ckalloc(sizeof(Tcl_StatBuf));
}
/*
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index b9ca8b9..6be3e03 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclFileSystem.h,v 1.13 2008/07/28 21:31:21 nijtmans Exp $
*/
#ifndef _TCLFILESYSTEM
@@ -18,45 +16,6 @@
#include "tcl.h"
/*
- * struct FilesystemRecord --
- *
- * A filesystem record is used to keep track of each filesystem currently
- * registered with the core, in a linked list. Pointers to these structures
- * are also kept by each "path" Tcl_Obj, and we must retain a refCount on the
- * number of such references.
- */
-
-typedef struct FilesystemRecord {
- ClientData clientData; /* Client specific data for the new filesystem
- * (can be NULL) */
- const Tcl_Filesystem *fsPtr; /* Pointer to filesystem dispatch table. */
- int fileRefCount; /* How many Tcl_Obj's use this filesystem. */
- struct FilesystemRecord *nextPtr;
- /* The next filesystem registered to Tcl, or
- * NULL if no more. */
- struct FilesystemRecord *prevPtr;
- /* The previous filesystem registered to Tcl,
- * or NULL if no more. */
-} FilesystemRecord;
-
-/*
- * This structure holds per-thread private copy of the current directory
- * maintained by the global cwdPathPtr. This structure holds per-thread
- * private copies of some global data. This way we avoid most of the
- * synchronization calls which boosts performance, at cost of having to update
- * this information each time the corresponding epoch counter changes.
- */
-
-typedef struct ThreadSpecificData {
- int initialized;
- int cwdPathEpoch;
- int filesystemEpoch;
- Tcl_Obj *cwdPathPtr;
- ClientData cwdClientData;
- FilesystemRecord *filesystemList;
-} ThreadSpecificData;
-
-/*
* The internal TclFS API provides routines for handling and manipulating
* paths efficiently, taking direct advantage of the "path" Tcl_Obj type.
*
@@ -64,31 +23,23 @@ typedef struct ThreadSpecificData {
*/
MODULE_SCOPE int TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr);
-MODULE_SCOPE int TclFSMakePathFromNormalized(Tcl_Interp *interp,
- Tcl_Obj *pathPtr, ClientData clientData);
MODULE_SCOPE int TclFSNormalizeToUniquePath(Tcl_Interp *interp,
- Tcl_Obj *pathPtr, int startAt,
- ClientData *clientDataPtr);
+ Tcl_Obj *pathPtr, int startAt);
MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp,
Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr);
-MODULE_SCOPE Tcl_Obj * TclFSInternalToNormalized(
- const Tcl_Filesystem *fromFilesystem,
- ClientData clientData,
- FilesystemRecord **fsRecPtrPtr);
MODULE_SCOPE int TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
const Tcl_Filesystem **fsPtrPtr);
MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr,
- FilesystemRecord *fsRecPtr,
- ClientData clientData);
+ const Tcl_Filesystem *fsPtr, ClientData clientData);
MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
- Tcl_Obj *pathPtr, ClientData *clientDataPtr);
+ Tcl_Obj *pathPtr);
+MODULE_SCOPE int TclFSEpoch(void);
/*
* Private shared variables for use by tclIOUtil.c and tclPathObj.c
*/
MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem;
-MODULE_SCOPE Tcl_ThreadDataKey tclFsDataKey;
/*
* Private shared functions for use by tclIOUtil.c, tclPathObj.c and
diff --git a/generic/tclGet.c b/generic/tclGet.c
index 2ff203b..4c19b55 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclGet.c,v 1.22 2008/07/08 17:52:15 dgp Exp $
*/
#include "tclInt.h"
@@ -55,6 +53,7 @@ Tcl_GetInt(
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
+ TclFreeIntRep(&obj);
return code;
}
@@ -98,6 +97,7 @@ Tcl_GetDouble(
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
+ TclFreeIntRep(&obj);
return code;
}
diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y
index a27179c..da4c3fd 100644
--- a/generic/tclGetDate.y
+++ b/generic/tclGetDate.y
@@ -12,8 +12,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclGetDate.y,v 1.45 2010/03/04 23:16:56 nijtmans Exp $
*/
%parse-param {DateInfo* info}
@@ -1013,10 +1011,12 @@ TclClockOldscanObjCmd(
if (status == 1) {
Tcl_SetObjResult(interp, dateInfo.messages);
Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
return TCL_ERROR;
} else if (status == 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
} else if (status != 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned "
@@ -1024,6 +1024,7 @@ TclClockOldscanObjCmd(
"report this error as a "
"bug in Tcl.", -1));
Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
return TCL_ERROR;
}
Tcl_DecrRefCount(dateInfo.messages);
@@ -1031,26 +1032,31 @@ TclClockOldscanObjCmd(
if (yyHaveDate > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one date in string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
if (yyHaveTime > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one time of day in string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
if (yyHaveZone > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one time zone in string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
if (yyHaveDay > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one weekday in string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
if (yyHaveOrdinalMonth > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one ordinal month in string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
return TCL_ERROR;
}
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 81f9326..90be511 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclHash.c,v 1.46 2010/08/24 06:17:55 nijtmans Exp $
*/
#include "tclInt.h"
@@ -37,7 +35,7 @@
*/
#define RANDOM_INDEX(tablePtr, i) \
- (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
+ ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask)
/*
* Prototypes for the array hash key methods.
@@ -48,7 +46,9 @@ static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);
/*
- * Prototypes for the one word hash key methods.
+ * Prototypes for the one word hash key methods. Not actually declared because
+ * this is a critical path that is implemented in the core hash table access
+ * function.
*/
#if 0
@@ -362,7 +362,7 @@ CreateHashEntry(
if (typePtr->allocEntryProc) {
hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
} else {
- hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));
+ hPtr = ckalloc(sizeof(Tcl_HashEntry));
hPtr->key.oneWordValue = (char *) key;
hPtr->clientData = 0;
}
@@ -436,7 +436,7 @@ Tcl_DeleteHashEntry(
#if TCL_HASH_KEY_STORE_HASH
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
- index = RANDOM_INDEX(tablePtr, entryPtr->hash);
+ index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
} else {
index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
}
@@ -464,7 +464,7 @@ Tcl_DeleteHashEntry(
if (typePtr->freeEntryProc) {
typePtr->freeEntryProc(entryPtr);
} else {
- ckfree((char *) entryPtr);
+ ckfree(entryPtr);
}
}
@@ -515,7 +515,7 @@ Tcl_DeleteHashTable(
if (typePtr->freeEntryProc) {
typePtr->freeEntryProc(hPtr);
} else {
- ckfree((char *) hPtr);
+ ckfree(hPtr);
}
hPtr = nextPtr;
}
@@ -529,7 +529,7 @@ Tcl_DeleteHashTable(
if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
TclpSysFree((char *) tablePtr->buckets);
} else {
- ckfree((char *) tablePtr->buckets);
+ ckfree(tablePtr->buckets);
}
}
@@ -674,7 +674,7 @@ Tcl_HashStats(
* Print out the histogram and a few other pieces of information.
*/
- result = (char *) ckalloc((unsigned) (NUM_COUNTERS*60) + 300);
+ result = ckalloc((NUM_COUNTERS * 60) + 300);
sprintf(result, "%d entries in table, %d buckets\n",
tablePtr->numEntries, tablePtr->numBuckets);
p = result + strlen(result);
@@ -723,7 +723,7 @@ AllocArrayEntry(
if (size < sizeof(Tcl_HashEntry)) {
size = sizeof(Tcl_HashEntry);
}
- hPtr = (Tcl_HashEntry *) ckalloc(size);
+ hPtr = ckalloc(size);
for (iPtr1 = array, iPtr2 = hPtr->key.words;
count > 0; count--, iPtr1++, iPtr2++) {
@@ -829,14 +829,14 @@ AllocStringEntry(
{
const char *string = (const char *) keyPtr;
Tcl_HashEntry *hPtr;
- unsigned int size;
+ unsigned int size, allocsize;
- size = sizeof(Tcl_HashEntry) + strlen(string) + 1 - sizeof(hPtr->key);
- if (size < sizeof(Tcl_HashEntry)) {
- size = sizeof(Tcl_HashEntry);
+ allocsize = size = strlen(string) + 1;
+ if (size < sizeof(hPtr->key)) {
+ allocsize = sizeof(hPtr->key);
}
- hPtr = (Tcl_HashEntry *) ckalloc(size);
- strcpy(hPtr->key.string, string);
+ hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize);
+ memcpy(hPtr->key.string, string, size);
hPtr->clientData = 0;
return hPtr;
}
@@ -1044,8 +1044,8 @@ RebuildTable(
tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned)
(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0);
} else {
- tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
- (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
+ tablePtr->buckets =
+ ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
}
for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
count > 0; count--, newChainPtr++) {
@@ -1065,7 +1065,7 @@ RebuildTable(
#if TCL_HASH_KEY_STORE_HASH
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
- index = RANDOM_INDEX(tablePtr, hPtr->hash);
+ index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
} else {
index = PTR2UINT(hPtr->hash) & tablePtr->mask;
}
@@ -1102,7 +1102,7 @@ RebuildTable(
if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
TclpSysFree((char *) oldBuckets);
} else {
- ckfree((char *) oldBuckets);
+ ckfree(oldBuckets);
}
}
}
diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index 0d6af52..b10d423 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -11,8 +11,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclHistory.c,v 1.14 2009/12/29 16:58:41 dkf Exp $
*/
#include "tclInt.h"
@@ -140,7 +138,7 @@ Tcl_RecordAndEvalObj(
*/
if (histObjsPtr == NULL) {
- histObjsPtr = (HistoryObjs *) ckalloc(sizeof(HistoryObjs));
+ histObjsPtr = ckalloc(sizeof(HistoryObjs));
TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
TclNewLiteralStringObj(histObjsPtr->addObj, "add");
Tcl_IncrRefCount(histObjsPtr->historyObj);
@@ -220,7 +218,7 @@ DeleteHistoryObjs(
TclDecrRefCount(histObjsPtr->historyObj);
TclDecrRefCount(histObjsPtr->addObj);
- ckfree((char *) histObjsPtr);
+ ckfree(histObjsPtr);
}
/*
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 0ed57d0..715c1ef 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclIO.c,v 1.175 2010/03/20 17:49:15 dkf Exp $
*/
#include "tclInt.h"
@@ -81,7 +79,7 @@ static int DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
static void DiscardInputQueued(ChannelState *statePtr,
int discardSavedBuffers);
static void DiscardOutputQueued(ChannelState *chanPtr);
-static int DoRead(Channel *chanPtr, char *srcPtr, int slen);
+static int DoRead(Channel *chanPtr, char *srcPtr, int slen, int allowShortReads);
static int DoWrite(Channel *chanPtr, const char *src, int srcLen);
static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
int appendFlag);
@@ -398,6 +396,19 @@ TclFinalizeIOSubsystem(void)
Channel *chanPtr = NULL; /* Iterates over open channels. */
ChannelState *statePtr; /* State of channel stack */
int active = 1; /* Flag == 1 while there's still work to do */
+ int doflushnb;
+
+ /* Fetch the pre-TIP#398 compatibility flag */
+ {
+ const char *s;
+ Tcl_DString ds;
+
+ s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds);
+ doflushnb = ((s != NULL) && strcmp(s, "0"));
+ if (s != NULL) {
+ Tcl_DStringFree(&ds);
+ }
+ }
/*
* Walk all channel state structures known to this thread and close
@@ -416,25 +427,37 @@ TclFinalizeIOSubsystem(void)
statePtr != NULL;
statePtr = statePtr->nextCSPtr) {
chanPtr = statePtr->topChanPtr;
- if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED |
- CHANNEL_DEAD)) {
+ if (GotFlag(statePtr, CHANNEL_DEAD)) {
+ continue;
+ }
+ if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED )
+ || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
active = 1;
break;
}
}
/*
- * We've found a live channel. Close it.
+ * We've found a live (or bg-closing) channel. Close it.
*/
if (active) {
+
/*
- * Set the channel back into blocking mode to ensure that we wait
- * for all data to flush out.
+ * TIP #398: by default, we no longer set the channel back into
+ * blocking mode. To restore the old blocking behavior, the
+ * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set
+ * and not be "0".
*/
-
- (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
- "-blocking", "on");
+ if (doflushnb) {
+ /* Set the channel back into blocking mode to ensure that we wait
+ * for all data to flush out.
+ */
+
+ (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
+ "-blocking", "on");
+ }
if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
(chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
@@ -629,7 +652,7 @@ Tcl_CreateCloseHandler(
ChannelState *statePtr = ((Channel *) chan)->state;
CloseCallback *cbPtr;
- cbPtr = (CloseCallback *) ckalloc(sizeof(CloseCallback));
+ cbPtr = ckalloc(sizeof(CloseCallback));
cbPtr->proc = proc;
cbPtr->clientData = clientData;
@@ -673,7 +696,7 @@ Tcl_DeleteCloseHandler(
if (cbPrevPtr == NULL) {
statePtr->closeCbPtr = cbPtr->nextPtr;
}
- ckfree((char *) cbPtr);
+ ckfree(cbPtr);
break;
}
cbPrevPtr = cbPtr;
@@ -708,7 +731,7 @@ GetChannelTable(
hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == NULL) {
- hTblPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ hTblPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
Tcl_SetAssocData(interp, "tclIO",
(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);
@@ -800,7 +823,7 @@ DeleteChannelTable(
TclChannelEventScriptInvoker, sPtr);
TclDecrRefCount(sPtr->scriptPtr);
- ckfree((char *) sPtr);
+ ckfree(sPtr);
} else {
prevPtr = sPtr;
}
@@ -824,7 +847,7 @@ DeleteChannelTable(
}
Tcl_DeleteHashTable(hTblPtr);
- ckfree((char *) hTblPtr);
+ ckfree(hTblPtr);
}
/*
@@ -856,19 +879,25 @@ CheckForStdChannelsBeingClosed(
ChannelState *statePtr = ((Channel *) chan)->state;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if ((chan == tsdPtr->stdinChannel) && tsdPtr->stdinInitialized) {
+ if (tsdPtr->stdinInitialized
+ && tsdPtr->stdinChannel != NULL
+ && statePtr == ((Channel *)tsdPtr->stdinChannel)->state) {
if (statePtr->refCount < 2) {
statePtr->refCount = 0;
tsdPtr->stdinChannel = NULL;
return;
}
- } else if ((chan == tsdPtr->stdoutChannel) && tsdPtr->stdoutInitialized) {
+ } else if (tsdPtr->stdoutInitialized
+ && tsdPtr->stdoutChannel != NULL
+ && statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) {
if (statePtr->refCount < 2) {
statePtr->refCount = 0;
tsdPtr->stdoutChannel = NULL;
return;
}
- } else if ((chan == tsdPtr->stderrChannel) && tsdPtr->stderrInitialized) {
+ } else if (tsdPtr->stderrInitialized
+ && tsdPtr->stderrChannel != NULL
+ && statePtr == ((Channel *)tsdPtr->stderrChannel)->state) {
if (statePtr->refCount < 2) {
statePtr->refCount = 0;
tsdPtr->stderrChannel = NULL;
@@ -1004,8 +1033,9 @@ Tcl_UnregisterChannel(
if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "Illegal recursive call to close "
- "through close-handler of channel", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal recursive call to close through close-handler"
+ " of channel", -1));
}
return TCL_ERROR;
}
@@ -1240,8 +1270,8 @@ Tcl_GetChannel(
hTblPtr = GetChannelTable(interp);
hPtr = Tcl_FindHashEntry(hTblPtr, name);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "can not find channel named \"", chanName,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can not find channel named \"%s\"", chanName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, NULL);
return NULL;
}
@@ -1357,8 +1387,8 @@ Tcl_CreateChannel(
* assignments to 0/NULL below.
*/
- chanPtr = (Channel *) ckalloc(sizeof(Channel));
- statePtr = (ChannelState *) ckalloc(sizeof(ChannelState));
+ chanPtr = ckalloc(sizeof(Channel));
+ statePtr = ckalloc(sizeof(ChannelState));
chanPtr->state = statePtr;
chanPtr->instanceData = instanceData;
@@ -1438,7 +1468,7 @@ Tcl_CreateChannel(
statePtr->outputStage = NULL;
if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
- statePtr->outputStage = ckalloc((unsigned) statePtr->bufSize + 2);
+ statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
}
/*
@@ -1561,8 +1591,9 @@ Tcl_StackChannel(
if (statePtr == NULL) {
if (interp) {
- Tcl_AppendResult(interp, "couldn't find state for channel \"",
- Tcl_GetChannelName(prevChan), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't find state for channel \"%s\"",
+ Tcl_GetChannelName(prevChan)));
}
return NULL;
}
@@ -1582,9 +1613,9 @@ Tcl_StackChannel(
if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
if (interp) {
- Tcl_AppendResult(interp,
- "reading and writing both disallowed for channel \"",
- Tcl_GetChannelName(prevChan), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "reading and writing both disallowed for channel \"%s\"",
+ Tcl_GetChannelName(prevChan)));
}
return NULL;
}
@@ -1607,8 +1638,9 @@ Tcl_StackChannel(
statePtr->csPtrR = csPtrR;
statePtr->csPtrW = csPtrW;
if (interp) {
- Tcl_AppendResult(interp, "could not flush channel \"",
- Tcl_GetChannelName(prevChan), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not flush channel \"%s\"",
+ Tcl_GetChannelName(prevChan)));
}
return NULL;
}
@@ -1649,7 +1681,7 @@ Tcl_StackChannel(
statePtr->inQueueTail = NULL;
}
- chanPtr = (Channel *) ckalloc(sizeof(Channel));
+ chanPtr = ckalloc(sizeof(Channel));
/*
* Save some of the current state into the new structure, reinitialize the
@@ -1761,9 +1793,9 @@ Tcl_UnstackChannel(
*/
if (!TclChanCaughtErrorBypass(interp, chan) && interp) {
- Tcl_AppendResult(interp, "could not flush channel \"",
- Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not flush channel \"%s\"",
+ Tcl_GetChannelName((Tcl_Channel) chanPtr)));
}
return TCL_ERROR;
}
@@ -2097,12 +2129,9 @@ Tcl_GetChannelHandle(
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
if (!chanPtr->typePtr->getHandleProc) {
- Tcl_Obj *err;
-
- TclNewLiteralStringObj(err, "channel \"");
- Tcl_AppendToObj(err, Tcl_GetChannelName(chan), -1);
- Tcl_AppendToObj(err, "\" does not support OS handles", -1);
- Tcl_SetChannelError(chan, err);
+ Tcl_SetChannelError(chan, Tcl_ObjPrintf(
+ "channel \"%s\" does not support OS handles",
+ Tcl_GetChannelName(chan)));
return TCL_ERROR;
}
result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction,
@@ -2145,7 +2174,7 @@ AllocChannelBuffer(
int n;
n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
- bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
+ bufPtr = ckalloc(n);
bufPtr->nextAdded = BUFFER_PADDING;
bufPtr->nextRemoved = BUFFER_PADDING;
bufPtr->bufLength = length + BUFFER_PADDING;
@@ -2184,7 +2213,7 @@ RecycleBuffer(
*/
if (mustDiscard) {
- ckfree((char *) bufPtr);
+ ckfree(bufPtr);
return;
}
@@ -2195,7 +2224,7 @@ RecycleBuffer(
*/
if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
- ckfree((char *) bufPtr);
+ ckfree(bufPtr);
return;
}
@@ -2230,7 +2259,7 @@ RecycleBuffer(
* If we reached this code we return the buffer to the OS.
*/
- ckfree((char *) bufPtr);
+ ckfree(bufPtr);
return;
keepBuffer:
@@ -2298,8 +2327,8 @@ CheckForDeadChannel(
Tcl_SetErrno(EINVAL);
if (interp) {
- Tcl_AppendResult(interp, "unable to access channel: invalid channel",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to access channel: invalid channel", -1));
}
return 1;
}
@@ -2360,6 +2389,7 @@ FlushChannel(
* of the queued output to the channel.
*/
+ Tcl_Preserve(chanPtr);
while (1) {
/*
* If the queue is empty and there is a ready current buffer, OR if
@@ -2389,7 +2419,8 @@ FlushChannel(
*/
if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
- return 0;
+ errorCode = 0;
+ goto done;
}
/*
@@ -2441,7 +2472,7 @@ FlushChannel(
* it's a tty channel (dup'ed underneath)
*/
- if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED) && !TclInExit()) {
SetFlag(statePtr, BG_FLUSH_SCHEDULED);
UpdateInterest(chanPtr);
}
@@ -2512,7 +2543,9 @@ FlushChannel(
wroteSome = 1;
}
- bufPtr->nextRemoved += written;
+ if (!IsBufferEmpty(bufPtr)) {
+ bufPtr->nextRemoved += written;
+ }
/*
* If this buffer is now empty, recycle it.
@@ -2536,7 +2569,7 @@ FlushChannel(
if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
if (wroteSome) {
- return errorCode;
+ goto done;
} else if (statePtr->outQueueHead == NULL) {
ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
ChanWatch(chanPtr, statePtr->interestMask);
@@ -2553,7 +2586,8 @@ FlushChannel(
(statePtr->outQueueHead == NULL) &&
((statePtr->curOutPtr == NULL) ||
IsBufferEmpty(statePtr->curOutPtr))) {
- return CloseChannel(interp, chanPtr, errorCode);
+ errorCode = CloseChannel(interp, chanPtr, errorCode);
+ goto done;
}
/*
@@ -2566,8 +2600,12 @@ FlushChannel(
(statePtr->outQueueHead == NULL) &&
((statePtr->curOutPtr == NULL) ||
IsBufferEmpty(statePtr->curOutPtr))) {
- return CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE);
+ errorCode = CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE);
+ goto done;
}
+
+ done:
+ Tcl_Release(chanPtr);
return errorCode;
}
@@ -2621,7 +2659,7 @@ CloseChannel(
*/
if (statePtr->curOutPtr != NULL) {
- ckfree((char *) statePtr->curOutPtr);
+ ckfree(statePtr->curOutPtr);
statePtr->curOutPtr = NULL;
}
@@ -2679,13 +2717,13 @@ CloseChannel(
if (chanPtr == statePtr->bottomChanPtr) {
if (statePtr->channelName != NULL) {
- ckfree((char *) statePtr->channelName);
+ ckfree(statePtr->channelName);
statePtr->channelName = NULL;
}
Tcl_FreeEncoding(statePtr->encoding);
if (statePtr->outputStage != NULL) {
- ckfree((char *) statePtr->outputStage);
+ ckfree(statePtr->outputStage);
statePtr->outputStage = NULL;
}
}
@@ -3022,8 +3060,9 @@ Tcl_Close(
if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (interp) {
- Tcl_AppendResult(interp, "Illegal recursive call to close "
- "through close-handler of channel", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal recursive call to close through close-handler"
+ " of channel", -1));
}
return TCL_ERROR;
}
@@ -3068,7 +3107,7 @@ Tcl_Close(
cbPtr = statePtr->closeCbPtr;
statePtr->closeCbPtr = cbPtr->nextPtr;
cbPtr->proc(cbPtr->clientData);
- ckfree((char *) cbPtr);
+ ckfree(cbPtr);
}
ResetFlag(statePtr, CHANNEL_INCLOSE);
@@ -3181,8 +3220,9 @@ Tcl_CloseEx(
*/
if (!chanPtr->typePtr->close2Proc) {
- Tcl_AppendResult(interp, "Half-close of channels not supported by ",
- chanPtr->typePtr->typeName, "s", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "half-close of channels not supported by %ss",
+ chanPtr->typePtr->typeName));
return TCL_ERROR;
}
@@ -3191,9 +3231,8 @@ Tcl_CloseEx(
*/
if (chanPtr != statePtr->topChanPtr) {
- Tcl_AppendResult(interp,
- "Half-close not applicable to stack of transformations",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "half-close not applicable to stack of transformations", -1));
return TCL_ERROR;
}
@@ -3211,9 +3250,9 @@ Tcl_CloseEx(
} else {
msg = "write";
}
- Tcl_AppendResult(interp, "Half-close of ", msg,
- "-side not possible, side not opened or already closed",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Half-close of %s-side not possible, side not opened or"
+ " already closed", msg));
return TCL_ERROR;
}
@@ -3224,8 +3263,9 @@ Tcl_CloseEx(
if (statePtr->flags & CHANNEL_INCLOSE) {
if (interp) {
- Tcl_AppendResult(interp, "Illegal recursive call to close "
- "through close-handler of channel", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal recursive call to close through close-handler"
+ " of channel", -1));
}
return TCL_ERROR;
}
@@ -3294,10 +3334,11 @@ CloseWrite(
* interpreter */
{
/* Notes: clear-channel-handlers - write side only ? or keep around, just
- * not called */
+ * not called. */
/* No close cllbacks are run - channel is still open (read side) */
- ChannelState *statePtr = chanPtr->state; /* State of real IO channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State of real IO channel. */
int flushcode;
int result = 0;
@@ -3541,7 +3582,7 @@ Tcl_ClearChannelHandlers(
for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) {
chNext = chPtr->nextPtr;
- ckfree((char *) chPtr);
+ ckfree(chPtr);
}
statePtr->chPtr = NULL;
@@ -3568,7 +3609,7 @@ Tcl_ClearChannelHandlers(
for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) {
eNextPtr = ePtr->nextPtr;
TclDecrRefCount(ePtr->scriptPtr);
- ckfree((char *) ePtr);
+ ckfree(ePtr);
}
statePtr->scriptRecordPtr = NULL;
}
@@ -4404,14 +4445,12 @@ Tcl_Gets(
* for managing the storage. */
{
Tcl_Obj *objPtr;
- int charsStored, length;
- const char *string;
+ int charsStored;
TclNewObj(objPtr);
charsStored = Tcl_GetsObj(chan, objPtr);
if (charsStored > 0) {
- string = TclGetStringFromObj(objPtr, &length);
- Tcl_DStringAppend(lineRead, string, length);
+ TclDStringAppendObj(lineRead, objPtr);
}
TclDecrRefCount(objPtr);
return charsStored;
@@ -5447,7 +5486,7 @@ Tcl_Read(
return -1;
}
- return DoRead(chanPtr, dst, bytesToRead);
+ return DoRead(chanPtr, dst, bytesToRead, 0);
}
/*
@@ -6560,7 +6599,7 @@ DiscardInputQueued(
*/
if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) {
- ckfree((char *) statePtr->saveInBufPtr);
+ ckfree(statePtr->saveInBufPtr);
statePtr->saveInBufPtr = NULL;
}
}
@@ -6653,7 +6692,7 @@ GetInput(
if ((bufPtr != NULL)
&& (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
- ckfree((char *) bufPtr);
+ ckfree(bufPtr);
bufPtr = NULL;
}
@@ -7441,11 +7480,11 @@ Tcl_SetChannelBufferSize(
statePtr->bufSize = sz;
if (statePtr->outputStage != NULL) {
- ckfree((char *) statePtr->outputStage);
+ ckfree(statePtr->outputStage);
statePtr->outputStage = NULL;
}
if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
- statePtr->outputStage = ckalloc((unsigned) statePtr->bufSize + 2);
+ statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
}
}
@@ -7519,11 +7558,12 @@ Tcl_BadChannelOption(
const char **argv;
int argc, i;
Tcl_DString ds;
+ Tcl_Obj *errObj;
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, genericopt, -1);
if (optionList && (*optionList)) {
- Tcl_DStringAppend(&ds, " ", 1);
+ TclDStringAppendLiteral(&ds, " ");
Tcl_DStringAppend(&ds, optionList, -1);
}
if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
@@ -7531,15 +7571,16 @@ Tcl_BadChannelOption(
Tcl_Panic("malformed option list in channel driver");
}
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad option \"", optionName,
- "\": should be one of ", NULL);
+ errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ",
+ optionName);
argc--;
for (i = 0; i < argc; i++) {
- Tcl_AppendResult(interp, "-", argv[i], ", ", NULL);
+ Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
}
- Tcl_AppendResult(interp, "or -", argv[i], NULL);
+ Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]);
+ Tcl_SetObjResult(interp, errObj);
Tcl_DStringFree(&ds);
- ckfree((char *) argv);
+ ckfree(argv);
}
Tcl_SetErrno(EINVAL);
return TCL_ERROR;
@@ -7815,8 +7856,9 @@ Tcl_SetChannelOption(
if (statePtr->csPtrR || statePtr->csPtrW) {
if (interp) {
- Tcl_AppendResult(interp, "unable to set channel options: "
- "background copy in progress", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to set channel options: background copy in"
+ " progress", -1));
}
return TCL_ERROR;
}
@@ -7865,8 +7907,9 @@ Tcl_SetChannelOption(
ResetFlag(statePtr, CHANNEL_LINEBUFFERED);
SetFlag(statePtr, CHANNEL_UNBUFFERED);
} else if (interp) {
- Tcl_AppendResult(interp, "bad value for -buffering: "
- "must be one of full, line, or none", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -buffering: must be one of"
+ " full, line, or none", -1));
return TCL_ERROR;
}
return TCL_OK;
@@ -7921,10 +7964,11 @@ Tcl_SetChannelOption(
if (inValue & 0x80 || outValue & 0x80) {
if (interp) {
- Tcl_AppendResult(interp, "bad value for -eofchar: ",
- "must be non-NUL ASCII character", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -eofchar: must be non-NUL ASCII"
+ " character", -1));
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
if (GotFlag(statePtr, TCL_READABLE)) {
@@ -7935,15 +7979,15 @@ Tcl_SetChannelOption(
}
} else {
if (interp) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad value for -eofchar: should be a list of zero,"
- " one, or two elements", NULL);
+ " one, or two elements", -1));
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
if (argv != NULL) {
- ckfree((char *) argv);
+ ckfree(argv);
}
/*
@@ -7969,11 +8013,11 @@ Tcl_SetChannelOption(
writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
} else {
if (interp) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad value for -translation: must be a one or two"
- " element list", NULL);
+ " element list", -1));
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
@@ -7999,12 +8043,11 @@ Tcl_SetChannelOption(
translation = TCL_PLATFORM_TRANSLATION;
} else {
if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -translation: "
- "must be one of auto, binary, cr, lf, crlf,"
- " or platform", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -translation: must be one of "
+ "auto, binary, cr, lf, crlf, or platform", -1));
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
@@ -8050,16 +8093,15 @@ Tcl_SetChannelOption(
statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
} else {
if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -translation: "
- "must be one of auto, binary, cr, lf, crlf,"
- " or platform", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -translation: must be one of "
+ "auto, binary, cr, lf, crlf, or platform", -1));
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_OK;
} else if (chanPtr->typePtr->setOptionProc != NULL) {
return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp,
@@ -8093,7 +8135,7 @@ Tcl_SetChannelOption(
statePtr->outputStage = NULL;
}
if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
- statePtr->outputStage = ckalloc((unsigned) (statePtr->bufSize + 2));
+ statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
}
return TCL_OK;
}
@@ -8145,7 +8187,7 @@ CleanupChannelHandlers(
TclChannelEventScriptInvoker, sPtr);
TclDecrRefCount(sPtr->scriptPtr);
- ckfree((char *) sPtr);
+ ckfree(sPtr);
} else {
prevPtr = sPtr;
}
@@ -8392,8 +8434,8 @@ UpdateInterest(
mask &= ~TCL_EXCEPTION;
if (!statePtr->timer) {
- statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
- chanPtr);
+ statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+ ChannelTimerProc, chanPtr);
}
}
}
@@ -8434,7 +8476,8 @@ ChannelTimerProc(
* before UpdateInterest gets called by Tcl_NotifyChannel.
*/
- statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr);
+ statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+ ChannelTimerProc,chanPtr);
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
/*
@@ -8516,7 +8559,7 @@ Tcl_CreateChannelHandler(
}
}
if (chPtr == NULL) {
- chPtr = (ChannelHandler *) ckalloc(sizeof(ChannelHandler));
+ chPtr = ckalloc(sizeof(ChannelHandler));
chPtr->mask = 0;
chPtr->proc = proc;
chPtr->clientData = clientData;
@@ -8620,7 +8663,7 @@ Tcl_DeleteChannelHandler(
} else {
prevChPtr->nextPtr = chPtr->nextPtr;
}
- ckfree((char *) chPtr);
+ ckfree(chPtr);
/*
* Recompute the interest list for the channel, so that infinite loops
@@ -8679,7 +8722,7 @@ DeleteScriptRecord(
TclChannelEventScriptInvoker, esPtr);
TclDecrRefCount(esPtr->scriptPtr);
- ckfree((char *) esPtr);
+ ckfree(esPtr);
break;
}
@@ -8728,12 +8771,12 @@ CreateScriptRecord(
makeCH = (esPtr == NULL);
if (makeCH) {
- esPtr = (EventScriptRecord *) ckalloc(sizeof(EventScriptRecord));
+ esPtr = ckalloc(sizeof(EventScriptRecord));
}
/*
* Initialize the structure before calling Tcl_CreateChannelHandler,
- * because a reflected channel caling 'chan postevent' aka
+ * because a reflected channel calling 'chan postevent' aka
* 'Tcl_NotifyChannel' in its 'watch'Proc will invoke
* 'TclChannelEventScriptInvoker' immediately, and we do not wish it to
* see uninitialized memory and crash. See [Bug 2918110].
@@ -8796,6 +8839,7 @@ TclChannelEventScriptInvoker(
*/
Tcl_Preserve(interp);
+ Tcl_Preserve(chanPtr);
result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
/*
@@ -8812,6 +8856,7 @@ TclChannelEventScriptInvoker(
}
Tcl_BackgroundException(interp, result);
}
+ Tcl_Release(chanPtr);
Tcl_Release(interp);
}
@@ -8850,7 +8895,7 @@ Tcl_FileEventObjCmd(
int modeIndex; /* Index of mode argument. */
int mask;
static const char *const modeOptions[] = {"readable", "writable", NULL};
- static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
+ static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
@@ -8870,8 +8915,8 @@ Tcl_FileEventObjCmd(
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
if ((statePtr->flags & mask) == 0) {
- Tcl_AppendResult(interp, "channel is not ",
- (mask == TCL_READABLE) ? "readable" : "writable", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("channel is not %s",
+ (mask == TCL_READABLE) ? "readable" : "writable"));
return TCL_ERROR;
}
@@ -8915,6 +8960,33 @@ Tcl_FileEventObjCmd(
/*
*----------------------------------------------------------------------
*
+ * ZeroTransferTimerProc --
+ *
+ * Timer handler scheduled by TclCopyChannel so that -command is
+ * called asynchronously even when -size is 0.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Calls CopyData for -command invocation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ZeroTransferTimerProc(
+ ClientData clientData)
+{
+ /* calling CopyData with mask==0 still implies immediate invocation of the
+ * -command callback, and completion of the fcopy.
+ */
+ CopyData(clientData, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCopyChannel --
*
* This routine copies data from one channel to another, either
@@ -8965,15 +9037,15 @@ TclCopyChannel(
if (BUSY_STATE(inStatePtr, TCL_READABLE)) {
if (interp) {
- Tcl_AppendResult(interp, "channel \"",
- Tcl_GetChannelName(inChan), "\" is busy", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" is busy", Tcl_GetChannelName(inChan)));
}
return TCL_ERROR;
}
if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {
if (interp) {
- Tcl_AppendResult(interp, "channel \"",
- Tcl_GetChannelName(outChan), "\" is busy", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" is busy", Tcl_GetChannelName(outChan)));
}
return TCL_ERROR;
}
@@ -9015,7 +9087,7 @@ TclCopyChannel(
* completed.
*/
- csPtr = (CopyState *) ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
+ csPtr = ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
csPtr->bufSize = inStatePtr->bufSize;
csPtr->readPtr = inPtr;
csPtr->writePtr = outPtr;
@@ -9033,6 +9105,16 @@ TclCopyChannel(
outStatePtr->csPtrW = csPtr;
/*
+ * Special handling of -size 0 async transfers, so that the -command is
+ * still called asynchronously.
+ */
+
+ if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) {
+ Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr);
+ return 0;
+ }
+
+ /*
* Start copying data between the channels.
*/
@@ -9135,7 +9217,8 @@ CopyData(
}
if (inBinary || sameEncoding) {
- size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb);
+ size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
+ !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
} else {
size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
0 /* No append */);
@@ -9171,8 +9254,8 @@ CopyData(
if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) {
break;
}
- if (((!Tcl_Eof(inChan)) || (cmdPtr && (mask == 0))) &&
- !(mask & TCL_READABLE)) {
+ if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) &&
+ !(mask & TCL_READABLE)) {
if (mask & TCL_WRITABLE) {
Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
}
@@ -9374,7 +9457,8 @@ static int
DoRead(
Channel *chanPtr, /* The channel from which to read. */
char *bufPtr, /* Where to store input read. */
- int toRead) /* Maximum number of bytes to read. */
+ int toRead, /* Maximum number of bytes to read. */
+ int allowShortReads) /* Allow half-blocking (pipes,sockets) */
{
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
@@ -9415,7 +9499,10 @@ DoRead(
}
goto done;
}
- }
+ } else if (allowShortReads) {
+ copied += copiedNow;
+ break;
+ }
}
ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -9991,7 +10078,7 @@ StopCopy(
}
inStatePtr->csPtrR = NULL;
outStatePtr->csPtrW = NULL;
- ckfree((char *) csPtr);
+ ckfree(csPtr);
}
/*
@@ -10084,8 +10171,9 @@ SetBlockMode(
*/
if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
- Tcl_AppendResult(interp, "error setting blocking mode: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error setting blocking mode: %s",
+ Tcl_PosixError(interp)));
}
} else {
/*
@@ -10960,7 +11048,7 @@ FixLevelCode(
lcn += 2;
}
- lvn = (Tcl_Obj **) ckalloc(lcn * sizeof(Tcl_Obj *));
+ lvn = ckalloc(lcn * sizeof(Tcl_Obj *));
/*
* New level/code information is spliced into the first occurence of
@@ -11013,7 +11101,7 @@ FixLevelCode(
msg = Tcl_NewListObj(j, lvn);
- ckfree((char *) lvn);
+ ckfree(lvn);
return msg;
}
@@ -11160,6 +11248,9 @@ SetChannelFromAny(
ChannelState *statePtr;
Interp *interpPtr;
+ if (interp == NULL) {
+ return TCL_ERROR;
+ }
if (objPtr->typePtr == &tclChannelType) {
/*
* The channel is valid until any call to DetachChannel occurs.
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 5ff855f..1e89878 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclIO.h,v 1.17 2010/03/20 15:39:46 dkf Exp $
*/
/*
@@ -65,13 +63,13 @@ typedef struct ChannelBuffer {
int bufLength; /* How big is the buffer? */
struct ChannelBuffer *nextPtr;
/* Next buffer in chain. */
- char buf[4]; /* Placeholder for real buffer. The real
- * buffer occuppies this space + bufSize-4
+ char buf[1]; /* Placeholder for real buffer. The real
+ * buffer occuppies this space + bufSize-1
* bytes. This must be the last field in the
* structure. */
} ChannelBuffer;
-#define CHANNELBUFFER_HEADER_SIZE (sizeof(ChannelBuffer) - 4)
+#define CHANNELBUFFER_HEADER_SIZE TclOffset(ChannelBuffer, buf)
/*
* How much extra space to allocate in buffer to hold bytes from previous
@@ -425,6 +423,13 @@ typedef struct GetsState {
* appended to objPtr so far, just before the
* last call to FilterInputBytes(). */
} GetsState;
+
+/*
+ * The length of time to wait between synthetic timer events. Must be zero or
+ * bad things tend to happen.
+ */
+
+#define SYNTHETIC_EVENT_TIME 0
/*
* Local Variables:
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 696b3ac..005713d 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclIOCmd.c,v 1.69 2010/08/22 18:53:26 nijtmans Exp $
*/
#include "tclInt.h"
@@ -18,8 +16,8 @@
*/
typedef struct AcceptCallback {
- char *script; /* Script to invoke. */
- Tcl_Interp *interp; /* Interpreter in which to run it. */
+ char *script; /* Script to invoke. */
+ Tcl_Interp *interp; /* Interpreter in which to run it. */
} AcceptCallback;
/*
@@ -119,12 +117,12 @@ Tcl_PutsObjCmd(
ThreadSpecificData *tsdPtr;
switch (objc) {
- case 2: /* [puts $x] */
+ case 2: /* [puts $x] */
string = objv[1];
newline = 1;
break;
- case 3: /* [puts -nonewline $x] or [puts $chan $x] */
+ case 3: /* [puts -nonewline $x] or [puts $chan $x] */
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
newline = 0;
} else {
@@ -134,35 +132,30 @@ Tcl_PutsObjCmd(
string = objv[2];
break;
- case 4: /* [puts -nonewline $chan $x] or [puts $chan $x nonewline] */
+ case 4: /* [puts -nonewline $chan $x] or
+ * [puts $chan $x nonewline] */
+ newline = 0;
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
chanObjPtr = objv[2];
string = objv[3];
- } else {
+ break;
+#if TCL_MAJOR_VERSION < 9
+ } else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
/*
* The code below provides backwards compatibility with an old
* form of the command that is no longer recommended or
- * documented.
+ * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
+ * maybe even earlier.
*/
- const char *arg;
- int length;
-
- arg = TclGetStringFromObj(objv[3], &length);
- if ((length != 9)
- || (strncmp(arg, "nonewline", (size_t) length) != 0)) {
- Tcl_AppendResult(interp, "bad argument \"", arg,
- "\": should be \"nonewline\"", NULL);
- return TCL_ERROR;
- }
chanObjPtr = objv[1];
string = objv[2];
+ break;
+#endif
}
- newline = 0;
- break;
-
- default:
- /* [puts] or [puts some bad number of arguments...] */
+ /* Fall through */
+ default: /* [puts] or
+ * [puts some bad number of arguments...] */
Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
return TCL_ERROR;
}
@@ -181,9 +174,10 @@ Tcl_PutsObjCmd(
if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
- "\" wasn't opened for writing", NULL);
+ if (!(mode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for writing",
+ TclGetString(chanObjPtr)));
return TCL_ERROR;
}
@@ -208,9 +202,8 @@ Tcl_PutsObjCmd(
error:
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_AppendResult(interp, "error writing \"",
- TclGetString(chanObjPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
+ TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -252,9 +245,10 @@ Tcl_FlushObjCmd(
if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
- "\" wasn't opened for writing", NULL);
+ if (!(mode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for writing",
+ TclGetString(chanObjPtr)));
return TCL_ERROR;
}
@@ -267,9 +261,9 @@ Tcl_FlushObjCmd(
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_AppendResult(interp, "error flushing \"",
- TclGetString(chanObjPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error flushing \"%s\": %s",
+ TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -314,9 +308,10 @@ Tcl_GetsObjCmd(
if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
- "\" wasn't opened for reading", NULL);
+ if (!(mode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for reading",
+ TclGetString(chanObjPtr)));
return TCL_ERROR;
}
@@ -327,17 +322,16 @@ Tcl_GetsObjCmd(
Tcl_DecrRefCount(linePtr);
/*
- * TIP #219. Capture error messages put by the driver into the
- * bypass area and put them into the regular interpreter result.
- * Fall back to the regular message if nothing was found in the
- * bypass.
+ * TIP #219.
+ * Capture error messages put by the driver into the bypass area
+ * and put them into the regular interpreter result. Fall back to
+ * the regular message if nothing was found in the bypass.
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error reading \"",
- TclGetString(chanObjPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading \"%s\": %s",
+ TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -349,7 +343,6 @@ Tcl_GetsObjCmd(
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
- return TCL_OK;
} else {
Tcl_SetObjResult(interp, linePtr);
}
@@ -420,33 +413,41 @@ Tcl_ReadObjCmd(
if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
- "\" wasn't opened for reading", NULL);
+ if (!(mode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for reading",
+ TclGetString(chanObjPtr)));
return TCL_ERROR;
}
- i++; /* Consumed channel name. */
+ i++; /* Consumed channel name. */
/*
- * Compute how many bytes to read, and see whether the final newline
- * should be dropped.
+ * Compute how many bytes to read.
*/
toRead = -1;
if (i < objc) {
- const char *arg;
+ if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
+ || (toRead < 0)) {
+#if TCL_MAJOR_VERSION < 9
+ /*
+ * The code below provides backwards compatibility with an old
+ * form of the command that is no longer recommended or
+ * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
+ * maybe even earlier.
+ */
- arg = TclGetString(objv[i]);
- if (isdigit(UCHAR(arg[0]))) { /* INTL: digit */
- if (TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) {
+ if (strcmp(TclGetString(objv[i]), "nonewline") != 0) {
+#endif
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected non-negative integer but got \"%s\"",
+ TclGetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
return TCL_ERROR;
+#if TCL_MAJOR_VERSION < 9
}
- } else if (strcmp(arg, "nonewline") == 0) {
newline = 1;
- } else {
- Tcl_AppendResult(interp, "bad argument \"", arg,
- "\": should be \"nonewline\"", NULL);
- return TCL_ERROR;
+#endif
}
}
@@ -462,10 +463,9 @@ Tcl_ReadObjCmd(
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error reading \"",
- TclGetString(chanObjPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading \"%s\": %s",
+ TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
@@ -523,7 +523,7 @@ Tcl_SeekObjCmd(
static const char *const originOptions[] = {
"start", "current", "end", NULL
};
- static int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
+ static const int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?");
@@ -552,10 +552,11 @@ Tcl_SeekObjCmd(
* put them into the regular interpreter result. Fall back to the
* regular message if nothing was found in the bypass.
*/
+
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_AppendResult(interp, "error during seek on \"",
- TclGetString(objv[1]), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error during seek on \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -646,6 +647,10 @@ Tcl_CloseObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to close. */
+ static const char *const dirOptions[] = {
+ "read", "write", NULL
+ };
+ static const int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?");
@@ -657,21 +662,17 @@ Tcl_CloseObjCmd(
}
if (objc == 3) {
- int optionIndex, dir;
- static const char *const dirOptions[] = {
- "read", "write", NULL
- };
- static int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};
+ int index, dir;
/*
* Get direction requested to close, and check syntax.
*/
if (Tcl_GetIndexFromObj(interp, objv[2], dirOptions, "direction", 0,
- &optionIndex) != TCL_OK) {
+ &index) != TCL_OK) {
return TCL_ERROR;
}
- dir = dirArray[optionIndex];
+ dir = dirArray[index];
/*
* Check direction against channel mode. It is an error if we try to
@@ -680,10 +681,9 @@ Tcl_CloseObjCmd(
*/
if (!(dir & Tcl_GetChannelMode(chan))) {
- Tcl_AppendResult(interp, "Half-close of ",
- dirOptions[optionIndex],
- "-side not possible, side not opened or already closed",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Half-close of %s-side not possible, side not opened"
+ " or already closed", dirOptions[index]));
return TCL_ERROR;
}
@@ -760,8 +760,7 @@ Tcl_FconfigureObjCmd(
int i; /* Iterate over arg-value pairs. */
if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "channelId ?-option value ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId ?-option value ...?");
return TCL_ERROR;
}
@@ -872,14 +871,9 @@ Tcl_ExecObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- /*
- * This function generates an argv array for the string arguments. It
- * starts out with stack-allocated space but uses dynamically-allocated
- * storage if needed.
- */
-
Tcl_Obj *resultPtr;
- const char **argv;
+ const char **argv; /* An array for the string arguments. Stored
+ * on the _Tcl_ stack. */
const char *string;
Tcl_Channel chan;
int argc, background, i, index, keepNewline, result, skip, length;
@@ -937,8 +931,7 @@ Tcl_ExecObjCmd(
*/
argc = objc - skip;
- argv = (const char **)
- TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
+ argv = TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
/*
* Copy the string conversions of each (post option) object into the
@@ -950,7 +943,7 @@ Tcl_ExecObjCmd(
}
argv[argc] = NULL;
chan = Tcl_OpenCommandChannel(interp, argc, argv, (background ? 0 :
- (ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR)));
+ ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR));
/*
* Free the argv array.
@@ -986,9 +979,9 @@ Tcl_ExecObjCmd(
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error reading output from command: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading output from command: %s",
+ Tcl_PosixError(interp)));
Tcl_DecrRefCount(resultPtr);
}
return TCL_ERROR;
@@ -1057,9 +1050,10 @@ Tcl_FblockedObjCmd(
if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
- "\" wasn't opened for reading", NULL);
+ if (!(mode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for reading",
+ TclGetString(objv[1])));
return TCL_ERROR;
}
@@ -1110,11 +1104,13 @@ Tcl_OpenObjCmd(
int code = TCL_ERROR;
int scanned = TclParseAllWhiteSpace(permString, -1);
- /* Support legacy octal numbers */
+ /*
+ * Support legacy octal numbers.
+ */
+
if ((permString[scanned] == '0')
&& (permString[scanned+1] >= '0')
&& (permString[scanned+1] <= '7')) {
-
Tcl_Obj *permObj;
TclNewLiteralStringObj(permObj, "0o");
@@ -1175,13 +1171,13 @@ Tcl_OpenObjCmd(
Tcl_SetChannelOption(interp, chan, "-translation", "binary");
}
}
- ckfree((char *) cmdArgv);
+ ckfree(cmdArgv);
}
if (chan == NULL) {
return TCL_ERROR;
}
Tcl_RegisterChannel(interp, chan);
- Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
return TCL_OK;
}
@@ -1224,7 +1220,7 @@ TcpAcceptCallbacksDeleteProc(
acceptCallbackPtr->interp = NULL;
}
Tcl_DeleteHashTable(hTblPtr);
- ckfree((char *) hTblPtr);
+ ckfree(hTblPtr);
}
/*
@@ -1261,13 +1257,12 @@ RegisterTcpServerInterpCleanup(
Tcl_HashEntry *hPtr; /* Entry for this record. */
int isNew; /* Is the entry new? */
- hTblPtr = (Tcl_HashTable *)
- Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
+ hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
if (hTblPtr == NULL) {
- hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
+ hTblPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
- (void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
+ Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
TcpAcceptCallbacksDeleteProc, hTblPtr);
}
@@ -1308,8 +1303,7 @@ UnregisterTcpServerInterpCleanupProc(
Tcl_HashTable *hTblPtr;
Tcl_HashEntry *hPtr;
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
- "tclTCPAcceptCallbacks", NULL);
+ hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
if (hTblPtr == NULL) {
return;
}
@@ -1347,7 +1341,7 @@ AcceptCallbackProc(
char *address, /* Address of client that was accepted. */
int port) /* Port of client that was accepted. */
{
- AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
+ AcceptCallback *acceptCallbackPtr = callbackData;
/*
* Check if the callback is still valid; the interpreter may have gone
@@ -1392,8 +1386,8 @@ AcceptCallbackProc(
Tcl_Release(script);
} else {
/*
- * The interpreter has been deleted, so there is no useful way to
- * utilize the client socket - just close it.
+ * The interpreter has been deleted, so there is no useful way to use
+ * the client socket - just close it.
*/
Tcl_Close(NULL, chan);
@@ -1426,7 +1420,7 @@ TcpServerCloseProc(
ClientData callbackData) /* The data passed in the call to
* Tcl_CreateCloseHandler. */
{
- AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
+ AcceptCallback *acceptCallbackPtr = callbackData;
/* The actual data. */
if (acceptCallbackPtr->interp != NULL) {
@@ -1434,7 +1428,7 @@ TcpServerCloseProc(
acceptCallbackPtr);
}
Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC);
- ckfree((char *) acceptCallbackPtr);
+ ckfree(acceptCallbackPtr);
}
/*
@@ -1488,8 +1482,8 @@ Tcl_SocketObjCmd(
switch ((enum socketOptions) optionIndex) {
case SKT_ASYNC:
if (server == 1) {
- Tcl_AppendResult(interp,
- "cannot set -async option for server sockets", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot set -async option for server sockets", -1));
return TCL_ERROR;
}
async = 1;
@@ -1497,8 +1491,8 @@ Tcl_SocketObjCmd(
case SKT_MYADDR:
a++;
if (a >= objc) {
- Tcl_AppendResult(interp,
- "no argument given for -myaddr option", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -myaddr option", -1));
return TCL_ERROR;
}
myaddr = TclGetString(objv[a]);
@@ -1508,8 +1502,8 @@ Tcl_SocketObjCmd(
a++;
if (a >= objc) {
- Tcl_AppendResult(interp,
- "no argument given for -myport option", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -myport option", -1));
return TCL_ERROR;
}
myPortName = TclGetString(objv[a]);
@@ -1520,15 +1514,15 @@ Tcl_SocketObjCmd(
}
case SKT_SERVER:
if (async == 1) {
- Tcl_AppendResult(interp,
- "cannot set -async option for server sockets", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot set -async option for server sockets", -1));
return TCL_ERROR;
}
server = 1;
a++;
if (a >= objc) {
- Tcl_AppendResult(interp,
- "no argument given for -server option", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -server option", -1));
return TCL_ERROR;
}
script = TclGetString(objv[a]);
@@ -1540,8 +1534,8 @@ Tcl_SocketObjCmd(
if (server) {
host = myaddr; /* NULL implies INADDR_ANY */
if (myport != 0) {
- Tcl_AppendResult(interp, "option -myport is not valid for servers",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "option -myport is not valid for servers", -1));
return TCL_ERROR;
}
} else if (a < objc) {
@@ -1570,8 +1564,8 @@ Tcl_SocketObjCmd(
}
if (server) {
- AcceptCallback *acceptCallbackPtr = (AcceptCallback *)
- ckalloc((unsigned) sizeof(AcceptCallback));
+ AcceptCallback *acceptCallbackPtr =
+ ckalloc(sizeof(AcceptCallback));
unsigned len = strlen(script) + 1;
char *copyScript = ckalloc(len);
@@ -1582,7 +1576,7 @@ Tcl_SocketObjCmd(
acceptCallbackPtr);
if (chan == NULL) {
ckfree(copyScript);
- ckfree((char *) acceptCallbackPtr);
+ ckfree(acceptCallbackPtr);
return TCL_ERROR;
}
@@ -1608,9 +1602,9 @@ Tcl_SocketObjCmd(
return TCL_ERROR;
}
}
- Tcl_RegisterChannel(interp, chan);
- Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
+ Tcl_RegisterChannel(interp, chan);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
return TCL_OK;
}
@@ -1660,17 +1654,19 @@ Tcl_FcopyObjCmd(
if (TclGetChannelFromObj(interp, objv[1], &inChan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
- "\" wasn't opened for reading", NULL);
+ if (!(mode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for reading",
+ TclGetString(objv[1])));
return TCL_ERROR;
}
if (TclGetChannelFromObj(interp, objv[2], &outChan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(objv[2]),
- "\" wasn't opened for writing", NULL);
+ if (!(mode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for writing",
+ TclGetString(objv[2])));
return TCL_ERROR;
}
@@ -1754,14 +1750,14 @@ ChanPendingObjCmd(
switch ((enum options) index) {
case PENDING_INPUT:
- if ((mode & TCL_READABLE) == 0) {
+ if (!(mode & TCL_READABLE)) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
} else {
Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_InputBuffered(chan)));
}
break;
case PENDING_OUTPUT:
- if ((mode & TCL_WRITABLE) == 0) {
+ if (!(mode & TCL_WRITABLE)) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
} else {
Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_OutputBuffered(chan)));
@@ -1815,8 +1811,8 @@ ChanTruncateObjCmd(
return TCL_ERROR;
}
if (length < 0) {
- Tcl_AppendResult(interp,
- "cannot truncate to negative length of file", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot truncate to negative length of file", -1));
return TCL_ERROR;
}
} else {
@@ -1826,18 +1822,17 @@ ChanTruncateObjCmd(
length = Tcl_Tell(chan);
if (length == Tcl_WideAsLong(-1)) {
- Tcl_AppendResult(interp,
- "could not determine current location in \"",
- TclGetString(objv[1]), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not determine current location in \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
}
if (Tcl_TruncateChannel(chan, length) != TCL_OK) {
- Tcl_AppendResult(interp, "error during truncate on \"",
- TclGetString(objv[1]), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error during truncate on \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -1898,6 +1893,39 @@ ChanPipeObjCmd(
/*
*----------------------------------------------------------------------
*
+ * TclChannelNamesCmd --
+ *
+ * This function is invoked to process the "chan names" and "file
+ * channels" Tcl commands. See the user documentation for details on
+ * what they do.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChannelNamesCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ if (objc < 1 || objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+ return TCL_ERROR;
+ }
+ return Tcl_GetChannelNamesEx(interp,
+ ((objc == 1) ? NULL : TclGetString(objv[1])));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclInitChanCmd --
*
* This function is invoked to create the "chan" Tcl command. See the
@@ -1924,29 +1952,29 @@ TclInitChanCmd(
* function at the moment.
*/
static const EnsembleImplMap initMap[] = {
- {"blocked", Tcl_FblockedObjCmd, NULL, NULL, NULL},
- {"close", Tcl_CloseObjCmd, NULL, NULL, NULL},
- {"copy", Tcl_FcopyObjCmd, NULL, NULL, NULL},
- {"create", TclChanCreateObjCmd, NULL, NULL, NULL}, /* TIP #219 */
- {"eof", Tcl_EofObjCmd, NULL, NULL, NULL},
- {"event", Tcl_FileEventObjCmd, NULL, NULL, NULL},
- {"flush", Tcl_FlushObjCmd, NULL, NULL, NULL},
- {"gets", Tcl_GetsObjCmd, NULL, NULL, NULL},
- {"pending", ChanPendingObjCmd, NULL, NULL, NULL}, /* TIP #287 */
- {"pop", TclChanPopObjCmd, NULL, NULL, NULL}, /* TIP #230 */
- {"postevent", TclChanPostEventObjCmd, NULL, NULL, NULL}, /* TIP #219 */
- {"push", TclChanPushObjCmd, NULL, NULL, NULL}, /* TIP #230 */
- {"puts", Tcl_PutsObjCmd, NULL, NULL, NULL},
- {"read", Tcl_ReadObjCmd, NULL, NULL, NULL},
- {"seek", Tcl_SeekObjCmd, NULL, NULL, NULL},
- {"pipe", ChanPipeObjCmd, NULL, NULL, NULL}, /* TIP #304 */
- {"tell", Tcl_TellObjCmd, NULL, NULL, NULL},
- {"truncate", ChanTruncateObjCmd, NULL, NULL, NULL}, /* TIP #208 */
- {NULL, NULL, NULL, NULL, NULL}
+ {"blocked", Tcl_FblockedObjCmd, NULL, NULL, NULL, 0},
+ {"close", Tcl_CloseObjCmd, NULL, NULL, NULL, 0},
+ {"copy", Tcl_FcopyObjCmd, NULL, NULL, NULL, 0},
+ {"create", TclChanCreateObjCmd, NULL, NULL, NULL, 0}, /* TIP #219 */
+ {"eof", Tcl_EofObjCmd, NULL, NULL, NULL, 0},
+ {"event", Tcl_FileEventObjCmd, NULL, NULL, NULL, 0},
+ {"flush", Tcl_FlushObjCmd, NULL, NULL, NULL, 0},
+ {"gets", Tcl_GetsObjCmd, NULL, NULL, NULL, 0},
+ {"names", TclChannelNamesCmd, NULL, NULL, NULL, 0},
+ {"pending", ChanPendingObjCmd, NULL, NULL, NULL, 0}, /* TIP #287 */
+ {"pop", TclChanPopObjCmd, NULL, NULL, NULL, 0}, /* TIP #230 */
+ {"postevent", TclChanPostEventObjCmd, NULL, NULL, NULL, 0}, /* TIP #219 */
+ {"push", TclChanPushObjCmd, NULL, NULL, NULL, 0}, /* TIP #230 */
+ {"puts", Tcl_PutsObjCmd, NULL, NULL, NULL, 0},
+ {"read", Tcl_ReadObjCmd, NULL, NULL, NULL, 0},
+ {"seek", Tcl_SeekObjCmd, NULL, NULL, NULL, 0},
+ {"pipe", ChanPipeObjCmd, NULL, NULL, NULL, 0}, /* TIP #304 */
+ {"tell", Tcl_TellObjCmd, NULL, NULL, NULL, 0},
+ {"truncate", ChanTruncateObjCmd, NULL, NULL, NULL, 0}, /* TIP #208 */
+ {NULL, NULL, NULL, NULL, NULL, 0}
};
static const char *const extras[] = {
"configure", "::fconfigure",
- "names", "::file channels",
NULL
};
Tcl_Command ensemble;
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 1935a3d..bfe6a10 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * CVS: $Id: tclIOGT.c,v 1.22 2010/01/10 22:58:40 nijtmans Exp $
*/
#include "tclInt.h"
@@ -261,7 +259,7 @@ TclChannelTransform(
* regime of the underlying channel and to use the same for us too.
*/
- dataPtr = (TransformChannelData *) ckalloc(sizeof(TransformChannelData));
+ dataPtr = ckalloc(sizeof(TransformChannelData));
Tcl_DStringInit(&ds);
Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
@@ -286,11 +284,11 @@ TclChannelTransform(
dataPtr->self = Tcl_StackChannel(interp, &transformChannelType, dataPtr,
mode, chan);
if (dataPtr->self == NULL) {
- Tcl_AppendResult(interp, "\nfailed to stack channel \"",
- Tcl_GetChannelName(chan), "\"", NULL);
+ Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp),
+ "\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan));
Tcl_DecrRefCount(dataPtr->command);
ResultClear(&dataPtr->result);
- ckfree((char *) dataPtr);
+ ckfree(dataPtr);
return TCL_ERROR;
}
@@ -563,7 +561,7 @@ TransformCloseProc(
ResultClear(&dataPtr->result);
Tcl_DecrRefCount(dataPtr->command);
- ckfree((char *) dataPtr);
+ ckfree(dataPtr);
return TCL_OK;
}
@@ -1229,7 +1227,7 @@ ResultClear(
r->used = 0;
if (r->allocated) {
- ckfree((char *) r->buf);
+ ckfree(r->buf);
r->buf = NULL;
r->allocated = 0;
}
@@ -1373,10 +1371,10 @@ ResultAdd(
if (r->allocated == 0) {
r->allocated = toWrite + INCREMENT;
- r->buf = UCHARP(ckalloc(r->allocated));
+ r->buf = ckalloc(r->allocated);
} else {
r->allocated += toWrite + INCREMENT;
- r->buf = UCHARP(ckrealloc((char *) r->buf, r->allocated));
+ r->buf = ckrealloc(r->buf, r->allocated);
}
}
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index b8c248b..cb0282a 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -14,8 +14,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclIORChan.c,v 1.50 2010/08/04 16:49:02 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -41,6 +39,9 @@ static int ReflectOutput(ClientData clientData, const char *buf,
int toWrite, int *errorCodePtr);
static void ReflectWatch(ClientData clientData, int mask);
static int ReflectBlock(ClientData clientData, int mode);
+#ifdef TCL_THREADS
+static void ReflectThread(ClientData clientData, int action);
+#endif
static Tcl_WideInt ReflectSeekWide(ClientData clientData,
Tcl_WideInt offset, int mode, int *errorCodePtr);
static int ReflectSeek(ClientData clientData, long offset,
@@ -73,7 +74,11 @@ static const Tcl_ChannelType tclRChannelType = {
NULL, /* Flush channel. Not used by core. NULL'able */
NULL, /* Handle events. NULL'able */
ReflectSeekWide, /* Move access point (64 bit). NULL'able */
+#ifdef TCL_THREADS
+ ReflectThread, /* thread action, tracking owner */
+#else
NULL, /* thread action */
+#endif
NULL /* truncate */
};
@@ -91,7 +96,8 @@ typedef struct {
* command is gone.
*/
#ifdef TCL_THREADS
- Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
+ Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
+ Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
#endif
/* See [==] as well.
@@ -123,6 +129,9 @@ typedef struct {
int interest; /* Mask of events the channel is interested
* in. */
+ int dead; /* Boolean signal that some operations
+ * should no longer be attempted. */
+
/*
* Note regarding the usage of timers.
*
@@ -389,31 +398,31 @@ TCL_DECLARE_MUTEX(rcForwardMutex)
* leak resources when threads go away.
*/
-static void ForwardOpToOwnerThread(ReflectedChannel *rcPtr,
+static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr,
ForwardedOperation op, const void *param);
static int ForwardProc(Tcl_Event *evPtr, int mask);
static void SrcExitProc(ClientData clientData);
#define FreeReceivedError(p) \
- if ((p)->base.mustFree) { \
- ckfree((p)->base.msgStr); \
+ if ((p)->base.mustFree) { \
+ ckfree((p)->base.msgStr); \
}
#define PassReceivedErrorInterp(i,p) \
- if ((i) != NULL) { \
- Tcl_SetChannelErrorInterp((i), \
- Tcl_NewStringObj((p)->base.msgStr, -1)); \
- } \
+ if ((i) != NULL) { \
+ Tcl_SetChannelErrorInterp((i), \
+ Tcl_NewStringObj((p)->base.msgStr, -1)); \
+ } \
FreeReceivedError(p)
#define PassReceivedError(c,p) \
Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \
FreeReceivedError(p)
#define ForwardSetStaticError(p,emsg) \
- (p)->base.code = TCL_ERROR; \
- (p)->base.mustFree = 0; \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 0; \
(p)->base.msgStr = (char *) (emsg)
#define ForwardSetDynamicError(p,emsg) \
- (p)->base.code = TCL_ERROR; \
- (p)->base.mustFree = 1; \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 1; \
(p)->base.msgStr = (char *) (emsg)
static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr);
@@ -441,6 +450,7 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj);
static Tcl_Obj * NextHandle(void);
static void FreeReflectedChannel(ReflectedChannel *rcPtr);
+static void FreeReflectedChannelArgs(ReflectedChannel *rcPtr);
static int InvokeTclMethod(ReflectedChannel *rcPtr,
const char *method, Tcl_Obj *argOneObj,
Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
@@ -607,11 +617,9 @@ TclChanCreateObjCmd(
*/
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
- Tcl_AppendObjToObj(err, resObj);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned non-list: %s",
+ Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -635,42 +643,37 @@ TclChanCreateObjCmd(
Tcl_DecrRefCount(resObj);
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" does not support all required methods", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" does not support all required methods",
+ Tcl_GetString(cmdObj)));
goto error;
}
if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" lacks a \"read\" method", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" lacks a \"read\" method",
+ Tcl_GetString(cmdObj)));
goto error;
}
if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" lacks a \"write\" method", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" lacks a \"write\" method",
+ Tcl_GetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"cget\" but not \"cgetall\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"cget\" but not \"cgetall\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"cgetall\" but not \"cget\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
@@ -689,8 +692,7 @@ TclChanCreateObjCmd(
* as the actual channel type.
*/
- Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)
- ckalloc(sizeof(Tcl_ChannelType));
+ Tcl_ChannelType *clonePtr = ckalloc(sizeof(Tcl_ChannelType));
memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType));
@@ -737,7 +739,8 @@ TclChanCreateObjCmd(
* Return handle as result of command.
*/
- Tcl_SetResult(interp, (char *)chanPtr->state->channelName, TCL_VOLATILE);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(chanPtr->state->channelName, -1));
return TCL_OK;
error:
@@ -771,6 +774,50 @@ TclChanCreateObjCmd(
*----------------------------------------------------------------------
*/
+typedef struct ReflectEvent {
+ Tcl_Event header;
+ ReflectedChannel *rcPtr;
+ int events;
+} ReflectEvent;
+
+static int
+ReflectEventRun(
+ Tcl_Event *ev,
+ int flags)
+{
+ /* OWNER thread
+ *
+ * Note: When the channel is closed any pending events of this type are
+ * deleted. See ReflectClose() for the Tcl_DeleteEvents() calls
+ * accomplishing that.
+ */
+
+ ReflectEvent *e = (ReflectEvent *) ev;
+
+ Tcl_NotifyChannel(e->rcPtr->chan, e->events);
+ return 1;
+}
+
+static int
+ReflectEventDelete(
+ Tcl_Event *ev,
+ ClientData cd)
+{
+ /* OWNER thread
+ *
+ * Invoked by DeleteThreadReflectedChannelMap() and ReflectClose(). The
+ * latter ensures that no pending events of this type are run on an
+ * invalid channel.
+ */
+
+ ReflectEvent *e = (ReflectEvent *) ev;
+
+ if ((ev->proc != ReflectEventRun) || ((cd != NULL) && (cd != e->rcPtr))) {
+ return 0;
+ }
+ return 1;
+}
+
int
TclChanPostEventObjCmd(
ClientData clientData,
@@ -779,6 +826,8 @@ TclChanPostEventObjCmd(
Tcl_Obj *const *objv)
{
/*
+ * Ensure -> HANDLER thread
+ *
* Syntax: chan postevent CHANNEL EVENTSPEC
* [0] [1] [2] [3]
*
@@ -821,8 +870,8 @@ TclChanPostEventObjCmd(
hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "can not find reflected channel named \"",
- chanId, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can not find reflected channel named \"%s\"", chanId));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, NULL);
return TCL_ERROR;
}
@@ -879,8 +928,9 @@ TclChanPostEventObjCmd(
*/
if (events & ~rcPtr->interest) {
- Tcl_AppendResult(interp, "tried to post events channel \"", chanId,
- "\" is not interested in", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "tried to post events channel \"%s\" is not interested in",
+ chanId));
return TCL_ERROR;
}
@@ -888,7 +938,44 @@ TclChanPostEventObjCmd(
* We have the channel and the events to post.
*/
- Tcl_NotifyChannel(chan, events);
+#ifdef TCL_THREADS
+ if (rcPtr->owner == rcPtr->thread) {
+#endif
+ Tcl_NotifyChannel(chan, events);
+#ifdef TCL_THREADS
+ } else {
+ ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));
+
+ ev->header.proc = ReflectEventRun;
+ ev->events = events;
+ ev->rcPtr = rcPtr;
+
+ /*
+ * We are not preserving the structure here. When the channel is
+ * closed any pending events are deleted, see ReflectClose(), and
+ * ReflectEventDelete(). Trying to preserve and later release when the
+ * event is run may generate a situation where the channel structure
+ * is deleted but not our structure, crashing in
+ * FreeReflectedChannel().
+ *
+ * Force creation of the RCM, for proper cleanup on thread teardown.
+ * The teardown of unprocessed events is currently coupled to the
+ * thread reflected channel map
+ */
+
+ (void) GetThreadReflectedChannelMap();
+
+ /* XXX Race condition !!
+ * XXX The destination thread may not exist anymore already.
+ * XXX (Delayed postevent executed after channel got removed).
+ * XXX Can we detect this ? (check the validity of the owner threadid ?)
+ * XXX Actually, in that case the channel should be dead also !
+ */
+
+ Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL);
+ Tcl_ThreadAlert(rcPtr->owner);
+ }
+#endif
/*
* Squash interp results left by the event script.
@@ -1073,22 +1160,22 @@ ReflectClose(
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
- ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
result = p.base.code;
- /*
- * FreeReflectedChannel is done in the forwarded operation!, in
- * the other thread. rcPtr here is gone!
- */
+ /*
+ * Now squash the pending reflection events for this channel.
+ */
+
+ Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
if (result != TCL_OK) {
FreeReceivedError(&p);
}
- return EOK;
}
#endif
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return EOK;
}
@@ -1100,7 +1187,7 @@ ReflectClose(
*/
if (rcPtr->methods == 0) {
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return EOK;
}
@@ -1112,13 +1199,16 @@ ReflectClose(
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
- ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
result = p.base.code;
- /*
- * FreeReflectedChannel is done in the forwarded operation!, in the
- * other thread. rcPtr here is gone!
- */
+ /*
+ * Now squash the pending reflection events for this channel.
+ */
+
+ Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
+
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
if (result != TCL_OK) {
PassReceivedErrorInterp(interp, &p);
@@ -1146,7 +1236,7 @@ ReflectClose(
* the per-interp DeleteReflectedChannelMap exit-handler.
*/
- if (rcPtr->interp) {
+ if (!rcPtr->dead) {
rcmPtr = GetReflectedChannelMap(rcPtr->interp);
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
Tcl_GetChannelName(rcPtr->chan));
@@ -1163,7 +1253,7 @@ ReflectClose(
}
#endif
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
#ifdef TCL_THREADS
}
#endif
@@ -1222,7 +1312,7 @@ ReflectInput(
p.input.buf = buf;
p.input.toRead = toRead;
- ForwardOpToOwnerThread(rcPtr, ForwardedInput, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p);
if (p.base.code != TCL_OK) {
if (p.base.code < 0) {
@@ -1271,7 +1361,7 @@ ReflectInput(
*errorCodePtr = EOK;
if (bytec > 0) {
- memcpy(buf, bytev, (size_t)bytec);
+ memcpy(buf, bytev, (size_t) bytec);
}
stop:
@@ -1337,7 +1427,7 @@ ReflectOutput(
p.output.buf = buf;
p.output.toWrite = toWrite;
- ForwardOpToOwnerThread(rcPtr, ForwardedOutput, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p);
if (p.base.code != TCL_OK) {
if (p.base.code < 0) {
@@ -1453,7 +1543,7 @@ ReflectSeekWide(
p.seek.seekMode = seekMode;
p.seek.offset = offset;
- ForwardOpToOwnerThread(rcPtr, ForwardedSeek, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p);
if (p.base.code != TCL_OK) {
PassReceivedError(rcPtr->chan, &p);
@@ -1472,12 +1562,13 @@ ReflectSeekWide(
Tcl_Preserve(rcPtr);
offObj = Tcl_NewWideIntObj(offset);
- baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ? "start" :
- ((seekMode == SEEK_CUR) ? "current" : "end"), -1);
+ baseObj = Tcl_NewStringObj(
+ (seekMode == SEEK_SET) ? "start" :
+ (seekMode == SEEK_CUR) ? "current" : "end", -1);
Tcl_IncrRefCount(offObj);
Tcl_IncrRefCount(baseObj);
- if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK) {
+ if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj) != TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, resObj);
goto invalid;
}
@@ -1577,7 +1668,7 @@ ReflectWatch(
ForwardParam p;
p.watch.mask = mask;
- ForwardOpToOwnerThread(rcPtr, ForwardedWatch, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p);
/*
* Any failure from the forward is ignored. We have no place to put
@@ -1635,7 +1726,7 @@ ReflectBlock(
p.block.nonblocking = nonblocking;
- ForwardOpToOwnerThread(rcPtr, ForwardedBlock, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p);
if (p.base.code != TCL_OK) {
PassReceivedError(rcPtr->chan, &p);
@@ -1665,6 +1756,44 @@ ReflectBlock(
return errorNum;
}
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectThread --
+ *
+ * This function is invoked to tell the channel about thread movements.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReflectThread(
+ ClientData clientData,
+ int action)
+{
+ ReflectedChannel *rcPtr = clientData;
+
+ switch (action) {
+ case TCL_CHANNEL_THREAD_INSERT:
+ rcPtr->owner = Tcl_GetCurrentThread();
+ break;
+ case TCL_CHANNEL_THREAD_REMOVE:
+ rcPtr->owner = NULL;
+ break;
+ default:
+ Tcl_Panic("Unknown thread action code.");
+ break;
+ }
+}
+
+#endif
/*
*----------------------------------------------------------------------
*
@@ -1704,7 +1833,7 @@ ReflectSetOption(
p.setOpt.name = optionName;
p.setOpt.value = newValue;
- ForwardOpToOwnerThread(rcPtr, ForwardedSetOpt, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p);
if (p.base.code != TCL_OK) {
Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
@@ -1790,7 +1919,7 @@ ReflectGetOption(
opcode = ForwardedGetOpt;
}
- ForwardOpToOwnerThread(rcPtr, opcode, &p);
+ ForwardOpToHandlerThread(rcPtr, opcode, &p);
if (p.base.code != TCL_OK) {
Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
@@ -1834,7 +1963,7 @@ ReflectGetOption(
*/
if (optionObj != NULL) {
- Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1);
+ TclDStringAppendObj(dsPtr, resObj);
goto ok;
}
@@ -1869,7 +1998,7 @@ ReflectGetOption(
const char *str = Tcl_GetStringFromObj(resObj, &len);
if (len) {
- Tcl_DStringAppend(dsPtr, " ", 1);
+ TclDStringAppendLiteral(dsPtr, " ");
Tcl_DStringAppend(dsPtr, str, len);
}
goto ok;
@@ -1933,7 +2062,8 @@ EncodeEventMask(
}
if (listc < 1) {
- Tcl_AppendResult(interp, "bad ", objName, " list: is empty", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad %s list: is empty", objName));
return TCL_ERROR;
}
@@ -2032,7 +2162,7 @@ NewReflectedChannel(
int i, listc;
Tcl_Obj **listv;
- rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));
+ rcPtr = ckalloc(sizeof(ReflectedChannel));
/* rcPtr->chan: Assigned by caller. Dummy data here. */
/* rcPtr->methods: Assigned by caller. Dummy data here. */
@@ -2040,6 +2170,7 @@ NewReflectedChannel(
rcPtr->chan = NULL;
rcPtr->methods = 0;
rcPtr->interp = interp;
+ rcPtr->dead = 0;
#ifdef TCL_THREADS
rcPtr->thread = Tcl_GetCurrentThread();
#endif
@@ -2065,7 +2196,7 @@ NewReflectedChannel(
*/
rcPtr->argc = listc + 2;
- rcPtr->argv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (listc+4));
+ rcPtr->argv = ckalloc(sizeof(Tcl_Obj *) * (listc+4));
/*
* Duplicate object references.
@@ -2140,21 +2271,14 @@ NextHandle(void)
}
static void
-FreeReflectedChannel(
+FreeReflectedChannelArgs(
ReflectedChannel *rcPtr)
{
- Channel *chanPtr = (Channel *) rcPtr->chan;
- int i, n;
-
- if (chanPtr->typePtr != &tclRChannelType) {
- /*
- * Delete a cloned ChannelType structure.
- */
+ int i, n = rcPtr->argc - 2;
- ckfree((char *) chanPtr->typePtr);
+ if (n < 0) {
+ return;
}
-
- n = rcPtr->argc - 2;
for (i=0; i<n; i++) {
Tcl_DecrRefCount(rcPtr->argv[i]);
}
@@ -2165,8 +2289,28 @@ FreeReflectedChannel(
Tcl_DecrRefCount(rcPtr->argv[n+1]);
- ckfree((char *) rcPtr->argv);
- ckfree((char *) rcPtr);
+ rcPtr->argc = 1;
+}
+
+static void
+FreeReflectedChannel(
+ ReflectedChannel *rcPtr)
+{
+ Channel *chanPtr = (Channel *) rcPtr->chan;
+
+ if (chanPtr->typePtr != &tclRChannelType) {
+ /*
+ * Delete a cloned ChannelType structure.
+ */
+
+ ckfree(chanPtr->typePtr);
+ chanPtr->typePtr = NULL;
+ }
+
+ FreeReflectedChannelArgs(rcPtr);
+
+ ckfree(rcPtr->argv);
+ ckfree(rcPtr);
}
/*
@@ -2207,7 +2351,7 @@ InvokeTclMethod(
int result; /* Result code of method invokation */
Tcl_Obj *resObj = NULL; /* Result of method invokation. */
- if (!rcPtr->interp) {
+ if (rcPtr->dead) {
/*
* The channel is marked as dead. Bail out immediately, with an
* appropriate error.
@@ -2371,7 +2515,7 @@ ErrnoReturn(
int code;
Tcl_InterpState sr; /* State of handler interp */
- if (!rcPtr->interp) {
+ if (rcPtr->dead) {
return 0;
}
@@ -2383,7 +2527,7 @@ ErrnoReturn(
if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
|| (code >= 0))) {
if (strcmp("EAGAIN", Tcl_GetString(resObj)) == 0) {
- code = - EAGAIN;
+ code = -EAGAIN;
} else {
code = 0;
}
@@ -2417,7 +2561,7 @@ GetReflectedChannelMap(
ReflectedChannelMap *rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL);
if (rcmPtr == NULL) {
- rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap));
+ rcmPtr = ckalloc(sizeof(ReflectedChannelMap));
Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS);
Tcl_SetAssocData(interp, RCMKEY,
(Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr);
@@ -2480,11 +2624,11 @@ DeleteReflectedChannelMap(
chan = Tcl_GetHashValue(hPtr);
rcPtr = Tcl_GetChannelInstanceData(chan);
- rcPtr->interp = NULL;
+ rcPtr->dead = 1;
Tcl_DeleteHashEntry(hPtr);
}
Tcl_DeleteHashTable(&rcmPtr->map);
- ckfree((char *) &rcmPtr->map);
+ ckfree(&rcmPtr->map);
#ifdef TCL_THREADS
/*
@@ -2516,6 +2660,11 @@ DeleteReflectedChannelMap(
*/
evPtr = resultPtr->evPtr;
+
+ /* Basic crash safety until this routine can get revised [3411310] */
+ if (evPtr == NULL) {
+ continue;
+ }
paramPtr = evPtr->param;
evPtr->resultPtr = NULL;
@@ -2526,6 +2675,7 @@ DeleteReflectedChannelMap(
Tcl_ConditionNotify(&resultPtr->done);
}
+ Tcl_MutexUnlock(&rcForwardMutex);
/*
* Get the map of all channels handled by the current thread. This is a
@@ -2549,10 +2699,10 @@ DeleteReflectedChannelMap(
continue;
}
+ rcPtr->dead = 1;
+ FreeReflectedChannelArgs(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
-
- Tcl_MutexUnlock(&rcForwardMutex);
#endif
}
@@ -2580,8 +2730,7 @@ GetThreadReflectedChannelMap(void)
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->rcmPtr) {
- tsdPtr->rcmPtr = (ReflectedChannelMap *)
- ckalloc(sizeof(ReflectedChannelMap));
+ tsdPtr->rcmPtr = ckalloc(sizeof(ReflectedChannelMap));
Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
}
@@ -2651,6 +2800,11 @@ DeleteThreadReflectedChannelMap(
*/
evPtr = resultPtr->evPtr;
+
+ /* Basic crash safety until this routine can get revised [3411310] */
+ if (evPtr == NULL ) {
+ continue;
+ }
paramPtr = evPtr->param;
evPtr->resultPtr = NULL;
@@ -2661,6 +2815,16 @@ DeleteThreadReflectedChannelMap(
Tcl_ConditionNotify(&resultPtr->done);
}
+ Tcl_MutexUnlock(&rcForwardMutex);
+
+ /*
+ * Run over the event queue of this thread and remove all ReflectEvent's
+ * still pending. These are inbound events for reflected channels this
+ * thread owns but doesn't handle. The inverse of the channel map
+ * actually.
+ */
+
+ Tcl_DeleteEvents(ReflectEventDelete, NULL);
/*
* Get the map of all channels handled by the current thread. This is a
@@ -2675,23 +2839,27 @@ DeleteThreadReflectedChannelMap(
Tcl_Channel chan = Tcl_GetHashValue(hPtr);
ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);
- rcPtr->interp = NULL;
+ rcPtr->dead = 1;
+ FreeReflectedChannelArgs(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
-
- Tcl_MutexUnlock(&rcForwardMutex);
+ ckfree(rcmPtr);
}
static void
-ForwardOpToOwnerThread(
+ForwardOpToHandlerThread(
ReflectedChannel *rcPtr, /* Channel instance */
ForwardedOperation op, /* Forwarded driver operation */
const void *param) /* Arguments */
{
+ /*
+ * Core of the communication from OWNER to HANDLER thread.
+ * The receiver is ForwardProc() below.
+ */
+
Tcl_ThreadId dst = rcPtr->thread;
ForwardingEvent *evPtr;
ForwardingResult *resultPtr;
- int result;
/*
* We gather the lock early. This allows us to check the liveness of the
@@ -2700,7 +2868,7 @@ ForwardOpToOwnerThread(
Tcl_MutexLock(&rcForwardMutex);
- if (rcPtr->interp == NULL) {
+ if (rcPtr->dead) {
/*
* The channel is marked as dead. Bail out immediately, with an
* appropriate error. Do not forget to unlock the mutex on this path.
@@ -2715,8 +2883,8 @@ ForwardOpToOwnerThread(
* Create and initialize the event and data structures.
*/
- evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent));
- resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult));
+ evPtr = ckalloc(sizeof(ForwardingEvent));
+ resultPtr = ckalloc(sizeof(ForwardingResult));
evPtr->event.proc = ForwardProc;
evPtr->resultPtr = resultPtr;
@@ -2741,7 +2909,7 @@ ForwardOpToOwnerThread(
/*
* Ensure cleanup of the event if the origin thread exits while this event
* is pending or in progress. Exit of the destination thread is handled by
- * DeleteThreadReflectionChannelMap(), this is set up by
+ * DeleteThreadReflectedChannelMap(), this is set up by
* GetThreadReflectedChannelMap(). This is what we use the 'forwardList'
* (see above) for.
*/
@@ -2756,7 +2924,7 @@ ForwardOpToOwnerThread(
Tcl_ThreadAlert(dst);
/*
- * (*) Block until the other thread has either processed the transfer or
+ * (*) Block until the handler thread has either processed the transfer or
* rejected it.
*/
@@ -2795,8 +2963,7 @@ ForwardOpToOwnerThread(
Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);
- result = resultPtr->result;
- ckfree((char *) resultPtr);
+ ckfree(resultPtr);
}
static int
@@ -2805,6 +2972,11 @@ ForwardProc(
int mask)
{
/*
+ * HANDLER thread.
+
+ * The receiver part for the operations coming from the OWNER thread.
+ * See ForwardOpToHandlerThread() for the transmitter.
+ *
* Notes regarding access to the referenced data.
*
* In principle the data belongs to the originating thread (see
@@ -2823,9 +2995,8 @@ ForwardProc(
Tcl_Interp *interp = rcPtr->interp;
ForwardParam *paramPtr = evPtr->param;
Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */
- ReflectedChannelMap *rcmPtr;
- /* Map of reflected channels with handlers in
- * this interp. */
+ ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
+ * this interp. */
Tcl_HashEntry *hPtr; /* Entry in the above map */
/*
@@ -2868,15 +3039,15 @@ ForwardProc(
rcmPtr = GetReflectedChannelMap(interp);
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
- Tcl_GetChannelName(rcPtr->chan));
+ Tcl_GetChannelName(rcPtr->chan));
Tcl_DeleteHashEntry(hPtr);
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
- Tcl_GetChannelName(rcPtr->chan));
+ Tcl_GetChannelName(rcPtr->chan));
Tcl_DeleteHashEntry(hPtr);
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+ FreeReflectedChannelArgs(rcPtr);
break;
case ForwardedInput: {
@@ -2908,7 +3079,7 @@ ForwardProc(
paramPtr->input.toRead = -1;
} else {
if (bytec > 0) {
- memcpy(paramPtr->input.buf, bytev, (size_t)bytec);
+ memcpy(paramPtr->input.buf, bytev, (size_t) bytec);
}
paramPtr->input.toRead = bytec;
}
@@ -2920,7 +3091,7 @@ ForwardProc(
case ForwardedOutput: {
Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
- paramPtr->output.buf, paramPtr->output.toWrite);
+ paramPtr->output.buf, paramPtr->output.toWrite);
Tcl_IncrRefCount(bufObj);
Tcl_Preserve(rcPtr);
@@ -2941,7 +3112,9 @@ ForwardProc(
int written;
if (Tcl_GetIntFromObj(interp, resObj, &written) != TCL_OK) {
- ForwardSetObjError(paramPtr, MarshallError(interp));
+ Tcl_DecrRefCount(resObj);
+ resObj = MarshallError(interp);
+ ForwardSetObjError(paramPtr, resObj);
paramPtr->output.toWrite = -1;
} else if (written==0 || paramPtr->output.toWrite<written) {
ForwardSetStaticError(paramPtr, msg_write_toomuch);
@@ -2958,8 +3131,8 @@ ForwardProc(
case ForwardedSeek: {
Tcl_Obj *offObj = Tcl_NewWideIntObj(paramPtr->seek.offset);
Tcl_Obj *baseObj = Tcl_NewStringObj(
- (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
- (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);
+ (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
+ (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);
Tcl_IncrRefCount(offObj);
Tcl_IncrRefCount(baseObj);
@@ -2984,7 +3157,9 @@ ForwardProc(
paramPtr->seek.offset = newLoc;
}
} else {
- ForwardSetObjError(paramPtr, MarshallError(interp));
+ Tcl_DecrRefCount(resObj);
+ resObj = MarshallError(interp);
+ ForwardSetObjError(paramPtr, resObj);
paramPtr->seek.offset = -1;
}
}
@@ -3007,11 +3182,11 @@ ForwardProc(
case ForwardedBlock: {
Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);
- Tcl_IncrRefCount(blockObj);
+ Tcl_IncrRefCount(blockObj);
Tcl_Preserve(rcPtr);
if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL,
- &resObj) != TCL_OK) {
+ &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
Tcl_Release(rcPtr);
@@ -3027,7 +3202,7 @@ ForwardProc(
Tcl_IncrRefCount(valueObj);
Tcl_Preserve(rcPtr);
if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj,
- &resObj) != TCL_OK) {
+ &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
Tcl_Release(rcPtr);
@@ -3042,14 +3217,13 @@ ForwardProc(
*/
Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);
- Tcl_IncrRefCount(optionObj);
+ Tcl_IncrRefCount(optionObj);
Tcl_Preserve(rcPtr);
if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
ForwardSetObjError(paramPtr, resObj);
} else {
- Tcl_DStringAppend(paramPtr->getOpt.value,
- TclGetString(resObj), -1);
+ TclDStringAppendObj(paramPtr->getOpt.value, resObj);
}
Tcl_Release(rcPtr);
Tcl_DecrRefCount(optionObj);
@@ -3074,8 +3248,10 @@ ForwardProc(
Tcl_Obj **listv;
if (Tcl_ListObjGetElements(interp, resObj, &listc,
- &listv) != TCL_OK) {
- ForwardSetObjError(paramPtr, MarshallError(interp));
+ &listv) != TCL_OK) {
+ Tcl_DecrRefCount(resObj);
+ resObj = MarshallError(interp);
+ ForwardSetObjError(paramPtr, resObj);
} else if ((listc % 2) == 1) {
/*
* Odd number of elements is wrong. [x].
@@ -3092,7 +3268,7 @@ ForwardProc(
const char *str = Tcl_GetStringFromObj(resObj, &len);
if (len) {
- Tcl_DStringAppend(paramPtr->getOpt.value, " ", 1);
+ TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
}
}
@@ -3191,7 +3367,7 @@ ForwardSetObjError(
const char *msgStr = Tcl_GetStringFromObj(obj, &len);
len++;
- ForwardSetDynamicError(paramPtr, ckalloc((unsigned) len));
+ ForwardSetDynamicError(paramPtr, ckalloc(len));
memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 54b73c0..2b9efb9 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -14,8 +14,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclIORTrans.c,v 1.18 2010/08/04 16:49:02 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -163,6 +161,8 @@ typedef struct {
int mode; /* Mask of R/W mode */
int nonblocking; /* Flag: Channel is blocking or not. */
int readIsDrained; /* Flag: Read buffers are flushed. */
+ int dead; /* Boolean signal that some operations
+ * should no longer be attempted. */
ResultBuffer result;
} ReflectedTransform;
@@ -363,33 +363,43 @@ static int ForwardProc(Tcl_Event *evPtr, int mask);
static void SrcExitProc(ClientData clientData);
#define FreeReceivedError(p) \
- if ((p)->base.mustFree) { \
- ckfree((p)->base.msgStr); \
- }
+ do { \
+ if ((p)->base.mustFree) { \
+ ckfree((p)->base.msgStr); \
+ } \
+ } while (0)
#define PassReceivedErrorInterp(i,p) \
- if ((i) != NULL) { \
- Tcl_SetChannelErrorInterp((i), \
- Tcl_NewStringObj((p)->base.msgStr, -1)); \
- } \
- FreeReceivedError(p)
+ do { \
+ if ((i) != NULL) { \
+ Tcl_SetChannelErrorInterp((i), \
+ Tcl_NewStringObj((p)->base.msgStr, -1)); \
+ } \
+ FreeReceivedError(p); \
+ } while (0)
#define PassReceivedError(c,p) \
- Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \
- FreeReceivedError(p)
+ do { \
+ Tcl_SetChannelError((c), \
+ Tcl_NewStringObj((p)->base.msgStr, -1)); \
+ FreeReceivedError(p); \
+ } while (0)
#define ForwardSetStaticError(p,emsg) \
- (p)->base.code = TCL_ERROR; \
- (p)->base.mustFree = 0; \
- (p)->base.msgStr = (char *) (emsg)
+ do { \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 0; \
+ (p)->base.msgStr = (char *) (emsg); \
+ } while (0)
#define ForwardSetDynamicError(p,emsg) \
- (p)->base.code = TCL_ERROR; \
- (p)->base.mustFree = 1; \
- (p)->base.msgStr = (char *) (emsg)
+ do { \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 1; \
+ (p)->base.msgStr = (char *) (emsg); \
+ } while (0)
static void ForwardSetObjError(ForwardParam *p,
Tcl_Obj *objPtr);
-
static ReflectedTransformMap * GetThreadReflectedTransformMap(void);
-static void DeleteThreadReflectedTransformMap(ClientData clientData);
-
+static void DeleteThreadReflectedTransformMap(
+ ClientData clientData);
#endif /* TCL_THREADS */
#define SetChannelErrorStr(c,msgStr) \
@@ -409,6 +419,7 @@ static ReflectedTransform * NewReflectedTransform(Tcl_Interp *interp,
Tcl_Channel parentChan);
static Tcl_Obj * NextHandle(void);
static void FreeReflectedTransform(ReflectedTransform *rtPtr);
+static void FreeReflectedTransformArgs(ReflectedTransform *rtPtr);
static int InvokeTclMethod(ReflectedTransform *rtPtr,
const char *method, Tcl_Obj *argOneObj,
Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
@@ -438,13 +449,6 @@ static const char *msg_dstlost =
*/
/*
- * Number of milliseconds to wait before firing an event to try to flush out
- * information waiting in buffers (fileevent support).
- */
-
-#define FLUSH_DELAY (5)
-
-/*
* Helper functions encapsulating some of the thread forwarding to make the
* control flow in callers easier.
*/
@@ -519,7 +523,6 @@ TclChanPushObjCmd(
int result; /* Result code for 'initialize' */
Tcl_Obj *resObj; /* Result data for 'initialize' */
int methods; /* Bitmask for supported methods. */
- Tcl_Obj *err; /* Error message */
ReflectedTransformMap *rtmPtr;
/* Map of reflected transforms with handlers
* in this interp. */
@@ -603,11 +606,9 @@ TclChanPushObjCmd(
*/
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
- Tcl_AppendObjToObj(err, resObj);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned non-list: %s",
+ Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -616,11 +617,10 @@ TclChanPushObjCmd(
while (listc > 0) {
if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
"method", TCL_EXACT, &methIndex) != TCL_OK) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, " initialize\" returned ", -1);
- Tcl_AppendObjToObj(err, Tcl_GetObjResult(interp));
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned %s",
+ Tcl_GetString(cmdObj),
+ Tcl_GetString(Tcl_GetObjResult(interp))));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -631,10 +631,9 @@ TclChanPushObjCmd(
Tcl_DecrRefCount(resObj);
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" does not support all required methods", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" does not support all required methods",
+ Tcl_GetString(cmdObj)));
goto error;
}
@@ -654,10 +653,9 @@ TclChanPushObjCmd(
}
if (!mode) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" makes the channel inacessible", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" makes the channel inaccessible",
+ Tcl_GetString(cmdObj)));
goto error;
}
@@ -666,18 +664,16 @@ TclChanPushObjCmd(
*/
if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"drain\" but not \"read\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"drain\" but not \"read\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"flush\" but not \"write\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"flush\" but not \"write\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
@@ -707,13 +703,14 @@ TclChanPushObjCmd(
rtmPtr = GetThreadReflectedTransformMap();
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
Tcl_SetHashValue(hPtr, rtPtr);
-#endif
+#endif /* TCL_THREADS */
/*
* Return the channel as the result of the command.
*/
- Tcl_AppendResult(interp, Tcl_GetChannelName(rtPtr->chan), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_GetChannelName(rtPtr->chan), -1));
return TCL_OK;
error:
@@ -722,7 +719,7 @@ TclChanPushObjCmd(
* structure.
*/
- Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+ Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
return TCL_ERROR;
#undef CHAN
@@ -889,7 +886,8 @@ ReflectClose(
Tcl_Interp *interp)
{
ReflectedTransform *rtPtr = clientData;
- int result; /* Result code for 'close' */
+ int errorCode, errorCodeSet = 0;
+ int result = TCL_OK; /* Result code for 'close' */
Tcl_Obj *resObj; /* Result data for 'close' */
ReflectedTransformMap *rtmPtr;
/* Map of reflected transforms with handlers
@@ -920,19 +918,13 @@ ReflectClose(
ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
result = p.base.code;
- /*
- * FreeReflectedTransform is done in the forwarded operation!, in
- * the other thread. rtPtr here is gone!
- */
-
if (result != TCL_OK) {
FreeReceivedError(&p);
}
- return EOK;
}
-#endif
+#endif /* TCL_THREADS */
- Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+ Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
return EOK;
}
@@ -945,18 +937,30 @@ ReflectClose(
*/
if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
- int errorCode;
-
if (!TransformDrain(rtPtr, &errorCode)) {
- return errorCode;
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ Tcl_EventuallyFree(rtPtr,
+ (Tcl_FreeProc *) FreeReflectedTransform);
+ return errorCode;
+ }
+#endif /* TCL_THREADS */
+ errorCodeSet = 1;
+ goto cleanup;
}
}
if (HAS(rtPtr->methods, METH_FLUSH)) {
- int errorCode;
-
if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
- return errorCode;
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ Tcl_EventuallyFree(rtPtr,
+ (Tcl_FreeProc *) FreeReflectedTransform);
+ return errorCode;
+ }
+#endif /* TCL_THREADS */
+ errorCodeSet = 1;
+ goto cleanup;
}
}
@@ -971,10 +975,7 @@ ReflectClose(
ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
result = p.base.code;
- /*
- * FreeReflectedTransform is done in the forwarded operation!, in the
- * other thread. rtPtr here is gone!
- */
+ Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
if (result != TCL_OK) {
PassReceivedErrorInterp(interp, &p);
@@ -982,7 +983,7 @@ ReflectClose(
}
return EOK;
}
-#endif
+#endif /* TCL_THREADS */
/*
* Do the actual invokation of "finalize" now; we're in the right thread.
@@ -996,6 +997,8 @@ ReflectClose(
Tcl_DecrRefCount(resObj); /* Remove reference we held from the
* invoke. */
+ cleanup:
+
/*
* Remove the transform from the map before releasing the memory, to
* prevent future accesses from finding and dereferencing a dangling
@@ -1009,30 +1012,30 @@ ReflectClose(
* the per-interp DeleteReflectedTransformMap exit-handler.
*/
- if (rtPtr->interp) {
+ if (!rtPtr->dead) {
rtmPtr = GetReflectedTransformMap(rtPtr->interp);
hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
if (hPtr) {
Tcl_DeleteHashEntry(hPtr);
}
- }
- /*
- * In a threaded interpreter we manage a per-thread map as well, to allow
- * us to survive if the script level pulls the rug out under a channel by
- * deleting the owning thread.
- */
+ /*
+ * In a threaded interpreter we manage a per-thread map as well,
+ * to allow us to survive if the script level pulls the rug out
+ * under a channel by deleting the owning thread.
+ */
#ifdef TCL_THREADS
- rtmPtr = GetThreadReflectedTransformMap();
- hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
- if (hPtr) {
- Tcl_DeleteHashEntry(hPtr);
+ rtmPtr = GetThreadReflectedTransformMap();
+ hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
+ if (hPtr) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+#endif /* TCL_THREADS */
}
-#endif
Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
- return (result == TCL_OK) ? EOK : EINVAL;
+ return errorCodeSet ? errorCode : ((result == TCL_OK) ? EOK : EINVAL);
}
/*
@@ -1229,7 +1232,7 @@ ReflectInput(
*
* ReflectOutput --
*
- * This function is invoked when data is writen to the channel.
+ * This function is invoked when data is written to the channel.
*
* Results:
* The number of bytes actually written.
@@ -1354,7 +1357,7 @@ ReflectSeekWide(
* transformation.
*/
- if ((rtPtr->methods & FLAG(METH_CLEAR))) {
+ if (rtPtr->methods & FLAG(METH_CLEAR)) {
TransformClear(rtPtr);
}
@@ -1753,7 +1756,7 @@ NewReflectedTransform(
Tcl_Obj **listv;
int i;
- rtPtr = (ReflectedTransform *) ckalloc(sizeof(ReflectedTransform));
+ rtPtr = ckalloc(sizeof(ReflectedTransform));
/* rtPtr->chan: Assigned by caller. Dummy data here. */
/* rtPtr->methods: Assigned by caller. Dummy data here. */
@@ -1772,6 +1775,7 @@ NewReflectedTransform(
rtPtr->readIsDrained = 0;
rtPtr->nonblocking =
(((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING);
+ rtPtr->dead = 0;
/*
* Query parent for current blocking mode.
@@ -1798,7 +1802,7 @@ NewReflectedTransform(
*/
rtPtr->argc = listc + 2;
- rtPtr->argv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (listc+4));
+ rtPtr->argv = ckalloc(sizeof(Tcl_Obj *) * (listc+4));
/*
* Duplicate object references.
@@ -1872,18 +1876,18 @@ NextHandle(void)
}
static void
-FreeReflectedTransform(
+FreeReflectedTransformArgs(
ReflectedTransform *rtPtr)
{
- int i, n;
+ int i, n = rtPtr->argc - 2;
- TimerKill(rtPtr);
- ResultClear(&rtPtr->result);
+ if (n < 0) {
+ return;
+ }
Tcl_DecrRefCount(rtPtr->handle);
rtPtr->handle = NULL;
- n = rtPtr->argc - 2;
for (i=0; i<n; i++) {
Tcl_DecrRefCount(rtPtr->argv[i]);
}
@@ -1894,8 +1898,20 @@ FreeReflectedTransform(
*/
Tcl_DecrRefCount(rtPtr->argv[n+1]);
- ckfree((char*) rtPtr->argv);
- ckfree((char*) rtPtr);
+ rtPtr->argc = 1;
+}
+
+static void
+FreeReflectedTransform(
+ ReflectedTransform *rtPtr)
+{
+ TimerKill(rtPtr);
+ ResultClear(&rtPtr->result);
+
+ FreeReflectedTransformArgs(rtPtr);
+
+ ckfree(rtPtr->argv);
+ ckfree(rtPtr);
}
/*
@@ -1939,7 +1955,7 @@ InvokeTclMethod(
int result; /* Result code of method invokation */
Tcl_Obj *resObj = NULL; /* Result of method invokation. */
- if (!rtPtr->interp) {
+ if (rtPtr->dead) {
/*
* The transform is marked as dead. Bail out immediately, with an
* appropriate error.
@@ -2092,8 +2108,7 @@ GetReflectedTransformMap(
ReflectedTransformMap *rtmPtr = Tcl_GetAssocData(interp, RTMKEY, NULL);
if (rtmPtr == NULL) {
- rtmPtr = (ReflectedTransformMap *)
- ckalloc(sizeof(ReflectedTransformMap));
+ rtmPtr = ckalloc(sizeof(ReflectedTransformMap));
Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS);
Tcl_SetAssocData(interp, RTMKEY,
(Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr);
@@ -2134,7 +2149,7 @@ DeleteReflectedTransformMap(
ForwardingResult *resultPtr;
ForwardingEvent *evPtr;
ForwardParam *paramPtr;
-#endif
+#endif /* TCL_THREADS */
/*
* Delete all entries. The channels may have been closed already, or will
@@ -2153,11 +2168,12 @@ DeleteReflectedTransformMap(
hPtr != NULL;
hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
rtPtr = Tcl_GetHashValue(hPtr);
- rtPtr->interp = NULL;
+
+ rtPtr->dead = 1;
Tcl_DeleteHashEntry(hPtr);
}
Tcl_DeleteHashTable(&rtmPtr->map);
- ckfree((char *) &rtmPtr->map);
+ ckfree(&rtmPtr->map);
#ifdef TCL_THREADS
/*
@@ -2165,6 +2181,32 @@ DeleteReflectedTransformMap(
*/
/*
+ * Get the map of all channels handled by the current thread. This is a
+ * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
+ * through the channels and remove all which were handled by this
+ * interpreter. They have already been marked as dead.
+ */
+
+ rtmPtr = GetThreadReflectedTransformMap();
+ for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
+ hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+ rtPtr = Tcl_GetHashValue(hPtr);
+
+ if (rtPtr->interp != interp) {
+ /*
+ * Ignore entries for other interpreters.
+ */
+
+ continue;
+ }
+
+ rtPtr->dead = 1;
+ FreeReflectedTransformArgs(rtPtr);
+ Tcl_DeleteHashEntry(hPtr);
+ }
+
+ /*
* Go through the list of pending results and cancel all whose events were
* destined for this interpreter. While this is in progress we block any
* other access to the list of pending results.
@@ -2198,33 +2240,8 @@ DeleteReflectedTransformMap(
Tcl_ConditionNotify(&resultPtr->done);
}
-
- /*
- * Get the map of all channels handled by the current thread. This is a
- * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
- * through the channels and remove all which were handled by this
- * interpreter. They have already been marked as dead.
- */
-
- rtmPtr = GetThreadReflectedTransformMap();
- for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
- hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- rtPtr = Tcl_GetHashValue(hPtr);
-
- if (rtPtr->interp != interp) {
- /*
- * Ignore entries for other interpreters.
- */
-
- continue;
- }
-
- Tcl_DeleteHashEntry(hPtr);
- }
-
Tcl_MutexUnlock(&rtForwardMutex);
-#endif
+#endif /* TCL_THREADS */
}
#ifdef TCL_THREADS
@@ -2251,8 +2268,7 @@ GetThreadReflectedTransformMap(void)
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->rtmPtr) {
- tsdPtr->rtmPtr = (ReflectedTransformMap *)
- ckalloc(sizeof(ReflectedTransformMap));
+ tsdPtr->rtmPtr = ckalloc(sizeof(ReflectedTransformMap));
Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS);
Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL);
}
@@ -2295,6 +2311,24 @@ DeleteThreadReflectedTransformMap(
*/
/*
+ * Get the map of all channels handled by the current thread. This is a
+ * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
+ * through the channels, remove all, mark them as dead.
+ */
+
+ rtmPtr = GetThreadReflectedTransformMap();
+ for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
+ hPtr != NULL;
+ hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
+ ReflectedTransform *rtPtr = Tcl_GetHashValue(hPtr);
+
+ rtPtr->dead = 1;
+ FreeReflectedTransformArgs(rtPtr);
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ ckfree(rtmPtr);
+
+ /*
* Go through the list of pending results and cancel all whose events were
* destined for this thread. While this is in progress we block any
* other access to the list of pending results.
@@ -2331,23 +2365,6 @@ DeleteThreadReflectedTransformMap(
Tcl_ConditionNotify(&resultPtr->done);
}
-
- /*
- * Get the map of all channels handled by the current thread. This is a
- * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
- * through the channels, remove all, mark them as dead.
- */
-
- rtmPtr = GetThreadReflectedTransformMap();
- for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
- hPtr != NULL;
- hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
- ReflectedTransform *rtPtr = Tcl_GetHashValue(hPtr);
-
- rtPtr->interp = NULL;
- Tcl_DeleteHashEntry(hPtr);
- }
-
Tcl_MutexUnlock(&rtForwardMutex);
}
@@ -2360,7 +2377,6 @@ ForwardOpToOwnerThread(
Tcl_ThreadId dst = rtPtr->thread;
ForwardingEvent *evPtr;
ForwardingResult *resultPtr;
- int result;
/*
* We gather the lock early. This allows us to check the liveness of the
@@ -2369,7 +2385,7 @@ ForwardOpToOwnerThread(
Tcl_MutexLock(&rtForwardMutex);
- if (rtPtr->interp == NULL) {
+ if (rtPtr->dead) {
/*
* The channel is marked as dead. Bail out immediately, with an
* appropriate error. Do not forget to unlock the mutex on this path.
@@ -2384,8 +2400,8 @@ ForwardOpToOwnerThread(
* Create and initialize the event and data structures.
*/
- evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent));
- resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult));
+ evPtr = ckalloc(sizeof(ForwardingEvent));
+ resultPtr = ckalloc(sizeof(ForwardingResult));
evPtr->event.proc = ForwardProc;
evPtr->resultPtr = resultPtr;
@@ -2395,6 +2411,7 @@ ForwardOpToOwnerThread(
resultPtr->src = Tcl_GetCurrentThread();
resultPtr->dst = dst;
+ resultPtr->dsti = rtPtr->interp;
resultPtr->done = NULL;
resultPtr->result = -1;
resultPtr->evPtr = evPtr;
@@ -2464,8 +2481,7 @@ ForwardOpToOwnerThread(
Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);
- result = resultPtr->result;
- ckfree((char*) resultPtr);
+ ckfree(resultPtr);
}
static int
@@ -2552,7 +2568,7 @@ ForwardProc(
hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
Tcl_DeleteHashEntry(hPtr);
- Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+ FreeReflectedTransformArgs(rtPtr);
break;
case ForwardedInput: {
@@ -2623,7 +2639,7 @@ ForwardProc(
break;
}
- case ForwardedDrain: {
+ case ForwardedDrain:
if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->transform.size = -1;
@@ -2648,9 +2664,8 @@ ForwardProc(
}
}
break;
- }
- case ForwardedFlush: {
+ case ForwardedFlush:
if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->transform.size = -1;
@@ -2676,12 +2691,10 @@ ForwardProc(
}
}
break;
- }
- case ForwardedClear: {
+ case ForwardedClear:
(void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
break;
- }
case ForwardedLimit:
if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) {
@@ -2784,10 +2797,10 @@ ForwardSetObjError(
const char *msgStr = Tcl_GetStringFromObj(obj, &len);
len++;
- ForwardSetDynamicError(paramPtr, ckalloc((unsigned) len));
+ ForwardSetDynamicError(paramPtr, ckalloc(len));
memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
-#endif
+#endif /* TCL_THREADS */
/*
*----------------------------------------------------------------------
@@ -2846,7 +2859,8 @@ TimerSetup(
return;
}
- rtPtr->timer = Tcl_CreateTimerHandler(FLUSH_DELAY, TimerRun, rtPtr);
+ rtPtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+ TimerRun, rtPtr);
}
/*
@@ -3083,7 +3097,7 @@ TransformRead(
ckfree(p.transform.buf);
return 1;
}
-#endif
+#endif /* TCL_THREADS */
/* ASSERT: rtPtr->method & FLAG(METH_READ) */
/* ASSERT: rtPtr->mode & TCL_READABLE */
@@ -3144,7 +3158,7 @@ TransformWrite(
p.transform.size);
ckfree(p.transform.buf);
} else
-#endif
+#endif /* TCL_THREADS */
{
/* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
/* ASSERT: rtPtr->mode & TCL_WRITABLE */
@@ -3206,7 +3220,7 @@ TransformDrain(
ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
ckfree(p.transform.buf);
} else
-#endif
+#endif /* TCL_THREADS */
{
if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
@@ -3261,7 +3275,7 @@ TransformFlush(
}
ckfree(p.transform.buf);
} else
-#endif
+#endif /* TCL_THREADS */
{
if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
@@ -3302,7 +3316,7 @@ TransformClear(
ForwardOpToOwnerThread(rtPtr, ForwardedClear, &p);
return;
}
-#endif
+#endif /* TCL_THREADS */
/* ASSERT: rtPtr->method & FLAG(METH_READ) */
/* ASSERT: rtPtr->mode & TCL_READABLE */
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 6887b0c..694501f 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -7,11 +7,15 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclIOSock.c,v 1.11 2007/02/20 23:24:04 nijtmans Exp $
*/
#include "tclInt.h"
+
+#if defined(_WIN32) && defined(UNICODE)
+/* On Windows, we always need the ASCII version. */
+# undef gai_strerror
+# define gai_strerror gai_strerrorA
+#endif
/*
*---------------------------------------------------------------------------
@@ -60,8 +64,8 @@ TclSockGetPort(
return TCL_ERROR;
}
if (*portPtr > 0xFFFF) {
- Tcl_AppendResult(interp, "couldn't open socket: port number too high",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't open socket: port number too high", -1));
return TCL_ERROR;
}
return TCL_OK;
@@ -83,30 +87,190 @@ TclSockGetPort(
*----------------------------------------------------------------------
*/
+#if !defined(_WIN32) && !defined(__CYGWIN__)
+# define SOCKET int
+#endif
+
int
TclSockMinimumBuffers(
- int sock, /* Socket file descriptor */
+ void *sock, /* Socket file descriptor */
int size) /* Minimum buffer size */
{
int current;
socklen_t len;
len = sizeof(int);
- getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
+ getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF,
+ (char *) &current, &len);
if (current < size) {
len = sizeof(int);
- setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
+ setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF,
+ (char *) &size, len);
}
len = sizeof(int);
- getsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
+ getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF,
+ (char *) &current, &len);
if (current < size) {
len = sizeof(int);
- setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
+ setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF,
+ (char *) &size, len);
}
return TCL_OK;
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclCreateSocketAddress --
+ *
+ * This function initializes a sockaddr structure for a host and port.
+ *
+ * Results:
+ * 1 if the host was valid, 0 if the host could not be converted to an IP
+ * address.
+ *
+ * Side effects:
+ * Fills in the *sockaddrPtr structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCreateSocketAddress(
+ Tcl_Interp *interp, /* Interpreter for querying
+ * the desired socket family */
+ struct addrinfo **addrlist, /* Socket address list */
+ const char *host, /* Host. NULL implies INADDR_ANY */
+ int port, /* Port number */
+ int willBind, /* Is this an address to bind() to or
+ * to connect() to? */
+ const char **errorMsgPtr) /* Place to store the error message
+ * detail, if available. */
+{
+ struct addrinfo hints;
+ struct addrinfo *p;
+ struct addrinfo *v4head = NULL, *v4ptr = NULL;
+ struct addrinfo *v6head = NULL, *v6ptr = NULL;
+ char *native = NULL, portbuf[TCL_INTEGER_SPACE], *portstring;
+ const char *family = NULL;
+ Tcl_DString ds;
+ int result, i;
+
+ if (host != NULL) {
+ native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
+ }
+
+ /*
+ * Workaround for OSX's apparent inability to resolve "localhost", "0"
+ * when the loopback device is the only available network interface.
+ */
+ if (host != NULL && port == 0) {
+ portstring = NULL;
+ } else {
+ TclFormatInt(portbuf, port);
+ portstring = portbuf;
+ }
+
+ (void) memset(&hints, 0, sizeof(hints));
+ hints.ai_family = AF_UNSPEC;
+
+ /*
+ * Magic variable to enforce a certain address family - to be superseded
+ * by a TIP that adds explicit switches to [socket]
+ */
+
+ if (interp != NULL) {
+ family = Tcl_GetVar(interp, "::tcl::unsupported::socketAF", 0);
+ if (family != NULL) {
+ if (strcmp(family, "inet") == 0) {
+ hints.ai_family = AF_INET;
+ } else if (strcmp(family, "inet6") == 0) {
+ hints.ai_family = AF_INET6;
+ }
+ }
+ }
+
+ hints.ai_socktype = SOCK_STREAM;
+
+#if 0
+ /*
+ * We found some problems when using AI_ADDRCONFIG, e.g. on systems that
+ * have no networking besides the loopback interface and want to resolve
+ * localhost. See [Bugs 3385024, 3382419, 3382431]. As the advantage of
+ * using AI_ADDRCONFIG in situations where it works, is probably low,
+ * we'll leave it out for now. After all, it is just an optimisation.
+ *
+ * Missing on: OpenBSD, NetBSD.
+ * Causes failure when used on AIX 5.1 and HP-UX
+ */
+
+#if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux)
+ hints.ai_flags |= AI_ADDRCONFIG;
+#endif /* AI_ADDRCONFIG && !_AIX && !__hpux */
+#endif /* 0 */
+
+ if (willBind) {
+ hints.ai_flags |= AI_PASSIVE;
+ }
+
+ result = getaddrinfo(native, portstring, &hints, addrlist);
+
+ if (host != NULL) {
+ Tcl_DStringFree(&ds);
+ }
+
+ if (result != 0) {
+ *errorMsgPtr =
+#ifdef EAI_SYSTEM /* Doesn't exist on Windows */
+ (result == EAI_SYSTEM) ? Tcl_PosixError(interp) :
+#endif /* EAI_SYSTEM */
+ gai_strerror(result);
+ return 0;
+ }
+
+ /*
+ * Put IPv4 addresses before IPv6 addresses to maximize backwards
+ * compatibility of [fconfigure -sockname] output.
+ *
+ * There might be more elegant/efficient ways to do this.
+ */
+ if (willBind) {
+ for (p = *addrlist; p != NULL; p = p->ai_next) {
+ if (p->ai_family == AF_INET) {
+ if (v4head == NULL) {
+ v4head = p;
+ } else {
+ v4ptr->ai_next = p;
+ }
+ v4ptr = p;
+ } else {
+ if (v6head == NULL) {
+ v6head = p;
+ } else {
+ v6ptr->ai_next = p;
+ }
+ v6ptr = p;
+ }
+ }
+ *addrlist = NULL;
+ if (v6head != NULL) {
+ *addrlist = v6head;
+ v6ptr->ai_next = NULL;
+ }
+ if (v4head != NULL) {
+ v4ptr->ai_next = *addrlist;
+ *addrlist = v4head;
+ }
+ }
+ i = 0;
+ for (p = *addrlist; p != NULL; p = p->ai_next) {
+ i++;
+ }
+
+ return 1;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 6683ff9..ab08353 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -16,10 +16,11 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.178 2010/09/22 00:57:11 hobbs Exp $
*/
+#if defined(HAVE_SYS_STAT_H) && !defined _WIN32
+# include <sys/stat.h>
+#endif
#include "tclInt.h"
#ifdef __WIN32__
# include "tclWinInt.h"
@@ -27,6 +28,43 @@
#include "tclFileSystem.h"
/*
+ * struct FilesystemRecord --
+ *
+ * A filesystem record is used to keep track of each filesystem currently
+ * registered with the core, in a linked list.
+ */
+
+typedef struct FilesystemRecord {
+ ClientData clientData; /* Client specific data for the new filesystem
+ * (can be NULL) */
+ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */
+ struct FilesystemRecord *nextPtr;
+ /* The next filesystem registered to Tcl, or
+ * NULL if no more. */
+ struct FilesystemRecord *prevPtr;
+ /* The previous filesystem registered to Tcl,
+ * or NULL if no more. */
+} FilesystemRecord;
+
+/*
+ * This structure holds per-thread private copy of the current directory
+ * maintained by the global cwdPathPtr. This structure holds per-thread
+ * private copies of some global data. This way we avoid most of the
+ * synchronization calls which boosts performance, at cost of having to update
+ * this information each time the corresponding epoch counter changes.
+ */
+
+typedef struct ThreadSpecificData {
+ int initialized;
+ int cwdPathEpoch;
+ int filesystemEpoch;
+ Tcl_Obj *cwdPathPtr;
+ ClientData cwdClientData;
+ FilesystemRecord *filesystemList;
+ int claims;
+} ThreadSpecificData;
+
+/*
* Prototypes for functions defined later in this file.
*/
@@ -39,9 +77,10 @@ static void FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
Tcl_Obj *pathPtr, const char *pattern,
Tcl_GlobTypeData *types);
static void FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);
-#ifdef TCL_THREADS
static void FsRecacheFilesystemList(void);
-#endif
+static void Claim(void);
+static void Disclaim(void);
+
static void * DivertFindSymbol(Tcl_Interp *interp,
Tcl_LoadHandle loadHandle, const char *symbol);
static void DivertUnloadFile(Tcl_LoadHandle loadHandle);
@@ -143,8 +182,8 @@ const Tcl_Filesystem tclNativeFilesystem = {
TclpObjRenameFile,
TclpObjCopyDirectory,
TclpObjLstat,
- TclpDlopen,
- /* Needs a cast since we're using version_2. */
+ /* Needs casts since we're using version_2. */
+ (Tcl_FSLoadFileProc *) TclpDlopen,
(Tcl_FSGetCwdProc *) TclpGetNativeCwd,
TclpObjChdir
};
@@ -162,7 +201,6 @@ const Tcl_Filesystem tclNativeFilesystem = {
static FilesystemRecord nativeFilesystemRecord = {
NULL,
&tclNativeFilesystem,
- 1,
NULL,
NULL
};
@@ -174,7 +212,7 @@ static FilesystemRecord nativeFilesystemRecord = {
* trigger cache cleanup in all threads.
*/
-static int theFilesystemEpoch = 0;
+static int theFilesystemEpoch = 1;
/*
* Stores the linked list of filesystems. A 1:1 copy of this list is also
@@ -194,7 +232,7 @@ static int cwdPathEpoch = 0;
static ClientData cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)
-Tcl_ThreadDataKey tclFsDataKey;
+static Tcl_ThreadDataKey fsDataKey;
/*
* One of these structures is used each time we successfully load a file from
@@ -367,7 +405,7 @@ Tcl_GetCwd(
return NULL;
}
Tcl_DStringInit(cwdPtr);
- Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
+ TclDStringAppendObj(cwdPtr, cwd);
Tcl_DecrRefCount(cwd);
return Tcl_DStringValue(cwdPtr);
}
@@ -418,18 +456,18 @@ FsThrExitProc(
fsRecPtr = tsdPtr->filesystemList;
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr->nextPtr;
- if (--fsRecPtr->fileRefCount <= 0) {
- ckfree((char *) fsRecPtr);
- }
+ fsRecPtr->fsPtr = NULL;
+ ckfree(fsRecPtr);
fsRecPtr = tmpFsRecPtr;
}
+ tsdPtr->filesystemList = NULL;
tsdPtr->initialized = 0;
}
int
TclFSCwdIsNative(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (tsdPtr->cwdClientData != NULL) {
return 1;
@@ -463,7 +501,7 @@ int
TclFSCwdPointerEquals(
Tcl_Obj **pathPtrPtr)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
Tcl_MutexLock(&cwdMutex);
if (tsdPtr->cwdPathPtr == NULL
@@ -522,12 +560,11 @@ TclFSCwdPointerEquals(
}
}
-#ifdef TCL_THREADS
static void
FsRecacheFilesystemList(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
- FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+ FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list;
/*
* Trash the current cache.
@@ -536,20 +573,16 @@ FsRecacheFilesystemList(void)
fsRecPtr = tsdPtr->filesystemList;
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr->nextPtr;
- if (--fsRecPtr->fileRefCount <= 0) {
- ckfree((char *) fsRecPtr);
- }
+ fsRecPtr->nextPtr = toFree;
+ toFree = fsRecPtr;
fsRecPtr = tmpFsRecPtr;
}
- tsdPtr->filesystemList = NULL;
/*
- * Code below operates on shared data. We are already called under mutex
- * lock so we can safely proceed.
- *
* Locate tail of the global filesystem list.
*/
+ Tcl_MutexLock(&filesystemMutex);
fsRecPtr = filesystemList;
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr;
@@ -560,18 +593,26 @@ FsRecacheFilesystemList(void)
* Refill the cache honouring the order.
*/
+ list = NULL;
fsRecPtr = tmpFsRecPtr;
while (fsRecPtr != NULL) {
- tmpFsRecPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
+ tmpFsRecPtr = ckalloc(sizeof(FilesystemRecord));
*tmpFsRecPtr = *fsRecPtr;
- tmpFsRecPtr->nextPtr = tsdPtr->filesystemList;
+ tmpFsRecPtr->nextPtr = list;
tmpFsRecPtr->prevPtr = NULL;
- if (tsdPtr->filesystemList) {
- tsdPtr->filesystemList->prevPtr = tmpFsRecPtr;
- }
- tsdPtr->filesystemList = tmpFsRecPtr;
+ list = tmpFsRecPtr;
fsRecPtr = fsRecPtr->prevPtr;
}
+ tsdPtr->filesystemList = list;
+ tsdPtr->filesystemEpoch = theFilesystemEpoch;
+ Tcl_MutexUnlock(&filesystemMutex);
+
+ while (toFree) {
+ FilesystemRecord *next = toFree->nextPtr;
+ toFree->fsPtr = NULL;
+ ckfree(toFree);
+ toFree = next;
+ }
/*
* Make sure the above gets released on thread exit.
@@ -582,28 +623,16 @@ FsRecacheFilesystemList(void)
tsdPtr->initialized = 1;
}
}
-#endif /* TCL_THREADS */
static FilesystemRecord *
FsGetFirstFilesystem(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
- FilesystemRecord *fsRecPtr;
-
-#ifndef TCL_THREADS
- tsdPtr->filesystemEpoch = theFilesystemEpoch;
- fsRecPtr = filesystemList;
-#else
- Tcl_MutexLock(&filesystemMutex);
- if (tsdPtr->filesystemList == NULL
- || (tsdPtr->filesystemEpoch != theFilesystemEpoch)) {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+ if (tsdPtr->filesystemList == NULL || ((tsdPtr->claims == 0)
+ && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) {
FsRecacheFilesystemList();
- tsdPtr->filesystemEpoch = theFilesystemEpoch;
}
- Tcl_MutexUnlock(&filesystemMutex);
- fsRecPtr = tsdPtr->filesystemList;
-#endif
- return fsRecPtr;
+ return tsdPtr->filesystemList;
}
/*
@@ -615,11 +644,33 @@ int
TclFSEpochOk(
int filesystemEpoch)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
+}
+
+static void
+Claim(void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+
+ tsdPtr->claims++;
+}
+
+static void
+Disclaim(void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+
+ tsdPtr->claims--;
+}
+
+int
+TclFSEpoch(void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
- (void) FsGetFirstFilesystem();
- return (filesystemEpoch == tsdPtr->filesystemEpoch);
+ return tsdPtr->filesystemEpoch;
}
+
/*
* If non-NULL, clientData is owned by us and must be freed later.
@@ -632,7 +683,7 @@ FsUpdateCwd(
{
int len;
const char *str = NULL;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (cwdObj != NULL) {
str = Tcl_GetStringFromObj(cwdObj, &len);
@@ -729,17 +780,14 @@ TclFinalizeFilesystem(void)
while (fsRecPtr != NULL) {
FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;
- if (fsRecPtr->fileRefCount <= 0) {
- /*
- * The native filesystem is static, so we don't free it.
- */
+ /* The native filesystem is static, so we don't free it. */
- if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
- ckfree((char *) fsRecPtr);
- }
+ if (fsRecPtr != &nativeFilesystemRecord) {
+ ckfree(fsRecPtr);
}
fsRecPtr = tmpFsRecPtr;
}
+ theFilesystemEpoch++;
filesystemList = NULL;
/*
@@ -772,11 +820,7 @@ void
TclResetFilesystem(void)
{
filesystemList = &nativeFilesystemRecord;
-
- /*
- * Note, at this point, I believe nativeFilesystemRecord -> fileRefCount
- * should equal 1 and if not, we should try to track down the cause.
- */
+ theFilesystemEpoch++;
#ifdef __WIN32__
/*
@@ -829,19 +873,12 @@ Tcl_FSRegister(
return TCL_ERROR;
}
- newFilesystemPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
+ newFilesystemPtr = ckalloc(sizeof(FilesystemRecord));
newFilesystemPtr->clientData = clientData;
newFilesystemPtr->fsPtr = fsPtr;
/*
- * We start with a refCount of 1. If this drops to zero, then anyone is
- * welcome to ckfree us.
- */
-
- newFilesystemPtr->fileRefCount = 1;
-
- /*
* Is this lock and wait strictly speaking necessary? Since any iterators
* out there will have grabbed a copy of the head of the list and be
* iterating away from that, if we add a new element to the head of the
@@ -914,7 +951,7 @@ Tcl_FSUnregister(
*/
fsRecPtr = filesystemList;
- while ((retVal == TCL_ERROR) && (fsRecPtr->fsPtr != &tclNativeFilesystem)) {
+ while ((retVal == TCL_ERROR) && (fsRecPtr != &nativeFilesystemRecord)) {
if (fsRecPtr->fsPtr == fsPtr) {
if (fsRecPtr->prevPtr) {
fsRecPtr->prevPtr->nextPtr = fsRecPtr->nextPtr;
@@ -935,10 +972,7 @@ Tcl_FSUnregister(
theFilesystemEpoch++;
- fsRecPtr->fileRefCount--;
- if (fsRecPtr->fileRefCount <= 0) {
- ckfree((char *) fsRecPtr);
- }
+ ckfree(fsRecPtr);
retVal = TCL_OK;
} else {
@@ -1064,8 +1098,9 @@ Tcl_FSMatchInDirectory(
cwd = Tcl_FSGetCwd(NULL);
if (cwd == NULL) {
if (interp != NULL) {
- Tcl_SetResult(interp, "glob couldn't determine "
- "the current working directory", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "glob couldn't determine the current working directory",
+ -1));
}
return TCL_ERROR;
}
@@ -1346,14 +1381,9 @@ int
TclFSNormalizeToUniquePath(
Tcl_Interp *interp, /* Used for error messages. */
Tcl_Obj *pathPtr, /* The path to normalize in place. */
- int startAt, /* Start at this char-offset. */
- ClientData *clientDataPtr) /* If we generated a complete normalized path
- * for a given filesystem, we can optionally
- * return an fs-specific clientdata here. */
+ int startAt) /* Start at this char-offset. */
{
FilesystemRecord *fsRecPtr, *firstFsRecPtr;
- /* Ignore this variable */
- (void) clientDataPtr;
/*
* Call each of the "normalise path" functions in succession. This is a
@@ -1364,6 +1394,7 @@ TclFSNormalizeToUniquePath(
firstFsRecPtr = FsGetFirstFilesystem();
+ Claim();
for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
continue;
@@ -1401,6 +1432,7 @@ TclFSNormalizeToUniquePath(
* but there's not much benefit.
*/
}
+ Disclaim();
return startAt;
}
@@ -1545,8 +1577,8 @@ TclGetOpenModeEx(
*seekFlagPtr = 0;
*binaryPtr = 0;
if (interp != NULL) {
- Tcl_AppendResult(interp, "illegal access mode \"", modeString,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "illegal access mode \"%s\"", modeString));
}
return -1;
}
@@ -1595,10 +1627,11 @@ TclGetOpenModeEx(
mode |= O_NOCTTY;
#else
if (interp != NULL) {
- Tcl_AppendResult(interp, "access mode \"", flag,
- "\" not supported by this system", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "access mode \"%s\" not supported by this system",
+ flag));
}
- ckfree((char *) modeArgv);
+ ckfree(modeArgv);
return -1;
#endif
@@ -1607,10 +1640,11 @@ TclGetOpenModeEx(
mode |= O_NONBLOCK;
#else
if (interp != NULL) {
- Tcl_AppendResult(interp, "access mode \"", flag,
- "\" not supported by this system", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "access mode \"%s\" not supported by this system",
+ flag));
}
- ckfree((char *) modeArgv);
+ ckfree(modeArgv);
return -1;
#endif
@@ -1621,21 +1655,23 @@ TclGetOpenModeEx(
} else {
if (interp != NULL) {
- Tcl_AppendResult(interp, "invalid access mode \"", flag,
- "\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, "
- "CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid access mode \"%s\": must be RDONLY, WRONLY, "
+ "RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK,"
+ " or TRUNC", flag));
}
- ckfree((char *) modeArgv);
+ ckfree(modeArgv);
return -1;
}
}
- ckfree((char *) modeArgv);
+ ckfree(modeArgv);
if (!gotRW) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "access mode must include either"
- " RDONLY, WRONLY, or RDWR", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "access mode must include either RDONLY, WRONLY, or RDWR",
+ -1));
}
return -1;
}
@@ -1694,15 +1730,16 @@ Tcl_FSEvalFileEx(
if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
Tcl_SetErrno(errno);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
return result;
}
chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
if (chan == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
return result;
}
@@ -1728,10 +1765,32 @@ Tcl_FSEvalFileEx(
objPtr = Tcl_NewObj();
Tcl_IncrRefCount(objPtr);
- if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {
+
+ /*
+ * Try to read first character of stream, so we can check for utf-8 BOM to
+ * be handled especially.
+ */
+
+ if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
Tcl_Close(interp, chan);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+ goto end;
+ }
+ string = Tcl_GetString(objPtr);
+
+ /*
+ * If first character is not a BOM, append the remaining characters,
+ * otherwise replace them. [Bug 3466099]
+ */
+
+ if (Tcl_ReadChars(chan, objPtr, -1,
+ memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
+ Tcl_Close(interp, chan);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
goto end;
}
@@ -1750,7 +1809,7 @@ Tcl_FSEvalFileEx(
*/
iPtr->evalFlags |= TCL_EVAL_FILE;
- result = Tcl_EvalEx(interp, string, length, 0);
+ result = TclEvalEx(interp, string, length, 0, 1, NULL, string);
/*
* Now we have to be careful; the script may have changed the
@@ -1797,6 +1856,7 @@ TclNREvalFile(
Tcl_Obj *oldScriptFile, *objPtr;
Interp *iPtr;
Tcl_Channel chan;
+ const char *string;
if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
return TCL_ERROR;
@@ -1804,15 +1864,16 @@ TclNREvalFile(
if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
Tcl_SetErrno(errno);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
return TCL_ERROR;
}
chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
if (chan == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -1838,10 +1899,33 @@ TclNREvalFile(
objPtr = Tcl_NewObj();
Tcl_IncrRefCount(objPtr);
- if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {
+
+ /*
+ * Try to read first character of stream, so we can check for utf-8 BOM to
+ * be handled especially.
+ */
+
+ if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
Tcl_Close(interp, chan);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+ Tcl_DecrRefCount(objPtr);
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(objPtr);
+
+ /*
+ * If first character is not a BOM, append the remaining characters,
+ * otherwise replace them. [Bug 3466099]
+ */
+
+ if (Tcl_ReadChars(chan, objPtr, -1,
+ memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
+ Tcl_Close(interp, chan);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
Tcl_DecrRefCount(objPtr);
return TCL_ERROR;
}
@@ -2177,9 +2261,9 @@ Tcl_FSOpenFileChannel(
if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt) 0, SEEK_END)
< (Tcl_WideInt) 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not seek to end of file "
- "while opening \"", Tcl_GetString(pathPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not seek to end of file while opening \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
}
Tcl_Close(NULL, retVal);
return NULL;
@@ -2196,8 +2280,9 @@ Tcl_FSOpenFileChannel(
Tcl_SetErrno(ENOENT);
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open \"", Tcl_GetString(pathPtr),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
}
return NULL;
}
@@ -2553,7 +2638,7 @@ Tcl_Obj *
Tcl_FSGetCwd(
Tcl_Interp *interp)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (TclFSCwdPointerEquals(NULL)) {
FilesystemRecord *fsRecPtr;
@@ -2565,8 +2650,9 @@ Tcl_FSGetCwd(
* indicates the particular function has succeeded.
*/
- for (fsRecPtr = FsGetFirstFilesystem();
- (retVal == NULL) && (fsRecPtr != NULL);
+ fsRecPtr = FsGetFirstFilesystem();
+ Claim();
+ for (; (retVal == NULL) && (fsRecPtr != NULL);
fsRecPtr = fsRecPtr->nextPtr) {
ClientData retCd;
TclFSGetCwdProc2 *proc2;
@@ -2590,7 +2676,7 @@ Tcl_FSGetCwd(
retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd);
Tcl_IncrRefCount(retVal);
- norm = TclFSNormalizeAbsolutePath(interp,retVal,NULL);
+ norm = TclFSNormalizeAbsolutePath(interp,retVal);
if (norm != NULL) {
/*
* We found a cwd, which is now in our global storage. We
@@ -2611,13 +2697,15 @@ Tcl_FSGetCwd(
}
Tcl_DecrRefCount(retVal);
retVal = NULL;
+ Disclaim();
goto cdDidNotChange;
} else if (interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error getting working directory name: %s",
+ Tcl_PosixError(interp)));
}
}
+ Disclaim();
/*
* Now the 'cwd' may NOT be normalized, at least on some platforms.
@@ -2629,7 +2717,7 @@ Tcl_FSGetCwd(
*/
if (retVal != NULL) {
- Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
+ Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal);
if (norm != NULL) {
/*
@@ -2688,9 +2776,9 @@ Tcl_FSGetCwd(
retCd = proc2(tsdPtr->cwdClientData);
if (retCd == NULL && interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error getting working directory name: %s",
+ Tcl_PosixError(interp)));
}
if (retCd == tsdPtr->cwdClientData) {
@@ -2719,7 +2807,7 @@ Tcl_FSGetCwd(
* Normalize the path.
*/
- norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
+ norm = TclFSNormalizeAbsolutePath(interp, retVal);
/*
* Check whether cwd has changed from the value previously stored in
@@ -2901,7 +2989,7 @@ Tcl_FSChdir(
* instead. This should be examined by someone on Unix.
*/
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
ClientData cd;
ClientData oldcd = tsdPtr->cwdClientData;
@@ -3032,7 +3120,7 @@ Tcl_LoadFile(
* code. */
const char *const symbols[],/* Names of functions to look up in the file's
* symbol table. */
- int flags, /* Flags (unused) */
+ int flags, /* Flags */
void *procVPtrs, /* Where to return the addresses corresponding
* to symbols[]. */
Tcl_LoadHandle *handlePtr) /* Filled with token for shared library
@@ -3057,8 +3145,8 @@ Tcl_LoadFile(
}
if (fsPtr->loadFileProc != NULL) {
- int retVal = fsPtr->loadFileProc(interp, pathPtr, handlePtr,
- &unloadProcPtr);
+ int retVal = ((Tcl_FSLoadFileProc2 *)(fsPtr->loadFileProc))
+ (interp, pathPtr, handlePtr, &unloadProcPtr, flags);
if (retVal == TCL_OK) {
if (*handlePtr == NULL) {
@@ -3080,8 +3168,9 @@ Tcl_LoadFile(
*/
if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
- Tcl_AppendResult(interp, "couldn't load library \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't load library \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -3123,7 +3212,7 @@ Tcl_LoadFile(
ret = Tcl_Read(data, buffer, size);
Tcl_Close(interp, data);
ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
- &unloadProcPtr);
+ &unloadProcPtr, flags);
if (ret == TCL_OK && *handlePtr != NULL) {
goto resolveSymbols;
}
@@ -3131,7 +3220,7 @@ Tcl_LoadFile(
mustCopyToTempAnyway:
Tcl_ResetResult(interp);
-#endif
+#endif /* TCL_LOAD_FROM_MEMORY */
/*
* Get a temporary filename to use, first to copy the file into, and then
@@ -3151,8 +3240,8 @@ Tcl_LoadFile(
Tcl_FSDeleteFile(copyToPtr);
Tcl_DecrRefCount(copyToPtr);
- Tcl_AppendResult(interp, "couldn't load from current filesystem",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't load from current filesystem", -1));
return TCL_ERROR;
}
@@ -3194,7 +3283,7 @@ Tcl_LoadFile(
Tcl_ResetResult(interp);
- retVal = Tcl_LoadFile(interp, copyToPtr, symbols, 0, procPtrs,
+ retVal = Tcl_LoadFile(interp, copyToPtr, symbols, flags, procPtrs,
&newLoadHandle);
if (retVal != TCL_OK) {
/*
@@ -3231,7 +3320,7 @@ Tcl_LoadFile(
* unload and cleanup the temporary file correctly.
*/
- tvdlPtr = (FsDivertLoad *) ckalloc(sizeof(FsDivertLoad));
+ tvdlPtr = ckalloc(sizeof(FsDivertLoad));
/*
* Remember three pieces of information. This allows us to cleanup the
@@ -3277,10 +3366,8 @@ Tcl_LoadFile(
copyToPtr = NULL;
-
- divertedLoadHandle = (Tcl_LoadHandle)
- ckalloc(sizeof (struct Tcl_LoadHandle_));
- divertedLoadHandle->clientData = (ClientData) tvdlPtr;
+ divertedLoadHandle = ckalloc(sizeof(struct Tcl_LoadHandle_));
+ divertedLoadHandle->clientData = tvdlPtr;
divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol;
divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
*handlePtr = divertedLoadHandle;
@@ -3423,52 +3510,8 @@ DivertUnloadFile(
Tcl_DecrRefCount(tvdlPtr->divertedFile);
}
- ckfree((void *) tvdlPtr);
- ckfree((void *) loadHandle);
-}
-
-/*
- * This function used to be in the platform specific directories, but it has
- * now been made to work cross-platform.
- */
-
-int
-TclpLoadFile(
- Tcl_Interp *interp, /* Used for error reporting. */
- Tcl_Obj *pathPtr, /* Name of the file containing the desired
- * code (UTF-8). */
- const char *sym1, const char *sym2,
- /* Names of two functions to look up in the
- * file's symbol table. */
- Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr,
- /* Where to return the addresses corresponding
- * to sym1 and sym2. */
- ClientData *clientDataPtr, /* Filled with token for dynamically loaded
- * file which will be passed back to
- * (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
- /* Filled with address of Tcl_FSUnloadFileProc
- * function which should be used for this
- * file. */
-{
- Tcl_LoadHandle handle = NULL;
- int res;
-
- res = TclpDlopen(interp, pathPtr, &handle, unloadProcPtr);
-
- if (res != TCL_OK) {
- return res;
- }
-
- if (handle == NULL) {
- return TCL_ERROR;
- }
-
- *clientDataPtr = handle;
-
- *proc1Ptr = (Tcl_PackageInitProc*) Tcl_FindSymbol(interp, handle, sym1);
- *proc2Ptr = (Tcl_PackageInitProc*) Tcl_FindSymbol(interp, handle, sym2);
- return TCL_OK;
+ ckfree(tvdlPtr);
+ ckfree(loadHandle);
}
/*
@@ -3637,7 +3680,7 @@ TclFSUnloadTempFile(
Tcl_DecrRefCount(tvdlPtr->divertedFile);
}
- ckfree((char *) tvdlPtr);
+ ckfree(tvdlPtr);
}
/*
@@ -3740,6 +3783,7 @@ Tcl_FSListVolumes(void)
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
while (fsRecPtr != NULL) {
if (fsRecPtr->fsPtr->listVolumesProc != NULL) {
Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
@@ -3751,6 +3795,7 @@ Tcl_FSListVolumes(void)
}
fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
return resultPtr;
}
@@ -3790,6 +3835,7 @@ FsListMounts(
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
while (fsRecPtr != NULL) {
if (fsRecPtr->fsPtr != &tclNativeFilesystem &&
fsRecPtr->fsPtr->matchInDirectoryProc != NULL) {
@@ -3801,6 +3847,7 @@ FsListMounts(
}
fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
return resultPtr;
}
@@ -3912,31 +3959,6 @@ Tcl_FSSplitPath(
}
return result;
}
-
-/* Simple helper function. */
-Tcl_Obj *
-TclFSInternalToNormalized(
- const Tcl_Filesystem *fromFilesystem,
- ClientData clientData,
- FilesystemRecord **fsRecPtrPtr)
-{
- FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
-
- while (fsRecPtr != NULL) {
- if (fsRecPtr->fsPtr == fromFilesystem) {
- *fsRecPtrPtr = fsRecPtr;
- break;
- }
- fsRecPtr = fsRecPtr->nextPtr;
- }
-
- if ((fsRecPtr == NULL)
- || (fromFilesystem->internalToNormalizedProc == NULL)) {
- return NULL;
- }
- return fromFilesystem->internalToNormalizedProc(clientData);
-}
-
/*
*----------------------------------------------------------------------
*
@@ -4038,6 +4060,7 @@ TclFSNonnativePathType(
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
while (fsRecPtr != NULL) {
/*
* We want to skip the native filesystem in this loop because
@@ -4115,6 +4138,7 @@ TclFSNonnativePathType(
}
fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
return type;
}
@@ -4502,10 +4526,14 @@ Tcl_FSGetFileSystemForPath(
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
+
if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
+ Disclaim();
return NULL;
} else if (retVal != NULL) {
/* TODO: Can this happen? */
+ Disclaim();
return retVal;
}
@@ -4527,10 +4555,12 @@ Tcl_FSGetFileSystemForPath(
* call to the pathInFilesystemProc.
*/
- TclFSSetPathDetails(pathPtr, fsRecPtr, clientData);
+ TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData);
+ Disclaim();
return fsRecPtr->fsPtr;
}
}
+ Disclaim();
return NULL;
}
@@ -4591,7 +4621,7 @@ static void
NativeFreeInternalRep(
ClientData clientData)
{
- ckfree((char *) clientData);
+ ckfree(clientData);
}
/*
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 9eef11a..cb345e2 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -11,8 +11,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclIndexObj.c,v 1.59 2010/03/30 13:17:18 nijtmans Exp $
*/
#include "tclInt.h"
@@ -195,14 +193,14 @@ GetIndexFromObjList(
* Build a string table from the list.
*/
- tablePtr = (const char **) ckalloc((objc + 1) * sizeof(char *));
+ tablePtr = ckalloc((objc + 1) * sizeof(char *));
for (t = 0; t < objc; t++) {
if (objv[t] == objPtr) {
/*
* An exact match is always chosen, so we can stop here.
*/
- ckfree((char *) tablePtr);
+ ckfree(tablePtr);
*indexPtr = t;
return TCL_OK;
}
@@ -219,8 +217,7 @@ GetIndexFromObjList(
*/
TclFreeIntRep(objPtr);
- objPtr->typePtr = NULL;
- ckfree((char *) tablePtr);
+ ckfree(tablePtr);
return result;
}
@@ -342,7 +339,7 @@ Tcl_GetIndexFromObjStruct(
indexRep = objPtr->internalRep.otherValuePtr;
} else {
TclFreeIntRep(objPtr);
- indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
+ indexRep = ckalloc(sizeof(IndexRep));
objPtr->internalRep.otherValuePtr = indexRep;
objPtr->typePtr = &indexType;
}
@@ -359,29 +356,34 @@ Tcl_GetIndexFromObjStruct(
* Produce a fancy error message.
*/
- int count;
+ int count = 0;
TclNewObj(resultPtr);
- Tcl_SetObjResult(interp, resultPtr);
+ entryPtr = tablePtr;
+ while ((*entryPtr != NULL) && !**entryPtr) {
+ entryPtr = NEXT_ENTRY(entryPtr, offset);
+ }
Tcl_AppendStringsToObj(resultPtr,
(numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "),
msg, " \"", key, NULL);
- if (STRING_AT(tablePtr, offset, 0) == NULL) {
+ if (*entryPtr == NULL) {
Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL);
} else {
Tcl_AppendStringsToObj(resultPtr, "\": must be ",
- STRING_AT(tablePtr, offset, 0), NULL);
- for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0;
- *entryPtr != NULL;
- entryPtr = NEXT_ENTRY(entryPtr, offset), count++) {
+ *entryPtr, NULL);
+ entryPtr = NEXT_ENTRY(entryPtr, offset);
+ while (*entryPtr != NULL) {
if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""),
" or ", *entryPtr, NULL);
- } else {
+ } else if (**entryPtr) {
Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL);
+ count++;
}
+ entryPtr = NEXT_ENTRY(entryPtr, offset);
}
}
+ Tcl_SetObjResult(interp, resultPtr);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL);
}
return TCL_ERROR;
@@ -412,9 +414,11 @@ SetIndexFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"can't convert value to index except via Tcl_GetIndexFromObj API",
-1));
+ }
return TCL_ERROR;
}
@@ -445,7 +449,7 @@ UpdateStringOfIndex(
register const char *indexStr = EXPAND_OF(indexRep);
len = strlen(indexStr);
- buf = (char *) ckalloc(len + 1);
+ buf = ckalloc(len + 1);
memcpy(buf, indexStr, len+1);
objPtr->bytes = buf;
objPtr->length = len;
@@ -475,7 +479,7 @@ DupIndex(
Tcl_Obj *dupPtr)
{
IndexRep *srcIndexRep = srcPtr->internalRep.otherValuePtr;
- IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
+ IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep));
memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
dupPtr->internalRep.otherValuePtr = dupIndexRep;
@@ -503,7 +507,7 @@ static void
FreeIndex(
Tcl_Obj *objPtr)
{
- ckfree((char *) objPtr->internalRep.otherValuePtr);
+ ckfree(objPtr->internalRep.otherValuePtr);
objPtr->typePtr = NULL;
}
@@ -529,10 +533,10 @@ TclInitPrefixCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
static const EnsembleImplMap prefixImplMap[] = {
- {"all", PrefixAllObjCmd, NULL, NULL, NULL},
- {"longest", PrefixLongestObjCmd, NULL, NULL, NULL},
- {"match", PrefixMatchObjCmd, NULL, NULL, NULL},
- {NULL, NULL, NULL, NULL, NULL}
+ {"all", PrefixAllObjCmd, NULL, NULL, NULL, 0},
+ {"longest", PrefixLongestObjCmd, NULL, NULL, NULL, 0},
+ {"match", PrefixMatchObjCmd, NULL, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
};
Tcl_Command prefixCmd;
@@ -592,16 +596,20 @@ PrefixMatchObjCmd(
flags |= TCL_EXACT;
break;
case PRFMATCH_MESSAGE:
- if (i > (objc - 4)) {
- Tcl_AppendResult(interp, "missing message", NULL);
+ if (i > objc-4) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing value for -message", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
return TCL_ERROR;
}
i++;
message = Tcl_GetString(objv[i]);
break;
case PRFMATCH_ERROR:
- if (i > (objc - 4)) {
- Tcl_AppendResult(interp, "missing error options", NULL);
+ if (i > objc-4) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing value for -error", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
return TCL_ERROR;
}
i++;
@@ -610,8 +618,10 @@ PrefixMatchObjCmd(
return TCL_ERROR;
}
if ((errorLength % 2) != 0) {
- Tcl_AppendResult(interp, "error options must have an even"
- " number of elements", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error options must have an even number of elements",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
return TCL_ERROR;
}
errorPtr = objv[i];
@@ -951,12 +961,14 @@ Tcl_WrongNumArgs(
} else {
elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
}
- len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
+ flags = 0;
+ len = TclScanElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
- char *quotedElementStr = TclStackAlloc(interp, (unsigned)len);
+ char *quotedElementStr = TclStackAlloc(interp,
+ (unsigned)len + 1);
- len = Tcl_ConvertCountedElement(elementStr, elemLen,
+ len = TclConvertElement(elementStr, elemLen,
quotedElementStr, flags);
Tcl_AppendToObj(objPtr, quotedElementStr, len);
TclStackFree(interp, quotedElementStr);
@@ -1005,12 +1017,14 @@ Tcl_WrongNumArgs(
*/
elementStr = TclGetStringFromObj(objv[i], &elemLen);
- len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
+ flags = 0;
+ len = TclScanElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
- char *quotedElementStr = TclStackAlloc(interp,(unsigned) len);
+ char *quotedElementStr = TclStackAlloc(interp,
+ (unsigned) len + 1);
- len = Tcl_ConvertCountedElement(elementStr, elemLen,
+ len = TclConvertElement(elementStr, elemLen,
quotedElementStr, flags);
Tcl_AppendToObj(objPtr, quotedElementStr, len);
TclStackFree(interp, quotedElementStr);
@@ -1090,7 +1104,7 @@ Tcl_ParseArgsObjv(
/* Pointer to the current entry in the table
* of argument descriptions. */
const Tcl_ArgvInfo *matchPtr;
- /* Descriptor that matches current argument. */
+ /* Descriptor that matches current argument */
Tcl_Obj *curArg; /* Current argument */
const char *str = NULL;
register char c; /* Second character of current arg (used for
@@ -1103,17 +1117,19 @@ Tcl_ParseArgsObjv(
* being processed, primarily for error
* reporting. */
int objc; /* # arguments in objv still to process. */
- int length; /* Number of characters in current argument. */
+ int length; /* Number of characters in current argument */
if (remObjv != NULL) {
/*
- * Then we should copy the name of the command (0th argument).
+ * Then we should copy the name of the command (0th argument). The
+ * upper bound on the number of elements is known, and (undocumented,
+ * but historically true) there should be a NULL argument after the
+ * last result. [Bug 3413857]
*/
nrem = 1;
- leftovers = (Tcl_Obj **) ckalloc((nrem+1) * sizeof(Tcl_Obj *));
- leftovers[nrem-1] = objv[0];
- leftovers[nrem] = NULL;
+ leftovers = ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
+ leftovers[0] = objv[0];
} else {
nrem = 0;
leftovers = NULL;
@@ -1144,8 +1160,7 @@ Tcl_ParseArgsObjv(
matchPtr = NULL;
infoPtr = argTable;
- for (; (infoPtr != NULL) && (infoPtr->type != TCL_ARGV_END);
- infoPtr++) {
+ for (; infoPtr != NULL && infoPtr->type != TCL_ARGV_END ; infoPtr++) {
if (infoPtr->keyStr == NULL) {
continue;
}
@@ -1158,8 +1173,8 @@ Tcl_ParseArgsObjv(
goto gotMatch;
}
if (matchPtr != NULL) {
- Tcl_AppendResult(interp, "ambiguous option \"", str, "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "ambiguous option \"%s\"", str));
goto error;
}
matchPtr = infoPtr;
@@ -1171,21 +1186,13 @@ Tcl_ParseArgsObjv(
*/
if (remObjv == NULL) {
- Tcl_AppendResult(interp, "unrecognized argument \"", str,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unrecognized argument \"%s\"", str));
goto error;
}
dstIndex++; /* This argument is now handled */
- nrem++;
-
- /*
- * Allocate nrem (+1 extra for NULL terminator) pointers.
- */
-
- leftovers = (Tcl_Obj **) ckrealloc((void *) leftovers,
- (nrem+1) * sizeof(Tcl_Obj *));
- leftovers[nrem-1] = curArg;
+ leftovers[nrem++] = curArg;
continue;
}
@@ -1205,9 +1212,9 @@ Tcl_ParseArgsObjv(
}
if (Tcl_GetIntFromObj(interp, objv[srcIndex],
(int *) infoPtr->dstPtr) == TCL_ERROR) {
- Tcl_AppendResult(interp, "expected integer argument for \"",
- infoPtr->keyStr, "\" but got \"",
- Tcl_GetString(objv[srcIndex]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer argument for \"%s\" but got \"%s\"",
+ infoPtr->keyStr, Tcl_GetString(objv[srcIndex])));
goto error;
}
srcIndex++;
@@ -1223,7 +1230,14 @@ Tcl_ParseArgsObjv(
objc--;
break;
case TCL_ARGV_REST:
- *((int *) infoPtr->dstPtr) = dstIndex;
+ /*
+ * Only store the point where we got to if it's not to be written
+ * to NULL, so that TCL_ARGV_AUTO_REST works.
+ */
+
+ if (infoPtr->dstPtr != NULL) {
+ *((int *) infoPtr->dstPtr) = dstIndex;
+ }
goto argsDone;
case TCL_ARGV_FLOAT:
if (objc == 0) {
@@ -1231,16 +1245,17 @@ Tcl_ParseArgsObjv(
}
if (Tcl_GetDoubleFromObj(interp, objv[srcIndex],
(double *) infoPtr->dstPtr) == TCL_ERROR) {
- Tcl_AppendResult(interp, "expected floating-point argument ",
- "for \"", infoPtr->keyStr, "\" but got \"",
- Tcl_GetString(objv[srcIndex]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected floating-point argument for \"%s\" but got \"%s\"",
+ infoPtr->keyStr, Tcl_GetString(objv[srcIndex])));
goto error;
}
srcIndex++;
objc--;
break;
case TCL_ARGV_FUNC: {
- Tcl_ArgvFuncProc *handlerProc;
+ Tcl_ArgvFuncProc *handlerProc = (Tcl_ArgvFuncProc *)
+ infoPtr->srcPtr;
Tcl_Obj *argObj;
if (objc == 0) {
@@ -1248,7 +1263,6 @@ Tcl_ParseArgsObjv(
} else {
argObj = objv[srcIndex];
}
- handlerProc = (Tcl_ArgvFuncProc *) infoPtr->srcPtr;
if (handlerProc(infoPtr->clientData, argObj, infoPtr->dstPtr)) {
srcIndex++;
objc--;
@@ -1256,9 +1270,9 @@ Tcl_ParseArgsObjv(
break;
}
case TCL_ARGV_GENFUNC: {
- Tcl_ArgvGenFuncProc *handlerProc;
+ Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *)
+ infoPtr->srcPtr;
- handlerProc = (Tcl_ArgvGenFuncProc *) infoPtr->srcPtr;
objc = handlerProc(infoPtr->clientData, interp, objc,
&objv[srcIndex], infoPtr->dstPtr);
if (objc < 0) {
@@ -1269,20 +1283,18 @@ Tcl_ParseArgsObjv(
case TCL_ARGV_HELP:
PrintUsage(interp, argTable);
goto error;
- default: {
- char buf[64 + TCL_INTEGER_SPACE];
-
- sprintf(buf, "bad argument type %d in Tcl_ArgvInfo",
- infoPtr->type);
- Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
+ default:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad argument type %d in Tcl_ArgvInfo", infoPtr->type));
goto error;
}
- }
}
/*
* If we broke out of the loop because of an OPT_REST argument, copy the
- * remaining arguments down.
+ * remaining arguments down. Note that there is always at least one
+ * argument left over - the command name - so we always have a result if
+ * our caller is willing to receive it. [Bug 3413857]
*/
argsDone:
@@ -1295,20 +1307,12 @@ Tcl_ParseArgsObjv(
}
if (objc > 0) {
- leftovers = (Tcl_Obj **) ckrealloc((void *) leftovers,
- (nrem+objc+1) * sizeof(Tcl_Obj *));
- while (objc) {
- leftovers[nrem] = objv[srcIndex];
- nrem++;
- srcIndex++;
- objc--;
- }
- } else if (leftovers != NULL) {
- ckfree((char *) leftovers);
+ memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *));
+ nrem += objc;
}
leftovers[nrem] = NULL;
- *objcPtr = nrem;
- *remObjv = leftovers;
+ *objcPtr = nrem++;
+ *remObjv = ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *));
return TCL_OK;
/*
@@ -1317,11 +1321,11 @@ Tcl_ParseArgsObjv(
*/
missingArg:
- Tcl_AppendResult(interp, "\"", str,
- "\" option requires an additional argument", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" option requires an additional argument", str));
error:
if (leftovers != NULL) {
- ckfree((char *) leftovers);
+ ckfree(leftovers);
}
return TCL_ERROR;
}
@@ -1354,8 +1358,9 @@ PrintUsage(
register const Tcl_ArgvInfo *infoPtr;
int width, numSpaces;
#define NUM_SPACES 20
- static char spaces[] = " ";
+ static const char spaces[] = " ";
char tmp[TCL_DOUBLE_SPACE];
+ Tcl_Obj *msg;
/*
* First, compute the width of the widest option key, so that we can make
@@ -1379,39 +1384,39 @@ PrintUsage(
* Now add the option information, with pretty-printing.
*/
- Tcl_AppendResult(interp, "Command-specific options:", NULL);
+ msg = Tcl_NewStringObj("Command-specific options:", -1);
for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
if ((infoPtr->type == TCL_ARGV_HELP) && (infoPtr->keyStr == NULL)) {
- Tcl_AppendResult(interp, "\n", infoPtr->helpStr, NULL);
+ Tcl_AppendPrintfToObj(msg, "\n%s", infoPtr->helpStr);
continue;
}
- Tcl_AppendResult(interp, "\n ", infoPtr->keyStr, ":", NULL);
+ Tcl_AppendPrintfToObj(msg, "\n %s:", infoPtr->keyStr);
numSpaces = width + 1 - strlen(infoPtr->keyStr);
while (numSpaces > 0) {
if (numSpaces >= NUM_SPACES) {
- Tcl_AppendResult(interp, spaces, NULL);
+ Tcl_AppendToObj(msg, spaces, NUM_SPACES);
} else {
- Tcl_AppendResult(interp, spaces+NUM_SPACES-numSpaces, NULL);
+ Tcl_AppendToObj(msg, spaces, numSpaces);
}
numSpaces -= NUM_SPACES;
}
- Tcl_AppendResult(interp, infoPtr->helpStr, NULL);
+ Tcl_AppendToObj(msg, infoPtr->helpStr, -1);
switch (infoPtr->type) {
case TCL_ARGV_INT:
- sprintf(tmp, "%d", *((int *) infoPtr->dstPtr));
- Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL);
+ Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %d",
+ *((int *) infoPtr->dstPtr));
break;
case TCL_ARGV_FLOAT:
+ Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g",
+ *((double *) infoPtr->dstPtr));
sprintf(tmp, "%g", *((double *) infoPtr->dstPtr));
- Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL);
break;
case TCL_ARGV_STRING: {
- char *string;
+ char *string = *((char **) infoPtr->dstPtr);
- string = *((char **) infoPtr->dstPtr);
if (string != NULL) {
- Tcl_AppendResult(interp, "\n\t\tDefault value: \"", string,
- "\"", NULL);
+ Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: \"%s\"",
+ string);
}
break;
}
@@ -1419,6 +1424,7 @@ PrintUsage(
break;
}
}
+ Tcl_SetObjResult(interp, msg);
}
/*
@@ -1430,8 +1436,8 @@ PrintUsage(
*
* Results:
* Returns TCL_ERROR if the value is an invalid completion code.
- * Otherwise, returns TCL_OK, and writes the completion code to
- * the pointer provided.
+ * Otherwise, returns TCL_OK, and writes the completion code to the
+ * pointer provided.
*
* Side effects:
* None.
@@ -1443,35 +1449,35 @@ int
TclGetCompletionCodeFromObj(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *value,
- int *code) /* Argument objects. */
+ int *codePtr) /* Argument objects. */
{
static const char *const returnCodes[] = {
- "ok", "error", "return", "break", "continue", NULL
+ "ok", "error", "return", "break", "continue", NULL
};
if ((value->typePtr != &indexType)
- && (TCL_OK == TclGetIntFromObj(NULL, value, code))) {
+ && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
return TCL_OK;
}
- if (TCL_OK == Tcl_GetIndexFromObj(
- NULL, value, returnCodes, NULL, TCL_EXACT, code)) {
+ if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT,
+ codePtr) == TCL_OK) {
return TCL_OK;
}
+
/*
* Value is not a legal completion code.
*/
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad completion code \"",
- TclGetString(value),
- "\": must be ok, error, return, break, "
- "continue, or an integer", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad completion code \"%s\": must be"
+ " ok, error, return, break, continue, or an integer",
+ TclGetString(value)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL);
}
return TCL_ERROR;
}
-
+
/*
* Local Variables:
* mode: c
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index fe08bd5..f215d32 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -12,15 +12,12 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: tclInt.decls,v 1.149 2010/09/27 19:42:38 msofer Exp $
library tcl
# Define the unsupported generic interfaces.
interface tclInt
-scspec EXTERN
# Declare each of the functions in the unsupported internal Tcl
# interface. These interfaces are allowed to changed between versions.
@@ -83,7 +80,7 @@ declare 12 {
# Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
#}
declare 14 {
- void TclDumpMemoryInfo(FILE *outFile)
+ int TclDumpMemoryInfo(ClientData clientData, int flags)
}
# Removed in 8.1:
# declare 15 {
@@ -116,10 +113,10 @@ declare 22 {
declare 23 {
Proc *TclFindProc(Interp *iPtr, const char *procName)
}
-# Replaced with macro (see tclInt.h) in Tcl 8.5
-#declare 24 {
-# int TclFormatInt(char *buffer, long n)
-#}
+# Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10
+declare 24 {
+ int TclFormatInt(char *buffer, long n)
+}
declare 25 {
void TclFreePackageInfo(Interp *iPtr)
}
@@ -191,7 +188,7 @@ declare 42 {
}
# Removed in Tcl 8.5a2
#declare 43 {
-# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
+# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
# int flags)
#}
declare 44 {
@@ -226,7 +223,7 @@ declare 51 {
}
# Removed in Tcl 8.5a2
#declare 52 {
-# int TclInvoke(Tcl_Interp *interp, int argc, const char **argv,
+# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
# int flags)
#}
declare 53 {
@@ -322,9 +319,10 @@ declare 76 {
declare 77 {
void TclpGetTime(Tcl_Time *time)
}
-declare 78 {
- int TclpGetTimeZone(unsigned long time)
-}
+# Removed in 8.6:
+#declare 78 {
+# int TclpGetTimeZone(unsigned long time)
+#}
# Replaced by Tcl_FSListVolumes in 8.4:
#declare 79 {
# int TclpListVolumes(Tcl_Interp *interp)
@@ -423,7 +421,7 @@ declare 103 {
int *portPtr)
}
declare 104 {
- int TclSockMinimumBuffers(int sock, int size)
+ int TclSockMinimumBuffersOld(int sock, int size)
}
# Replaced by Tcl_FSStat in 8.4:
#declare 105 {
@@ -441,6 +439,9 @@ declare 108 {
declare 109 {
int TclUpdateReturnInfo(Interp *iPtr)
}
+declare 110 {
+ int TclSockMinimumBuffers(void *sock, int size)
+}
# Removed in 8.1:
# declare 110 {
# char *TclWordEnd(char *start, char *lastChar, int nested, int *semiPtr)
@@ -691,12 +692,12 @@ declare 169 {
}
declare 170 {
int TclCheckInterpTraces(Tcl_Interp *interp, const char *command,
- int numChars, Command *cmdPtr, int result, int traceFlags,
+ int numChars, Command *cmdPtr, int result, int traceFlags,
int objc, Tcl_Obj *const objv[])
}
declare 171 {
int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command,
- int numChars, Command *cmdPtr, int result, int traceFlags,
+ int numChars, Command *cmdPtr, int result, int traceFlags,
int objc, Tcl_Obj *const objv[])
}
declare 172 {
@@ -748,7 +749,7 @@ declare 177 {
# const char *file, int line)
#}
-# TclpGmtime and TclpLocaltime promoted to the interface from unix
+# TclpGmtime and TclpLocaltime promoted to the generic interface from unix
declare 182 {
struct tm *TclpLocaltime(const time_t *clock)
@@ -961,7 +962,7 @@ declare 239 {
}
declare 240 {
int TclNRRunCallbacks(Tcl_Interp *interp, int result,
- struct TEOV_callback *rootPtr)
+ struct NRE_callback *rootPtr)
}
declare 241 {
int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
@@ -996,6 +997,15 @@ declare 248 {
int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr)
}
+
+declare 249 {
+ char *TclDoubleDigits(double dv, int ndigits, int flags,
+ int *decpt, int *signum, char **endPtr)
+}
+# TIP #285: Script cancellation support.
+declare 250 {
+ void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
+}
##############################################################################
@@ -1008,39 +1018,47 @@ interface tclIntPlat
# Windows specific functions
declare 0 win {
- void TclWinConvertError(unsigned long errCode)
+ void TclWinConvertError(DWORD errCode)
}
declare 1 win {
- void TclWinConvertWSAError(unsigned long errCode)
+ void TclWinConvertWSAError(DWORD errCode)
}
declare 2 win {
struct servent *TclWinGetServByName(const char *nm,
const char *proto)
}
declare 3 win {
- int TclWinGetSockOpt(int s, int level, int optname,
- char FAR *optval, int FAR *optlen)
+ int TclWinGetSockOpt(SOCKET s, int level, int optname,
+ char *optval, int *optlen)
}
declare 4 win {
HINSTANCE TclWinGetTclInstance(void)
}
+# new for 8.4.20+/8.5.12+ Cygwin only
+declare 5 win {
+ int TclUnixWaitForFile(int fd, int mask, int timeout)
+}
# Removed in 8.1:
# declare 5 win {
# HINSTANCE TclWinLoadLibrary(char *name)
# }
declare 6 win {
- u_short TclWinNToHS(u_short ns)
+ unsigned short TclWinNToHS(unsigned short ns)
}
declare 7 win {
- int TclWinSetSockOpt(int s, int level, int optname,
- const char FAR *optval, int optlen)
+ int TclWinSetSockOpt(SOCKET s, int level, int optname,
+ const char *optval, int optlen)
}
declare 8 win {
- unsigned long TclpGetPid(Tcl_Pid pid)
+ int TclpGetPid(Tcl_Pid pid)
}
declare 9 win {
int TclWinGetPlatformId(void)
}
+# new for 8.4.20+/8.5.12+ Cygwin only
+declare 10 win {
+ Tcl_DirEntry *TclpReaddir(DIR *dir)
+}
# Removed in 8.3.1 (for Win32s only)
#declare 10 win {
# int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
@@ -1062,9 +1080,13 @@ declare 14 win {
int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
}
declare 15 win {
- int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv,
- TclFile inputFile, TclFile outputFile, TclFile errorFile,
- Tcl_Pid *pidPtr)
+ int TclpCreateProcess(Tcl_Interp *interp, int argc,
+ const char **argv, TclFile inputFile, TclFile outputFile,
+ TclFile errorFile, Tcl_Pid *pidPtr)
+}
+# new for 8.4.20+/8.5.12+ Cygwin only
+declare 16 win {
+ int TclpIsAtty(int fd)
}
# Signature changed in 8.1:
# declare 16 win {
@@ -1073,6 +1095,11 @@ declare 15 win {
# declare 17 win {
# char *TclpGetTZName(void)
# }
+# new for 8.5.12+ Cygwin only
+declare 17 win {
+ int TclUnixCopyFile(const char *src, const char *dst,
+ const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
+}
declare 18 win {
TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
@@ -1080,9 +1107,12 @@ declare 19 win {
TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {
- void TclWinAddProcess(void *hProcess, unsigned long id)
+ void TclWinAddProcess(HANDLE hProcess, DWORD id)
+}
+# new for 8.4.20+/8.5.12+
+declare 21 win {
+ char *TclpInetNtoa(struct in_addr addr)
}
-
# removed permanently for 8.4
#declare 21 win {
# void TclpAsyncMark(Tcl_AsyncHandler async)
@@ -1092,13 +1122,14 @@ declare 20 win {
declare 22 win {
TclFile TclpCreateTempFile(const char *contents)
}
-declare 23 win {
- char *TclpGetTZName(int isdst)
-}
+# Removed in 8.6:
+#declare 23 win {
+# char *TclpGetTZName(int isdst)
+#}
declare 24 win {
char *TclWinNoBackslash(char *path)
}
-# replaced by TclGetPlatform
+# replaced by generic TclGetPlatform
#declare 25 win {
# TclPlatformType *TclWinGetPlatform(void)
#}
@@ -1117,9 +1148,6 @@ declare 27 win {
declare 28 win {
void TclWinResetInterfaces(void)
}
-declare 29 win {
- int TclWinCPUID(unsigned int index, unsigned int *regs)
-}
################################
# Unix specific functions
@@ -1140,9 +1168,9 @@ declare 3 unix {
int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
}
declare 4 unix {
- int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv,
- TclFile inputFile, TclFile outputFile, TclFile errorFile,
- Tcl_Pid *pidPtr)
+ int TclpCreateProcess(Tcl_Interp *interp, int argc,
+ const char **argv, TclFile inputFile, TclFile outputFile,
+ TclFile errorFile, Tcl_Pid *pidPtr)
}
# Signature changed in 8.1:
# declare 5 unix {
@@ -1170,7 +1198,7 @@ declare 10 unix {
Tcl_DirEntry *TclpReaddir(DIR *dir)
}
# Slots 11 and 12 are forwarders for functions that were promoted to
-# Stubs
+# generic Stubs
declare 11 unix {
struct tm *TclpLocaltime_unix(const time_t *clock)
}
@@ -1212,6 +1240,16 @@ declare 19 macosx {
void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}
+declare 29 {win unix} {
+ int TclWinCPUID(unsigned int index, unsigned int *regs)
+}
+# Added in 8.6; core of TclpOpenTemporaryFile
+declare 30 {win unix} {
+ int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj,
+ Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj)
+}
+
+
# Local Variables:
# mode: tcl
diff --git a/generic/tclInt.h b/generic/tclInt.h
index f5b0666..1d04c82 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -14,8 +14,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclInt.h,v 1.483 2010/09/27 19:42:38 msofer Exp $
*/
#ifndef _TCLINT
@@ -803,13 +801,17 @@ typedef struct VarInHash {
#define TclSetVarNamespaceVar(varPtr) \
if (!TclIsVarNamespaceVar(varPtr)) {\
(varPtr)->flags |= VAR_NAMESPACE_VAR;\
- ((VarInHash *)(varPtr))->refCount++;\
+ if (TclIsVarInHash(varPtr)) {\
+ ((VarInHash *)(varPtr))->refCount++;\
+ }\
}
#define TclClearVarNamespaceVar(varPtr) \
if (TclIsVarNamespaceVar(varPtr)) {\
(varPtr)->flags &= ~VAR_NAMESPACE_VAR;\
- ((VarInHash *)(varPtr))->refCount--;\
+ if (TclIsVarInHash(varPtr)) {\
+ ((VarInHash *)(varPtr))->refCount--;\
+ }\
}
/*
@@ -954,7 +956,7 @@ typedef struct CompiledLocal {
* is marked by a unique ClientData tag during
* compilation, and that same tag is used to
* find the variable at runtime. */
- char name[4]; /* Name of the local variable starts here. If
+ char name[1]; /* 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
@@ -1152,7 +1154,7 @@ typedef struct CallFrame {
* meaning of the value is, which we do not
* specify. */
LocalCache *localCachePtr;
- struct TEOV_callback *tailcallPtr;
+ struct NRE_callback *tailcallPtr;
/* NULL if no tailcall is scheduled */
} CallFrame;
@@ -1493,8 +1495,8 @@ typedef struct ExecEnv {
* stack on the heap. */
Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1" objs. */
struct Tcl_Interp *interp;
- struct TEOV_callback *callbackPtr;
- /* Top callback in TEOV's stack. */
+ struct NRE_callback *callbackPtr;
+ /* Top callback in NRE's stack. */
struct CoroutineData *corPtr;
int rewind;
} ExecEnv;
@@ -1601,6 +1603,8 @@ typedef struct {
CompileProc *compileProc; /* The compiler for the subcommand. */
Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */
ClientData clientData; /* Any clientData to give the command. */
+ int unsafe; /* Whether this command is to be hidden by
+ * default in a safe interpreter. */
} EnsembleImplMap;
/*
@@ -2133,7 +2137,7 @@ typedef struct Interp {
* tclOOInt.h and tclOO.c for real definition
* and setup. */
- struct TEOV_callback *deferredCallbacks;
+ struct NRE_callback *deferredCallbacks;
/* Callbacks that are set previous to a call
* to some Eval function but that actually
* belong to the command that is about to be
@@ -2159,6 +2163,8 @@ typedef struct Interp {
Tcl_Obj *errorStack; /* [info errorstack] value (as a Tcl_Obj). */
Tcl_Obj *upLiteral; /* "UP" literal for [info errorstack] */
Tcl_Obj *callLiteral; /* "CALL" literal for [info errorstack] */
+ Tcl_Obj *innerLiteral; /* "INNER" literal for [info errorstack] */
+ Tcl_Obj *innerContext; /* cached list for fast reallocation */
int resetErrorStack; /* controls cleaning up of ::errorStack */
#ifdef TCL_COMPILE_STATS
@@ -2180,6 +2186,22 @@ typedef struct Interp {
*((iPtr)->asyncReadyPtr)
/*
+ * Macros for script cancellation support (TIP #285).
+ */
+
+#define TclCanceled(iPtr) \
+ (((iPtr)->flags & CANCELED) || ((iPtr)->flags & TCL_CANCEL_UNWIND))
+
+#define TclSetCancelFlags(iPtr, cancelFlags) \
+ (iPtr)->flags |= CANCELED; \
+ if ((cancelFlags) & TCL_CANCEL_UNWIND) { \
+ (iPtr)->flags |= TCL_CANCEL_UNWIND; \
+ }
+
+#define TclUnsetCancelFlags(iPtr) \
+ (iPtr)->flags &= (~(CANCELED | TCL_CANCEL_UNWIND))
+
+/*
* General list of interpreters. Doubly linked for easier removal of items
* deep in the list.
*/
@@ -2251,6 +2273,9 @@ typedef struct InterpList {
* SAFE_INTERP: Non zero means that the current interp is a safe
* interp (i.e. it has only the safe commands installed,
* less priviledge than a regular interp).
+ * INTERP_DEBUG_FRAME: Used for switching on various extra interpreter
+ * debug/info mechanisms (e.g. info frame eval/uplevel
+ * tracing) which are performance intensive.
* INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently
* active; so no further trace callbacks should be
* invoked.
@@ -2276,6 +2301,7 @@ typedef struct InterpList {
#define DELETED 1
#define ERR_ALREADY_LOGGED 4
+#define INTERP_DEBUG_FRAME 0x10
#define DONT_COMPILE_CMDS_INLINE 0x20
#define RAND_SEED_INITIALIZED 0x40
#define SAFE_INTERP 0x80
@@ -2419,6 +2445,11 @@ typedef struct List {
* accomodate all elements. */
} List;
+#define LIST_MAX \
+ (1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *)))
+#define LIST_SIZE(numElems) \
+ (unsigned)(sizeof(List) + (((numElems) - 1) * sizeof(Tcl_Obj *)))
+
/*
* Macro used to get the elements of a list object.
*/
@@ -2426,6 +2457,12 @@ typedef struct List {
#define ListRepPtr(listPtr) \
((List *) (listPtr)->internalRep.twoPtrValue.ptr1)
+#define ListSetIntRep(objPtr, listRepPtr) \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(listRepPtr), \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = NULL, \
+ (listRepPtr)->refCount++, \
+ (objPtr)->typePtr = &tclListType
+
#define ListObjGetElements(listPtr, objc, objv) \
((objv) = &(ListRepPtr(listPtr)->elements), \
(objc) = ListRepPtr(listPtr)->elemCount)
@@ -2433,6 +2470,9 @@ typedef struct List {
#define ListObjLength(listPtr, len) \
((len) = ListRepPtr(listPtr)->elemCount)
+#define ListObjIsCanonical(listPtr) \
+ (((listPtr)->bytes == NULL) || ListRepPtr(listPtr)->canonicalFlag)
+
#define TclListObjGetElements(interp, listPtr, objcPtr, objvPtr) \
(((listPtr)->typePtr == &tclListType) \
? ((ListObjGetElements((listPtr), *(objcPtr), *(objvPtr))), TCL_OK)\
@@ -2443,6 +2483,17 @@ typedef struct List {
? ((ListObjLength((listPtr), *(lenPtr))), TCL_OK)\
: Tcl_ListObjLength((interp), (listPtr), (lenPtr)))
+#define TclListObjIsCanonical(listPtr) \
+ (((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0)
+
+/*
+ * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
+ * TclNRLmapCmd and their compilations.
+ */
+
+#define TCL_EACH_KEEP_NONE 0 /* Discard iteration result like [foreach] */
+#define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */
+
/*
* Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere,
* Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints.
@@ -2513,6 +2564,8 @@ typedef struct List {
#define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2)
typedef ClientData (TclFSGetCwdProc2)(ClientData clientData);
+typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
/*
* The following types are used for getting and storing platform-specific file
@@ -2728,29 +2781,32 @@ MODULE_SCOPE char tclEmptyString;
*----------------------------------------------------------------
*/
-MODULE_SCOPE Tcl_ObjCmdProc TclNRNamespaceObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRApplyObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNREvalObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd;
MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback;
+MODULE_SCOPE Tcl_NRPostProc TclNRCoroutineActivateCallback;
MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd;
+MODULE_SCOPE Tcl_NRPostProc TclNRTailcallEval;
MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
MODULE_SCOPE void TclSpliceTailcall(Tcl_Interp *interp,
- struct TEOV_callback *tailcallPtr);
+ struct NRE_callback *tailcallPtr);
/*
* This structure holds the data for the various iteration callbacks used to
@@ -2789,6 +2845,32 @@ struct Tcl_LoadHandle_ {
/* Procedure that unloads a loaded module */
};
+/* Flags for conversion of doubles to digit strings */
+
+#define TCL_DD_SHORTEST 0x4
+ /* Use the shortest possible string */
+#define TCL_DD_STEELE 0x5
+ /* Use the original Steele&White algorithm */
+#define TCL_DD_E_FORMAT 0x2
+ /* Use a fixed-length string of digits,
+ * suitable for E format*/
+#define TCL_DD_F_FORMAT 0x3
+ /* Use a fixed number of digits after the
+ * decimal point, suitable for F format */
+
+#define TCL_DD_SHORTEN_FLAG 0x4
+ /* Allow return of a shorter digit string
+ * if it converts losslessly */
+#define TCL_DD_NO_QUICK 0x8
+ /* Debug flag: forbid quick FP conversion */
+
+#define TCL_DD_CONVERSION_TYPE_MASK 0x3
+ /* Mask to isolate the conversion type */
+#define TCL_DD_STEELE0 0x1
+ /* 'Steele&White' after masking */
+#define TCL_DD_SHORTEST0 0x0
+ /* 'Shortest possible' after masking */
+
/*
*----------------------------------------------------------------
* Procedures shared among Tcl modules but not used by the outside world:
@@ -2826,10 +2908,9 @@ MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
const char *value);
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
+MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE int TclClearRootEnsemble(ClientData data[],
Tcl_Interp *interp, int result);
-MODULE_SCOPE void TclCleanupLiteralTable(Tcl_Interp *interp,
- LiteralTable *tablePtr);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
int *loc);
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
@@ -2837,26 +2918,30 @@ MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
Tcl_Obj *originObjPtr);
-MODULE_SCOPE int TclDoubleDigits(char *buf, double value, int *signum);
+MODULE_SCOPE int TclConvertElement(const char *src, int length,
+ char *dst, int flags);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
/* TIP #280 - Modified token based evulation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags, int line,
int *clNextOuter, const char *outerScript);
-MODULE_SCOPE int TclFileAttrsCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
-MODULE_SCOPE int TclFileCopyCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
-MODULE_SCOPE int TclFileDeleteCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
-MODULE_SCOPE int TclFileMakeDirsCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
-MODULE_SCOPE int TclFileRenameCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc,
ClientData clientData);
MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc,
ClientData clientData);
+MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr,
+ Tcl_Obj *objPtr);
+MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr,
+ Tcl_DString *toAppendPtr);
+MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE void TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void TclFinalizeAsync(void);
MODULE_SCOPE void TclFinalizeDoubleConversion(void);
@@ -2931,6 +3016,8 @@ MODULE_SCOPE void TclInitObjSubsystem(void);
MODULE_SCOPE void TclInitSubsystems(void);
MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp);
MODULE_SCOPE int TclIsLocalScalar(const char *src, int len);
+MODULE_SCOPE int TclIsSpaceProc(char byte);
+MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]);
MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp,
@@ -2948,12 +3035,12 @@ MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
const EnsembleImplMap map[]);
-MODULE_SCOPE int TclMarkList(Tcl_Interp *interp, const char *list,
- const char *end, int *argcPtr,
- const int **argszPtr, const char ***argvPtr);
+MODULE_SCOPE int TclMaxListLength(const char *bytes, int numBytes,
+ const char **endPtr);
MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
int *codePtr, int *levelPtr);
+MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int TclNokia770Doubles(void);
MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
@@ -2967,7 +3054,7 @@ MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp,
MODULE_SCOPE int TclParseBackslash(const char *src,
int numBytes, int *readPtr, char *dst);
MODULE_SCOPE int TclParseHex(const char *src, int numBytes,
- Tcl_UniChar *resultPtr);
+ int *resultPtr);
MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr,
const char *expected, const char *bytes,
int numBytes, const char **endPtrPtr, int flags);
@@ -2986,6 +3073,10 @@ MODULE_SCOPE void TclpFinalizeCondition(Tcl_Condition *condPtr);
MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
MODULE_SCOPE void TclpFinalizePipes(void);
MODULE_SCOPE void TclpFinalizeSockets(void);
+MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp,
+ struct addrinfo **addrlist,
+ const char *host, int port, int willBind,
+ const char **errorMsgPtr);
MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr,
Tcl_ThreadCreateProc *proc, ClientData clientData,
int stackSize, int flags);
@@ -2995,12 +3086,6 @@ MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr,
MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE void TclpInitPlatform(void);
MODULE_SCOPE void TclpInitUnlock(void);
-MODULE_SCOPE int TclpLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
- const char *sym1, const char *sym2,
- Tcl_PackageInitProc **proc1Ptr,
- Tcl_PackageInitProc **proc2Ptr,
- ClientData *clientDataPtr,
- Tcl_FSUnloadFileProc **unloadProcPtr);
MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void);
MODULE_SCOPE void TclpMasterLock(void);
MODULE_SCOPE void TclpMasterUnlock(void);
@@ -3041,6 +3126,8 @@ MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr,
int reStrLen, Tcl_DString *dsPtr, int *flagsPtr);
+MODULE_SCOPE int TclScanElement(const char *string, int length,
+ int *flagPtr);
MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
Tcl_Obj *cmdPrefix);
MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr,
@@ -3069,17 +3156,21 @@ MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes,
MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
int count, int *tokensLeftPtr, int line,
int *clNextOuter, const char *outerScript);
+MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes,
+ const char *trim, int numTrim);
+MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes,
+ const char *trim, int numTrim);
MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_LoadHandle *loadHandle,
- Tcl_FSUnloadFileProc **unloadProcPtr);
+ Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
MODULE_SCOPE int TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
#ifdef TCL_LOAD_FROM_MEMORY
MODULE_SCOPE void * TclpLoadMemoryGetBuffer(Tcl_Interp *interp, int size);
MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer,
int size, int codeSize, Tcl_LoadHandle *loadHandle,
- Tcl_FSUnloadFileProc **unloadProcPtr);
+ Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
#endif
MODULE_SCOPE void TclInitThreadStorage(void);
MODULE_SCOPE void TclFinalizeThreadDataThread(void);
@@ -3095,6 +3186,8 @@ MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
+MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
+
/*
*----------------------------------------------------------------
* Command procedures in the generic core:
@@ -3155,9 +3248,24 @@ MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
+MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
+ Var *arrayPtr, Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr, int index, int pathc,
+ Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
+MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+ int pathc, Tcl_Obj *const pathv[]);
MODULE_SCOPE int Tcl_DisassembleObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+
+/* Assemble command function */
+MODULE_SCOPE int Tcl_AssembleObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclNRAssembleObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+
MODULE_SCOPE int Tcl_EncodingObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3188,9 +3296,8 @@ MODULE_SCOPE int Tcl_FconfigureObjCmd(
MODULE_SCOPE int Tcl_FcopyObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-MODULE_SCOPE int Tcl_FileObjCmd(ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp);
+MODULE_SCOPE int TclMakeFileCommandSafe(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_FileEventObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3246,6 +3353,9 @@ MODULE_SCOPE int Tcl_LlengthObjCmd(ClientData clientData,
MODULE_SCOPE int Tcl_ListObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tcl_LmapObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LoadObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3270,9 +3380,7 @@ MODULE_SCOPE int Tcl_LsetObjCmd(ClientData clientData,
MODULE_SCOPE int Tcl_LsortObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-MODULE_SCOPE int Tcl_NamespaceObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp);
MODULE_SCOPE int TclNamespaceEnsembleCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3383,6 +3491,15 @@ MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData,
MODULE_SCOPE int TclCompileAppendCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileArrayExistsCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileArraySetCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileArrayUnsetCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileBreakCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3395,6 +3512,12 @@ MODULE_SCOPE int TclCompileContinueCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileDictAppendCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileDictCreateCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileDictExistsCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileDictForCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3407,12 +3530,24 @@ MODULE_SCOPE int TclCompileDictIncrCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileDictLappendCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileDictMapCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileDictMergeCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileDictSetCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileDictUnsetCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileDictUpdateCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileDictWithCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileEnsemble(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3428,15 +3563,36 @@ MODULE_SCOPE int TclCompileForCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileForeachCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileFormatCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileGlobalCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileIfCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileInfoCommandsCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileInfoCoroutineCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileInfoExistsCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileInfoLevelCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileInfoObjectClassCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileInfoObjectIsACmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileInfoObjectNamespaceCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileIncrCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3455,18 +3611,48 @@ MODULE_SCOPE int TclCompileListCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileLlengthCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileLmapCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileLrangeCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileLreplaceCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileLsetCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
-MODULE_SCOPE int TclCompileNamespaceCmd(Tcl_Interp *interp,
+MODULE_SCOPE int TclCompileNamespaceCodeCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileNamespaceCurrentCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileNamespaceQualifiersCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileNamespaceTailCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileNamespaceUpvarCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileNamespaceWhichCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileObjectSelfCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileRegexpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileRegsubCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileReturnCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3479,21 +3665,36 @@ MODULE_SCOPE int TclCompileStringCmpCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileStringEqualCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringFirstCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringIndexCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringLastCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringLenCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringMapCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringMatchCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringRangeCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileSubstCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileSwitchCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileTailcallCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileThrowCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3512,6 +3713,9 @@ MODULE_SCOPE int TclCompileVariableCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileYieldCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclInvertOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -3651,6 +3855,10 @@ MODULE_SCOPE int TclStreqOpCmd(ClientData clientData,
MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+
+MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
/*
* Functions defined in generic/tclVar.c and currenttly exported only for use
@@ -3702,6 +3910,8 @@ MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr);
MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
+MODULE_SCOPE int TclFullFinalizationRequested(void);
+
/*
*----------------------------------------------------------------
* Macros used by the Tcl core to create and release Tcl objects.
@@ -3860,6 +4070,13 @@ MODULE_SCOPE void TclpFreeAllocCache(void *);
#else /* not PURIFY or USE_THREAD_ALLOC */
+#if defined(USE_TCLALLOC) && USE_TCLALLOC
+ MODULE_SCOPE void TclFinalizeAllocSubsystem();
+ MODULE_SCOPE void TclInitAlloc();
+#else
+# define USE_TCLALLOC 0
+#endif
+
#ifdef TCL_THREADS
/* declared in tclObj.c */
MODULE_SCOPE Tcl_Mutex tclObjMutex;
@@ -3968,9 +4185,10 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
#define TclFreeIntRep(objPtr) \
- if ((objPtr)->typePtr != NULL && \
- (objPtr)->typePtr->freeIntRepProc != NULL) { \
- (objPtr)->typePtr->freeIntRepProc(objPtr); \
+ if ((objPtr)->typePtr != NULL) { \
+ if ((objPtr)->typePtr->freeIntRepProc != NULL) { \
+ (objPtr)->typePtr->freeIntRepProc(objPtr); \
+ } \
(objPtr)->typePtr = NULL; \
}
@@ -4005,8 +4223,22 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*----------------------------------------------------------------
*/
+/* General tuning for minimum growth in Tcl growth algorithms */
+#ifndef TCL_MIN_GROWTH
+# ifdef TCL_GROWTH_MIN_ALLOC
+ /* Support for any legacy tuners */
+# define TCL_MIN_GROWTH TCL_GROWTH_MIN_ALLOC
+# else
+# define TCL_MIN_GROWTH 1024
+# endif
+#endif
+
+/* Token growth tuning, default to the general value. */
+#ifndef TCL_MIN_TOKEN_GROWTH
+#define TCL_MIN_TOKEN_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Token)
+#endif
+
#define TCL_MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token))
-#define TCL_MIN_TOKEN_GROWTH 50
#define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr) \
do { \
int needed = (used) + (append); \
@@ -4061,8 +4293,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
#define TclUtfToUniChar(str, chPtr) \
- ((((unsigned char) *(str)) < 0xC0) ? \
- ((*(chPtr) = (Tcl_UniChar) *(str)), 1) \
+ ((((unsigned char) *(str)) < 0xC0) ? \
+ ((*(chPtr) = (Tcl_UniChar) *(str)), 1) \
: Tcl_UtfToUniChar(str, chPtr))
/*
@@ -4135,8 +4367,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
#define TclInvalidateNsCmdLookup(nsPtr) \
- if ((nsPtr)->numExportPatterns) { \
- (nsPtr)->exportLookupEpoch++; \
+ if ((nsPtr)->numExportPatterns) { \
+ (nsPtr)->exportLookupEpoch++; \
+ } \
+ if ((nsPtr)->commandPathLength) { \
+ (nsPtr)->cmdRefEpoch++; \
}
/*
@@ -4184,18 +4419,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
/*
*----------------------------------------------------------------
- * Macro used by the Tcl core to write the string rep of a long integer to a
- * character buffer. The ANSI C "prototype" for this macro is:
- *
- * MODULE_SCOPE int TclFormatInt(char *buf, long n);
- *----------------------------------------------------------------
- */
-
-#define TclFormatInt(buf, n) \
- sprintf((buf), "%ld", (long)(n))
-
-/*
- *----------------------------------------------------------------
* Macros used by the Tcl core to set a Tcl_Obj's numeric representation
* avoiding the corresponding function calls in time critical parts of the
* core. They should only be called on unshared objects. The ANSI C
@@ -4334,6 +4557,21 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
/*
*----------------------------------------------------------------
+ * Convenience macros for DStrings.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr,
+ * const char *sLiteral);
+ * MODULE_SCOPE void TclDStringClear(Tcl_DString *dsPtr);
+ */
+
+#define TclDStringAppendLiteral(dsPtr, sLiteral) \
+ Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
+#define TclDStringClear(dsPtr) \
+ Tcl_DStringSetLength((dsPtr), 0)
+
+/*
+ *----------------------------------------------------------------
* Macros used by the Tcl core to test for some special double values.
* The ANSI C "prototypes" for these macros are:
*
@@ -4508,11 +4746,11 @@ void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
* available.
*/
-typedef struct TEOV_callback {
+typedef struct NRE_callback {
Tcl_NRPostProc *procPtr;
ClientData data[4];
- struct TEOV_callback *nextPtr;
-} TEOV_callback;
+ struct NRE_callback *nextPtr;
+} NRE_callback;
#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
@@ -4522,7 +4760,7 @@ typedef struct TEOV_callback {
#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \
do { \
- TEOV_callback *callbackPtr; \
+ NRE_callback *callbackPtr; \
TCLNR_ALLOC((interp), (callbackPtr)); \
callbackPtr->procPtr = (postProcPtr); \
callbackPtr->data[0] = (ClientData)(data0); \
@@ -4535,7 +4773,7 @@ typedef struct TEOV_callback {
#define TclNRDeferCallback(interp,postProcPtr,data0,data1,data2,data3) \
do { \
- TEOV_callback *callbackPtr; \
+ NRE_callback *callbackPtr; \
TCLNR_ALLOC((interp), (callbackPtr)); \
callbackPtr->procPtr = (postProcPtr); \
callbackPtr->data[0] = (ClientData)(data0); \
@@ -4548,7 +4786,7 @@ typedef struct TEOV_callback {
#define TclNRSpliceCallbacks(interp, topPtr) \
do { \
- TEOV_callback *bottomPtr = topPtr; \
+ NRE_callback *bottomPtr = topPtr; \
while (bottomPtr->nextPtr) { \
bottomPtr = bottomPtr->nextPtr; \
} \
@@ -4564,11 +4802,11 @@ typedef struct TEOV_callback {
#if NRE_USE_SMALL_ALLOC
#define TCLNR_ALLOC(interp, ptr) \
- TclSmallAllocEx(interp, sizeof(TEOV_callback), (ptr))
+ TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
#define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
- (ptr = ((ClientData) ckalloc(sizeof(TEOV_callback))))
+ (ptr = ((ClientData) ckalloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr) ckfree((char *) (ptr))
#endif
@@ -4582,6 +4820,12 @@ typedef struct TEOV_callback {
#include "tclIntPlatDecls.h"
#include "tclTomMathDecls.h"
+#if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG)
+#define Tcl_AttemptAlloc(size) TclpAlloc(size)
+#define Tcl_AttemptRealloc(ptr, size) TclpRealloc((ptr), (size))
+#define Tcl_Free(ptr) TclpFree(ptr)
+#endif
+
#endif /* _TCLINT */
/*
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index bd4cdda..df5ac97 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclIntDecls.h,v 1.143 2010/09/27 19:42:38 msofer Exp $
*/
#ifndef _TCLINTDECLS
@@ -92,7 +90,7 @@ EXTERN void TclDeleteVars(Interp *iPtr,
TclVarHashTable *tablePtr);
/* Slot 13 is reserved */
/* 14 */
-EXTERN void TclDumpMemoryInfo(FILE *outFile);
+EXTERN int TclDumpMemoryInfo(ClientData clientData, int flags);
/* Slot 15 is reserved */
/* 16 */
EXTERN void TclExprFloatError(Tcl_Interp *interp, double value);
@@ -109,7 +107,8 @@ EXTERN int TclFindElement(Tcl_Interp *interp,
int *bracePtr);
/* 23 */
EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName);
-/* Slot 24 is reserved */
+/* 24 */
+EXTERN int TclFormatInt(char *buffer, long n);
/* 25 */
EXTERN void TclFreePackageInfo(Interp *iPtr);
/* Slot 26 is reserved */
@@ -215,8 +214,7 @@ EXTERN unsigned long TclpGetClicks(void);
EXTERN unsigned long TclpGetSeconds(void);
/* 77 */
EXTERN void TclpGetTime(Tcl_Time *time);
-/* 78 */
-EXTERN int TclpGetTimeZone(unsigned long time);
+/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
/* 81 */
@@ -264,7 +262,7 @@ EXTERN void TclSetupEnv(Tcl_Interp *interp);
EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str,
const char *proto, int *portPtr);
/* 104 */
-EXTERN int TclSockMinimumBuffers(int sock, int size);
+EXTERN int TclSockMinimumBuffersOld(int sock, int size);
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
@@ -272,7 +270,8 @@ EXTERN int TclSockMinimumBuffers(int sock, int size);
EXTERN void TclTeardownNamespace(Namespace *nsPtr);
/* 109 */
EXTERN int TclUpdateReturnInfo(Interp *iPtr);
-/* Slot 110 is reserved */
+/* 110 */
+EXTERN int TclSockMinimumBuffers(void *sock, int size);
/* 111 */
EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp,
const char *name,
@@ -571,7 +570,7 @@ EXTERN int TclNRInterpProcCore(Tcl_Interp *interp,
ProcErrorProc *errorProc);
/* 240 */
EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result,
- struct TEOV_callback *rootPtr);
+ struct NRE_callback *rootPtr);
/* 241 */
EXTERN int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags, const CmdFrame *invoker, int word);
@@ -596,10 +595,16 @@ EXTERN void TclResetRewriteEnsemble(Tcl_Interp *interp,
EXTERN int TclCopyChannel(Tcl_Interp *interp,
Tcl_Channel inChan, Tcl_Channel outChan,
Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
+/* 249 */
+EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags,
+ int *decpt, int *signum, char **endPtr);
+/* 250 */
+EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
+ int force);
typedef struct TclIntStubs {
int magic;
- const struct TclIntStubHooks *hooks;
+ void *hooks;
void (*reserved0)(void);
void (*reserved1)(void);
@@ -615,7 +620,7 @@ typedef struct TclIntStubs {
void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */
void (*reserved13)(void);
- void (*tclDumpMemoryInfo) (FILE *outFile); /* 14 */
+ int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */
void (*reserved15)(void);
void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */
void (*reserved17)(void);
@@ -625,7 +630,7 @@ typedef struct TclIntStubs {
void (*reserved21)(void);
int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */
Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */
- void (*reserved24)(void);
+ int (*tclFormatInt) (char *buffer, long n); /* 24 */
void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
void (*reserved26)(void);
void (*reserved27)(void);
@@ -679,7 +684,7 @@ typedef struct TclIntStubs {
unsigned long (*tclpGetClicks) (void); /* 75 */
unsigned long (*tclpGetSeconds) (void); /* 76 */
void (*tclpGetTime) (Tcl_Time *time); /* 77 */
- int (*tclpGetTimeZone) (unsigned long time); /* 78 */
+ void (*reserved78)(void);
void (*reserved79)(void);
void (*reserved80)(void);
char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */
@@ -705,13 +710,13 @@ typedef struct TclIntStubs {
CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */
void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
- int (*tclSockMinimumBuffers) (int sock, int size); /* 104 */
+ int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
void (*reserved105)(void);
void (*reserved106)(void);
void (*reserved107)(void);
void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */
int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
- void (*reserved110)(void);
+ int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */
void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
@@ -841,7 +846,7 @@ typedef struct TclIntStubs {
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
- int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct TEOV_callback *rootPtr); /* 240 */
+ int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */
int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
@@ -850,6 +855,8 @@ typedef struct TclIntStubs {
int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */
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 */
} TclIntStubs;
#ifdef __cplusplus
@@ -903,7 +910,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclFindElement) /* 22 */
#define TclFindProc \
(tclIntStubsPtr->tclFindProc) /* 23 */
-/* Slot 24 is reserved */
+#define TclFormatInt \
+ (tclIntStubsPtr->tclFormatInt) /* 24 */
#define TclFreePackageInfo \
(tclIntStubsPtr->tclFreePackageInfo) /* 25 */
/* Slot 26 is reserved */
@@ -987,8 +995,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclpGetSeconds) /* 76 */
#define TclpGetTime \
(tclIntStubsPtr->tclpGetTime) /* 77 */
-#define TclpGetTimeZone \
- (tclIntStubsPtr->tclpGetTimeZone) /* 78 */
+/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
#define TclpRealloc \
@@ -1026,8 +1033,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclSetupEnv) /* 102 */
#define TclSockGetPort \
(tclIntStubsPtr->tclSockGetPort) /* 103 */
-#define TclSockMinimumBuffers \
- (tclIntStubsPtr->tclSockMinimumBuffers) /* 104 */
+#define TclSockMinimumBuffersOld \
+ (tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
@@ -1035,7 +1042,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclTeardownNamespace) /* 108 */
#define TclUpdateReturnInfo \
(tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */
-/* Slot 110 is reserved */
+#define TclSockMinimumBuffers \
+ (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
#define Tcl_AddInterpResolvers \
(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
#define Tcl_AppendExportList \
@@ -1269,6 +1277,10 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclResetRewriteEnsemble) /* 247 */
#define TclCopyChannel \
(tclIntStubsPtr->tclCopyChannel) /* 248 */
+#define TclDoubleDigits \
+ (tclIntStubsPtr->tclDoubleDigits) /* 249 */
+#define TclSetSlaveCancelFlags \
+ (tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index 95a6016..dcf1753 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -8,13 +8,16 @@
*
* Copyright (c) 1998-1999 by Scriptics Corporation.
* All rights reserved.
- *
- * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.44 2010/08/21 16:30:26 nijtmans Exp $
*/
#ifndef _TCLINTPLATDECLS
#define _TCLINTPLATDECLS
+#ifdef __WIN32__
+# define Tcl_DirEntry void
+# define DIR void
+#endif
+
#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
# define TCL_STORAGE_CLASS DLLEXPORT
@@ -38,7 +41,7 @@
* Exported function declarations:
*/
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
@@ -76,31 +79,53 @@ EXTERN char * TclpInetNtoa(struct in_addr addr);
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
int dontCopyAtts);
+/* Slot 15 is reserved */
+/* Slot 16 is reserved */
+/* Slot 17 is reserved */
+/* Slot 18 is reserved */
+/* Slot 19 is reserved */
+/* Slot 20 is reserved */
+/* Slot 21 is reserved */
+/* Slot 22 is reserved */
+/* Slot 23 is reserved */
+/* Slot 24 is reserved */
+/* Slot 25 is reserved */
+/* Slot 26 is reserved */
+/* Slot 27 is reserved */
+/* Slot 28 is reserved */
+/* 29 */
+EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
+/* 30 */
+EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
+ Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
+ Tcl_Obj *resultingNameObj);
#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
/* 0 */
-EXTERN void TclWinConvertError(unsigned long errCode);
+EXTERN void TclWinConvertError(DWORD errCode);
/* 1 */
-EXTERN void TclWinConvertWSAError(unsigned long errCode);
+EXTERN void TclWinConvertWSAError(DWORD errCode);
/* 2 */
EXTERN struct servent * TclWinGetServByName(const char *nm,
const char *proto);
/* 3 */
-EXTERN int TclWinGetSockOpt(int s, int level, int optname,
- char FAR *optval, int FAR *optlen);
+EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname,
+ char *optval, int *optlen);
/* 4 */
EXTERN HINSTANCE TclWinGetTclInstance(void);
-/* Slot 5 is reserved */
+/* 5 */
+EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 6 */
-EXTERN u_short TclWinNToHS(u_short ns);
+EXTERN unsigned short TclWinNToHS(unsigned short ns);
/* 7 */
-EXTERN int TclWinSetSockOpt(int s, int level, int optname,
- const char FAR *optval, int optlen);
+EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname,
+ const char *optval, int optlen);
/* 8 */
-EXTERN unsigned long TclpGetPid(Tcl_Pid pid);
+EXTERN int TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN int TclWinGetPlatformId(void);
-/* Slot 10 is reserved */
+/* 10 */
+EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
/* 11 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
@@ -117,19 +142,23 @@ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
const char **argv, TclFile inputFile,
TclFile outputFile, TclFile errorFile,
Tcl_Pid *pidPtr);
-/* Slot 16 is reserved */
-/* Slot 17 is reserved */
+/* 16 */
+EXTERN int TclpIsAtty(int fd);
+/* 17 */
+EXTERN int TclUnixCopyFile(const char *src, const char *dst,
+ const Tcl_StatBuf *statBufPtr,
+ int dontCopyAtts);
/* 18 */
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
/* 20 */
-EXTERN void TclWinAddProcess(void *hProcess, unsigned long id);
-/* Slot 21 is reserved */
+EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id);
+/* 21 */
+EXTERN char * TclpInetNtoa(struct in_addr addr);
/* 22 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
-/* 23 */
-EXTERN char * TclpGetTZName(int isdst);
+/* Slot 23 is reserved */
/* 24 */
EXTERN char * TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
@@ -141,6 +170,10 @@ EXTERN void TclWinFlushDirtyChannels(void);
EXTERN void TclWinResetInterfaces(void);
/* 29 */
EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
+/* 30 */
+EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
+ Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
+ Tcl_Obj *resultingNameObj);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
@@ -200,13 +233,28 @@ EXTERN int TclMacOSXMatchType(Tcl_Interp *interp,
/* 19 */
EXTERN void TclMacOSXNotifierAddRunLoopMode(
const void *runLoopMode);
+/* Slot 20 is reserved */
+/* Slot 21 is reserved */
+/* Slot 22 is reserved */
+/* Slot 23 is reserved */
+/* Slot 24 is reserved */
+/* Slot 25 is reserved */
+/* Slot 26 is reserved */
+/* Slot 27 is reserved */
+/* Slot 28 is reserved */
+/* 29 */
+EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
+/* 30 */
+EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
+ Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
+ Tcl_Obj *resultingNameObj);
#endif /* MACOSX */
typedef struct TclIntPlatStubs {
int magic;
- const struct TclIntPlatStubHooks *hooks;
+ void *hooks;
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
int (*tclpCloseFile) (TclFile file); /* 1 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
@@ -222,38 +270,55 @@ typedef struct TclIntPlatStubs {
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
+ void (*reserved15)(void);
+ void (*reserved16)(void);
+ void (*reserved17)(void);
+ void (*reserved18)(void);
+ void (*reserved19)(void);
+ void (*reserved20)(void);
+ void (*reserved21)(void);
+ void (*reserved22)(void);
+ void (*reserved23)(void);
+ void (*reserved24)(void);
+ void (*reserved25)(void);
+ void (*reserved26)(void);
+ void (*reserved27)(void);
+ void (*reserved28)(void);
+ int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
+ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
- void (*tclWinConvertError) (unsigned long errCode); /* 0 */
- void (*tclWinConvertWSAError) (unsigned long errCode); /* 1 */
+#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+ void (*tclWinConvertError) (DWORD errCode); /* 0 */
+ void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
- int (*tclWinGetSockOpt) (int s, int level, int optname, char FAR *optval, int FAR *optlen); /* 3 */
+ int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
- void (*reserved5)(void);
- u_short (*tclWinNToHS) (u_short ns); /* 6 */
- int (*tclWinSetSockOpt) (int s, int level, int optname, const char FAR *optval, int optlen); /* 7 */
- unsigned long (*tclpGetPid) (Tcl_Pid pid); /* 8 */
+ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
+ unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
+ int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
+ int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
int (*tclWinGetPlatformId) (void); /* 9 */
- void (*reserved10)(void);
+ Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
int (*tclpCloseFile) (TclFile file); /* 12 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
- void (*reserved16)(void);
- void (*reserved17)(void);
+ int (*tclpIsAtty) (int fd); /* 16 */
+ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
- void (*tclWinAddProcess) (void *hProcess, unsigned long id); /* 20 */
- void (*reserved21)(void);
+ void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
+ char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
- char * (*tclpGetTZName) (int isdst); /* 23 */
+ void (*reserved23)(void);
char * (*tclWinNoBackslash) (char *path); /* 24 */
void (*reserved25)(void);
void (*tclWinSetInterfaces) (int wide); /* 26 */
void (*tclWinFlushDirtyChannels) (void); /* 27 */
void (*tclWinResetInterfaces) (void); /* 28 */
int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
+ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
@@ -276,6 +341,17 @@ typedef struct TclIntPlatStubs {
int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
+ void (*reserved20)(void);
+ void (*reserved21)(void);
+ void (*reserved22)(void);
+ void (*reserved23)(void);
+ void (*reserved24)(void);
+ void (*reserved25)(void);
+ void (*reserved26)(void);
+ void (*reserved27)(void);
+ void (*reserved28)(void);
+ int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
+ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* MACOSX */
} TclIntPlatStubs;
@@ -293,7 +369,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
* Inline function declarations:
*/
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
@@ -323,8 +399,26 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
#define TclUnixCopyFile \
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
+/* Slot 15 is reserved */
+/* Slot 16 is reserved */
+/* Slot 17 is reserved */
+/* Slot 18 is reserved */
+/* Slot 19 is reserved */
+/* Slot 20 is reserved */
+/* Slot 21 is reserved */
+/* Slot 22 is reserved */
+/* Slot 23 is reserved */
+/* Slot 24 is reserved */
+/* Slot 25 is reserved */
+/* Slot 26 is reserved */
+/* Slot 27 is reserved */
+/* Slot 28 is reserved */
+#define TclWinCPUID \
+ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
+#define TclUnixOpenTemporaryFile \
+ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#define TclWinConvertError \
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
@@ -335,7 +429,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
#define TclWinGetTclInstance \
(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
-/* Slot 5 is reserved */
+#define TclUnixWaitForFile \
+ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
#define TclWinNToHS \
(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
#define TclWinSetSockOpt \
@@ -344,7 +439,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclWinGetPlatformId \
(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
-/* Slot 10 is reserved */
+#define TclpReaddir \
+ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#define TclpCloseFile \
@@ -355,19 +451,21 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
#define TclpCreateProcess \
(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
-/* Slot 16 is reserved */
-/* Slot 17 is reserved */
+#define TclpIsAtty \
+ (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
+#define TclUnixCopyFile \
+ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
#define TclpMakeFile \
(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#define TclpOpenFile \
(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
-/* Slot 21 is reserved */
+#define TclpInetNtoa \
+ (tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
-#define TclpGetTZName \
- (tclIntPlatStubsPtr->tclpGetTZName) /* 23 */
+/* Slot 23 is reserved */
#define TclWinNoBackslash \
(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
@@ -379,6 +477,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
+#define TclUnixOpenTemporaryFile \
+ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define TclGetAndDetachPids \
@@ -420,6 +520,19 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
+/* Slot 20 is reserved */
+/* Slot 21 is reserved */
+/* Slot 22 is reserved */
+/* Slot 23 is reserved */
+/* Slot 24 is reserved */
+/* Slot 25 is reserved */
+/* Slot 26 is reserved */
+/* Slot 27 is reserved */
+/* Slot 28 is reserved */
+#define TclWinCPUID \
+ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
+#define TclUnixOpenTemporaryFile \
+ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* MACOSX */
#endif /* defined(USE_TCL_STUBS) */
@@ -428,5 +541,17 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
+#undef TclpLocaltime_unix
+#undef TclpGmtime_unix
+#undef TclWinConvertWSAError
+#define TclWinConvertWSAError TclWinConvertError
+
+#if defined(__WIN32__) || defined(__CYGWIN__)
+# undef TclWinNToHS
+# define TclWinNToHS ntohs
+#else
+# undef TclpGetPid
+# define TclpGetPid(pid) ((unsigned long) (pid))
+#endif
#endif /* _TCLINTPLATDECLS */
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index e22133a..0b0f652 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclInterp.c,v 1.113 2010/08/22 18:53:26 nijtmans Exp $
*/
#include "tclInt.h"
@@ -210,6 +208,9 @@ static int SlaveBgerror(Tcl_Interp *interp,
Tcl_Obj *const objv[]);
static Tcl_Interp * SlaveCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr,
int safe);
+static int SlaveDebugCmd(Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp,
+ int objc, Tcl_Obj *const objv[]);
static int SlaveEval(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
int objc, Tcl_Obj *const objv[]);
static int SlaveExpose(Tcl_Interp *interp,
@@ -299,8 +300,8 @@ Tcl_Init(
{
if (tclPreInitScript != NULL) {
if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
- return (TCL_ERROR);
- };
+ return TCL_ERROR;
+ }
}
/*
@@ -435,7 +436,7 @@ TclInterpInit(
Master *masterPtr;
Slave *slavePtr;
- interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo));
+ interpInfoPtr = ckalloc(sizeof(InterpInfo));
((Interp *) interp)->interpInfo = interpInfoPtr;
masterPtr = &interpInfoPtr->master;
@@ -531,7 +532,7 @@ InterpInfoDeleteProc(
}
Tcl_DeleteHashTable(&slavePtr->aliasTable);
- ckfree((char *) interpInfoPtr);
+ ckfree(interpInfoPtr);
}
/*
@@ -558,19 +559,22 @@ Tcl_InterpObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
+ Tcl_Interp *slaveInterp;
int index;
static const char *const options[] = {
"alias", "aliases", "bgerror", "cancel",
- "create", "delete", "eval", "exists",
- "expose", "hide", "hidden", "issafe",
+ "create", "debug", "delete",
+ "eval", "exists", "expose",
+ "hide", "hidden", "issafe",
"invokehidden", "limit", "marktrusted", "recursionlimit",
"slaves", "share", "target", "transfer",
NULL
};
enum option {
OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CANCEL,
- OPT_CREATE, OPT_DELETE, OPT_EVAL, OPT_EXISTS,
- OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE,
+ 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,
OPT_SLAVES, OPT_SHARE, OPT_TARGET, OPT_TRANSFER
};
@@ -585,7 +589,7 @@ Tcl_InterpObjCmd(
}
switch ((enum option) index) {
case OPT_ALIAS: {
- Tcl_Interp *slaveInterp, *masterInterp;
+ Tcl_Interp *masterInterp;
if (objc < 4) {
aliasArgs:
@@ -619,18 +623,13 @@ Tcl_InterpObjCmd(
}
goto aliasArgs;
}
- case OPT_ALIASES: {
- Tcl_Interp *slaveInterp;
-
+ case OPT_ALIASES:
slaveInterp = GetInterp2(interp, objc, objv);
if (slaveInterp == NULL) {
return TCL_ERROR;
}
return AliasList(interp, slaveInterp);
- }
- case OPT_BGERROR: {
- Tcl_Interp *slaveInterp;
-
+ case OPT_BGERROR:
if (objc != 3 && objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path ?cmdPrefix?");
return TCL_ERROR;
@@ -640,10 +639,8 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveBgerror(interp, slaveInterp, objc - 3, objv + 3);
- }
case OPT_CANCEL: {
int i, flags;
- Tcl_Interp *slaveInterp;
Tcl_Obj *resultObjPtr;
static const char *const cancelOptions[] = {
"-unwind", "--", NULL
@@ -677,8 +674,7 @@ Tcl_InterpObjCmd(
}
}
- endOfForLoop:
-
+ endOfForLoop:
if ((i + 2) < objc) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-unwind? ?--? ?path? ?result?");
@@ -686,35 +682,34 @@ Tcl_InterpObjCmd(
}
/*
- * Did they specify a slave interp to cancel the script in
- * progress in? If not, use the current interp.
+ * Did they specify a slave 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) {
+ return TCL_ERROR;
+ }
i++;
} else {
slaveInterp = interp;
}
- if (slaveInterp != NULL) {
- if (i < objc) {
- resultObjPtr = objv[i];
-
- /*
- * Tcl_CancelEval removes this reference.
- */
+ if (i < objc) {
+ resultObjPtr = objv[i];
- Tcl_IncrRefCount(resultObjPtr);
- i++;
- } else {
- resultObjPtr = NULL;
- }
+ /*
+ * Tcl_CancelEval removes this reference.
+ */
- return Tcl_CancelEval(slaveInterp, resultObjPtr, 0, flags);
+ Tcl_IncrRefCount(resultObjPtr);
+ i++;
} else {
- return TCL_ERROR;
+ resultObjPtr = NULL;
}
+
+ return Tcl_CancelEval(slaveInterp, resultObjPtr, 0, flags);
}
case OPT_CREATE: {
int i, last, safe;
@@ -784,10 +779,23 @@ Tcl_InterpObjCmd(
Tcl_SetObjResult(interp, slavePtr);
return TCL_OK;
}
+ case OPT_DEBUG: /* TIP #378 */
+ /*
+ * Currently only -frame supported, otherwise ?-option ?value??
+ */
+
+ if (objc < 3 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "path ?-frame ?bool??");
+ return TCL_ERROR;
+ }
+ slaveInterp = GetInterp(interp, objv[2]);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+ return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3);
case OPT_DELETE: {
int i;
InterpInfo *iiPtr;
- Tcl_Interp *slaveInterp;
for (i = 2; i < objc; i++) {
slaveInterp = GetInterp(interp, objv[i]);
@@ -796,6 +804,8 @@ Tcl_InterpObjCmd(
} else if (slaveInterp == 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;
@@ -804,9 +814,7 @@ Tcl_InterpObjCmd(
}
return TCL_OK;
}
- case OPT_EVAL: {
- Tcl_Interp *slaveInterp;
-
+ case OPT_EVAL:
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
return TCL_ERROR;
@@ -816,12 +824,9 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveEval(interp, slaveInterp, objc - 3, objv + 3);
- }
case OPT_EXISTS: {
- int exists;
- Tcl_Interp *slaveInterp;
+ int exists = 1;
- exists = 1;
slaveInterp = GetInterp2(interp, objc, objv);
if (slaveInterp == NULL) {
if (objc > 3) {
@@ -833,9 +838,7 @@ Tcl_InterpObjCmd(
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists));
return TCL_OK;
}
- case OPT_EXPOSE: {
- Tcl_Interp *slaveInterp;
-
+ case OPT_EXPOSE:
if ((objc < 4) || (objc > 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "path hiddenCmdName ?cmdName?");
return TCL_ERROR;
@@ -845,10 +848,7 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3);
- }
- case OPT_HIDE: {
- Tcl_Interp *slaveInterp; /* A slave. */
-
+ case OPT_HIDE:
if ((objc < 4) || (objc > 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "path cmdName ?hiddenCmdName?");
return TCL_ERROR;
@@ -858,30 +858,22 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveHide(interp, slaveInterp, objc - 3, objv + 3);
- }
- case OPT_HIDDEN: {
- Tcl_Interp *slaveInterp; /* A slave. */
-
+ case OPT_HIDDEN:
slaveInterp = GetInterp2(interp, objc, objv);
if (slaveInterp == NULL) {
return TCL_ERROR;
}
return SlaveHidden(interp, slaveInterp);
- }
- case OPT_ISSAFE: {
- Tcl_Interp *slaveInterp;
-
+ case OPT_ISSAFE:
slaveInterp = GetInterp2(interp, objc, objv);
if (slaveInterp == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp)));
return TCL_OK;
- }
case OPT_INVOKEHID: {
int i;
const char *namespaceName;
- Tcl_Interp *slaveInterp;
static const char *const hiddenOptions[] = {
"-global", "-namespace", "--", NULL
};
@@ -924,7 +916,6 @@ Tcl_InterpObjCmd(
objv + i);
}
case OPT_LIMIT: {
- Tcl_Interp *slaveInterp;
static const char *const limitTypes[] = {
"commands", "time", NULL
};
@@ -953,9 +944,7 @@ Tcl_InterpObjCmd(
return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv);
}
}
- case OPT_MARKTRUSTED: {
- Tcl_Interp *slaveInterp;
-
+ case OPT_MARKTRUSTED:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "path");
return TCL_ERROR;
@@ -965,10 +954,7 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveMarkTrusted(interp, slaveInterp);
- }
- case OPT_RECLIMIT: {
- Tcl_Interp *slaveInterp;
-
+ case OPT_RECLIMIT:
if (objc != 3 && objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?");
return TCL_ERROR;
@@ -978,9 +964,7 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3);
- }
case OPT_SLAVES: {
- Tcl_Interp *slaveInterp;
InterpInfo *iiPtr;
Tcl_Obj *resultPtr;
Tcl_HashEntry *hPtr;
@@ -1004,8 +988,7 @@ Tcl_InterpObjCmd(
}
case OPT_TRANSFER:
case OPT_SHARE: {
- Tcl_Interp *slaveInterp; /* A slave. */
- Tcl_Interp *masterInterp; /* Its master. */
+ Tcl_Interp *masterInterp; /* The master of the slave. */
Tcl_Channel chan;
if (objc != 5) {
@@ -1040,7 +1023,6 @@ Tcl_InterpObjCmd(
return TCL_OK;
}
case OPT_TARGET: {
- Tcl_Interp *slaveInterp;
InterpInfo *iiPtr;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
@@ -1061,18 +1043,20 @@ Tcl_InterpObjCmd(
iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "alias \"", aliasName, "\" in path \"",
- Tcl_GetString(objv[2]), "\" not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "alias \"%s\" in path \"%s\" not found",
+ aliasName, Tcl_GetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
NULL);
return TCL_ERROR;
}
aliasPtr = Tcl_GetHashValue(hPtr);
if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "target interpreter for alias \"",
- aliasName, "\" in path \"", Tcl_GetString(objv[2]),
- "\" is not my descendant", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "target interpreter for alias \"%s\" in path \"%s\" is "
+ "not my descendant", aliasName, Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+ "TARGETSHROUDED", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -1250,7 +1234,8 @@ Tcl_GetAlias(
hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "alias \"%s\" not found", aliasName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
return TCL_ERROR;
}
@@ -1269,7 +1254,7 @@ Tcl_GetAlias(
}
if (argvPtr != NULL) {
*argvPtr = (const char **)
- ckalloc((unsigned) sizeof(const char *) * (objc - 1));
+ ckalloc(sizeof(const char *) * (objc - 1));
for (i = 1; i < objc; i++) {
(*argvPtr)[i - 1] = TclGetString(objv[i]);
}
@@ -1311,7 +1296,8 @@ Tcl_GetAliasObj(
hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "alias \"%s\" not found", aliasName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
return TCL_ERROR;
}
@@ -1399,9 +1385,9 @@ TclPreventAliasLoop(
* [Bug #641195]
*/
- Tcl_AppendResult(interp, "cannot define or rename alias \"",
- Tcl_GetCommandName(cmdInterp, cmd),
- "\": interpreter deleted", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot define or rename alias \"%s\": interpreter deleted",
+ Tcl_GetCommandName(cmdInterp, cmd)));
return TCL_ERROR;
}
cmdNamePtr = nextAliasPtr->objPtr;
@@ -1414,9 +1400,11 @@ TclPreventAliasLoop(
}
aliasCmdPtr = (Command *) aliasCmd;
if (aliasCmdPtr == cmdPtr) {
- Tcl_AppendResult(interp, "cannot define or rename alias \"",
- Tcl_GetCommandName(cmdInterp, cmd),
- "\": would create a loop", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot define or rename alias \"%s\": would create a loop",
+ Tcl_GetCommandName(cmdInterp, cmd)));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+ "ALIASLOOP", NULL);
return TCL_ERROR;
}
@@ -1472,8 +1460,7 @@ AliasCreate(
Tcl_Obj **prefv;
int isNew, i;
- aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias)
- + objc * sizeof(Tcl_Obj *)));
+ aliasPtr = ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
aliasPtr->token = namePtr;
Tcl_IncrRefCount(aliasPtr->token);
aliasPtr->targetInterp = masterInterp;
@@ -1524,7 +1511,7 @@ AliasCreate(
cmdPtr->deleteData = NULL;
Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
- ckfree((char *) aliasPtr);
+ ckfree(aliasPtr);
/*
* The result was already set by TclPreventAliasLoop.
@@ -1581,11 +1568,11 @@ AliasCreate(
* interp alias {} foo {} zop # Now recreate "foo"...
*/
- targetPtr = (Target *) ckalloc((unsigned) sizeof(Target));
+ targetPtr = ckalloc(sizeof(Target));
targetPtr->slaveCmd = aliasPtr->slaveCmd;
targetPtr->slaveInterp = slaveInterp;
- masterPtr = &((InterpInfo *) ((Interp*) masterInterp)->interpInfo)->master;
+ masterPtr = &((InterpInfo*) ((Interp*) masterInterp)->interpInfo)->master;
targetPtr->nextPtr = masterPtr->targetsPtr;
targetPtr->prevPtr = NULL;
if (masterPtr->targetsPtr != NULL) {
@@ -1636,8 +1623,8 @@ AliasDelete(
slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, TclGetString(namePtr));
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "alias \"", TclGetString(namePtr),
- "\" not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "alias \"%s\" not found", TclGetString(namePtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS",
TclGetString(namePtr), NULL);
return TCL_ERROR;
@@ -1968,8 +1955,8 @@ AliasObjCmdDeleteProc(
targetPtr->nextPtr->prevPtr = targetPtr->prevPtr;
}
- ckfree((char *) targetPtr);
- ckfree((char *) aliasPtr);
+ ckfree(targetPtr);
+ ckfree(aliasPtr);
}
/*
@@ -2074,6 +2061,72 @@ Tcl_GetMaster(
/*
*----------------------------------------------------------------------
*
+ * TclSetSlaveCancelFlags --
+ *
+ * This function marks all slave interpreters belonging to a given
+ * interpreter as being canceled or not canceled, depending on the
+ * provided flags.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclSetSlaveCancelFlags(
+ Tcl_Interp *interp, /* Set cancel flags of this interpreter. */
+ int flags, /* Collection of OR-ed bits that control
+ * the cancellation of the script. Only
+ * TCL_CANCEL_UNWIND is currently
+ * supported. */
+ int force) /* Non-zero to ignore numLevels for the purpose
+ * of resetting the cancellation flags. */
+{
+ Master *masterPtr; /* Master record of given interpreter. */
+ Tcl_HashEntry *hPtr; /* Search element. */
+ Tcl_HashSearch hashSearch; /* Search variable. */
+ Slave *slavePtr; /* Slave record of interpreter. */
+ Interp *iPtr;
+
+ if (interp == NULL) {
+ return;
+ }
+
+ flags &= (CANCELED | TCL_CANCEL_UNWIND);
+
+ masterPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->master;
+
+ hPtr = Tcl_FirstHashEntry(&masterPtr->slaveTable, &hashSearch);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
+ slavePtr = Tcl_GetHashValue(hPtr);
+ iPtr = (Interp *) slavePtr->slaveInterp;
+
+ if (iPtr == NULL) {
+ continue;
+ }
+
+ if (flags == 0) {
+ TclResetCancellation((Tcl_Interp *) iPtr, force);
+ } else {
+ TclSetCancelFlags(iPtr, flags);
+ }
+
+ /*
+ * Now, recursively handle this for the slaves of this slave
+ * interpreter.
+ */
+
+ TclSetSlaveCancelFlags((Tcl_Interp *) iPtr, flags, force);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetInterpPath --
*
* Sets the result of the asking interpreter to a proper Tcl list
@@ -2103,17 +2156,19 @@ Tcl_GetInterpPath(
InterpInfo *iiPtr;
if (targetInterp == askingInterp) {
+ Tcl_SetObjResult(askingInterp, 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(askingInterp, iiPtr->slave.masterInterp) != TCL_OK){
return TCL_ERROR;
}
- Tcl_AppendElement(askingInterp, Tcl_GetHashKey(&iiPtr->master.slaveTable,
- iiPtr->slave.slaveEntryPtr));
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(askingInterp),
+ Tcl_NewStringObj(Tcl_GetHashKey(&iiPtr->master.slaveTable,
+ iiPtr->slave.slaveEntryPtr), -1));
return TCL_OK;
}
@@ -2167,8 +2222,8 @@ GetInterp(
}
}
if (searchInterp == NULL) {
- Tcl_AppendResult(interp, "could not find interpreter \"",
- TclGetString(pathPtr), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not find interpreter \"%s\"", TclGetString(pathPtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP",
TclGetString(pathPtr), NULL);
}
@@ -2205,8 +2260,10 @@ SlaveBgerror(
if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length)
|| (length < 1)) {
- Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cmdPrefix must be list of length >= 1", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+ "BGERRORFORMAT", NULL);
return TCL_ERROR;
}
TclSetBgErrorHandler(slaveInterp, objv[0]);
@@ -2273,8 +2330,9 @@ SlaveCreate(
hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path,
&isNew);
if (isNew == 0) {
- Tcl_AppendResult(interp, "interpreter named \"", path,
- "\" already exists, cannot create", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "interpreter named \"%s\" already exists, cannot create",
+ path));
return NULL;
}
@@ -2376,14 +2434,16 @@ SlaveObjCmd(
Tcl_Interp *slaveInterp = clientData;
int index;
static const char *const options[] = {
- "alias", "aliases", "bgerror", "eval",
- "expose", "hide", "hidden", "issafe",
- "invokehidden", "limit", "marktrusted", "recursionlimit", NULL
+ "alias", "aliases", "bgerror", "debug",
+ "eval", "expose", "hide", "hidden",
+ "issafe", "invokehidden", "limit", "marktrusted",
+ "recursionlimit", NULL
};
enum options {
- OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_EVAL,
- OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE,
- OPT_INVOKEHIDDEN, OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT
+ OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_DEBUG,
+ OPT_EVAL, OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN,
+ OPT_ISSAFE, OPT_INVOKEHIDDEN, OPT_LIMIT, OPT_MARKTRUSTED,
+ OPT_RECLIMIT
};
if (slaveInterp == NULL) {
@@ -2428,6 +2488,16 @@ SlaveObjCmd(
return TCL_ERROR;
}
return SlaveBgerror(interp, slaveInterp, objc - 2, objv + 2);
+ case OPT_DEBUG:
+ /*
+ * TIP #378
+ * Currently only -frame supported, otherwise ?-option ?value? ...?
+ */
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-frame ?bool??");
+ return TCL_ERROR;
+ }
+ return SlaveDebugCmd(interp, slaveInterp, objc - 2, objv + 2);
case OPT_EVAL:
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
@@ -2591,6 +2661,77 @@ SlaveObjCmdDeleteProc(
/*
*----------------------------------------------------------------------
*
+ * SlaveDebugCmd -- TIP #378
+ *
+ * Helper function to handle 'debug' command in a slave interpreter.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * May modify INTERP_DEBUG_FRAME flag in the slave.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveDebugCmd(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* The slave interpreter in which command
+ * will be evaluated. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const debugTypes[] = {
+ "-frame", NULL
+ };
+ enum DebugTypes {
+ DEBUG_TYPE_FRAME
+ };
+ int debugType;
+ Interp *iPtr;
+ Tcl_Obj *resultPtr;
+
+ iPtr = (Interp *) slaveInterp;
+ if (objc == 0) {
+ resultPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj("-frame", -1));
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
+ Tcl_SetObjResult(interp, resultPtr);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes, "debug option",
+ 0, &debugType) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (debugType == DEBUG_TYPE_FRAME) {
+ if (objc == 2) { /* set */
+ if (Tcl_GetBooleanFromObj(interp, objv[1], &debugType)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Quietly ignore attempts to disable interp debugging. This
+ * is a one-way switch as frame debug info is maintained in a
+ * stack that must be consistent once turned on.
+ */
+
+ if (debugType) {
+ iPtr->flags |= INTERP_DEBUG_FRAME;
+ }
+ }
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* SlaveEval --
*
* Helper function to evaluate a command in a slave interpreter.
@@ -2614,6 +2755,16 @@ 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
+ * evaluate any scripts unless somebody calls the TclResetCancellation
+ * function for that particular Tcl_Interp.
+ */
+
+ TclSetSlaveCancelFlags(slaveInterp, 0, 0);
+
Tcl_Preserve(slaveInterp);
Tcl_AllowExceptions(slaveInterp);
@@ -2671,6 +2822,8 @@ SlaveExpose(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"permission denied: safe interpreter cannot expose commands",
-1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
+ NULL);
return TCL_ERROR;
}
@@ -2712,8 +2865,10 @@ SlaveRecursionLimit(
if (objc) {
if (Tcl_IsSafe(interp)) {
- Tcl_AppendResult(interp, "permission denied: "
- "safe interpreters cannot change recursion limit", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("permission denied: "
+ "safe interpreters cannot change recursion limit", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
+ NULL);
return TCL_ERROR;
}
if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
@@ -2722,6 +2877,8 @@ SlaveRecursionLimit(
if (limit <= 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"recursion limit must be > 0", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT",
+ NULL);
return TCL_ERROR;
}
Tcl_SetRecursionLimit(slaveInterp, limit);
@@ -2729,6 +2886,7 @@ SlaveRecursionLimit(
if (interp == slaveInterp && iPtr->numLevels > limit) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"falling back due to new recursion limit", -1));
+ Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, objv[0]);
@@ -2770,6 +2928,8 @@ SlaveHide(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"permission denied: safe interpreter cannot hide commands",
-1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
+ NULL);
return TCL_ERROR;
}
@@ -2852,6 +3012,8 @@ SlaveInvokeHidden(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"not allowed to invoke hidden commands from safe interpreter",
-1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
+ NULL);
return TCL_ERROR;
}
@@ -2906,6 +3068,8 @@ SlaveMarkTrusted(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"permission denied: safe interpreter cannot mark trusted",
-1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
+ NULL);
return TCL_ERROR;
}
((Interp *) slaveInterp)->flags &= ~SAFE_INTERP;
@@ -3161,8 +3325,9 @@ Tcl_LimitCheck(
if (iPtr->limit.cmdCount >= iPtr->cmdCount) {
iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
} else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "command count limit exceeded", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command count limit exceeded", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", NULL);
Tcl_Release(interp);
return TCL_ERROR;
}
@@ -3186,8 +3351,9 @@ Tcl_LimitCheck(
iPtr->limit.time.usec >= now.usec)) {
iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
} else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "time limit exceeded", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "time limit exceeded", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LIMIT", "TIME", NULL);
Tcl_Release(interp);
return TCL_ERROR;
}
@@ -3263,7 +3429,7 @@ RunLimitHandlers(
if (handlerPtr->deleteProc != NULL) {
handlerPtr->deleteProc(handlerPtr->clientData);
}
- ckfree((char *) handlerPtr);
+ ckfree(handlerPtr);
}
}
}
@@ -3310,7 +3476,7 @@ Tcl_LimitAddHandler(
* Allocate a handler record.
*/
- handlerPtr = (LimitHandler *) ckalloc(sizeof(LimitHandler));
+ handlerPtr = ckalloc(sizeof(LimitHandler));
handlerPtr->flags = 0;
handlerPtr->handlerProc = handlerProc;
handlerPtr->clientData = clientData;
@@ -3429,7 +3595,7 @@ Tcl_LimitRemoveHandler(
if (handlerPtr->deleteProc != NULL) {
handlerPtr->deleteProc(handlerPtr->clientData);
}
- ckfree((char *) handlerPtr);
+ ckfree(handlerPtr);
}
return;
}
@@ -3489,7 +3655,7 @@ TclLimitRemoveAllHandlers(
if (handlerPtr->deleteProc != NULL) {
handlerPtr->deleteProc(handlerPtr->clientData);
}
- ckfree((char *) handlerPtr);
+ ckfree(handlerPtr);
}
}
@@ -3522,7 +3688,7 @@ TclLimitRemoveAllHandlers(
if (handlerPtr->deleteProc != NULL) {
handlerPtr->deleteProc(handlerPtr->clientData);
}
- ckfree((char *) handlerPtr);
+ ckfree(handlerPtr);
}
}
@@ -3917,7 +4083,7 @@ DeleteScriptLimitCallback(
if (limitCBPtr->entryPtr != NULL) {
Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
}
- ckfree((char *) limitCBPtr);
+ ckfree(limitCBPtr);
}
/*
@@ -4017,7 +4183,7 @@ SetScriptLimitCallback(
limitCBPtr);
}
- limitCBPtr = (ScriptLimitCallback *) ckalloc(sizeof(ScriptLimitCallback));
+ limitCBPtr = ckalloc(sizeof(ScriptLimitCallback));
limitCBPtr->interp = interp;
limitCBPtr->scriptObj = scriptObj;
limitCBPtr->entryPtr = hashPtr;
@@ -4184,6 +4350,20 @@ SlaveCommandLimitCmd(
ScriptLimitCallback *limitCBPtr;
Tcl_HashEntry *hPtr;
+ /*
+ * First, ensure that we are not reading or writing the calling
+ * interpreter's limits; it may only manipulate its children. Note that
+ * the low level API enforces this with Tcl_Panic, which we want to
+ * avoid. [Bug 3398794]
+ */
+
+ if (interp == slaveInterp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "limits on current interpreter inaccessible", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
+ return TCL_ERROR;
+ }
+
if (objc == consumedObjc) {
Tcl_Obj *dictPtr;
@@ -4253,8 +4433,7 @@ SlaveCommandLimitCmd(
}
return TCL_OK;
} else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
- Tcl_WrongNumArgs(interp, consumedObjc, objv,
- "?-option value ...?");
+ Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
return TCL_ERROR;
} else {
int i, scriptLen = 0, limitLen = 0;
@@ -4277,8 +4456,10 @@ SlaveCommandLimitCmd(
return TCL_ERROR;
}
if (gran < 1) {
- Tcl_AppendResult(interp, "granularity must be at "
- "least 1", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "granularity must be at least 1", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+ "BADVALUE", NULL);
return TCL_ERROR;
}
break;
@@ -4292,8 +4473,10 @@ SlaveCommandLimitCmd(
return TCL_ERROR;
}
if (limit < 0) {
- Tcl_AppendResult(interp, "command limit value must be at "
- "least 0", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command limit value must be at least 0", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+ "BADVALUE", NULL);
return TCL_ERROR;
}
break;
@@ -4355,6 +4538,20 @@ SlaveTimeLimitCmd(
ScriptLimitCallback *limitCBPtr;
Tcl_HashEntry *hPtr;
+ /*
+ * First, ensure that we are not reading or writing the calling
+ * interpreter's limits; it may only manipulate its children. Note that
+ * the low level API enforces this with Tcl_Panic, which we want to
+ * avoid. [Bug 3398794]
+ */
+
+ if (interp == slaveInterp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "limits on current interpreter inaccessible", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
+ return TCL_ERROR;
+ }
+
if (objc == consumedObjc) {
Tcl_Obj *dictPtr;
@@ -4441,8 +4638,7 @@ SlaveTimeLimitCmd(
}
return TCL_OK;
} else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
- Tcl_WrongNumArgs(interp, consumedObjc, objv,
- "?-option value ...?");
+ Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
return TCL_ERROR;
} else {
int i, scriptLen = 0, milliLen = 0, secLen = 0;
@@ -4469,8 +4665,10 @@ SlaveTimeLimitCmd(
return TCL_ERROR;
}
if (gran < 1) {
- Tcl_AppendResult(interp, "granularity must be at "
- "least 1", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "granularity must be at least 1", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+ "BADVALUE", NULL);
return TCL_ERROR;
}
break;
@@ -4484,11 +4682,13 @@ SlaveTimeLimitCmd(
return TCL_ERROR;
}
if (tmp < 0) {
- Tcl_AppendResult(interp, "milliseconds must be at least 0",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "milliseconds must be at least 0", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+ "BADVALUE", NULL);
return TCL_ERROR;
}
- limitMoment.usec = ((long)tmp)*1000;
+ limitMoment.usec = ((long) tmp)*1000;
break;
case OPT_SEC:
secObj = objv[i+1];
@@ -4500,8 +4700,10 @@ SlaveTimeLimitCmd(
return TCL_ERROR;
}
if (tmp < 0) {
- Tcl_AppendResult(interp, "seconds must be at least 0",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "seconds must be at least 0", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+ "BADVALUE", NULL);
return TCL_ERROR;
}
limitMoment.sec = tmp;
@@ -4516,13 +4718,19 @@ SlaveTimeLimitCmd(
*/
if (secObj != NULL && secLen == 0 && milliLen > 0) {
- Tcl_AppendResult(interp, "may only set -milliseconds "
- "if -seconds is not also being reset", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may only set -milliseconds if -seconds is not "
+ "also being reset", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+ "BADUSAGE", NULL);
return TCL_ERROR;
}
if (milliLen == 0 && (secObj == NULL || secLen > 0)) {
- Tcl_AppendResult(interp, "may only reset -milliseconds "
- "if -seconds is also being reset", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may only reset -milliseconds if -seconds is "
+ "also being reset", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+ "BADUSAGE", NULL);
return TCL_ERROR;
}
}
diff --git a/generic/tclLink.c b/generic/tclLink.c
index b2d236b..a3b42bd 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -11,8 +11,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclLink.c,v 1.26 2008/10/28 23:29:54 nijtmans Exp $
*/
#include "tclInt.h"
@@ -114,7 +112,15 @@ Tcl_LinkVar(
Link *linkPtr;
int code;
- linkPtr = (Link *) ckalloc(sizeof(Link));
+ linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
+ LinkTraceProc, (ClientData) NULL);
+ if (linkPtr != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "variable '%s' is already linked", varName));
+ return TCL_ERROR;
+ }
+
+ linkPtr = ckalloc(sizeof(Link));
linkPtr->interp = interp;
linkPtr->varName = Tcl_NewStringObj(varName, -1);
Tcl_IncrRefCount(linkPtr->varName);
@@ -129,14 +135,14 @@ Tcl_LinkVar(
if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_DecrRefCount(linkPtr->varName);
- ckfree((char *) linkPtr);
+ ckfree(linkPtr);
return TCL_ERROR;
}
code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
if (code != TCL_OK) {
Tcl_DecrRefCount(linkPtr->varName);
- ckfree((char *) linkPtr);
+ ckfree(linkPtr);
}
return code;
}
@@ -174,7 +180,7 @@ Tcl_UnlinkVar(
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
LinkTraceProc, linkPtr);
Tcl_DecrRefCount(linkPtr->varName);
- ckfree((char *) linkPtr);
+ ckfree(linkPtr);
}
/*
@@ -268,7 +274,7 @@ LinkTraceProc(
if (flags & TCL_TRACE_UNSETS) {
if (Tcl_InterpDeleted(interp)) {
Tcl_DecrRefCount(linkPtr->varName);
- ckfree((char *) linkPtr);
+ ckfree(linkPtr);
} else if (flags & TCL_TRACE_DESTROYED) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 6745f62..3668b45 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclListObj.c,v 1.60 2010/03/18 20:34:48 dgp Exp $
*/
#include "tclInt.h"
@@ -19,7 +17,9 @@
* Prototypes for functions defined later in this file:
*/
-static List * NewListIntRep(int objc, Tcl_Obj *const objv[]);
+static List * AttemptNewList(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static List * NewListIntRep(int objc, Tcl_Obj *const objv[], int p);
static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeListInternalRep(Tcl_Obj *listPtr);
static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
@@ -45,22 +45,26 @@ const Tcl_ObjType tclListType = {
UpdateStringOfList, /* updateStringProc */
SetListFromAny /* setFromAnyProc */
};
+
+#ifndef TCL_MIN_ELEMENT_GROWTH
+#define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
+#endif
/*
*----------------------------------------------------------------------
*
* NewListIntRep --
*
- * If objc>0 and objv!=NULL, this function creates a list internal rep
- * with objc elements given in the array objv. If objc>0 and objv==NULL
- * it creates the list internal rep of a list with 0 elements, where
- * enough space has been preallocated to store objc elements. If objc<=0,
- * it returns NULL.
+ * Creates a list internal rep with space for objc elements. objc
+ * must be > 0. If objv!=NULL, initializes with the first objc values
+ * in that array. If objv==NULL, initalize list internal rep to have
+ * 0 elements, with space to add objc more. Flag value "p" indicates
+ * how to behave on failure.
*
* Results:
- * A new List struct is returned. If objc<=0 or if the allocation fails
- * for lack of memory, NULL is returned. The list returned has refCount
- * 0.
+ * A new List struct with refCount 0 is returned. If some failure
+ * prevents this then if p=0, NULL is returned and otherwise the
+ * routine panics.
*
* Side effects:
* The ref counts of the elements in objv are incremented since the
@@ -72,12 +76,13 @@ const Tcl_ObjType tclListType = {
static List *
NewListIntRep(
int objc,
- Tcl_Obj *const objv[])
+ Tcl_Obj *const objv[],
+ int p)
{
List *listRepPtr;
if (objc <= 0) {
- return NULL;
+ Tcl_Panic("NewListIntRep: expects postive element count");
}
/*
@@ -87,13 +92,20 @@ NewListIntRep(
* requires API changes to fix. See [Bug 219196] for a discussion.
*/
- if ((size_t)objc > INT_MAX/sizeof(Tcl_Obj *)) {
+ if ((size_t)objc > LIST_MAX) {
+ if (p) {
+ Tcl_Panic("max length of a Tcl list (%d elements) exceeded",
+ LIST_MAX);
+ }
return NULL;
}
- listRepPtr = (List *)
- attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)));
+ listRepPtr = attemptckalloc(LIST_SIZE(objc));
if (listRepPtr == NULL) {
+ if (p) {
+ Tcl_Panic("list creation failed: unable to alloc %u bytes",
+ LIST_SIZE(objc));
+ }
return NULL;
}
@@ -120,6 +132,51 @@ NewListIntRep(
/*
*----------------------------------------------------------------------
*
+ * AttemptNewList --
+ *
+ * Creates a list internal rep with space for objc elements. objc
+ * must be > 0. If objv!=NULL, initializes with the first objc values
+ * in that array. If objv==NULL, initalize list internal rep to have
+ * 0 elements, with space to add objc more.
+ *
+ * Results:
+ * A new List struct with refCount 0 is returned. If some failure
+ * prevents this then NULL is returned, and an error message is left
+ * in the interp result, unless interp is NULL.
+ *
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static List *
+AttemptNewList(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ List *listRepPtr = NewListIntRep(objc, objv, 0);
+
+ if (interp != NULL && listRepPtr == NULL) {
+ if (objc > LIST_MAX) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max length of a Tcl list (%d elements) exceeded",
+ LIST_MAX));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "list creation failed: unable to alloc %u bytes",
+ LIST_SIZE(objc)));
+ }
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return listRepPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_NewListObj --
*
* This function is normally called when not debugging: i.e., when
@@ -174,21 +231,14 @@ Tcl_NewListObj(
* Create the internal rep.
*/
- listRepPtr = NewListIntRep(objc, objv);
- if (!listRepPtr) {
- Tcl_Panic("Not enough memory to allocate list");
- }
+ listRepPtr = NewListIntRep(objc, objv, 1);
/*
* Now create the object.
*/
Tcl_InvalidateStringRep(listPtr);
- listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
- listPtr->typePtr = &tclListType;
- listRepPtr->refCount++;
-
+ ListSetIntRep(listPtr, listRepPtr);
return listPtr;
}
#endif /* if TCL_MEM_DEBUG */
@@ -246,20 +296,14 @@ Tcl_DbNewListObj(
* Create the internal rep.
*/
- listRepPtr = NewListIntRep(objc, objv);
- if (!listRepPtr) {
- Tcl_Panic("Not enough memory to allocate list");
- }
+ listRepPtr = NewListIntRep(objc, objv, 1);
/*
* Now create the object.
*/
Tcl_InvalidateStringRep(listPtr);
- listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
- listPtr->typePtr = &tclListType;
- listRepPtr->refCount++;
+ ListSetIntRep(listPtr, listRepPtr);
return listPtr;
}
@@ -318,7 +362,6 @@ Tcl_SetListObj(
*/
TclFreeIntRep(objPtr);
- objPtr->typePtr = NULL;
Tcl_InvalidateStringRep(objPtr);
/*
@@ -328,14 +371,8 @@ Tcl_SetListObj(
*/
if (objc > 0) {
- listRepPtr = NewListIntRep(objc, objv);
- if (!listRepPtr) {
- Tcl_Panic("Cannot allocate enough memory for Tcl_SetListObj");
- }
- objPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclListType;
- listRepPtr->refCount++;
+ listRepPtr = NewListIntRep(objc, objv, 1);
+ ListSetIntRep(objPtr, listRepPtr);
} else {
objPtr->bytes = tclEmptyStringRep;
objPtr->length = 0;
@@ -426,30 +463,19 @@ Tcl_ListObjGetElements(
register List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
- int result, length;
-
- /*
- * Don't get the string version of a dictionary; that transformation
- * is not lossy, but is expensive.
- */
+ int result;
- if (listPtr->typePtr == &tclDictType) {
- (void) Tcl_DictObjSize(NULL, listPtr, &length);
- } else {
- (void) TclGetStringFromObj(listPtr, &length);
- }
- if (!length) {
+ if (listPtr->bytes == tclEmptyStringRep) {
*objcPtr = 0;
*objvPtr = NULL;
return TCL_OK;
}
-
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
}
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr = ListRepPtr(listPtr);
*objcPtr = listRepPtr->elemCount;
*objvPtr = &listRepPtr->elements;
return TCL_OK;
@@ -460,16 +486,13 @@ Tcl_ListObjGetElements(
*
* Tcl_ListObjAppendList --
*
- * This function appends the objects in the list referenced by
- * elemListPtr to the list object referenced by listPtr. If listPtr is
- * not already a list object, an attempt will be made to convert it to
- * one.
+ * This function appends the elements in the list value referenced by
+ * elemListPtr to the list value referenced by listPtr.
*
* Results:
* The return value is normally TCL_OK. If listPtr or elemListPtr do not
- * refer to list objects and they can not be converted to one, TCL_ERROR
- * is returned and an error message is left in the interpreter's result
- * if interp is not NULL.
+ * refer to list values, TCL_ERROR is returned and an error message is
+ * left in the interpreter's result if interp is not NULL.
*
* Side effects:
* The reference counts of the elements in elemListPtr are incremented
@@ -487,29 +510,27 @@ Tcl_ListObjAppendList(
register Tcl_Obj *listPtr, /* List object to append elements to. */
Tcl_Obj *elemListPtr) /* List obj with elements to append. */
{
- int listLen, objc, result;
+ int objc;
Tcl_Obj **objv;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
}
- result = TclListObjLength(interp, listPtr, &listLen);
- if (result != TCL_OK) {
- return result;
- }
+ /*
+ * Pull the elements to append from elemListPtr.
+ */
- result = TclListObjGetElements(interp, elemListPtr, &objc, &objv);
- if (result != TCL_OK) {
- return result;
+ if (TCL_OK != TclListObjGetElements(interp, elemListPtr, &objc, &objv)) {
+ return TCL_ERROR;
}
/*
- * Insert objc new elements starting after the lists's last element.
+ * Insert the new elements starting after the lists's last element.
* Delete zero existing elements.
*/
- return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
+ return Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, objc, objv);
}
/*
@@ -545,77 +566,129 @@ Tcl_ListObjAppendElement(
Tcl_Obj *listPtr, /* List object to append objPtr to. */
Tcl_Obj *objPtr) /* Object to append to listPtr's list. */
{
- register List *listRepPtr;
- register Tcl_Obj **elemPtrs;
- int numElems, numRequired, newMax, newSize, i;
+ register List *listRepPtr, *newPtr = NULL;
+ int numElems, numRequired, needGrow, isShared, attempt;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
}
if (listPtr->typePtr != &tclListType) {
- int result, length;
+ int result;
- (void) TclGetStringFromObj(listPtr, &length);
- if (!length) {
+ if (listPtr->bytes == tclEmptyStringRep) {
Tcl_SetListObj(listPtr, 1, &objPtr);
return TCL_OK;
}
-
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
}
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr = ListRepPtr(listPtr);
numElems = listRepPtr->elemCount;
numRequired = numElems + 1 ;
+ needGrow = (numRequired > listRepPtr->maxElemCount);
+ isShared = (listRepPtr->refCount > 1);
- /*
- * If there is no room in the current array of element pointers, allocate
- * a new, larger array and copy the pointers to it. If the List struct is
- * shared, allocate a new one.
- */
+ if (numRequired > LIST_MAX) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max length of a Tcl list (%d elements) exceeded",
+ LIST_MAX));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return TCL_ERROR;
+ }
- if (numRequired > listRepPtr->maxElemCount){
- newMax = 2 * numRequired;
- newSize = sizeof(List) + ((newMax-1) * sizeof(Tcl_Obj *));
- } else {
- newMax = listRepPtr->maxElemCount;
- newSize = 0;
+ if (needGrow && !isShared) {
+ /*
+ * Need to grow + unshared intrep => try to realloc
+ */
+
+ attempt = 2 * numRequired;
+ if (attempt <= LIST_MAX) {
+ newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
+ }
+ if (newPtr == NULL) {
+ attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
+ if (attempt > LIST_MAX) {
+ attempt = LIST_MAX;
+ }
+ newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
+ }
+ if (newPtr == NULL) {
+ attempt = numRequired;
+ newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
+ }
+ if (newPtr) {
+ listRepPtr = newPtr;
+ listRepPtr->maxElemCount = attempt;
+ needGrow = 0;
+ }
}
+ if (isShared || needGrow) {
+ Tcl_Obj **dst, **src = &listRepPtr->elements;
- if (listRepPtr->refCount > 1) {
- List *oldListRepPtr = listRepPtr;
- Tcl_Obj **oldElems;
+ /*
+ * Either we have a shared intrep and we must copy to write, or we
+ * need to grow and realloc attempts failed. Attempt intrep copy.
+ */
- listRepPtr = NewListIntRep(newMax, NULL);
- if (!listRepPtr) {
- Tcl_Panic("Not enough memory to allocate list");
+ attempt = 2 * numRequired;
+ newPtr = AttemptNewList(NULL, attempt, NULL);
+ if (newPtr == NULL) {
+ attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
+ if (attempt > LIST_MAX) {
+ attempt = LIST_MAX;
+ }
+ newPtr = AttemptNewList(NULL, attempt, NULL);
}
- oldElems = &oldListRepPtr->elements;
- elemPtrs = &listRepPtr->elements;
- for (i=0; i<numElems; i++) {
- elemPtrs[i] = oldElems[i];
- Tcl_IncrRefCount(elemPtrs[i]);
+ if (newPtr == NULL) {
+ attempt = numRequired;
+ newPtr = AttemptNewList(interp, attempt, NULL);
}
- listRepPtr->elemCount = numElems;
- listRepPtr->refCount++;
- oldListRepPtr->refCount--;
- listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
- } else if (newSize) {
- listRepPtr = (List *) ckrealloc((char *)listRepPtr, (size_t)newSize);
- listRepPtr->maxElemCount = newMax;
- listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ if (newPtr == NULL) {
+ /*
+ * All growth attempts failed; throw the error.
+ */
+
+ return TCL_ERROR;
+ }
+
+ dst = &newPtr->elements;
+ newPtr->refCount++;
+ newPtr->canonicalFlag = listRepPtr->canonicalFlag;
+ newPtr->elemCount = listRepPtr->elemCount;
+
+ if (isShared) {
+ /*
+ * The original intrep must remain undisturbed. Copy into the new
+ * one and bump refcounts
+ */
+ while (numElems--) {
+ *dst = *src++;
+ Tcl_IncrRefCount(*dst++);
+ }
+ listRepPtr->refCount--;
+ } else {
+ /*
+ * Old intrep to be freed, re-use refCounts.
+ */
+
+ memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *));
+ ckfree(listRepPtr);
+ }
+ listRepPtr = newPtr;
}
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
/*
* Add objPtr to the end of listPtr's array of element pointers. Increment
* the ref count for the (now shared) objPtr.
*/
- elemPtrs = &listRepPtr->elements;
- elemPtrs[numElems] = objPtr;
+ *(&listRepPtr->elements + listRepPtr->elemCount) = objPtr;
Tcl_IncrRefCount(objPtr);
listRepPtr->elemCount++;
@@ -664,21 +737,19 @@ Tcl_ListObjIndex(
register List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
- int result, length;
+ int result;
- (void) TclGetStringFromObj(listPtr, &length);
- if (!length) {
+ if (listPtr->bytes == tclEmptyStringRep) {
*objPtrPtr = NULL;
return TCL_OK;
}
-
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
}
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr = ListRepPtr(listPtr);
if ((index < 0) || (index >= listRepPtr->elemCount)) {
*objPtrPtr = NULL;
} else {
@@ -719,21 +790,19 @@ Tcl_ListObjLength(
register List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
- int result, length;
+ int result;
- (void) TclGetStringFromObj(listPtr, &length);
- if (!length) {
+ if (listPtr->bytes == tclEmptyStringRep) {
*intPtr = 0;
return TCL_OK;
}
-
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
}
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr = ListRepPtr(listPtr);
*intPtr = listRepPtr->elemCount;
return TCL_OK;
}
@@ -794,15 +863,11 @@ Tcl_ListObjReplace(
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
if (listPtr->typePtr != &tclListType) {
- int length;
-
- (void) TclGetStringFromObj(listPtr, &length);
- if (!length) {
- if (objc) {
- Tcl_SetListObj(listPtr, objc, NULL);
- } else {
+ if (listPtr->bytes == tclEmptyStringRep) {
+ if (!objc) {
return TCL_OK;
}
+ Tcl_SetListObj(listPtr, objc, NULL);
} else {
int result = SetListFromAny(interp, listPtr);
@@ -820,7 +885,7 @@ Tcl_ListObjReplace(
* Resist any temptation to optimize this case.
*/
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr = ListRepPtr(listPtr);
elemPtrs = &listRepPtr->elements;
numElems = listRepPtr->elemCount;
@@ -835,8 +900,9 @@ Tcl_ListObjReplace(
} else if (numElems < first+count || first+count < 0) {
/*
* The 'first+count < 0' condition here guards agains integer
- * overflow in determining 'first+count'
+ * overflow in determining 'first+count'.
*/
+
count = numElems - first;
}
@@ -886,12 +952,23 @@ Tcl_ListObjReplace(
newMax = listRepPtr->maxElemCount;
}
- listRepPtr = NewListIntRep(newMax, NULL);
- if (!listRepPtr) {
- Tcl_Panic("Not enough memory to allocate list");
+ listRepPtr = AttemptNewList(NULL, newMax, NULL);
+ if (listRepPtr == NULL) {
+ unsigned int limit = LIST_MAX - numRequired;
+ unsigned int extra = numRequired - numElems
+ + TCL_MIN_ELEMENT_GROWTH;
+ int growth = (int) ((extra > limit) ? limit : extra);
+
+ listRepPtr = AttemptNewList(NULL, numRequired + growth, NULL);
+ if (listRepPtr == NULL) {
+ listRepPtr = AttemptNewList(interp, numRequired, NULL);
+ if (listRepPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
}
- listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
listRepPtr->refCount++;
elemPtrs = &listRepPtr->elements;
@@ -945,7 +1022,7 @@ Tcl_ListObjReplace(
(size_t) numAfterLast * sizeof(Tcl_Obj *));
}
- ckfree((char *) oldListRepPtr);
+ ckfree(oldListRepPtr);
}
}
@@ -1008,8 +1085,6 @@ TclLindexList(
{
int index; /* Index into the list. */
- Tcl_Obj **indices; /* Array of list indices. */
- int indexCount; /* Size of the array of list indices. */
Tcl_Obj *indexListCopy;
/*
@@ -1049,8 +1124,19 @@ TclLindexList(
return TclLindexFlat(interp, listPtr, 1, &argPtr);
}
- TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
- listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
+ if (indexListCopy->typePtr == &tclListType) {
+ List *listRepPtr = ListRepPtr(indexListCopy);
+
+ listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount,
+ &listRepPtr->elements);
+ } else {
+ int indexCount = -1; /* Size of the array of list indices. */
+ Tcl_Obj **indices = NULL;
+ /* Array of list indices. */
+
+ Tcl_ListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
+ listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
+ }
Tcl_DecrRefCount(indexListCopy);
return listPtr;
}
@@ -1232,8 +1318,8 @@ TclLsetList(
*
* Results:
* Returns the new value of the list variable, or NULL if an error
- * occurred. The returned object includes one reference count for
- * the pointer returned.
+ * occurred. The returned object includes one reference count for the
+ * pointer returned.
*
* Side effects:
* On entry, the reference count of the variable value does not reflect
@@ -1279,8 +1365,8 @@ TclLsetFlat(
Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
/*
- * If there are no indices, simply return the new value.
- * (Without indices, [lset] is a synonym for [set].
+ * If there are no indices, simply return the new value. (Without
+ * indices, [lset] is a synonym for [set].
*/
if (indexCount == 0) {
@@ -1289,14 +1375,14 @@ TclLsetFlat(
}
/*
- * If the list is shared, make a copy we can modify (copy-on-write).
- * We use Tcl_DuplicateObj() instead of TclListObjCopy() for a few
- * reasons: 1) we have not yet confirmed listPtr is actually a list;
- * 2) We make a verbatim copy of any existing string rep, and when
- * we combine that with the delayed invalidation of string reps of
- * modified Tcl_Obj's implemented below, the outcome is that any
- * error condition that causes this routine to return NULL, will
- * leave the string rep of listPtr and all elements to be unchanged.
+ * If the list is shared, make a copy we can modify (copy-on-write). We
+ * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons:
+ * 1) we have not yet confirmed listPtr is actually a list; 2) We make a
+ * verbatim copy of any existing string rep, and when we combine that with
+ * the delayed invalidation of string reps of modified Tcl_Obj's
+ * implemented below, the outcome is that any error condition that causes
+ * this routine to return NULL, will leave the string rep of listPtr and
+ * all elements to be unchanged.
*/
subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;
@@ -1308,21 +1394,25 @@ TclLsetFlat(
retValuePtr = subListPtr;
chainPtr = NULL;
+ result = TCL_OK;
/*
- * Loop through all the index arguments, and for each one dive
- * into the appropriate sublist.
+ * Loop through all the index arguments, and for each one dive into the
+ * appropriate sublist.
*/
do {
int elemCount;
Tcl_Obj *parentList, **elemPtrs;
- /* Check for the possible error conditions... */
- result = TCL_ERROR;
+ /*
+ * Check for the possible error conditions...
+ */
+
if (TclListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs)
!= TCL_OK) {
/* ...the sublist we're indexing into isn't a list at all. */
+ result = TCL_ERROR;
break;
}
@@ -1334,6 +1424,7 @@ TclLsetFlat(
if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index)
!= TCL_OK) {
/* ...the index we're trying to use isn't an index at all. */
+ result = TCL_ERROR;
indexArray++;
break;
}
@@ -1341,19 +1432,23 @@ TclLsetFlat(
if (index < 0 || index > elemCount) {
/* ...the index points outside the sublist. */
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("list index out of range", -1));
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("list index out of range", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET",
+ "BADINDEX", NULL);
+ }
+ result = TCL_ERROR;
break;
}
/*
- * No error conditions. As long as we're not yet on the last
- * index, determine the next sublist for the next pass through
- * the loop, and take steps to make sure it is an unshared copy,
- * as we intend to modify it.
+ * No error conditions. As long as we're not yet on the last index,
+ * determine the next sublist for the next pass through the loop, and
+ * take steps to make sure it is an unshared copy, as we intend to
+ * modify it.
*/
- result = TCL_OK;
if (--indexCount) {
parentList = subListPtr;
if (index == elemCount) {
@@ -1370,8 +1465,8 @@ TclLsetFlat(
* we know to be unshared. This call will also deal with the
* situation where parentList shares its intrep with other
* Tcl_Obj's. Dealing with the shared intrep case can cause
- * subListPtr to become shared again, so detect that case and
- * make and store another copy.
+ * subListPtr to become shared again, so detect that case and make
+ * and store another copy.
*/
if (index == elemCount) {
@@ -1385,62 +1480,71 @@ TclLsetFlat(
}
/*
- * The TclListObjSetElement() calls do not spoil the string
- * rep of parentList, and that's fine for now, since all we've
- * done so far is replace a list element with an unshared copy.
- * The list value remains the same, so the string rep. is still
- * valid, and unchanged, which is good because if this whole
- * routine returns NULL, we'd like to leave no change to the
- * value of the lset variable. Later on, when we set valuePtr
- * in its proper place, then all containing lists will have
- * their values changed, and will need their string reps spoiled.
- * We maintain a list of all those Tcl_Obj's (via a little intrep
- * surgery) so we can spoil them at that time.
+ * The TclListObjSetElement() calls do not spoil the string rep of
+ * parentList, and that's fine for now, since all we've done so
+ * far is replace a list element with an unshared copy. The list
+ * value remains the same, so the string rep. is still valid, and
+ * unchanged, which is good because if this whole routine returns
+ * NULL, we'd like to leave no change to the value of the lset
+ * variable. Later on, when we set valuePtr in its proper place,
+ * then all containing lists will have their values changed, and
+ * will need their string reps spoiled. We maintain a list of all
+ * those Tcl_Obj's (via a little intrep surgery) so we can spoil
+ * them at that time.
*/
- parentList->internalRep.twoPtrValue.ptr2 = (void *) chainPtr;
+ parentList->internalRep.twoPtrValue.ptr2 = chainPtr;
chainPtr = parentList;
}
} while (indexCount > 0);
/*
- * Either we've detected and error condition, and exited the loop
- * with result == TCL_ERROR, or we've successfully reached the last
- * index, and we're ready to store valuePtr. In either case, we
- * need to clean up our string spoiling list of Tcl_Obj's.
+ * Either we've detected and error condition, and exited the loop with
+ * result == TCL_ERROR, or we've successfully reached the last index, and
+ * we're ready to store valuePtr. In either case, we need to clean up our
+ * string spoiling list of Tcl_Obj's.
*/
while (chainPtr) {
Tcl_Obj *objPtr = chainPtr;
if (result == TCL_OK) {
-
/*
- * We're going to store valuePtr, so spoil string reps
- * of all containing lists.
+ * We're going to store valuePtr, so spoil string reps of all
+ * containing lists.
*/
Tcl_InvalidateStringRep(objPtr);
}
- /* Clear away our intrep surgery mess */
- chainPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
+ /*
+ * Clear away our intrep surgery mess.
+ */
+
+ chainPtr = objPtr->internalRep.twoPtrValue.ptr2;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
}
if (result != TCL_OK) {
/*
- * Error return; message is already in interp. Clean up
- * any excess memory.
+ * Error return; message is already in interp. Clean up any excess
+ * memory.
*/
+
if (retValuePtr != listPtr) {
Tcl_DecrRefCount(retValuePtr);
}
return NULL;
}
- /* Store valuePtr in proper sublist and return */
- Tcl_ListObjLength(NULL, subListPtr, &len);
+ /*
+ * Store valuePtr in proper sublist and return. The -1 is to avoid a
+ * compiler warning (not a problem because we checked that we have a
+ * proper list - or something convertible to one - above).
+ */
+
+ len = -1;
+ TclListObjLength(NULL, subListPtr, &len);
if (index == len) {
Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
} else {
@@ -1503,12 +1607,15 @@ TclListObjSetElement(
Tcl_Panic("%s called with shared object", "TclListObjSetElement");
}
if (listPtr->typePtr != &tclListType) {
- int length, result;
+ int result;
- (void) TclGetStringFromObj(listPtr, &length);
- if (!length) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("list index out of range", -1));
+ if (listPtr->bytes == tclEmptyStringRep) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("list index out of range", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET",
+ "BADINDEX", NULL);
+ }
return TCL_ERROR;
}
result = SetListFromAny(interp, listPtr);
@@ -1517,9 +1624,8 @@ TclListObjSetElement(
}
}
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr = ListRepPtr(listPtr);
elemCount = listRepPtr->elemCount;
- elemPtrs = &listRepPtr->elements;
/*
* Ensure that the index is in bounds.
@@ -1529,6 +1635,8 @@ TclListObjSetElement(
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX",
+ NULL);
}
return TCL_ERROR;
}
@@ -1538,25 +1646,30 @@ TclListObjSetElement(
*/
if (listRepPtr->refCount > 1) {
- List *oldListRepPtr = listRepPtr;
- Tcl_Obj **oldElemPtrs = elemPtrs;
- int i;
+ Tcl_Obj **dst, **src = &listRepPtr->elements;
+ List *newPtr = AttemptNewList(NULL, listRepPtr->maxElemCount, NULL);
- listRepPtr = NewListIntRep(listRepPtr->maxElemCount, NULL);
- if (listRepPtr == NULL) {
- Tcl_Panic("Not enough memory to allocate list");
+ if (newPtr == NULL) {
+ newPtr = AttemptNewList(interp, elemCount, NULL);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
}
- listRepPtr->canonicalFlag = oldListRepPtr->canonicalFlag;
- elemPtrs = &listRepPtr->elements;
- for (i=0; i < elemCount; i++) {
- elemPtrs[i] = oldElemPtrs[i];
- Tcl_IncrRefCount(elemPtrs[i]);
+ newPtr->refCount++;
+ newPtr->elemCount = elemCount;
+ newPtr->canonicalFlag = listRepPtr->canonicalFlag;
+
+ dst = &newPtr->elements;
+ while (elemCount--) {
+ *dst = *src++;
+ Tcl_IncrRefCount(*dst++);
}
- listRepPtr->refCount++;
- listRepPtr->elemCount = elemCount;
- listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
- oldListRepPtr->refCount--;
+
+ listRepPtr->refCount--;
+
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr = newPtr;
}
+ elemPtrs = &listRepPtr->elements;
/*
* Add a reference to the new list element.
@@ -1602,18 +1715,16 @@ static void
FreeListInternalRep(
Tcl_Obj *listPtr) /* List object with internal rep to free. */
{
- register List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
- register Tcl_Obj **elemPtrs = &listRepPtr->elements;
- register Tcl_Obj *objPtr;
- int numElems = listRepPtr->elemCount;
- int i;
+ List *listRepPtr = ListRepPtr(listPtr);
if (--listRepPtr->refCount <= 0) {
+ Tcl_Obj **elemPtrs = &listRepPtr->elements;
+ int i, numElems = listRepPtr->elemCount;
+
for (i = 0; i < numElems; i++) {
- objPtr = elemPtrs[i];
- Tcl_DecrRefCount(objPtr);
+ Tcl_DecrRefCount(elemPtrs[i]);
}
- ckfree((char *) listRepPtr);
+ ckfree(listRepPtr);
}
listPtr->internalRep.twoPtrValue.ptr1 = NULL;
@@ -1643,12 +1754,9 @@ DupListInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- List *listRepPtr = (List *) srcPtr->internalRep.twoPtrValue.ptr1;
+ List *listRepPtr = ListRepPtr(srcPtr);
- listRepPtr->refCount++;
- copyPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
- copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
- copyPtr->typePtr = &tclListType;
+ ListSetIntRep(copyPtr, listRepPtr);
}
/*
@@ -1675,15 +1783,8 @@ SetListFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr) /* The object to convert. */
{
- const char *string;
- char *s;
- const char *elemStart, *nextElem;
- int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
- const char *limit; /* Points just after string's last byte. */
- register const char *p;
- register Tcl_Obj **elemPtrs;
- register Tcl_Obj *elemPtr;
List *listRepPtr;
+ Tcl_Obj **elemPtrs;
/*
* Dictionaries are a special case; they have a string representation such
@@ -1708,12 +1809,8 @@ SetListFromAny(
*/
Tcl_DictObjSize(NULL, objPtr, &size);
- listRepPtr = NewListIntRep(size > 0 ? 2*size : 1, NULL);
+ listRepPtr = AttemptNewList(interp, size > 0 ? 2*size : 1, NULL);
if (!listRepPtr) {
- Tcl_SetResult(interp,
- "insufficient memory to allocate list working space",
- TCL_STATIC);
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
}
listRepPtr->elemCount = 2 * size;
@@ -1724,117 +1821,75 @@ SetListFromAny(
elemPtrs = &listRepPtr->elements;
Tcl_DictObjFirst(NULL, objPtr, &search, &keyPtr, &valuePtr, &done);
- i = 0;
while (!done) {
- elemPtrs[i++] = keyPtr;
- elemPtrs[i++] = valuePtr;
+ *elemPtrs++ = keyPtr;
+ *elemPtrs++ = valuePtr;
Tcl_IncrRefCount(keyPtr);
Tcl_IncrRefCount(valuePtr);
Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
}
+ } else {
+ int estCount, length;
+ const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);
/*
- * Swap the representations.
+ * Allocate enough space to hold a (Tcl_Obj *) for each
+ * (possible) list element.
*/
- goto commitRepresentation;
- }
-
- /*
- * Get the string representation. Make it up-to-date if necessary.
- */
-
- string = TclGetStringFromObj(objPtr, &length);
-
- /*
- * Parse the string into separate string objects, and create a List
- * structure that points to the element string objects. We use a modified
- * version of Tcl_SplitList's implementation to avoid one malloc and a
- * string copy for each list element. First, estimate the number of
- * elements by counting the number of space characters in the list.
- */
-
- limit = string + length;
- estCount = 1;
- for (p = string; p < limit; p++) {
- if (isspace(UCHAR(*p))) { /* INTL: ISO space. */
- estCount++;
+ estCount = TclMaxListLength(nextElem, length, &limit);
+ estCount += (estCount == 0); /* Smallest list struct holds 1
+ * element. */
+ listRepPtr = AttemptNewList(interp, estCount, NULL);
+ if (listRepPtr == NULL) {
+ return TCL_ERROR;
}
- }
+ elemPtrs = &listRepPtr->elements;
- /*
- * Allocate a new List structure with enough room for "estCount" elements.
- * Each element is a pointer to a Tcl_Obj with the appropriate string rep.
- * The initial "estCount" elements are set using the corresponding "argv"
- * strings.
- */
+ /*
+ * Each iteration, parse and store a list element.
+ */
- listRepPtr = NewListIntRep(estCount, NULL);
- if (!listRepPtr) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "Not enough memory to allocate the list internal rep", -1));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
- return TCL_ERROR;
- }
- elemPtrs = &listRepPtr->elements;
+ while (nextElem < limit) {
+ const char *elemStart;
+ int elemSize, literal;
- for (p=string, lenRemain=length, i=0;
- lenRemain > 0;
- p=nextElem, lenRemain=limit-nextElem, i++) {
- result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
- &elemSize, &hasBrace);
- if (result != TCL_OK) {
- for (j = 0; j < i; j++) {
- elemPtr = elemPtrs[j];
- Tcl_DecrRefCount(elemPtr);
+ if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
+ &elemStart, &nextElem, &elemSize, &literal)) {
+ while (--elemPtrs >= &listRepPtr->elements) {
+ Tcl_DecrRefCount(*elemPtrs);
+ }
+ ckfree((char *) listRepPtr);
+ return TCL_ERROR;
}
- ckfree((char *) listRepPtr);
- if (interp != NULL) {
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", NULL);
+ if (elemStart == limit) {
+ break;
}
- return result;
- }
- if (elemStart >= limit) {
- break;
- }
- if (i > estCount) {
- Tcl_Panic("SetListFromAny: bad size estimate for list");
- }
- /*
- * Allocate a Tcl object for the element and initialize it from the
- * "elemSize" bytes starting at "elemStart".
- */
+ /* TODO: replace panic with error on alloc failure? */
+ if (literal) {
+ TclNewStringObj(*elemPtrs, elemStart, elemSize);
+ } else {
+ TclNewObj(*elemPtrs);
+ (*elemPtrs)->bytes = ckalloc((unsigned) elemSize + 1);
+ (*elemPtrs)->length = TclCopyAndCollapse(elemSize, elemStart,
+ (*elemPtrs)->bytes);
+ }
- s = ckalloc((unsigned) elemSize + 1);
- if (hasBrace) {
- memcpy(s, elemStart, (size_t) elemSize);
- s[elemSize] = 0;
- } else {
- elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
+ Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
}
- TclNewObj(elemPtr);
- elemPtr->bytes = s;
- elemPtr->length = elemSize;
- elemPtrs[i] = elemPtr;
- Tcl_IncrRefCount(elemPtr); /* Since list now holds ref to it. */
+ listRepPtr->elemCount = elemPtrs - &listRepPtr->elements;
}
- listRepPtr->elemCount = i;
-
/*
* Free the old internalRep before setting the new one. We do this as late
* as possible to allow the conversion code, in particular
* Tcl_GetStringFromObj, to use that old internalRep.
*/
- commitRepresentation:
- listRepPtr->refCount++;
TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclListType;
+ ListSetIntRep(objPtr, listRepPtr);
return TCL_OK;
}
@@ -1864,20 +1919,32 @@ UpdateStringOfList(
Tcl_Obj *listPtr) /* List object with string rep to update. */
{
# define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr;
- List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+ List *listRepPtr = ListRepPtr(listPtr);
int numElems = listRepPtr->elemCount;
- register int i;
+ int i, length, bytesNeeded = 0;
const char *elem;
char *dst;
- int length;
Tcl_Obj **elemPtrs;
/*
- * Convert each element of the list to string form and then convert it to
- * proper list element form, adding it to the result buffer.
+ * Mark the list as being canonical; although it will now have a string
+ * rep, it is one we derived through proper "canonical" quoting and so
+ * it's known to be free from nasties relating to [concat] and [eval].
*/
+ listRepPtr->canonicalFlag = 1;
+
+ /*
+ * Handle empty list case first, so rest of the routine is simpler.
+ */
+
+ if (numElems == 0) {
+ listPtr->bytes = tclEmptyStringRep;
+ listPtr->length = 0;
+ return;
+ }
+
/*
* Pass 1: estimate space, gather flags.
*/
@@ -1885,54 +1952,44 @@ UpdateStringOfList(
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
} else {
- flagPtr = (int *) ckalloc((unsigned) numElems * sizeof(int));
+ /*
+ * We know numElems <= LIST_MAX, so this is safe.
+ */
+
+ flagPtr = ckalloc(numElems * sizeof(int));
}
- listPtr->length = 1;
elemPtrs = &listRepPtr->elements;
for (i = 0; i < numElems; i++) {
+ flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
elem = TclGetStringFromObj(elemPtrs[i], &length);
- listPtr->length += Tcl_ScanCountedElement(elem, length, flagPtr+i)+1;
-
- /*
- * Check for continued sanity. [Bug 1267380]
- */
-
- if (listPtr->length < 1) {
- Tcl_Panic("string representation size exceeds sane bounds");
+ bytesNeeded += TclScanElement(elem, length, flagPtr+i);
+ if (bytesNeeded < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
}
+ if (bytesNeeded > INT_MAX - numElems + 1) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+ bytesNeeded += numElems;
/*
* Pass 2: copy into string rep buffer.
*/
- listPtr->bytes = ckalloc((unsigned) listPtr->length);
+ listPtr->length = bytesNeeded - 1;
+ listPtr->bytes = ckalloc(bytesNeeded);
dst = listPtr->bytes;
for (i = 0; i < numElems; i++) {
+ flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
elem = TclGetStringFromObj(elemPtrs[i], &length);
- dst += Tcl_ConvertCountedElement(elem, length, dst,
- flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
- *dst = ' ';
- dst++;
+ dst += TclConvertElement(elem, length, dst, flagPtr[i]);
+ *dst++ = ' ';
}
+ listPtr->bytes[listPtr->length] = '\0';
+
if (flagPtr != localFlags) {
- ckfree((char *) flagPtr);
+ ckfree(flagPtr);
}
- if (dst == listPtr->bytes) {
- *dst = 0;
- } else {
- dst--;
- *dst = 0;
- }
- listPtr->length = dst - listPtr->bytes;
-
- /*
- * Mark the list as being canonical; although it has a string rep, it is
- * one we derived through proper "canonical" quoting and so it's known to
- * be free from nasties relating to [concat] and [eval].
- */
-
- listRepPtr->canonicalFlag = 1;
}
/*
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index b991ef3..441ea91 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -12,8 +12,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclLiteral.c,v 1.43 2010/04/29 23:39:32 msofer Exp $
*/
#include "tclInt.h"
@@ -77,78 +75,6 @@ TclInitLiteralTable(
/*
*----------------------------------------------------------------------
*
- * TclCleanupLiteralTable --
- *
- * This function frees the internal representation of every literal in a
- * literal table. It is called prior to deleting an interp, so that
- * variable refs will be cleaned up properly.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Each literal in the table has its internal representation freed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclCleanupLiteralTable(
- Tcl_Interp *interp, /* Interpreter containing literals to purge */
- LiteralTable *tablePtr) /* Points to the literal table being
- * cleaned. */
-{
- int i;
- LiteralEntry *entryPtr; /* Pointer to the current entry in the hash
- * table of literals. */
- LiteralEntry *nextPtr; /* Pointer to the next entry in the bucket. */
- Tcl_Obj *objPtr; /* Pointer to a literal object whose internal
- * rep is being freed. */
- const Tcl_ObjType *typePtr; /* Pointer to the object's type. */
- int didOne; /* Flag for whether we've removed a literal in
- * the current bucket. */
-
-#ifdef TCL_COMPILE_DEBUG
- TclVerifyGlobalLiteralTable((Interp *) interp);
-#endif /* TCL_COMPILE_DEBUG */
-
- for (i=0 ; i<tablePtr->numBuckets ; i++) {
- /*
- * It is tempting simply to walk each hash bucket once and delete the
- * internal representations of each literal in turn. It's also wrong.
- * The problem is that freeing a literal's internal representation can
- * delete other literals to which it refers, making nextPtr invalid.
- * So each time we free an internal rep, we start its bucket over
- * again.
- */
-
- do {
- didOne = 0;
- entryPtr = tablePtr->buckets[i];
- while (entryPtr != NULL) {
- objPtr = entryPtr->objPtr;
- nextPtr = entryPtr->nextPtr;
- typePtr = objPtr->typePtr;
- if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
- if (objPtr->bytes == NULL) {
- Tcl_Panic("%s: literal without a string rep",
- "TclCleanupLiteralTable");
- }
- objPtr->typePtr = NULL;
- typePtr->freeIntRepProc(objPtr);
- didOne = 1;
- break;
- } else {
- entryPtr = nextPtr;
- }
- }
- } while (didOne);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclDeleteLiteralTable --
*
* This function frees up everything associated with a literal table
@@ -201,7 +127,7 @@ TclDeleteLiteralTable(
objPtr = entryPtr->objPtr;
TclDecrRefCount(objPtr);
nextPtr = entryPtr->nextPtr;
- ckfree((char *) entryPtr);
+ ckfree(entryPtr);
entryPtr = nextPtr;
}
}
@@ -211,7 +137,7 @@ TclDeleteLiteralTable(
*/
if (tablePtr->buckets != tablePtr->staticBuckets) {
- ckfree((char *) tablePtr->buckets);
+ ckfree(tablePtr->buckets);
}
}
@@ -285,7 +211,7 @@ TclCreateLiteral(
*globalPtrPtr = globalPtr;
}
if (flags & LITERAL_ON_HEAP) {
- ckfree((char *) bytes);
+ ckfree(bytes);
}
globalPtr->refCount++;
return objPtr;
@@ -293,7 +219,7 @@ TclCreateLiteral(
}
if (!newPtr) {
if (flags & LITERAL_ON_HEAP) {
- ckfree((char *) bytes);
+ ckfree(bytes);
}
return NULL;
}
@@ -319,7 +245,7 @@ TclCreateLiteral(
}
#endif
- globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
+ globalPtr = ckalloc(sizeof(LiteralEntry));
globalPtr->objPtr = objPtr;
globalPtr->refCount = 1;
globalPtr->nsPtr = nsPtr;
@@ -441,7 +367,7 @@ TclRegisterLiteral(
|| ((objPtr->bytes[0] == bytes[0])
&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
if (flags & LITERAL_ON_HEAP) {
- ckfree((char *) bytes);
+ ckfree(bytes);
}
objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
@@ -759,15 +685,14 @@ ExpandLocalLiteralArray(
int i;
if (envPtr->mallocedLiteralArray) {
- newArrayPtr = (LiteralEntry *)
- ckrealloc((char *)currArrayPtr, 2 * currBytes);
+ newArrayPtr = ckrealloc(currArrayPtr, 2 * currBytes);
} else {
/*
* envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
* code a ckrealloc equivalent for ourselves.
*/
- newArrayPtr = (LiteralEntry *) ckalloc(2 * currBytes);
+ newArrayPtr = ckalloc(2 * currBytes);
memcpy(newArrayPtr, currArrayPtr, currBytes);
envPtr->mallocedLiteralArray = 1;
}
@@ -856,7 +781,7 @@ TclReleaseLiteral(
} else {
prevPtr->nextPtr = entryPtr->nextPtr;
}
- ckfree((char *) entryPtr);
+ ckfree(entryPtr);
globalTablePtr->numEntries--;
TclDecrRefCount(objPtr);
@@ -978,8 +903,7 @@ RebuildLiteralTable(
*/
tablePtr->numBuckets *= 4;
- tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned)
- (tablePtr->numBuckets * sizeof(LiteralEntry *)));
+ tablePtr->buckets = ckalloc(tablePtr->numBuckets * sizeof(LiteralEntry*));
for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
count>0 ; count--, newChainPtr++) {
*newChainPtr = NULL;
@@ -1008,7 +932,47 @@ RebuildLiteralTable(
*/
if (oldBuckets != tablePtr->staticBuckets) {
- ckfree((char *) oldBuckets);
+ ckfree(oldBuckets);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInvalidateCmdLiteral --
+ *
+ * Invalidate a command literal entry, if present in the literal hash
+ * tables, by resetting its internal representation. This invalidation
+ * leaves it in the literal tables and in existing literal arrays. As a
+ * result, existing references continue to work but we force a fresh
+ * command look-up upon the next use (see, in particular,
+ * TclSetCmdNameObj()).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resets the internal representation of the CmdName Tcl_Obj
+ * using TclFreeIntRep().
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInvalidateCmdLiteral(
+ Tcl_Interp *interp, /* Interpreter for which to invalidate a
+ * command literal. */
+ const char *name, /* Points to the start of the cmd literal
+ * name. */
+ Namespace *nsPtr) /* The namespace for which to lookup and
+ * invalidate a cmd literal. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, (char *) name,
+ strlen(name), -1, NULL, nsPtr, 0, NULL);
+
+ if (literalObjPtr != NULL && literalObjPtr->typePtr == &tclCmdNameType) {
+ TclFreeIntRep(literalObjPtr);
}
}
@@ -1070,7 +1034,7 @@ TclLiteralStats(
* Print out the histogram and a few other pieces of information.
*/
- result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
+ result = ckalloc(NUM_COUNTERS*60 + 300);
sprintf(result, "%d entries in table, %d buckets\n",
tablePtr->numEntries, tablePtr->numBuckets);
p = result + strlen(result);
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 22f1c86..5cacab1 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclLoad.c,v 1.26 2010/05/19 08:23:09 nijtmans Exp $
*/
#include "tclInt.h"
@@ -133,9 +131,35 @@ Tcl_LoadObjCmd(
const char *p, *fullFileName, *packageName;
Tcl_LoadHandle loadHandle;
Tcl_UniChar ch;
+ unsigned len;
+ int index, flags = 0;
+ Tcl_Obj *const *savedobjv = objv;
+ static const char *const options[] = {
+ "-global", "-lazy", "--", NULL
+ };
+ enum options {
+ LOAD_GLOBAL, LOAD_LAZY, LOAD_LAST
+ };
+ while (objc > 2) {
+ if (TclGetString(objv[1])[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ++objv; --objc;
+ if (LOAD_GLOBAL == (enum options) index) {
+ flags |= TCL_LOAD_GLOBAL;
+ } else if (LOAD_LAZY == (enum options) index) {
+ flags |= TCL_LOAD_LAZY;
+ } else {
+ break;
+ }
+ }
if ((objc < 2) || (objc > 4)) {
- Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?");
+ Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?packageName? ?interp?");
return TCL_ERROR;
}
if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
@@ -158,9 +182,10 @@ Tcl_LoadObjCmd(
}
}
if ((fullFileName[0] == 0) && (packageName == NULL)) {
- Tcl_SetResult(interp,
- "must specify either file name or package name",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must specify either file name or package name", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY",
+ NULL);
code = TCL_ERROR;
goto done;
}
@@ -197,9 +222,9 @@ Tcl_LoadObjCmd(
if (packageName == NULL) {
namesMatch = 0;
} else {
- Tcl_DStringSetLength(&pkgName, 0);
+ TclDStringClear(&pkgName);
Tcl_DStringAppend(&pkgName, packageName, -1);
- Tcl_DStringSetLength(&tmp, 0);
+ TclDStringClear(&tmp);
Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
Tcl_UtfToLower(Tcl_DStringValue(&tmp));
@@ -210,7 +235,7 @@ Tcl_LoadObjCmd(
namesMatch = 0;
}
}
- Tcl_DStringSetLength(&pkgName, 0);
+ TclDStringClear(&pkgName);
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
if (filesMatch && (namesMatch || (packageName == NULL))) {
@@ -224,9 +249,11 @@ Tcl_LoadObjCmd(
* Can't have two different packages loaded from the same file.
*/
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" is already loaded for package \"",
- pkgPtr->packageName, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" is already loaded for package \"%s\"",
+ fullFileName, pkgPtr->packageName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
+ "SPLITPERSONALITY", NULL);
code = TCL_ERROR;
Tcl_MutexUnlock(&packageMutex);
goto done;
@@ -260,8 +287,10 @@ Tcl_LoadObjCmd(
*/
if (fullFileName[0] == 0) {
- Tcl_AppendResult(interp, "package \"", packageName,
- "\" isn't loaded statically", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "package \"%s\" isn't loaded statically", packageName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC",
+ NULL);
code = TCL_ERROR;
goto done;
}
@@ -281,8 +310,7 @@ Tcl_LoadObjCmd(
retc = TclGuessPackageName(fullFileName, &pkgName);
if (!retc) {
- Tcl_Obj *splitPtr;
- Tcl_Obj *pkgGuessPtr;
+ Tcl_Obj *splitPtr, *pkgGuessPtr;
int pElements;
const char *pkgGuess;
@@ -301,6 +329,12 @@ Tcl_LoadObjCmd(
&& (pkgGuess[2] == 'b')) {
pkgGuess += 3;
}
+#ifdef __CYGWIN__
+ if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y')
+ && (pkgGuess[2] == 'g')) {
+ pkgGuess += 3;
+ }
+#endif /* __CYGWIN__ */
for (p = pkgGuess; *p != 0; p += offset) {
offset = Tcl_UtfToUniChar(p, &ch);
if ((ch > 0x100)
@@ -311,13 +345,15 @@ Tcl_LoadObjCmd(
}
if (p == pkgGuess) {
Tcl_DecrRefCount(splitPtr);
- Tcl_AppendResult(interp,
- "couldn't figure out package name for ",
- fullFileName, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't figure out package name for %s",
+ fullFileName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
+ "WHATPACKAGE", NULL);
code = TCL_ERROR;
goto done;
}
- Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess));
+ Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess);
Tcl_DecrRefCount(splitPtr);
}
}
@@ -336,14 +372,14 @@ Tcl_LoadObjCmd(
* package name.
*/
- Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1);
- Tcl_DStringAppend(&initName, "_Init", 5);
- Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1);
- Tcl_DStringAppend(&safeInitName, "_SafeInit", 9);
- Tcl_DStringAppend(&unloadName, Tcl_DStringValue(&pkgName), -1);
- Tcl_DStringAppend(&unloadName, "_Unload", 7);
- Tcl_DStringAppend(&safeUnloadName, Tcl_DStringValue(&pkgName), -1);
- Tcl_DStringAppend(&safeUnloadName, "_SafeUnload", 11);
+ TclDStringAppendDString(&initName, &pkgName);
+ TclDStringAppendLiteral(&initName, "_Init");
+ TclDStringAppendDString(&safeInitName, &pkgName);
+ TclDStringAppendLiteral(&safeInitName, "_SafeInit");
+ TclDStringAppendDString(&unloadName, &pkgName);
+ TclDStringAppendLiteral(&unloadName, "_Unload");
+ TclDStringAppendDString(&safeUnloadName, &pkgName);
+ TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload");
/*
* Call platform-specific code to load the package and find the two
@@ -354,7 +390,8 @@ Tcl_LoadObjCmd(
symbols[1] = NULL;
Tcl_MutexLock(&packageMutex);
- code = Tcl_LoadFile(interp, objv[1], symbols, 0, &initProc, &loadHandle);
+ code = Tcl_LoadFile(interp, objv[1], symbols, flags, &initProc,
+ &loadHandle);
Tcl_MutexUnlock(&packageMutex);
if (code != TCL_OK) {
goto done;
@@ -364,22 +401,24 @@ Tcl_LoadObjCmd(
* Create a new record to describe this package.
*/
- pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
- pkgPtr->fileName =
- ckalloc((unsigned) (strlen(fullFileName) + 1));
- strcpy(pkgPtr->fileName, fullFileName);
- pkgPtr->packageName =
- ckalloc((unsigned) (Tcl_DStringLength(&pkgName) + 1));
- strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName));
+ pkgPtr = ckalloc(sizeof(LoadedPackage));
+ len = strlen(fullFileName) + 1;
+ pkgPtr->fileName = ckalloc(len);
+ memcpy(pkgPtr->fileName, fullFileName, len);
+ len = (unsigned) Tcl_DStringLength(&pkgName) + 1;
+ pkgPtr->packageName = ckalloc(len);
+ memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
pkgPtr->loadHandle = loadHandle;
pkgPtr->initProc = initProc;
- pkgPtr->safeInitProc = (Tcl_PackageInitProc*)
- Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&safeInitName));
- pkgPtr->unloadProc = (Tcl_PackageUnloadProc*)
- Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&unloadName));
- pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc *)
- Tcl_FindSymbol(interp, loadHandle,
- Tcl_DStringValue(&safeUnloadName));
+ pkgPtr->safeInitProc = (Tcl_PackageInitProc *)
+ Tcl_FindSymbol(interp, loadHandle,
+ Tcl_DStringValue(&safeInitName));
+ pkgPtr->unloadProc = (Tcl_PackageUnloadProc *)
+ Tcl_FindSymbol(interp, loadHandle,
+ Tcl_DStringValue(&unloadName));
+ pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc *)
+ Tcl_FindSymbol(interp, loadHandle,
+ Tcl_DStringValue(&safeUnloadName));
pkgPtr->interpRefCount = 0;
pkgPtr->safeInterpRefCount = 0;
@@ -387,10 +426,12 @@ Tcl_LoadObjCmd(
pkgPtr->nextPtr = firstPackagePtr;
firstPackagePtr = pkgPtr;
Tcl_MutexUnlock(&packageMutex);
+
/*
- * The Tcl_FindSymbol calls may have left a spurious error message
- * in the interpreter result.
+ * The Tcl_FindSymbol calls may have left a spurious error message in
+ * the interpreter result.
*/
+
Tcl_ResetResult(interp);
}
@@ -400,50 +441,64 @@ Tcl_LoadObjCmd(
*/
if (Tcl_IsSafe(target)) {
- if (pkgPtr->safeInitProc != NULL) {
- code = pkgPtr->safeInitProc(target);
- } else {
- Tcl_AppendResult(interp,
- "can't use package in a safe interpreter: no ",
- pkgPtr->packageName, "_SafeInit procedure", NULL);
+ if (pkgPtr->safeInitProc == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't use package in a safe interpreter: no"
+ " %s_SafeInit procedure", pkgPtr->packageName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE",
+ NULL);
code = TCL_ERROR;
goto done;
}
+ code = pkgPtr->safeInitProc(target);
} else {
+ if (pkgPtr->initProc == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't attach package to interpreter: no %s_Init procedure",
+ pkgPtr->packageName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
+ NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
code = pkgPtr->initProc(target);
}
/*
- * Record the fact that the package has been loaded in the target
- * interpreter.
+ * Test for whether the initialization failed. If so, transfer the error
+ * from the target interpreter to the originating one.
*/
- if (code == TCL_OK) {
- /*
- * Update the proper reference count.
- */
-
- Tcl_MutexLock(&packageMutex);
- if (Tcl_IsSafe(target)) {
- pkgPtr->safeInterpRefCount++;
- } else {
- pkgPtr->interpRefCount++;
- }
- Tcl_MutexUnlock(&packageMutex);
+ if (code != TCL_OK) {
+ Tcl_TransferResult(target, code, interp);
+ goto done;
+ }
- /*
- * Refetch ipFirstPtr: loading the package may have introduced
- * additional static packages at the head of the linked list!
- */
+ /*
+ * Record the fact that the package has been loaded in the target
+ * interpreter.
+ *
+ * Update the proper reference count.
+ */
- ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
- ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
- ipPtr->pkgPtr = pkgPtr;
- ipPtr->nextPtr = ipFirstPtr;
- Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
+ Tcl_MutexLock(&packageMutex);
+ if (Tcl_IsSafe(target)) {
+ pkgPtr->safeInterpRefCount++;
} else {
- Tcl_TransferResult(target, code, interp);
+ pkgPtr->interpRefCount++;
}
+ Tcl_MutexUnlock(&packageMutex);
+
+ /*
+ * Refetch ipFirstPtr: loading the package may have introduced additional
+ * static packages at the head of the linked list!
+ */
+
+ ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
+ ipPtr = ckalloc(sizeof(InterpPackage));
+ ipPtr->pkgPtr = pkgPtr;
+ ipPtr->nextPtr = ipFirstPtr;
+ Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
done:
Tcl_DStringFree(&pkgName);
@@ -550,9 +605,10 @@ Tcl_UnloadObjCmd(
}
}
if ((fullFileName[0] == 0) && (packageName == NULL)) {
- Tcl_SetResult(interp,
- "must specify either file name or package name",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must specify either file name or package name", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY",
+ NULL);
code = TCL_ERROR;
goto done;
}
@@ -590,9 +646,9 @@ Tcl_UnloadObjCmd(
if (packageName == NULL) {
namesMatch = 0;
} else {
- Tcl_DStringSetLength(&pkgName, 0);
+ TclDStringClear(&pkgName);
Tcl_DStringAppend(&pkgName, packageName, -1);
- Tcl_DStringSetLength(&tmp, 0);
+ TclDStringClear(&tmp);
Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
Tcl_UtfToLower(Tcl_DStringValue(&tmp));
@@ -603,7 +659,7 @@ Tcl_UnloadObjCmd(
namesMatch = 0;
}
}
- Tcl_DStringSetLength(&pkgName, 0);
+ TclDStringClear(&pkgName);
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
if (filesMatch && (namesMatch || (packageName == NULL))) {
@@ -622,8 +678,11 @@ Tcl_UnloadObjCmd(
* It's an error to try unload a static package.
*/
- Tcl_AppendResult(interp, "package \"", packageName,
- "\" is loaded statically and cannot be unloaded", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "package \"%s\" is loaded statically and cannot be unloaded",
+ packageName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC",
+ NULL);
code = TCL_ERROR;
goto done;
}
@@ -632,8 +691,10 @@ Tcl_UnloadObjCmd(
* The DLL pointed by the provided filename has never been loaded.
*/
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" has never been loaded", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" has never been loaded", fullFileName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
+ NULL);
code = TCL_ERROR;
goto done;
}
@@ -659,8 +720,11 @@ Tcl_UnloadObjCmd(
* The package has not been loaded in this interpreter.
*/
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" has never been loaded in this interpreter", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" has never been loaded in this interpreter",
+ fullFileName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
+ NULL);
code = TCL_ERROR;
goto done;
}
@@ -673,16 +737,22 @@ Tcl_UnloadObjCmd(
if (Tcl_IsSafe(target)) {
if (pkgPtr->safeUnloadProc == NULL) {
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" cannot be unloaded under a safe interpreter", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" cannot be unloaded under a safe interpreter",
+ fullFileName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
+ NULL);
code = TCL_ERROR;
goto done;
}
unloadProc = pkgPtr->safeUnloadProc;
} else {
if (pkgPtr->unloadProc == NULL) {
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" cannot be unloaded under a trusted interpreter", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" cannot be unloaded under a trusted interpreter",
+ fullFileName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
+ NULL);
code = TCL_ERROR;
goto done;
}
@@ -769,8 +839,7 @@ Tcl_UnloadObjCmd(
*/
if (pkgPtr->fileName[0] != '\0') {
-
- Tcl_MutexLock(&packageMutex);
+ Tcl_MutexLock(&packageMutex);
if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) {
/*
* Remove this library from the loaded library cache.
@@ -812,16 +881,19 @@ Tcl_UnloadObjCmd(
ipFirstPtr);
ckfree(defaultPtr->fileName);
ckfree(defaultPtr->packageName);
- ckfree((char *) defaultPtr);
- ckfree((char *) ipPtr);
+ ckfree(defaultPtr);
+ ckfree(ipPtr);
Tcl_MutexUnlock(&packageMutex);
} else {
code = TCL_ERROR;
}
}
#else
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" cannot be unloaded: unloading disabled", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" cannot be unloaded: unloading disabled",
+ fullFileName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED",
+ NULL);
code = TCL_ERROR;
#endif
}
@@ -829,40 +901,10 @@ Tcl_UnloadObjCmd(
done:
Tcl_DStringFree(&pkgName);
Tcl_DStringFree(&tmp);
- if (!complain && code!=TCL_OK) {
+ if (!complain && (code != TCL_OK)) {
code = TCL_OK;
Tcl_ResetResult(interp);
}
- if (code == TCL_OK) {
-#if 0
- /*
- * Result of [unload] was not documented in TIP#100, so force to be
- * the empty string by commenting this out. DKF.
- */
-
- Tcl_Obj *resultObjPtr, *objPtr[2];
-
- /*
- * Our result is the two reference counts.
- */
-
- TclNewIntObj(objPtr[0], trustedRefCount);
- TclNewIntObj(objPtr[1], safeRefCount);
- if (objPtr[0] == NULL || objPtr[1] == NULL) {
- if (objPtr[0]) {
- Tcl_DecrRefCount(objPtr[0]);
- }
- if (objPtr[1]) {
- Tcl_DecrRefCount(objPtr[1]);
- }
- } else {
- TclNewListObj(resultObjPtr, 2, objPtr);
- if (resultObjPtr != NULL) {
- Tcl_SetObjResult(interp, resultObjPtr);
- }
- }
-#endif
- }
return code;
}
@@ -927,10 +969,10 @@ Tcl_StaticPackage(
*/
if (pkgPtr == NULL) {
- pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
- pkgPtr->fileName = ckalloc((unsigned) 1);
+ pkgPtr = ckalloc(sizeof(LoadedPackage));
+ pkgPtr->fileName = ckalloc(1);
pkgPtr->fileName[0] = 0;
- pkgPtr->packageName = ckalloc((unsigned) (strlen(pkgName) + 1));
+ pkgPtr->packageName = ckalloc(strlen(pkgName) + 1);
strcpy(pkgPtr->packageName, pkgName);
pkgPtr->loadHandle = NULL;
pkgPtr->initProc = initProc;
@@ -960,7 +1002,7 @@ Tcl_StaticPackage(
* loaded.
*/
- ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
+ ipPtr = ckalloc(sizeof(InterpPackage));
ipPtr->pkgPtr = pkgPtr;
ipPtr->nextPtr = ipFirstPtr;
Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
@@ -997,28 +1039,27 @@ TclGetLoadedPackages(
* otherwise, just return info about this
* interpreter. */
{
- /* TODO: Use Tcl_Obj APIs to generate this info for cleanliness. */
Tcl_Interp *target;
LoadedPackage *pkgPtr;
InterpPackage *ipPtr;
- const char *prefix;
+ Tcl_Obj *resultObj, *pkgDesc[2];
if (targetName == NULL) {
/*
* Return information about all of the available packages.
*/
- prefix = "{";
+ resultObj = Tcl_NewObj();
Tcl_MutexLock(&packageMutex);
for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
pkgPtr = pkgPtr->nextPtr) {
- Tcl_AppendResult(interp, prefix, NULL);
- Tcl_AppendElement(interp, pkgPtr->fileName);
- Tcl_AppendElement(interp, pkgPtr->packageName);
- Tcl_AppendResult(interp, "}", NULL);
- prefix = " {";
+ pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
+ pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewListObj(2, pkgDesc));
}
Tcl_MutexUnlock(&packageMutex);
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
@@ -1032,15 +1073,14 @@ TclGetLoadedPackages(
return TCL_ERROR;
}
ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
- prefix = "{";
+ resultObj = Tcl_NewObj();
for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
pkgPtr = ipPtr->pkgPtr;
- Tcl_AppendResult(interp, prefix, NULL);
- Tcl_AppendElement(interp, pkgPtr->fileName);
- Tcl_AppendElement(interp, pkgPtr->packageName);
- Tcl_AppendResult(interp, "}", NULL);
- prefix = " {";
+ pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
+ pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc));
}
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
@@ -1073,7 +1113,7 @@ LoadCleanupProc(
ipPtr = clientData;
while (ipPtr != NULL) {
nextPtr = ipPtr->nextPtr;
- ckfree((char *) ipPtr);
+ ckfree(ipPtr);
ipPtr = nextPtr;
}
}
@@ -1126,7 +1166,7 @@ TclFinalizeLoad(void)
ckfree(pkgPtr->fileName);
ckfree(pkgPtr->packageName);
- ckfree((char *) pkgPtr);
+ ckfree(pkgPtr);
}
}
diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c
index dbb0a25..f030d89 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclLoadNone.c,v 1.14 2010/04/02 21:21:06 kennykb Exp $
*/
#include "tclInt.h"
@@ -41,14 +39,15 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"dynamic loading is not currently available on this system",
- TCL_STATIC);
+ -1));
return TCL_ERROR;
}
diff --git a/generic/tclMain.c b/generic/tclMain.c
index b274f41..f445383 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -2,6 +2,11 @@
* tclMain.c --
*
* Main program for Tcl shells and other Tcl-based applications.
+ * This file contains a generic main program for Tcl shells and other
+ * Tcl-based applications. It can be used as-is for many applications,
+ * just by supplying a different appInitProc function for each specific
+ * application. Or, it can be used as a template for creating new main
+ * programs for Tcl applications.
*
* Copyright (c) 1988-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -9,10 +14,24 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclMain.c,v 1.51 2010/09/23 18:08:35 dgp Exp $
*/
+/*
+ * On Windows, this file needs to be compiled twice, once with TCL_ASCII_MAIN
+ * defined. This way both Tcl_Main and Tcl_MainExW can be implemented, sharing
+ * the same source code.
+ */
+
+#if defined(TCL_ASCII_MAIN)
+# ifdef UNICODE
+# undef UNICODE
+# undef _UNICODE
+# else
+# define UNICODE
+# define _UNICODE
+# endif
+#endif
+
#include "tclInt.h"
/*
@@ -22,6 +41,40 @@
#define DEFAULT_PRIMARY_PROMPT "% "
/*
+ * This file can be compiled on Windows in UNICODE mode, as well as on all
+ * other platforms using the native encoding. This is done by using the normal
+ * Windows functions like _tcscmp, but on platforms which don't have <tchar.h>
+ * we have to translate that to strcmp here.
+ */
+
+#ifndef __WIN32__
+# define TCHAR char
+# define TEXT(arg) arg
+# define _tcscmp strcmp
+#endif
+
+/*
+ * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise
+ * NewNativeObj is needed (which provides proper conversion from native
+ * encoding to UTF-8).
+ */
+
+#ifdef UNICODE
+# define NewNativeObj Tcl_NewUnicodeObj
+#else /* !UNICODE */
+static inline Tcl_Obj *
+NewNativeObj(
+ char *string,
+ int length)
+{
+ Tcl_DString ds;
+
+ Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+ return TclDStringToObj(&ds);
+}
+#endif /* !UNICODE */
+
+/*
* Declarations for various library functions and variables (don't want to
* include tclPort.h here, because people might copy this file out of the Tcl
* source directory to make their own modified versions).
@@ -43,7 +96,6 @@ typedef struct {
/* Any installed main loop handler. The main
* extension that installs these is Tk. */
} ThreadSpecificData;
-static Tcl_ThreadDataKey dataKey;
/*
* Structure definition for information used to keep the state of an
@@ -74,10 +126,14 @@ typedef struct InteractiveState {
* Forward declarations for functions defined later in this file.
*/
-static Tcl_MainLoopProc * GetMainLoop(void);
-static void Prompt(Tcl_Interp *interp, PromptType *promptPtr);
+MODULE_SCOPE Tcl_MainLoopProc *TclGetMainLoop(void);
+static void Prompt(Tcl_Interp *interp, InteractiveState *isPtr);
static void StdinProc(ClientData clientData, int mask);
+static void FreeMainInterp(ClientData clientData);
+#ifndef TCL_ASCII_MAIN
+static Tcl_ThreadDataKey dataKey;
+
/*
*----------------------------------------------------------------------
*
@@ -185,7 +241,7 @@ Tcl_SourceRCFile(
{
Tcl_DString temp;
const char *fileName;
- Tcl_Channel errChannel;
+ Tcl_Channel chan;
fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
if (fileName != NULL) {
@@ -209,10 +265,10 @@ Tcl_SourceRCFile(
if (c != NULL) {
Tcl_Close(NULL, c);
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel) {
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
}
}
}
@@ -220,10 +276,11 @@ Tcl_SourceRCFile(
Tcl_DStringFree(&temp);
}
}
+#endif /* !TCL_ASCII_MAIN */
/*----------------------------------------------------------------------
*
- * Tcl_Main --
+ * Tcl_Main, Tcl_MainEx --
*
* Main program for tclsh and most other Tcl-based applications.
*
@@ -240,28 +297,28 @@ Tcl_SourceRCFile(
*/
void
-Tcl_Main(
+Tcl_MainEx(
int argc, /* Number of arguments. */
- char **argv, /* Array of argument strings. */
- Tcl_AppInitProc *appInitProc)
+ TCHAR **argv, /* Array of argument strings. */
+ Tcl_AppInitProc *appInitProc,
/* Application-specific initialization
* function to call after most initialization
* but before starting to execute commands. */
+ Tcl_Interp *interp)
{
- Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL;
+ Tcl_Obj *path, *resultPtr, *argvPtr, *appName;
const char *encodingName = NULL;
- PromptType prompt = PROMPT_START;
- int code, length, tty, exitCode = 0;
+ int code, exitCode = 0;
Tcl_MainLoopProc *mainLoopProc;
- Tcl_Channel inChannel, outChannel, errChannel;
- Tcl_Interp *interp;
- Tcl_DString appName;
-
- Tcl_FindExecutable(argv[0]);
+ Tcl_Channel chan;
+ InteractiveState is;
- interp = Tcl_CreateInterp();
Tcl_InitMemory(interp);
+ is.interp = interp;
+ is.prompt = PROMPT_START;
+ is.commandPtr = Tcl_NewObj();
+
/*
* If the application has not already set a startup script, parse the
* first few command line arguments to determine the script path and
@@ -271,18 +328,21 @@ Tcl_Main(
if (NULL == Tcl_GetStartupScript(NULL)) {
/*
* Check whether first 3 args (argv[1] - argv[3]) look like
- * -encoding ENCODING FILENAME
+ * -encoding ENCODING FILENAME
* or like
- * FILENAME
+ * FILENAME
*/
- if ((argc > 3) && (0 == strcmp("-encoding", argv[1]))
+ if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
&& ('-' != argv[3][0])) {
- Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]);
+ Tcl_Obj *value = NewNativeObj(argv[2], -1);
+ Tcl_SetStartupScript(NewNativeObj(argv[3], -1),
+ Tcl_GetString(value));
+ Tcl_DecrRefCount(value);
argc -= 3;
argv += 3;
} else if ((argc > 1) && ('-' != argv[1][0])) {
- Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL);
+ Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL);
argc--;
argv++;
}
@@ -290,16 +350,11 @@ Tcl_Main(
path = Tcl_GetStartupScript(&encodingName);
if (path == NULL) {
- Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
+ appName = NewNativeObj(argv[0], -1);
} else {
- const char *pathName = Tcl_GetStringFromObj(path, &length);
-
- Tcl_ExternalToUtfDString(NULL, pathName, length, &appName);
- path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1);
- Tcl_SetStartupScript(path, encodingName);
+ appName = path;
}
- Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
- Tcl_DStringFree(&appName);
+ Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
argc--;
argv++;
@@ -307,12 +362,7 @@ Tcl_Main(
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
- Tcl_DString ds;
-
- Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
- Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
- Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
- Tcl_DStringFree(&ds);
+ Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1));
}
Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
@@ -320,9 +370,9 @@ Tcl_Main(
* Set the "tcl_interactive" variable.
*/
- tty = isatty(0);
- Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0",
- TCL_GLOBAL_ONLY);
+ is.tty = isatty(0);
+ Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
+ Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
@@ -330,12 +380,12 @@ Tcl_Main(
Tcl_Preserve(interp);
if (appInitProc(interp) != TCL_OK) {
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel) {
- Tcl_WriteChars(errChannel,
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan) {
+ Tcl_WriteChars(chan,
"application-specific initialization failed: ", -1);
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
}
}
if (Tcl_InterpDeleted(interp)) {
@@ -344,18 +394,27 @@ Tcl_Main(
if (Tcl_LimitExceeded(interp)) {
goto done;
}
+ if (TclFullFinalizationRequested()) {
+ /*
+ * Arrange for final deletion of the main interp
+ */
+
+ /* ARGH Munchhausen effect */
+ Tcl_CreateExitHandler(FreeMainInterp, interp);
+ }
/*
- * If a script file was specified then just source that file and quit.
- * Must fetch it again, as the appInitProc might have reset it.
+ * Invoke the script specified on the command line, if any. Must fetch it
+ * again, as the appInitProc might have reset it.
*/
path = Tcl_GetStartupScript(&encodingName);
if (path != NULL) {
+ Tcl_ResetResult(interp);
code = Tcl_FSEvalFileEx(interp, path, encodingName);
if (code != TCL_OK) {
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel) {
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
Tcl_Obj *keyPtr, *valuePtr;
@@ -365,9 +424,9 @@ Tcl_Main(
Tcl_DecrRefCount(keyPtr);
if (valuePtr) {
- Tcl_WriteObj(errChannel, valuePtr);
+ Tcl_WriteObj(chan, valuePtr);
}
- Tcl_WriteChars(errChannel, "\n", 1);
+ Tcl_WriteChars(chan, "\n", 1);
Tcl_DecrRefCount(options);
}
exitCode = 1;
@@ -391,40 +450,40 @@ Tcl_Main(
* may have been changed.
*/
- commandPtr = Tcl_NewObj();
- Tcl_IncrRefCount(commandPtr);
+ Tcl_IncrRefCount(is.commandPtr);
/*
* Get a new value for tty if anyone writes to ::tcl_interactive
*/
- Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
- inChannel = Tcl_GetStdChannel(TCL_STDIN);
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- while ((inChannel != NULL) && !Tcl_InterpDeleted(interp)) {
- mainLoopProc = GetMainLoop();
+ Tcl_LinkVar(interp, "tcl_interactive", (char *) &is.tty, TCL_LINK_BOOLEAN);
+ is.input = Tcl_GetStdChannel(TCL_STDIN);
+ while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) {
+ mainLoopProc = TclGetMainLoop();
if (mainLoopProc == NULL) {
- if (tty) {
- Prompt(interp, &prompt);
+ int length;
+
+ if (is.tty) {
+ Prompt(interp, &is);
if (Tcl_InterpDeleted(interp)) {
break;
}
if (Tcl_LimitExceeded(interp)) {
break;
}
- inChannel = Tcl_GetStdChannel(TCL_STDIN);
- if (inChannel == NULL) {
+ is.input = Tcl_GetStdChannel(TCL_STDIN);
+ if (is.input == NULL) {
break;
}
}
- if (Tcl_IsShared(commandPtr)) {
- Tcl_DecrRefCount(commandPtr);
- commandPtr = Tcl_DuplicateObj(commandPtr);
- Tcl_IncrRefCount(commandPtr);
+ if (Tcl_IsShared(is.commandPtr)) {
+ Tcl_DecrRefCount(is.commandPtr);
+ is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
+ Tcl_IncrRefCount(is.commandPtr);
}
- length = Tcl_GetsObj(inChannel, commandPtr);
+ length = Tcl_GetsObj(is.input, is.commandPtr);
if (length < 0) {
- if (Tcl_InputBlocked(inChannel)) {
+ if (Tcl_InputBlocked(is.input)) {
/*
* This can only happen if stdin has been set to
* non-blocking. In that case cycle back and try again.
@@ -449,45 +508,46 @@ Tcl_Main(
* a difference. [Bug 1775878]
*/
- if (Tcl_IsShared(commandPtr)) {
- Tcl_DecrRefCount(commandPtr);
- commandPtr = Tcl_DuplicateObj(commandPtr);
- Tcl_IncrRefCount(commandPtr);
+ if (Tcl_IsShared(is.commandPtr)) {
+ Tcl_DecrRefCount(is.commandPtr);
+ is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
+ Tcl_IncrRefCount(is.commandPtr);
}
- Tcl_AppendToObj(commandPtr, "\n", 1);
- if (!TclObjCommandComplete(commandPtr)) {
- prompt = PROMPT_CONTINUE;
+ Tcl_AppendToObj(is.commandPtr, "\n", 1);
+ if (!TclObjCommandComplete(is.commandPtr)) {
+ is.prompt = PROMPT_CONTINUE;
continue;
}
- prompt = PROMPT_START;
+ is.prompt = PROMPT_START;
/*
* The final newline is syntactically redundant, and causes some
* error messages troubles deeper in, so lop it back off.
*/
- Tcl_GetStringFromObj(commandPtr, &length);
- Tcl_SetObjLength(commandPtr, --length);
- code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
- inChannel = Tcl_GetStdChannel(TCL_STDIN);
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- Tcl_DecrRefCount(commandPtr);
- commandPtr = Tcl_NewObj();
- Tcl_IncrRefCount(commandPtr);
+ Tcl_GetStringFromObj(is.commandPtr, &length);
+ Tcl_SetObjLength(is.commandPtr, --length);
+ code = Tcl_RecordAndEvalObj(interp, is.commandPtr,
+ TCL_EVAL_GLOBAL);
+ is.input = Tcl_GetStdChannel(TCL_STDIN);
+ Tcl_DecrRefCount(is.commandPtr);
+ is.commandPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(is.commandPtr);
if (code != TCL_OK) {
- if (errChannel) {
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
}
- } else if (tty) {
+ } else if (is.tty) {
resultPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resultPtr);
Tcl_GetStringFromObj(resultPtr, &length);
- if ((length > 0) && outChannel) {
- Tcl_WriteObj(outChannel, resultPtr);
- Tcl_WriteChars(outChannel, "\n", 1);
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if ((length > 0) && chan) {
+ Tcl_WriteObj(chan, resultPtr);
+ Tcl_WriteChars(chan, "\n", 1);
}
Tcl_DecrRefCount(resultPtr);
}
@@ -498,65 +558,40 @@ Tcl_Main(
* channel handler for stdin.
*/
- InteractiveState *isPtr = NULL;
-
- if (inChannel) {
- if (tty) {
- Prompt(interp, &prompt);
+ if (is.input) {
+ if (is.tty) {
+ Prompt(interp, &is);
}
- isPtr = (InteractiveState *)
- ckalloc(sizeof(InteractiveState));
- isPtr->input = inChannel;
- isPtr->tty = tty;
- isPtr->commandPtr = commandPtr;
- isPtr->prompt = prompt;
- isPtr->interp = interp;
-
- Tcl_UnlinkVar(interp, "tcl_interactive");
- Tcl_LinkVar(interp, "tcl_interactive", (char *) &isPtr->tty,
- TCL_LINK_BOOLEAN);
-
- Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
- isPtr);
+
+ Tcl_CreateChannelHandler(is.input, TCL_READABLE,
+ StdinProc, &is);
}
mainLoopProc();
Tcl_SetMainLoop(NULL);
- if (inChannel) {
- tty = isPtr->tty;
- Tcl_UnlinkVar(interp, "tcl_interactive");
- Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty,
- TCL_LINK_BOOLEAN);
- prompt = isPtr->prompt;
- commandPtr = isPtr->commandPtr;
- if (isPtr->input != NULL) {
- Tcl_DeleteChannelHandler(isPtr->input, StdinProc, isPtr);
- }
- ckfree((char *) isPtr);
+ if (is.input) {
+ Tcl_DeleteChannelHandler(is.input, StdinProc, &is);
}
- inChannel = Tcl_GetStdChannel(TCL_STDIN);
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ is.input = Tcl_GetStdChannel(TCL_STDIN);
}
-#ifdef TCL_MEM_DEBUG
/*
* This code here only for the (unsupported and deprecated) [checkmem]
* command.
*/
+#ifdef TCL_MEM_DEBUG
if (tclMemDumpFileName != NULL) {
Tcl_SetMainLoop(NULL);
Tcl_DeleteInterp(interp);
}
-#endif
+#endif /* TCL_MEM_DEBUG */
}
done:
- mainLoopProc = GetMainLoop();
- if ((exitCode == 0) && (mainLoopProc != NULL)
- && !Tcl_LimitExceeded(interp)) {
+ mainLoopProc = TclGetMainLoop();
+ if ((exitCode == 0) && mainLoopProc && !Tcl_LimitExceeded(interp)) {
/*
* If everything has gone OK so far, call the main loop proc, if it
* exists. Packages (like Tk) can set it to start processing events at
@@ -566,8 +601,8 @@ Tcl_Main(
mainLoopProc();
Tcl_SetMainLoop(NULL);
}
- if (commandPtr != NULL) {
- Tcl_DecrRefCount(commandPtr);
+ if (is.commandPtr != NULL) {
+ Tcl_DecrRefCount(is.commandPtr);
}
/*
@@ -576,37 +611,42 @@ Tcl_Main(
* exit. The Tcl_EvalObjEx call should never return.
*/
- if (!Tcl_InterpDeleted(interp)) {
- if (!Tcl_LimitExceeded(interp)) {
- Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode);
-
- Tcl_IncrRefCount(cmd);
- Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
- Tcl_DecrRefCount(cmd);
- }
-
- /*
- * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual
- * is happening. Maybe interp has been deleted; maybe [exit] was
- * redefined, maybe we've blown up because of an exceeded limit. We
- * still want to cleanup and exit.
- */
-
- if (!Tcl_InterpDeleted(interp)) {
- Tcl_DeleteInterp(interp);
- }
+ if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) {
+ Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode);
+
+ Tcl_IncrRefCount(cmd);
+ Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(cmd);
}
- Tcl_SetStartupScript(NULL, NULL);
/*
- * If we get here, the master interp has been deleted. Allow its
- * destruction with the last matching Tcl_Release.
+ * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual is
+ * happening. Maybe interp has been deleted; maybe [exit] was redefined,
+ * maybe we've blown up because of an exceeded limit. We still want to
+ * cleanup and exit.
*/
- Tcl_Release(interp);
Tcl_Exit(exitCode);
}
+
+#if (TCL_MAJOR_VERSION == 8) && !defined(UNICODE)
+#undef Tcl_Main
+extern DLLEXPORT void
+Tcl_Main(
+ int argc, /* Number of arguments. */
+ char **argv, /* Array of argument strings. */
+ Tcl_AppInitProc *appInitProc)
+ /* Application-specific initialization
+ * function to call after most initialization
+ * but before starting to execute commands. */
+{
+ Tcl_FindExecutable(argv[0]);
+ Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp());
+}
+#endif /* TCL_MAJOR_VERSION == 8 && !UNICODE */
+#ifndef TCL_ASCII_MAIN
+
/*
*---------------------------------------------------------------
*
@@ -636,7 +676,7 @@ Tcl_SetMainLoop(
/*
*---------------------------------------------------------------
*
- * GetMainLoop --
+ * TclGetMainLoop --
*
* Returns the current alternative main loop function.
*
@@ -652,8 +692,8 @@ Tcl_SetMainLoop(
*---------------------------------------------------------------
*/
-static Tcl_MainLoopProc *
-GetMainLoop(void)
+Tcl_MainLoopProc *
+TclGetMainLoop(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -663,6 +703,44 @@ GetMainLoop(void)
/*
*----------------------------------------------------------------------
*
+ * TclFullFinalizationRequested --
+ *
+ * This function returns true when either -DPURIFY is specified, or the
+ * environment variable TCL_FINALIZE_ON_EXIT is set and not "0". This
+ * predicate is called at places affecting the exit sequence, so that the
+ * default behavior is a fast and deadlock-free exit, and the modified
+ * behavior is a more thorough finalization for debugging purposes (leak
+ * hunting etc).
+ *
+ * Results:
+ * A boolean.
+ *
+ *----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE int
+TclFullFinalizationRequested(void)
+{
+#ifdef PURIFY
+ return 1;
+#else
+ const char *fin;
+ Tcl_DString ds;
+ int finalize = 0;
+
+ fin = TclGetEnv("TCL_FINALIZE_ON_EXIT", &ds);
+ finalize = ((fin != NULL) && strcmp(fin, "0"));
+ if (fin != NULL) {
+ Tcl_DStringFree(&ds);
+ }
+ return finalize;
+#endif /* PURIFY */
+}
+#endif /* !TCL_ASCII_MAIN */
+
+/*
+ *----------------------------------------------------------------------
+ *
* StdinProc --
*
* This function is invoked by the event dispatcher whenever standard
@@ -685,11 +763,11 @@ StdinProc(
ClientData clientData, /* The state of interactive cmd line */
int mask) /* Not used. */
{
+ int code, length;
InteractiveState *isPtr = clientData;
Tcl_Channel chan = isPtr->input;
Tcl_Obj *commandPtr = isPtr->commandPtr;
Tcl_Interp *interp = isPtr->interp;
- int code, length;
if (Tcl_IsShared(commandPtr)) {
Tcl_DecrRefCount(commandPtr);
@@ -745,21 +823,21 @@ StdinProc(
Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, isPtr);
}
if (code != TCL_OK) {
- Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ chan = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel != NULL) {
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
+ if (chan != NULL) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
}
} else if (isPtr->tty) {
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
- Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
Tcl_IncrRefCount(resultPtr);
Tcl_GetStringFromObj(resultPtr, &length);
- if ((length >0) && (outChannel != NULL)) {
- Tcl_WriteObj(outChannel, resultPtr);
- Tcl_WriteChars(outChannel, "\n", 1);
+ if ((length > 0) && (chan != NULL)) {
+ Tcl_WriteObj(chan, resultPtr);
+ Tcl_WriteChars(chan, "\n", 1);
}
Tcl_DecrRefCount(resultPtr);
}
@@ -770,7 +848,7 @@ StdinProc(
prompt:
if (isPtr->tty && (isPtr->input != NULL)) {
- Prompt(interp, &isPtr->prompt);
+ Prompt(interp, isPtr);
isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
}
}
@@ -795,20 +873,19 @@ StdinProc(
static void
Prompt(
Tcl_Interp *interp, /* Interpreter to use for prompting. */
- PromptType *promptPtr) /* Points to type of prompt to print. Filled
- * with PROMPT_NONE after a prompt is
- * printed. */
+ InteractiveState *isPtr) /* InteractiveState. Filled with PROMPT_NONE
+ * after a prompt is printed. */
{
Tcl_Obj *promptCmdPtr;
int code;
- Tcl_Channel outChannel, errChannel;
+ Tcl_Channel chan;
- if (*promptPtr == PROMPT_NONE) {
+ if (isPtr->prompt == PROMPT_NONE) {
return;
}
promptCmdPtr = Tcl_GetVar2Ex(interp,
- ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
+ (isPtr->prompt==PROMPT_CONTINUE ? "tcl_prompt2" : "tcl_prompt1"),
NULL, TCL_GLOBAL_ONLY);
if (Tcl_InterpDeleted(interp)) {
@@ -816,30 +893,58 @@ Prompt(
}
if (promptCmdPtr == NULL) {
defaultPrompt:
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- if ((*promptPtr == PROMPT_START) && (outChannel != NULL)) {
- Tcl_WriteChars(outChannel, DEFAULT_PRIMARY_PROMPT,
- strlen(DEFAULT_PRIMARY_PROMPT));
+ if (isPtr->prompt == PROMPT_START) {
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan != NULL) {
+ Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT,
+ strlen(DEFAULT_PRIMARY_PROMPT));
+ }
}
} else {
code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
Tcl_AddErrorInfo(interp,
"\n (script that generates prompt)");
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel != NULL) {
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan != NULL) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
}
goto defaultPrompt;
}
}
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- if (outChannel != NULL) {
- Tcl_Flush(outChannel);
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan != NULL) {
+ Tcl_Flush(chan);
}
- *promptPtr = PROMPT_NONE;
+ isPtr->prompt = PROMPT_NONE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeMainInterp --
+ *
+ * Exit handler used to cleanup the main interpreter and ancillary
+ * startup script storage at exit.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeMainInterp(
+ ClientData clientData)
+{
+ Tcl_Interp *interp = clientData;
+
+ /*if (TclInExit()) return;*/
+
+ if (!Tcl_InterpDeleted(interp)) {
+ Tcl_DeleteInterp(interp);
+ }
+ Tcl_SetStartupScript(NULL, NULL);
+ Tcl_Release(interp);
}
/*
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 6961fd5..02d517f 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -21,12 +21,10 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclNamesp.c,v 1.212 2010/08/30 14:02:10 msofer Exp $
*/
#include "tclInt.h"
-#include "tclCompile.h" /* just for NRCommand */
+#include "tclCompile.h" /* for TclLogCommandInfo visibility */
/*
* Thread-local storage used to avoid having a global lock on data that is not
@@ -105,6 +103,8 @@ static int NamespaceDeleteCmd(ClientData dummy,Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int NamespaceEvalCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
+static int NRNamespaceEvalCmd(ClientData dummy,
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceExistsCmd(ClientData dummy,Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int NamespaceExportCmd(ClientData dummy,Tcl_Interp *interp,
@@ -116,6 +116,8 @@ static int NamespaceImportCmd(ClientData dummy,Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int NamespaceInscopeCmd(ClientData dummy,
Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static int NRNamespaceInscopeCmd(ClientData dummy,
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceOriginCmd(ClientData dummy,Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int NamespaceParentCmd(ClientData dummy,Tcl_Interp *interp,
@@ -129,8 +131,7 @@ static int NamespaceTailCmd(ClientData dummy, Tcl_Interp *interp,
static int NamespaceUpvarCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int NamespaceUnknownCmd(ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceWhichCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
@@ -152,6 +153,34 @@ static const Tcl_ObjType nsNameType = {
NULL, /* updateStringProc */
SetNsNameFromAny /* setFromAnyProc */
};
+
+/*
+ * Array of values describing how to implement each standard subcommand of the
+ * "namespace" command.
+ */
+
+static const EnsembleImplMap defaultNamespaceMap[] = {
+ {"children", NamespaceChildrenCmd, NULL, NULL, NULL, 0},
+ {"code", NamespaceCodeCmd, TclCompileNamespaceCodeCmd, NULL, NULL, 0},
+ {"current", NamespaceCurrentCmd, TclCompileNamespaceCurrentCmd, NULL, NULL, 0},
+ {"delete", NamespaceDeleteCmd, NULL, NULL, NULL, 0},
+ {"ensemble", TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
+ {"eval", NamespaceEvalCmd, NULL, NRNamespaceEvalCmd, NULL, 0},
+ {"exists", NamespaceExistsCmd, NULL, NULL, NULL, 0},
+ {"export", NamespaceExportCmd, NULL, NULL, NULL, 0},
+ {"forget", NamespaceForgetCmd, NULL, NULL, NULL, 0},
+ {"import", NamespaceImportCmd, NULL, NULL, NULL, 0},
+ {"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0},
+ {"origin", NamespaceOriginCmd, NULL, NULL, NULL, 0},
+ {"parent", NamespaceParentCmd, NULL, NULL, NULL, 0},
+ {"path", NamespacePathCmd, NULL, NULL, NULL, 0},
+ {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0},
+ {"tail", NamespaceTailCmd, TclCompileNamespaceTailCmd, NULL, NULL, 0},
+ {"unknown", NamespaceUnknownCmd, NULL, NULL, NULL, 0},
+ {"upvar", NamespaceUpvarCmd, TclCompileNamespaceUpvarCmd, NULL, NULL, 0},
+ {"which", NamespaceWhichCmd, TclCompileNamespaceWhichCmd, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
+};
/*
*----------------------------------------------------------------------
@@ -368,7 +397,7 @@ Tcl_PopCallFrame(
if (framePtr->varTablePtr != NULL) {
TclDeleteVars(iPtr, framePtr->varTablePtr);
- ckfree((char *) framePtr->varTablePtr);
+ ckfree(framePtr->varTablePtr);
framePtr->varTablePtr = NULL;
}
if (framePtr->numCompiledLocals > 0) {
@@ -394,7 +423,7 @@ Tcl_PopCallFrame(
framePtr->nsPtr = NULL;
if (framePtr->tailcallPtr) {
- TclSpliceTailcall(interp, framePtr->tailcallPtr);
+ TclSpliceTailcall(interp, framePtr->tailcallPtr);
}
}
@@ -658,9 +687,10 @@ Tcl_CreateNamespace(
parentPtr = NULL;
simpleName = "";
} else if (*name == '\0') {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "can't create namespace \"\": "
- "only global namespace can have empty name", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace"
+ " \"\": only global namespace can have empty name", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
+ "CREATEGLOBAL", NULL);
return NULL;
} else {
/*
@@ -694,8 +724,10 @@ Tcl_CreateNamespace(
Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL
#endif
) {
- Tcl_AppendResult(interp, "can't create namespace \"", name,
- "\": already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create namespace \"%s\": already exists", name));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
+ "CREATEEXISTING", NULL);
return NULL;
}
}
@@ -705,9 +737,10 @@ Tcl_CreateNamespace(
* of namespaces created.
*/
- nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
- nsPtr->name = ckalloc((unsigned) (strlen(simpleName)+1));
- strcpy(nsPtr->name, simpleName);
+ nsPtr = ckalloc(sizeof(Namespace));
+ nameLen = strlen(simpleName) + 1;
+ nsPtr->name = ckalloc(nameLen);
+ memcpy(nsPtr->name, simpleName, nameLen);
nsPtr->fullName = NULL; /* Set below. */
nsPtr->clientData = clientData;
nsPtr->deleteProc = deleteProc;
@@ -769,10 +802,9 @@ Tcl_CreateNamespace(
if (ancestorPtr != globalNsPtr) {
register Tcl_DString *tempPtr = namePtr;
- Tcl_DStringAppend(buffPtr, "::", 2);
+ TclDStringAppendLiteral(buffPtr, "::");
Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1);
- Tcl_DStringAppend(buffPtr, Tcl_DStringValue(namePtr),
- Tcl_DStringLength(namePtr));
+ TclDStringAppendDString(buffPtr, namePtr);
/*
* Clear the unwanted buffer or we end up appending to previous
@@ -780,7 +812,7 @@ Tcl_CreateNamespace(
* very wrong (and strange).
*/
- Tcl_DStringSetLength(namePtr, 0);
+ TclDStringClear(namePtr);
/*
* Now swap the buffer pointers so that we build in the other
@@ -795,7 +827,7 @@ Tcl_CreateNamespace(
name = Tcl_DStringValue(namePtr);
nameLen = Tcl_DStringLength(namePtr);
- nsPtr->fullName = ckalloc((unsigned) (nameLen+1));
+ nsPtr->fullName = ckalloc(nameLen + 1);
memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);
Tcl_DStringFree(&buffer1);
@@ -881,13 +913,13 @@ Tcl_DeleteNamespace(
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
entryPtr != NULL;) {
- cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
- if (cmdPtr->nreProc == NRInterpCoroutine) {
+ cmdPtr = Tcl_GetHashValue(entryPtr);
+ if (cmdPtr->nreProc == TclNRInterpCoroutine) {
Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
(Tcl_Command) cmdPtr);
entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
} else {
- entryPtr = entryPtr->nextPtr;
+ entryPtr = Tcl_NextHashEntry(&search);
}
}
@@ -976,7 +1008,7 @@ Tcl_DeleteNamespace(
#else
if (nsPtr->childTablePtr != NULL) {
Tcl_DeleteHashTable(nsPtr->childTablePtr);
- ckfree((char *) nsPtr->childTablePtr);
+ ckfree(nsPtr->childTablePtr);
}
#endif
Tcl_DeleteHashTable(&nsPtr->cmdTable);
@@ -1140,7 +1172,7 @@ TclTeardownNamespace(
for (i = 0; i < nsPtr->numExportPatterns; i++) {
ckfree(nsPtr->exportArrayPtr[i]);
}
- ckfree((char *) nsPtr->exportArrayPtr);
+ ckfree(nsPtr->exportArrayPtr);
nsPtr->exportArrayPtr = NULL;
nsPtr->numExportPatterns = 0;
nsPtr->maxExportPatterns = 0;
@@ -1194,8 +1226,7 @@ NamespaceFree(
ckfree(nsPtr->name);
ckfree(nsPtr->fullName);
-
- ckfree((char *) nsPtr);
+ ckfree(nsPtr);
}
/*
@@ -1287,7 +1318,7 @@ Tcl_Export(
for (i = 0; i < nsPtr->numExportPatterns; i++) {
ckfree(nsPtr->exportArrayPtr[i]);
}
- ckfree((char *) nsPtr->exportArrayPtr);
+ ckfree(nsPtr->exportArrayPtr);
nsPtr->exportArrayPtr = NULL;
TclInvalidateNsCmdLookup(nsPtr);
nsPtr->numExportPatterns = 0;
@@ -1304,8 +1335,9 @@ Tcl_Export(
&exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
- Tcl_AppendResult(interp, "invalid export pattern \"", pattern,
- "\": pattern can't specify a namespace", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid export pattern"
+ " \"%s\": pattern can't specify a namespace", pattern));
+ Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", NULL);
return TCL_ERROR;
}
@@ -1334,8 +1366,7 @@ Tcl_Export(
if (neededElems > nsPtr->maxExportPatterns) {
nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ?
2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS;
- nsPtr->exportArrayPtr = (char **)
- ckrealloc((char *) nsPtr->exportArrayPtr,
+ nsPtr->exportArrayPtr = ckrealloc(nsPtr->exportArrayPtr,
sizeof(char *) * nsPtr->maxExportPatterns);
}
@@ -1344,7 +1375,7 @@ Tcl_Export(
*/
len = strlen(pattern);
- patternCpy = ckalloc((unsigned) (len + 1));
+ patternCpy = ckalloc(len + 1);
memcpy(patternCpy, pattern, (unsigned) len + 1);
nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
@@ -1511,6 +1542,7 @@ Tcl_Import(
if (strlen(pattern) == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1));
+ Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", NULL);
return TCL_ERROR;
}
TclGetNamespaceForQualName(interp, pattern, nsPtr,
@@ -1518,20 +1550,22 @@ Tcl_Import(
&importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if (importNsPtr == NULL) {
- Tcl_AppendResult(interp, "unknown namespace in import pattern \"",
- pattern, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown namespace in import pattern \"%s\"", pattern));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
return TCL_ERROR;
}
if (importNsPtr == nsPtr) {
if (pattern == simplePattern) {
- Tcl_AppendResult(interp,
- "no namespace specified in import pattern \"", pattern,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no namespace specified in import pattern \"%s\"",
+ pattern));
+ Tcl_SetErrorCode(interp, "TCL", "IMPORT", "ORIGIN", NULL);
} else {
- Tcl_AppendResult(interp, "import pattern \"", pattern,
- "\" tries to import from namespace \"",
- importNsPtr->name, "\" into itself", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "import pattern \"%s\" tries to import from namespace"
+ " \"%s\" into itself", pattern, importNsPtr->name));
+ Tcl_SetErrorCode(interp, "TCL", "IMPORT", "SELF", NULL);
}
return TCL_ERROR;
}
@@ -1631,7 +1665,7 @@ DoImport(
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
if (nsPtr != ((Interp *) interp)->globalNsPtr) {
- Tcl_DStringAppend(&ds, "::", 2);
+ TclDStringAppendLiteral(&ds, "::");
}
Tcl_DStringAppend(&ds, cmdName, -1);
@@ -1649,16 +1683,18 @@ DoImport(
dataPtr = linkCmd->objClientData;
linkCmd = dataPtr->realCmdPtr;
if (overwrite == linkCmd) {
- Tcl_AppendResult(interp, "import pattern \"", pattern,
- "\" would create a loop containing command \"",
- Tcl_DStringValue(&ds), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "import pattern \"%s\" would create a loop"
+ " containing command \"%s\"",
+ pattern, Tcl_DStringValue(&ds)));
Tcl_DStringFree(&ds);
+ Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", NULL);
return TCL_ERROR;
}
}
}
- dataPtr = (ImportedCmdData *) ckalloc(sizeof(ImportedCmdData));
+ dataPtr = ckalloc(sizeof(ImportedCmdData));
importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
InvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
DeleteImportedCmd);
@@ -1672,7 +1708,7 @@ DoImport(
* and add it to the import ref list in the "real" command.
*/
- refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
+ refPtr = ckalloc(sizeof(ImportRef));
refPtr->importedCmdPtr = (Command *) importedCmd;
refPtr->nextPtr = cmdPtr->importRefPtr;
cmdPtr->importRefPtr = refPtr;
@@ -1690,8 +1726,9 @@ DoImport(
return TCL_OK;
}
}
- Tcl_AppendResult(interp, "can't import command \"", cmdName,
- "\": already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't import command \"%s\": already exists", cmdName));
+ Tcl_SetErrorCode(interp, "TCL", "IMPORT", "OVERWRITE", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -1759,9 +1796,9 @@ Tcl_ForgetImport(
&sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if (sourceNsPtr == NULL) {
- Tcl_AppendResult(interp,
- "unknown namespace in namespace forget pattern \"",
- pattern, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown namespace in namespace forget pattern \"%s\"",
+ pattern));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
return TCL_ERROR;
}
@@ -1969,8 +2006,8 @@ DeleteImportedCmd(
} else {
prevPtr->nextPtr = refPtr->nextPtr;
}
- ckfree((char *) refPtr);
- ckfree((char *) dataPtr);
+ ckfree(refPtr);
+ ckfree(dataPtr);
return;
}
prevPtr = refPtr;
@@ -2203,7 +2240,7 @@ TclGetNamespaceForQualName(
* qualName since it may be a string constant.
*/
- Tcl_DStringSetLength(&buffer, 0);
+ TclDStringClear(&buffer);
Tcl_DStringAppend(&buffer, start, len);
nsName = Tcl_DStringValue(&buffer);
}
@@ -2365,8 +2402,8 @@ Tcl_FindNamespace(
}
if (flags & TCL_LEAVE_ERR_MSG) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "unknown namespace \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown namespace \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL);
}
return NULL;
@@ -2552,8 +2589,8 @@ Tcl_FindCommand(
}
if (flags & TCL_LEAVE_ERR_MSG) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "unknown command \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown command \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, NULL);
}
return NULL;
@@ -2743,7 +2780,7 @@ TclGetNamespaceFromObj(
* Get the current namespace name.
*/
- NamespaceCurrentCmd(NULL, interp, 2, NULL);
+ NamespaceCurrentCmd(NULL, interp, 1, NULL);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"namespace \"%s\" not found in \"%s\"", name,
Tcl_GetStringResult(interp)));
@@ -2770,18 +2807,18 @@ GetNamespaceFromObj(
* cross interps.
*/
- resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
+ resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
nsPtr = resNamePtr->nsPtr;
refNsPtr = resNamePtr->refNsPtr;
if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) &&
(!refNsPtr || ((interp == refNsPtr->interp) &&
- (refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))) {
+ (refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))){
*nsPtrPtr = (Tcl_Namespace *) nsPtr;
return TCL_OK;
}
}
if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
- resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
+ resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
return TCL_OK;
}
@@ -2791,132 +2828,25 @@ GetNamespaceFromObj(
/*
*----------------------------------------------------------------------
*
- * Tcl_NamespaceObjCmd --
+ * TclInitNamespaceCmd --
*
- * Invoked to implement the "namespace" command that creates, deletes, or
- * manipulates Tcl namespaces. Handles the following syntax:
- *
- * namespace children ?name? ?pattern?
- * namespace code arg
- * namespace current
- * namespace delete ?name name...?
- * namespace ensemble subcommand ?arg...?
- * namespace eval name arg ?arg...?
- * namespace exists name
- * namespace export ?-clear? ?pattern pattern...?
- * namespace forget ?pattern pattern...?
- * namespace import ?-force? ?pattern pattern...?
- * namespace inscope name arg ?arg...?
- * namespace origin name
- * namespace parent ?name?
- * namespace qualifiers string
- * namespace tail string
- * namespace which ?-command? ?-variable? name
+ * This function is called to create the "namespace" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
- * Returns TCL_OK if the command is successful. Returns TCL_ERROR if
- * anything goes wrong.
+ * Handle for the namespace command, or NULL on failure.
*
* Side effects:
- * Based on the subcommand name (e.g., "import"), this function
- * dispatches to a corresponding function NamespaceXXXCmd defined
- * statically in this file. This function's side effects depend on
- * whatever that subcommand function does. If there is an error, this
- * function returns an error message in the interpreter's result object.
- * Otherwise it may return a result in the interpreter's result object.
+ * none
*
*----------------------------------------------------------------------
*/
-int
-Tcl_NamespaceObjCmd(
- ClientData clientData, /* Arbitrary value passed to cmd. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument objects. */
-{
- return Tcl_NRCallObjProc(interp, TclNRNamespaceObjCmd, clientData, objc,
- objv);
-}
-
-int
-TclNRNamespaceObjCmd(
- ClientData clientData, /* Arbitrary value passed to cmd. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument objects. */
+Tcl_Command
+TclInitNamespaceCmd(
+ Tcl_Interp *interp) /* Current interpreter. */
{
- static const char *const subCmds[] = {
- "children", "code", "current", "delete", "ensemble",
- "eval", "exists", "export", "forget", "import",
- "inscope", "origin", "parent", "path", "qualifiers",
- "tail", "unknown", "upvar", "which", NULL
- };
- enum NSSubCmdIdx {
- NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx, NSEnsembleIdx,
- NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
- NSInscopeIdx, NSOriginIdx, NSParentIdx, NSPathIdx, NSQualifiersIdx,
- NSTailIdx, NSUnknownIdx, NSUpvarIdx, NSWhichIdx
- };
- int index;
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
- return TCL_ERROR;
- }
-
- /*
- * Return an index reflecting the particular subcommand.
- */
-
- if (Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option", /*flags*/ 0,
- (int *) &index) != TCL_OK) {
- return TCL_ERROR;
- }
-
- switch (index) {
- case NSChildrenIdx:
- return NamespaceChildrenCmd(clientData, interp, objc, objv);
- case NSCodeIdx:
- return NamespaceCodeCmd(clientData, interp, objc, objv);
- case NSCurrentIdx:
- return NamespaceCurrentCmd(clientData, interp, objc, objv);
- case NSDeleteIdx:
- return NamespaceDeleteCmd(clientData, interp, objc, objv);
- case NSEnsembleIdx:
- return TclNamespaceEnsembleCmd(clientData, interp, objc, objv);
- case NSEvalIdx:
- return NamespaceEvalCmd(clientData, interp, objc, objv);
- case NSExistsIdx:
- return NamespaceExistsCmd(clientData, interp, objc, objv);
- case NSExportIdx:
- return NamespaceExportCmd(clientData, interp, objc, objv);
- case NSForgetIdx:
- return NamespaceForgetCmd(clientData, interp, objc, objv);
- case NSImportIdx:
- return NamespaceImportCmd(clientData, interp, objc, objv);
- case NSInscopeIdx:
- return NamespaceInscopeCmd(clientData, interp, objc, objv);
- case NSOriginIdx:
- return NamespaceOriginCmd(clientData, interp, objc, objv);
- case NSParentIdx:
- return NamespaceParentCmd(clientData, interp, objc, objv);
- case NSPathIdx:
- return NamespacePathCmd(clientData, interp, objc, objv);
- case NSQualifiersIdx:
- return NamespaceQualifiersCmd(clientData, interp, objc, objv);
- case NSTailIdx:
- return NamespaceTailCmd(clientData, interp, objc, objv);
- case NSUpvarIdx:
- return NamespaceUpvarCmd(clientData, interp, objc, objv);
- case NSUnknownIdx:
- return NamespaceUnknownCmd(clientData, interp, objc, objv);
- case NSWhichIdx:
- return NamespaceWhichCmd(clientData, interp, objc, objv);
- default:
- Tcl_Panic("unhandled namespace subcommand");
- }
- return TCL_ERROR;
+ return TclMakeEnsemble(interp, "namespace", defaultNamespaceMap);
}
/*
@@ -2960,15 +2890,15 @@ NamespaceChildrenCmd(
* Get a pointer to the specified namespace, or the current namespace.
*/
- if (objc == 2) {
+ if (objc == 1) {
nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
- } else if ((objc == 3) || (objc == 4)) {
- if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK){
+ } else if ((objc == 2) || (objc == 3)) {
+ if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK){
return TCL_ERROR;
}
nsPtr = (Namespace *) namespacePtr;
} else {
- Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?");
+ Tcl_WrongNumArgs(interp, 1, objv, "?name? ?pattern?");
return TCL_ERROR;
}
@@ -2977,15 +2907,15 @@ NamespaceChildrenCmd(
*/
Tcl_DStringInit(&buffer);
- if (objc == 4) {
- const char *name = TclGetString(objv[3]);
+ if (objc == 3) {
+ const char *name = TclGetString(objv[2]);
if ((*name == ':') && (*(name+1) == ':')) {
pattern = name;
} else {
Tcl_DStringAppend(&buffer, nsPtr->fullName, -1);
if (nsPtr != globalNsPtr) {
- Tcl_DStringAppend(&buffer, "::", 2);
+ TclDStringAppendLiteral(&buffer, "::");
}
Tcl_DStringAppend(&buffer, name, -1);
pattern = Tcl_DStringValue(&buffer);
@@ -3078,31 +3008,27 @@ NamespaceCodeCmd(
{
Namespace *currNsPtr;
Tcl_Obj *listPtr, *objPtr;
- register const char *arg, *p;
+ register const char *arg;
int length;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "arg");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arg");
return TCL_ERROR;
}
/*
* If "arg" is already a scoped value, then return it directly.
+ * Take care to only check for scoping in precisely the style that
+ * [::namespace code] generates it. Anything more forgiving can have
+ * the effect of failing in namespaces that contain their own custom
+ " "namespace" command. [Bug 3202171].
*/
- arg = TclGetStringFromObj(objv[2], &length);
- while (*arg == ':') {
- arg++;
- length--;
- }
- if (*arg=='n' && length>17 && strncmp(arg, "namespace", 9)==0) {
- for (p=arg+9 ; isspace(UCHAR(*p)) ; p++) {
- /* empty body: skip over whitespace */
- }
- if (*p=='i' && (p+7 <= arg+length) && strncmp(p, "inscope", 7)==0) {
- Tcl_SetObjResult(interp, objv[2]);
- return TCL_OK;
- }
+ arg = TclGetStringFromObj(objv[1], &length);
+ if (*arg==':' && length > 20
+ && strncmp(arg, "::namespace inscope ", 20) == 0) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
}
/*
@@ -3127,7 +3053,7 @@ NamespaceCodeCmd(
}
Tcl_ListObjAppendElement(interp, listPtr, objPtr);
- Tcl_ListObjAppendElement(interp, listPtr, objv[2]);
+ Tcl_ListObjAppendElement(interp, listPtr, objv[1]);
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
@@ -3163,8 +3089,8 @@ NamespaceCurrentCmd(
{
register Namespace *currNsPtr;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
@@ -3228,8 +3154,8 @@ NamespaceDeleteCmd(
const char *name;
register int i;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv, "?name name...?");
+ if (objc < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?name name...?");
return TCL_ERROR;
}
@@ -3239,14 +3165,14 @@ NamespaceDeleteCmd(
* command line are valid, and report any errors.
*/
- for (i = 2; i < objc; i++) {
+ for (i = 1; i < objc; i++) {
name = TclGetString(objv[i]);
namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
if ((namespacePtr == NULL)
|| (((Namespace *) namespacePtr)->flags & NS_KILLED)) {
- Tcl_AppendResult(interp, "unknown namespace \"",
- TclGetString(objv[i]),
- "\" in namespace delete command", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown namespace \"%s\" in namespace delete command",
+ TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE",
TclGetString(objv[i]), NULL);
return TCL_ERROR;
@@ -3257,7 +3183,7 @@ NamespaceDeleteCmd(
* Okay, now delete each namespace.
*/
- for (i = 2; i < objc; i++) {
+ for (i = 1; i < objc; i++) {
name = TclGetString(objv[i]);
namespacePtr = Tcl_FindNamespace(interp, name, NULL, /* flags */ 0);
if (namespacePtr) {
@@ -3296,6 +3222,17 @@ NamespaceDeleteCmd(
static int
NamespaceEvalCmd(
+ ClientData clientData, /* Arbitrary value passed to cmd. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, NRNamespaceEvalCmd, clientData, objc,
+ objv);
+}
+
+static int
+NRNamespaceEvalCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
@@ -3309,8 +3246,8 @@ NamespaceEvalCmd(
Tcl_Obj *objPtr;
int result;
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
return TCL_ERROR;
}
@@ -3319,14 +3256,14 @@ NamespaceEvalCmd(
* namespace object along the way.
*/
- result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
+ result = GetNamespaceFromObj(interp, objv[1], &namespacePtr);
/*
* If the namespace wasn't found, try to create it.
*/
if (result == TCL_ERROR) {
- const char *name = TclGetString(objv[2]);
+ const char *name = TclGetString(objv[1]);
namespacePtr = Tcl_CreateNamespace(interp, name, NULL, NULL);
if (namespacePtr == NULL) {
@@ -3347,15 +3284,21 @@ NamespaceEvalCmd(
return TCL_ERROR;
}
- framePtr->objc = objc;
- framePtr->objv = objv;
+ if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+ framePtr->objc = objc;
+ framePtr->objv = objv;
+ } else {
+ framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs
+ - iPtr->ensembleRewrite.numInsertedObjs;
+ framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
+ }
- if (objc == 4) {
+ if (objc == 3) {
/*
* TIP #280: Make actual argument location available to eval'd script.
*/
- objPtr = objv[3];
+ objPtr = objv[2];
invoker = iPtr->cmdFramePtr;
word = 3;
TclArgumentGet(interp, objPtr, &invoker, &word);
@@ -3366,7 +3309,7 @@ NamespaceEvalCmd(
* object when it decrements its refcount after eval'ing it.
*/
- objPtr = Tcl_ConcatObj(objc-3, objv+3);
+ objPtr = Tcl_ConcatObj(objc-2, objv+2);
invoker = NULL;
word = 0;
}
@@ -3439,13 +3382,13 @@ NamespaceExistsCmd(
{
Tcl_Namespace *namespacePtr;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "name");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
- GetNamespaceFromObj(interp, objv[2], &namespacePtr) == TCL_OK));
+ GetNamespaceFromObj(interp, objv[1], &namespacePtr) == TCL_OK));
return TCL_OK;
}
@@ -3497,8 +3440,8 @@ NamespaceExportCmd(
int resetListFirst = 0;
int firstArg, patternCt, i, result;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv, "?-clear? ?pattern pattern...?");
+ if (objc < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-clear? ?pattern pattern...?");
return TCL_ERROR;
}
@@ -3506,7 +3449,7 @@ NamespaceExportCmd(
* Process the optional "-clear" argument.
*/
- firstArg = 2;
+ firstArg = 1;
if (firstArg < objc) {
string = TclGetString(objv[firstArg]);
if (strcmp(string, "-clear") == 0) {
@@ -3520,9 +3463,9 @@ NamespaceExportCmd(
* the namespace's current export pattern list.
*/
- patternCt = (objc - firstArg);
+ patternCt = objc - firstArg;
if (patternCt == 0) {
- if (firstArg > 2) {
+ if (firstArg > 1) {
return TCL_OK;
} else {
/*
@@ -3596,12 +3539,12 @@ NamespaceForgetCmd(
const char *pattern;
register int i, result;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv, "?pattern pattern...?");
+ if (objc < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?");
return TCL_ERROR;
}
- for (i = 2; i < objc; i++) {
+ for (i = 1; i < objc; i++) {
pattern = TclGetString(objv[i]);
result = Tcl_ForgetImport(interp, NULL, pattern);
if (result != TCL_OK) {
@@ -3663,8 +3606,8 @@ NamespaceImportCmd(
register int i, result;
int firstArg;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv, "?-force? ?pattern pattern...?");
+ if (objc < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-force? ?pattern pattern...?");
return TCL_ERROR;
}
@@ -3672,7 +3615,7 @@ NamespaceImportCmd(
* Skip over the optional "-force" as the first argument.
*/
- firstArg = 2;
+ firstArg = 1;
if (firstArg < objc) {
string = TclGetString(objv[firstArg]);
if ((*string == '-') && (strcmp(string, "-force") == 0)) {
@@ -3681,7 +3624,7 @@ NamespaceImportCmd(
}
} else {
/*
- * When objc == 2, command is just [namespace import]. Introspection
+ * When objc == 1, command is just [namespace import]. Introspection
* form to return list of imported commands.
*/
@@ -3757,6 +3700,17 @@ NamespaceImportCmd(
static int
NamespaceInscopeCmd(
+ ClientData clientData, /* Arbitrary value passed to cmd. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, NRNamespaceInscopeCmd, clientData, objc,
+ objv);
+}
+
+static int
+NRNamespaceInscopeCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
@@ -3764,11 +3718,12 @@ NamespaceInscopeCmd(
{
Tcl_Namespace *namespacePtr;
CallFrame *framePtr, **framePtrPtr;
+ register Interp *iPtr = (Interp *) interp;
int i, result;
Tcl_Obj *cmdObjPtr;
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
return TCL_ERROR;
}
@@ -3776,7 +3731,7 @@ NamespaceInscopeCmd(
* Resolve the namespace reference.
*/
- if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+ if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK) {
return TCL_ERROR;
}
@@ -3792,8 +3747,14 @@ NamespaceInscopeCmd(
return result;
}
- framePtr->objc = objc;
- framePtr->objv = objv;
+ if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+ framePtr->objc = objc;
+ framePtr->objv = objv;
+ } else {
+ framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs
+ - iPtr->ensembleRewrite.numInsertedObjs;
+ framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
+ }
/*
* Execute the command. If there is just one argument, just treat it as a
@@ -3802,21 +3763,21 @@ NamespaceInscopeCmd(
* of extra arguments to form the command to evaluate.
*/
- if (objc == 4) {
- cmdObjPtr = objv[3];
+ if (objc == 3) {
+ cmdObjPtr = objv[2];
} else {
Tcl_Obj *concatObjv[2];
register Tcl_Obj *listPtr;
listPtr = Tcl_NewListObj(0, NULL);
- for (i = 4; i < objc; i++) {
+ for (i = 3; i < objc; i++) {
if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK){
Tcl_DecrRefCount(listPtr); /* Free unneeded obj. */
return TCL_ERROR;
}
}
- concatObjv[0] = objv[3];
+ concatObjv[0] = objv[2];
concatObjv[1] = listPtr;
cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
Tcl_DecrRefCount(listPtr); /* We're done with the list object. */
@@ -3866,17 +3827,17 @@ NamespaceOriginCmd(
Tcl_Command command, origCommand;
Tcl_Obj *resultPtr;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "name");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
- command = Tcl_GetCommandFromObj(interp, objv[2]);
+ command = Tcl_GetCommandFromObj(interp, objv[1]);
if (command == NULL) {
- Tcl_AppendResult(interp, "invalid command name \"",
- TclGetString(objv[2]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid command name \"%s\"", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
- TclGetString(objv[2]), NULL);
+ TclGetString(objv[1]), NULL);
return TCL_ERROR;
}
origCommand = TclGetOriginalCommand(command);
@@ -3926,14 +3887,14 @@ NamespaceParentCmd(
{
Tcl_Namespace *nsPtr;
- if (objc == 2) {
+ if (objc == 1) {
nsPtr = TclGetCurrentNamespace(interp);
- } else if (objc == 3) {
- if (TclGetNamespaceFromObj(interp, objv[2], &nsPtr) != TCL_OK) {
+ } else if (objc == 2) {
+ if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
return TCL_ERROR;
}
} else {
- Tcl_WrongNumArgs(interp, 2, objv, "?name?");
+ Tcl_WrongNumArgs(interp, 1, objv, "?name?");
return TCL_ERROR;
}
@@ -3987,8 +3948,8 @@ NamespacePathCmd(
Tcl_Obj **nsObjv;
Tcl_Namespace **namespaceList = NULL;
- if (objc > 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "?pathList?");
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
return TCL_ERROR;
}
@@ -3996,17 +3957,16 @@ NamespacePathCmd(
* If no path is given, return the current path.
*/
- if (objc == 2) {
- /*
- * Not a very fast way to compute this, but easy to get right.
- */
+ if (objc == 1) {
+ Tcl_Obj *resultObj = Tcl_NewObj();
for (i=0 ; i<nsPtr->commandPathLength ; i++) {
if (nsPtr->commandPathArray[i].nsPtr != NULL) {
- Tcl_AppendElement(interp,
- nsPtr->commandPathArray[i].nsPtr->fullName);
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ nsPtr->commandPathArray[i].nsPtr->fullName, -1));
}
}
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
@@ -4014,7 +3974,7 @@ NamespacePathCmd(
* There is a path given, so parse it into an array of namespace pointers.
*/
- if (TclListObjGetElements(interp, objv[2], &nsObjc, &nsObjv) != TCL_OK) {
+ if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
goto badNamespace;
}
if (nsObjc != 0) {
@@ -4070,7 +4030,7 @@ TclSetNsPath(
Tcl_Namespace *pathAry[]) /* Array of namespaces that are the path. */
{
if (pathLength != 0) {
- NamespacePathEntry *tmpPathArray = (NamespacePathEntry *)
+ NamespacePathEntry *tmpPathArray =
ckalloc(sizeof(NamespacePathEntry) * pathLength);
int i;
@@ -4139,7 +4099,7 @@ UnlinkNsPath(
}
}
}
- ckfree((char *) nsPtr->commandPathArray);
+ ckfree(nsPtr->commandPathArray);
}
/*
@@ -4211,8 +4171,8 @@ NamespaceQualifiersCmd(
register const char *name, *p;
int length;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "string");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
@@ -4221,7 +4181,7 @@ NamespaceQualifiersCmd(
* the last "::" qualifier.
*/
- name = TclGetString(objv[2]);
+ name = TclGetString(objv[1]);
for (p = name; *p != '\0'; p++) {
/* empty body */
}
@@ -4280,14 +4240,14 @@ NamespaceUnknownCmd(
Tcl_Obj *resultPtr;
int rc;
- if (objc > 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "?script?");
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?script?");
return TCL_ERROR;
}
currNsPtr = TclGetCurrentNamespace(interp);
- if (objc == 2) {
+ if (objc == 1) {
/*
* Introspection - return the current namespace handler.
*/
@@ -4298,9 +4258,9 @@ NamespaceUnknownCmd(
}
Tcl_SetObjResult(interp, resultPtr);
} else {
- rc = Tcl_SetNamespaceUnknownHandler(interp, currNsPtr, objv[2]);
+ rc = Tcl_SetNamespaceUnknownHandler(interp, currNsPtr, objv[1]);
if (rc == TCL_OK) {
- Tcl_SetObjResult(interp, objv[2]);
+ Tcl_SetObjResult(interp, objv[1]);
}
return rc;
}
@@ -4465,8 +4425,8 @@ NamespaceTailCmd(
{
register const char *name, *p;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "string");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
@@ -4475,7 +4435,7 @@ NamespaceTailCmd(
* qualifier.
*/
- name = TclGetString(objv[2]);
+ name = TclGetString(objv[1]);
for (p = name; *p != '\0'; p++) {
/* empty body */
}
@@ -4526,17 +4486,17 @@ NamespaceUpvarCmd(
Var *otherPtr, *arrayPtr;
const char *myName;
- if (objc < 3 || !(objc & 1)) {
- Tcl_WrongNumArgs(interp, 2, objv, "ns ?otherVar myVar ...?");
+ if (objc < 2 || (objc & 1)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "ns ?otherVar myVar ...?");
return TCL_ERROR;
}
- if (TclGetNamespaceFromObj(interp, objv[2], &nsPtr) != TCL_OK) {
+ if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
return TCL_ERROR;
}
- objc -= 3;
- objv += 3;
+ objc -= 2;
+ objv += 2;
for (; objc>0 ; objc-=2, objv+=2) {
/*
@@ -4601,16 +4561,16 @@ NamespaceWhichCmd(
int lookupType = 0;
Tcl_Obj *resultPtr;
- if (objc < 3 || objc > 4) {
+ if (objc < 2 || objc > 3) {
badArgs:
- Tcl_WrongNumArgs(interp, 2, objv, "?-command? ?-variable? name");
+ Tcl_WrongNumArgs(interp, 1, objv, "?-command? ?-variable? name");
return TCL_ERROR;
- } else if (objc == 4) {
+ } else if (objc == 3) {
/*
* Look for a flag controlling the lookup.
*/
- if (Tcl_GetIndexFromObj(interp, objv[2], opts, "option", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0,
&lookupType) != TCL_OK) {
/*
* Preserve old style of error message!
@@ -4685,7 +4645,7 @@ FreeNsNameInternalRep(
*/
TclNsDecrRefCount(resNamePtr->nsPtr);
- ckfree((char *) resNamePtr);
+ ckfree(resNamePtr);
}
objPtr->typePtr = NULL;
}
@@ -4753,8 +4713,13 @@ SetNsNameFromAny(
const char *dummy;
Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
register ResolvedNsName *resNamePtr;
- const char *name = TclGetString(objPtr);
+ const char *name;
+
+ if (interp == NULL) {
+ return TCL_ERROR;
+ }
+ name = TclGetString(objPtr);
TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS,
&nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
@@ -4772,13 +4737,12 @@ SetNsNameFromAny(
if (objPtr->typePtr == &nsNameType) {
TclFreeIntRep(objPtr);
- objPtr->typePtr = NULL;
}
return TCL_ERROR;
}
nsPtr->refCount++;
- resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
+ resNamePtr = ckalloc(sizeof(ResolvedNsName));
resNamePtr->nsPtr = nsPtr;
if ((name[0] == ':') && (name[1] == ':')) {
resNamePtr->refNsPtr = NULL;
@@ -4840,7 +4804,7 @@ TclGetNamespaceChildTable(
return &nPtr->childTable;
#else
if (nPtr->childTablePtr == NULL) {
- nPtr->childTablePtr = (Tcl_HashTable*) ckalloc(sizeof(Tcl_HashTable));
+ nPtr->childTablePtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS);
}
return nPtr->childTablePtr;
@@ -4850,31 +4814,37 @@ TclGetNamespaceChildTable(
/*
*----------------------------------------------------------------------
*
- * Tcl_LogCommandInfo --
+ * TclLogCommandInfo --
*
* This function is invoked after an error occurs in an interpreter. It
- * adds information to iPtr->errorInfo field to describe the command that
- * was being executed when the error occurred.
+ * adds information to iPtr->errorInfo/errorStack fields to describe the
+ * command that was being executed when the error occurred. When pc and
+ * tosPtr are non-NULL, conveying a bytecode execution "inner context",
+ * and the offending instruction is suitable, that inner context is
+ * recorded in errorStack.
*
* Results:
* None.
*
* Side effects:
- * Information about the command is added to errorInfo and the line
- * number stored internally in the interpreter is set.
+ * Information about the command is added to errorInfo/errorStack and the
+ * line number stored internally in the interpreter is set.
*
*----------------------------------------------------------------------
*/
void
-Tcl_LogCommandInfo(
+TclLogCommandInfo(
Tcl_Interp *interp, /* Interpreter in which to log information. */
const char *script, /* First character in script containing
* command (must be <= command). */
const char *command, /* First character in command that generated
* the error. */
- int length) /* Number of bytes in command (-1 means use
+ int length, /* Number of bytes in command (-1 means use
* all bytes up to first null byte). */
+ const unsigned char *pc, /* Current pc of bytecode execution context */
+ Tcl_Obj **tosPtr) /* Current stack of bytecode execution
+ * context */
{
register const char *p;
Interp *iPtr = (Interp *) interp;
@@ -4891,55 +4861,55 @@ Tcl_LogCommandInfo(
}
if (command != NULL) {
- /*
- * Compute the line number where the error occurred.
- */
-
- iPtr->errorLine = 1;
- for (p = script; p != command; p++) {
- if (*p == '\n') {
- iPtr->errorLine++;
- }
- }
-
- if (length < 0) {
- length = strlen(command);
- }
- overflow = (length > limit);
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ /*
+ * Compute the line number where the error occurred.
+ */
+
+ iPtr->errorLine = 1;
+ for (p = script; p != command; p++) {
+ if (*p == '\n') {
+ iPtr->errorLine++;
+ }
+ }
+
+ if (length < 0) {
+ length = strlen(command);
+ }
+ overflow = (length > limit);
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL)
? "while executing" : "invoked from within"),
(overflow ? limit : length), command,
(overflow ? "..." : "")));
- varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
+ varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
NULL, 0, 0, &arrayPtr);
- if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) {
- /*
- * Should not happen.
- */
-
- return;
- } else {
- Tcl_HashEntry *hPtr
+ if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) {
+ /*
+ * Should not happen.
+ */
+
+ return;
+ } else {
+ Tcl_HashEntry *hPtr
= Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
- VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
+ VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
- if (tracePtr->traceProc != EstablishErrorInfoTraces) {
- /*
- * The most recent trace set on ::errorInfo is not the one the
- * core itself puts on last. This means some other code is
+ if (tracePtr->traceProc != EstablishErrorInfoTraces) {
+ /*
+ * The most recent trace set on ::errorInfo is not the one the
+ * core itself puts on last. This means some other code is
* tracing the variable, and the additional trace(s) might be
* write traces that expect the timing of writes to
* ::errorInfo that existed Tcl releases before 8.5. To
* satisfy that compatibility need, we write the current
* -errorinfo value to the ::errorInfo variable.
- */
+ */
- Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo,
+ Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo,
TCL_GLOBAL_ONLY);
- }
- }
+ }
+ }
}
/*
@@ -4947,44 +4917,153 @@ Tcl_LogCommandInfo(
*/
if (Tcl_IsShared(iPtr->errorStack)) {
- Tcl_Obj *newObj;
-
- newObj = Tcl_DuplicateObj(iPtr->errorStack);
- Tcl_DecrRefCount(iPtr->errorStack);
- Tcl_IncrRefCount(newObj);
- iPtr->errorStack = newObj;
+ Tcl_Obj *newObj;
+
+ newObj = Tcl_DuplicateObj(iPtr->errorStack);
+ Tcl_DecrRefCount(iPtr->errorStack);
+ Tcl_IncrRefCount(newObj);
+ iPtr->errorStack = newObj;
}
if (iPtr->resetErrorStack) {
int len;
- iPtr->resetErrorStack = 0;
+ iPtr->resetErrorStack = 0;
Tcl_ListObjLength(interp, iPtr->errorStack, &len);
- /* reset while keeping the list intrep as much as possible */
- Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
+
+ /*
+ * Reset while keeping the list intrep as much as possible.
+ */
+
+ Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
+ if (pc != NULL) {
+ Tcl_Obj *innerContext;
+
+ innerContext = TclGetInnerContext(interp, pc, tosPtr);
+ if (innerContext != NULL) {
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
+ iPtr->innerLiteral);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, innerContext);
+ }
+ } else if (command != NULL) {
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
+ iPtr->innerLiteral);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
+ Tcl_NewStringObj(command, length));
+ }
}
if (!iPtr->framePtr->objc) {
- /* special frame, nothing to report */
+ /*
+ * Special frame, nothing to report.
+ */
} else if (iPtr->varFramePtr != iPtr->framePtr) {
- /* uplevel case, [lappend errorstack UP $relativelevel] */
+ /*
+ * uplevel case, [lappend errorstack UP $relativelevel]
+ */
- Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
- Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj(
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj(
iPtr->framePtr->level - iPtr->varFramePtr->level));
} else if (iPtr->framePtr != iPtr->rootFramePtr) {
- /* normal case, [lappend errorstack CALL [info level 0]] */
- Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
- Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewListObj(
+ /*
+ * normal case, [lappend errorstack CALL [info level 0]]
+ */
+
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewListObj(
iPtr->framePtr->objc, iPtr->framePtr->objv));
}
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclErrorStackResetIf --
+ *
+ * The TIP 348 reset/no-bc part of TLCI, for specific use by
+ * TclCompileSyntaxError.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Reset errorstack if it needs be, and in that case remember the
+ * passed-in error message as inner context.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclErrorStackResetIf(
+ Tcl_Interp *interp,
+ const char *msg,
+ int length)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ if (Tcl_IsShared(iPtr->errorStack)) {
+ Tcl_Obj *newObj;
+
+ newObj = Tcl_DuplicateObj(iPtr->errorStack);
+ Tcl_DecrRefCount(iPtr->errorStack);
+ Tcl_IncrRefCount(newObj);
+ iPtr->errorStack = newObj;
+ }
+ if (iPtr->resetErrorStack) {
+ int len;
+
+ iPtr->resetErrorStack = 0;
+ Tcl_ListObjLength(interp, iPtr->errorStack, &len);
+
+ /*
+ * Reset while keeping the list intrep as much as possible.
+ */
+
+ Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
+ Tcl_NewStringObj(msg, length));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LogCommandInfo --
+ *
+ * This function is invoked after an error occurs in an interpreter. It
+ * adds information to iPtr->errorInfo/errorStack fields to describe the
+ * command that was being executed when the error occurred.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information about the command is added to errorInfo/errorStack and the
+ * line number stored internally in the interpreter is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_LogCommandInfo(
+ Tcl_Interp *interp, /* Interpreter in which to log information. */
+ const char *script, /* First character in script containing
+ * command (must be <= command). */
+ const char *command, /* First character in command that generated
+ * the error. */
+ int length) /* Number of bytes in command (-1 means use
+ * all bytes up to first null byte). */
+{
+ TclLogCommandInfo(interp, script, command, length, NULL, NULL);
+}
+
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* tab-width: 8
- * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index 5f0483c..a6523fc 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -13,8 +13,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclNotify.c,v 1.31 2010/02/24 10:45:04 dkf Exp $
*/
#include "tclInt.h"
@@ -183,7 +181,7 @@ TclFinalizeNotifier(void)
for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) {
hold = evPtr;
evPtr = evPtr->nextPtr;
- ckfree((char *) hold);
+ ckfree(hold);
}
tsdPtr->firstEventPtr = NULL;
tsdPtr->lastEventPtr = NULL;
@@ -278,7 +276,7 @@ Tcl_CreateEventSource(
* checkProc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- EventSource *sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
+ EventSource *sourcePtr = ckalloc(sizeof(EventSource));
sourcePtr->setupProc = setupProc;
sourcePtr->checkProc = checkProc;
@@ -332,7 +330,7 @@ Tcl_DeleteEventSource(
} else {
prevPtr->nextPtr = sourcePtr->nextPtr;
}
- ckfree((char *) sourcePtr);
+ ckfree(sourcePtr);
return;
}
}
@@ -364,6 +362,7 @@ Tcl_QueueEvent(
* TCL_QUEUE_MARK. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
QueueEvent(tsdPtr, evPtr, position);
}
@@ -413,7 +412,7 @@ Tcl_ThreadQueueEvent(
if (tsdPtr) {
QueueEvent(tsdPtr, evPtr, position);
} else {
- ckfree((char *) evPtr);
+ ckfree(evPtr);
}
Tcl_MutexUnlock(&listLock);
}
@@ -564,7 +563,7 @@ Tcl_DeleteEvents(
hold = evPtr;
evPtr = evPtr->nextPtr;
- ckfree((char *) hold);
+ ckfree(hold);
} else {
/*
* Event is to be retained.
@@ -703,7 +702,7 @@ Tcl_ServiceEvent(
}
}
if (evPtr) {
- ckfree((char *) evPtr);
+ ckfree(evPtr);
}
Tcl_MutexUnlock(&(tsdPtr->queueMutex));
return 1;
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 820fee0..d6d2d6a 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -3,12 +3,10 @@
*
* This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
*
- * Copyright (c) 2005-2008 by Donal K. Fellows
+ * Copyright (c) 2005-2012 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclOO.c,v 1.36 2010/03/05 15:32:16 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -30,27 +28,20 @@ static const struct {
{"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
{"destructor", TclOODefineDestructorObjCmd, 0},
{"export", TclOODefineExportObjCmd, 0},
- {"filter", TclOODefineFilterObjCmd, 0},
{"forward", TclOODefineForwardObjCmd, 0},
{"method", TclOODefineMethodObjCmd, 0},
- {"mixin", TclOODefineMixinObjCmd, 0},
{"renamemethod", TclOODefineRenameMethodObjCmd, 0},
{"self", TclOODefineSelfObjCmd, 0},
- {"superclass", TclOODefineSuperclassObjCmd, 0},
{"unexport", TclOODefineUnexportObjCmd, 0},
- {"variable", TclOODefineVariablesObjCmd, 0},
{NULL, NULL, 0}
}, objdefCmds[] = {
{"class", TclOODefineClassObjCmd, 1},
{"deletemethod", TclOODefineDeleteMethodObjCmd, 1},
{"export", TclOODefineExportObjCmd, 1},
- {"filter", TclOODefineFilterObjCmd, 1},
{"forward", TclOODefineForwardObjCmd, 1},
{"method", TclOODefineMethodObjCmd, 1},
- {"mixin", TclOODefineMixinObjCmd, 1},
{"renamemethod", TclOODefineRenameMethodObjCmd, 1},
{"unexport", TclOODefineUnexportObjCmd, 1},
- {"variable", TclOODefineVariablesObjCmd, 1},
{NULL, NULL, 0}
};
@@ -81,7 +72,7 @@ static int FinalizeNext(ClientData data[],
Tcl_Interp *interp, int result);
static int FinalizeObjectCall(ClientData data[],
Tcl_Interp *interp, int result);
-static void InitFoundation(Tcl_Interp *interp);
+static int InitFoundation(Tcl_Interp *interp);
static void KillFoundation(ClientData clientData,
Tcl_Interp *interp);
static void MyDeleted(ClientData clientData);
@@ -90,6 +81,7 @@ static void ObjectRenamedTrace(ClientData clientData,
Tcl_Interp *interp, const char *oldName,
const char *newName, int flags);
static void ReleaseClassContents(Tcl_Interp *interp,Object *oPtr);
+static inline void SquelchCachedName(Object *oPtr);
static void SquelchedNsFirst(ClientData clientData);
static int PublicObjectCmd(ClientData clientData,
@@ -131,11 +123,92 @@ static const DeclaredClassMethod objMethods[] = {
{NULL, 0, {0, NULL, NULL, NULL, NULL}}
};
-static char initScript[] =
- "namespace eval ::oo { variable version " TCLOO_VERSION " };"
- "namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
-/* "tcl_findLibrary tcloo $oo::version $oo::version" */
-/* " tcloo.tcl OO_LIBRARY oo::library;"; */
+/*
+ * And for the oo::class constructor...
+ */
+
+static const Tcl_MethodType classConstructor = {
+ TCL_OO_METHOD_VERSION_CURRENT,
+ "oo::class constructor",
+ TclOO_Class_Constructor, NULL, NULL
+};
+
+/*
+ * Scripted parts of TclOO. First, the master script (cannot be outside this
+ * file).
+ */
+
+static const char *initScript =
+"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
+"namespace eval ::oo { variable version " TCLOO_VERSION " };"
+"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
+/* "tcl_findLibrary tcloo $oo::version $oo::version" */
+/* " tcloo.tcl OO_LIBRARY oo::library;"; */
+
+/*
+ * The scripted part of the definitions of slots.
+ */
+
+static const char *slotScript =
+"::oo::define ::oo::Slot {\n"
+" method Get {} {error unimplemented}\n"
+" method Set list {error unimplemented}\n"
+" method -set args {\n"
+" uplevel 1 [list [namespace which my] Set $args]\n"
+" }\n"
+" method -append args {\n"
+" uplevel 1 [list [namespace which my] Set [list"
+" {*}[uplevel 1 [list [namespace which my] Get]] {*}$args]]\n"
+" }\n"
+" method -clear {} {uplevel 1 [list [namespace which my] Set {}]}\n"
+" forward --default-operation my -append\n"
+" method unknown {args} {\n"
+" set def --default-operation\n"
+" if {[llength $args] == 0} {\n"
+" return [uplevel 1 [list [namespace which my] $def]]\n"
+" } elseif {![string match -* [lindex $args 0]]} {\n"
+" return [uplevel 1 [list [namespace which my] $def {*}$args]]\n"
+" }\n"
+" next {*}$args\n"
+" }\n"
+" export -set -append -clear\n"
+" unexport unknown destroy\n"
+"}\n"
+"::oo::objdefine ::oo::define::superclass forward --default-operation my -set\n"
+"::oo::objdefine ::oo::define::mixin forward --default-operation my -set\n"
+"::oo::objdefine ::oo::objdefine::mixin forward --default-operation my -set\n";
+
+/*
+ * The body of the <cloned> method of oo::object.
+ */
+
+static const char *clonedBody =
+"foreach p [info procs [info object namespace $originObject]::*] {"
+" set args [info args $p];"
+" set idx -1;"
+" foreach a $args {"
+" lset args [incr idx] "
+" [if {[info default $p $a d]} {list $a $d} {list $a}]"
+" };"
+" set b [info body $p];"
+" set p [namespace tail $p];"
+" proc $p $args $b;"
+"};"
+"foreach v [info vars [info object namespace $originObject]::*] {"
+" upvar 0 $v vOrigin;"
+" namespace upvar [namespace current] [namespace tail $v] vNew;"
+" if {[info exists vOrigin]} {"
+" if {[array exists vOrigin]} {"
+" array set vNew [array get vOrigin];"
+" } else {"
+" set vNew $vOrigin;"
+" }"
+" }"
+"}";
+
+/*
+ * The actual definition of the variable holding the TclOO stub table.
+ */
MODULE_SCOPE const TclOOStubs tclOOStubs;
@@ -145,6 +218,20 @@ MODULE_SCOPE const TclOOStubs tclOOStubs;
#define GetFoundation(interp) \
((Foundation *)((Interp *)(interp))->objectFoundation)
+
+/*
+ * Macros to make inspecting into the guts of an object cleaner.
+ *
+ * The ocPtr parameter (only in these macros) is assumed to work fine with
+ * either an oPtr or a classPtr. Note that the roots oo::object and oo::class
+ * have _both_ their object and class flags tagged with ROOT_OBJECT and
+ * ROOT_CLASS respectively.
+ */
+
+#define Deleted(oPtr) (((Object *)(oPtr))->command == NULL)
+#define IsRootObject(ocPtr) ((ocPtr)->flags & ROOT_OBJECT)
+#define IsRootClass(ocPtr) ((ocPtr)->flags & ROOT_CLASS)
+#define IsRoot(ocPtr) ((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS))
/*
* ----------------------------------------------------------------------
@@ -171,7 +258,9 @@ TclOOInit(
* Build the core of the OO system.
*/
- InitFoundation(interp);
+ if (InitFoundation(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
/*
* Run our initialization script and, if that works, declare the package
@@ -215,16 +304,17 @@ TclOOGetFoundation(
* ----------------------------------------------------------------------
*/
-static void
+static int
InitFoundation(
Tcl_Interp *interp)
{
static Tcl_ThreadDataKey tsdKey;
ThreadLocalData *tsdPtr =
Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
- Foundation *fPtr = (Foundation *) ckalloc(sizeof(Foundation));
+ Foundation *fPtr = ckalloc(sizeof(Foundation));
Tcl_Obj *namePtr, *argsPtr, *bodyPtr;
Tcl_DString buffer;
+ Command *cmdPtr;
int i;
/*
@@ -246,17 +336,19 @@ InitFoundation(
DeletedHelpersNamespace);
fPtr->epoch = 0;
fPtr->tsdPtr = tsdPtr;
- fPtr->unknownMethodNameObj = Tcl_NewStringObj("unknown", -1);
- fPtr->constructorName = Tcl_NewStringObj("<constructor>", -1);
- fPtr->destructorName = Tcl_NewStringObj("<destructor>", -1);
+ TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown");
+ TclNewLiteralStringObj(fPtr->constructorName, "<constructor>");
+ TclNewLiteralStringObj(fPtr->destructorName, "<destructor>");
+ TclNewLiteralStringObj(fPtr->clonedName, "<cloned>");
+ TclNewLiteralStringObj(fPtr->defineName, "::oo::define");
Tcl_IncrRefCount(fPtr->unknownMethodNameObj);
Tcl_IncrRefCount(fPtr->constructorName);
Tcl_IncrRefCount(fPtr->destructorName);
- Tcl_NRCreateCommand(interp, "::oo::UpCatch", TclOOUpcatchCmd,
- TclOONRUpcatch, NULL, NULL);
+ Tcl_IncrRefCount(fPtr->clonedName);
+ Tcl_IncrRefCount(fPtr->defineName);
Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition",
TclOOUnknownDefinition, NULL, NULL);
- namePtr = Tcl_NewStringObj("::oo::UnknownDefinition", -1);
+ TclNewLiteralStringObj(namePtr, "::oo::UnknownDefinition");
Tcl_SetNamespaceUnknownHandler(interp, fPtr->defineNs, namePtr);
Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr);
@@ -266,14 +358,14 @@ InitFoundation(
Tcl_DStringInit(&buffer);
for (i=0 ; defineCmds[i].name ; i++) {
- Tcl_DStringAppend(&buffer, "::oo::define::", 14);
+ TclDStringAppendLiteral(&buffer, "::oo::define::");
Tcl_DStringAppend(&buffer, defineCmds[i].name, -1);
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL);
Tcl_DStringFree(&buffer);
}
for (i=0 ; objdefCmds[i].name ; i++) {
- Tcl_DStringAppend(&buffer, "::oo::objdefine::", 17);
+ TclDStringAppendLiteral(&buffer, "::oo::objdefine::");
Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1);
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL);
@@ -293,11 +385,13 @@ InitFoundation(
AllocObject(interp, "::oo::class", NULL));
fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
+ fPtr->objectCls->flags |= ROOT_OBJECT;
fPtr->objectCls->superclasses.num = 0;
- ckfree((char *) fPtr->objectCls->superclasses.list);
+ ckfree(fPtr->objectCls->superclasses.list);
fPtr->objectCls->superclasses.list = NULL;
fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
+ fPtr->classCls->flags |= ROOT_CLASS;
TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
AddRef(fPtr->objectCls->thisPtr);
@@ -315,31 +409,28 @@ InitFoundation(
}
/*
+ * Create the default <cloned> method implementation, used when 'oo::copy'
+ * is called to finish the copying of one object to another.
+ */
+
+ TclNewLiteralStringObj(argsPtr, "originObject");
+ Tcl_IncrRefCount(argsPtr);
+ bodyPtr = Tcl_NewStringObj(clonedBody, -1);
+ TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr,
+ bodyPtr, NULL);
+ TclDecrRefCount(argsPtr);
+
+ /*
* Finish setting up the class of classes by marking the 'new' method as
* private; classes, unlike general objects, must have explicit names. We
* also need to create the constructor for classes.
- *
- * The 0xDeadBeef is a special signal to the errorInfo logger that is used
- * by constructors that stops it from generating extra error information
- * that is confusing.
*/
- namePtr = Tcl_NewStringObj("new", -1);
+ TclNewLiteralStringObj(namePtr, "new");
Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);
-
- argsPtr = Tcl_NewStringObj("{definitionScript {}}", -1);
- Tcl_IncrRefCount(argsPtr);
- bodyPtr = Tcl_NewStringObj(
- "set script [list ::oo::define [self] $definitionScript];"
- "lassign [::oo::UpCatch $script] msg opts\n"
- "if {[dict get $opts -code] == 1} {"
- " dict set opts -errorline 0xDeadBeef\n"
- "}\n"
- "return -options $opts $msg", -1);
- fPtr->classCls->constructorPtr = TclOONewProcMethod(interp,
- fPtr->classCls, 0, NULL, argsPtr, bodyPtr, NULL);
- Tcl_DecrRefCount(argsPtr);
+ fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp,
+ (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);
/*
* Create non-object commands and plug ourselves into the Tcl [info]
@@ -348,14 +439,26 @@ InitFoundation(
Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL,
NULL);
- Tcl_CreateObjCommand(interp, "::oo::Helpers::self", TclOOSelfObjCmd, NULL,
- NULL);
+ Tcl_CreateObjCommand(interp, "::oo::Helpers::nextto", TclOONextToObjCmd,
+ NULL, NULL);
+ cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self",
+ TclOOSelfObjCmd, NULL, NULL);
+ cmdPtr->compileProc = TclCompileObjectSelfCmd;
Tcl_CreateObjCommand(interp, "::oo::define", TclOODefineObjCmd, NULL,
NULL);
Tcl_CreateObjCommand(interp, "::oo::objdefine", TclOOObjDefObjCmd, NULL,
NULL);
Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL,NULL);
TclOOInitInfo(interp);
+
+ /*
+ * Now make the class of slots.
+ */
+
+ if (TclOODefineSlots(fPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_Eval(interp, slotScript);
}
/*
@@ -418,10 +521,12 @@ KillFoundation(
DelRef(fPtr->objectCls->thisPtr);
DelRef(fPtr->objectCls);
- Tcl_DecrRefCount(fPtr->unknownMethodNameObj);
- Tcl_DecrRefCount(fPtr->constructorName);
- Tcl_DecrRefCount(fPtr->destructorName);
- ckfree((char *) fPtr);
+ TclDecrRefCount(fPtr->unknownMethodNameObj);
+ TclDecrRefCount(fPtr->constructorName);
+ TclDecrRefCount(fPtr->destructorName);
+ TclDecrRefCount(fPtr->clonedName);
+ TclDecrRefCount(fPtr->defineName);
+ ckfree(fPtr);
}
/*
@@ -455,7 +560,7 @@ AllocObject(
CommandTrace *tracePtr;
int creationEpoch, ignored;
- oPtr = (Object *) ckalloc(sizeof(Object));
+ oPtr = ckalloc(sizeof(Object));
memset(oPtr, 0, sizeof(Object));
/*
@@ -555,7 +660,7 @@ AllocObject(
Tcl_DStringInit(&buffer);
Tcl_DStringAppend(&buffer,
Tcl_GetCurrentNamespace(interp)->fullName, -1);
- Tcl_DStringAppend(&buffer, "::", 2);
+ TclDStringAppendLiteral(&buffer, "::");
Tcl_DStringAppend(&buffer, nameStr, -1);
oPtr->command = Tcl_CreateObjCommand(interp,
Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL);
@@ -569,8 +674,7 @@ AllocObject(
cmdPtr = (Command *) oPtr->command;
cmdPtr->nreProc = PublicNRObjectCmd;
- cmdPtr->tracePtr = tracePtr = (CommandTrace *)
- ckalloc(sizeof(CommandTrace));
+ cmdPtr->tracePtr = tracePtr = ckalloc(sizeof(CommandTrace));
tracePtr->traceProc = ObjectRenamedTrace;
tracePtr->clientData = oPtr;
tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE;
@@ -582,7 +686,7 @@ AllocObject(
* a bottleneck in string manipulation. Another abstraction-buster.
*/
- cmdPtr = (Command *) ckalloc(sizeof(Command));
+ cmdPtr = ckalloc(sizeof(Command));
memset(cmdPtr, 0, sizeof(Command));
cmdPtr->nsPtr = (Namespace *) oPtr->namespacePtr;
cmdPtr->hPtr = Tcl_CreateHashEntry(&cmdPtr->nsPtr->cmdTable, "my",
@@ -603,6 +707,27 @@ AllocObject(
/*
* ----------------------------------------------------------------------
*
+ * SquelchCachedName --
+ *
+ * Encapsulates how to throw away a cached object name. Called from
+ * object rename traces and at object destruction.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+SquelchCachedName(
+ Object *oPtr)
+{
+ if (oPtr->cachedNameObj) {
+ Tcl_DecrRefCount(oPtr->cachedNameObj);
+ oPtr->cachedNameObj = NULL;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* MyDeleted --
*
* This callback is triggered when the object's [my] command is deleted
@@ -669,8 +794,7 @@ ObjectRenamedTrace(
int flags) /* Why was the object deleted? */
{
Object *oPtr = clientData;
- Class *clsPtr;
- CallContext *contextPtr;
+ Foundation *fPtr = oPtr->fPtr;
/*
* If this is a rename and not a delete of the object, we just flush the
@@ -678,10 +802,7 @@ ObjectRenamedTrace(
*/
if (flags & TCL_TRACE_RENAME) {
- if (oPtr->cachedNameObj) {
- Tcl_DecrRefCount(oPtr->cachedNameObj);
- oPtr->cachedNameObj = NULL;
- }
+ SquelchCachedName(oPtr);
return;
}
@@ -702,17 +823,20 @@ ObjectRenamedTrace(
*/
AddRef(oPtr);
+ AddRef(fPtr->classCls);
+ AddRef(fPtr->objectCls);
+ AddRef(fPtr->classCls->thisPtr);
+ AddRef(fPtr->objectCls->thisPtr);
oPtr->command = NULL;
- oPtr->flags |= OBJECT_DELETED;
- if (!(oPtr->flags & DESTRUCTOR_CALLED) && (!Tcl_InterpDeleted(interp)
- || (oPtr->flags & (ROOT_OBJECT|ROOT_CLASS)))) {
- contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
+ if (!(oPtr->flags & DESTRUCTOR_CALLED) && !Tcl_InterpDeleted(interp)) {
+ CallContext *contextPtr =
+ TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
+ int result;
+ Tcl_InterpState state;
+
oPtr->flags |= DESTRUCTOR_CALLED;
if (contextPtr != NULL) {
- int result;
- Tcl_InterpState state;
-
contextPtr->callPtr->flags |= DESTRUCTOR;
contextPtr->skip = 0;
state = Tcl_SaveInterpState(interp, TCL_OK);
@@ -731,25 +855,20 @@ ObjectRenamedTrace(
* and nuke the namespace (which triggers the final crushing of the object
* structure itself).
*
- * The class of classes needs some special care; if it is deleted (and
+ * The class of objects needs some special care; if it is deleted (and
* we're not killing the whole interpreter) we force the delete of the
- * class of objects now as well. Due to the incestuous nature of those two
+ * class of classes now as well. Due to the incestuous nature of those two
* classes, if one goes the other must too and yet the tangle can
* sometimes not go away automatically; we force it here. [Bug 2962664]
*/
- if (!Tcl_InterpDeleted(interp)) {
- if ((oPtr->flags & ROOT_OBJECT) && oPtr->fPtr->classCls != NULL) {
- Tcl_DeleteCommandFromToken(interp,
- oPtr->fPtr->classCls->thisPtr->command);
- } else if (oPtr->flags & ROOT_CLASS) {
- oPtr->fPtr->classCls = NULL;
- }
+ if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr)
+ && !Deleted(fPtr->classCls->thisPtr)) {
+ Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
}
- clsPtr = oPtr->classPtr;
- if (clsPtr != NULL) {
- AddRef(clsPtr);
+ if (oPtr->classPtr != NULL) {
+ AddRef(oPtr->classPtr);
ReleaseClassContents(interp, oPtr);
}
@@ -761,9 +880,13 @@ ObjectRenamedTrace(
if (((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) {
Tcl_DeleteNamespace(oPtr->namespacePtr);
}
- if (clsPtr) {
- DelRef(clsPtr);
+ if (oPtr->classPtr) {
+ DelRef(oPtr->classPtr);
}
+ DelRef(fPtr->classCls->thisPtr);
+ DelRef(fPtr->objectCls->thisPtr);
+ DelRef(fPtr->classCls);
+ DelRef(fPtr->objectCls);
DelRef(oPtr);
}
@@ -783,77 +906,128 @@ ReleaseClassContents(
Tcl_Interp *interp, /* The interpreter containing the class. */
Object *oPtr) /* The object representing the class. */
{
- int i, n;
- Class *clsPtr = oPtr->classPtr, **list;
- Object **insts;
+ FOREACH_HASH_DECLS;
+ int i;
+ Class *clsPtr = oPtr->classPtr, *mixinSubclassPtr, *subclassPtr;
+ Object *instancePtr;
+ Foundation *fPtr = oPtr->fPtr;
+
+ /*
+ * Sanity check!
+ */
+
+ if (!Deleted(oPtr)) {
+ if (IsRootClass(oPtr)) {
+ Tcl_Panic("deleting class structure for non-deleted %s",
+ "::oo::class");
+ } else if (IsRootObject(oPtr)) {
+ Tcl_Panic("deleting class structure for non-deleted %s",
+ "::oo::object");
+ } else {
+ Tcl_Panic("deleting class structure for non-deleted %s",
+ "general object");
+ }
+ }
/*
- * Must empty list before processing the members of the list so that
- * things happen in the correct order even if something tries to play
- * fast-and-loose.
+ * Lock a number of dependent objects until we've stopped putting our
+ * fingers in them.
*/
- list = clsPtr->mixinSubs.list;
- n = clsPtr->mixinSubs.num;
- clsPtr->mixinSubs.list = NULL;
- clsPtr->mixinSubs.num = 0;
- clsPtr->mixinSubs.size = 0;
- for (i=0 ; i<n ; i++) {
- AddRef(list[i]);
- AddRef(list[i]->thisPtr);
+ FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
+ if (mixinSubclassPtr != NULL) {
+ AddRef(mixinSubclassPtr);
+ AddRef(mixinSubclassPtr->thisPtr);
+ }
}
- for (i=0 ; i<n ; i++) {
- if (!(list[i]->thisPtr->flags & OBJECT_DELETED)) {
- list[i]->thisPtr->flags |= OBJECT_DELETED;
- Tcl_DeleteCommandFromToken(interp, list[i]->thisPtr->command);
+ FOREACH(subclassPtr, clsPtr->subclasses) {
+ if (subclassPtr != NULL && !IsRoot(subclassPtr)) {
+ AddRef(subclassPtr);
+ AddRef(subclassPtr->thisPtr);
}
- DelRef(list[i]->thisPtr);
- DelRef(list[i]);
}
- if (list != NULL) {
- ckfree((char *) list);
+ if (!IsRootClass(oPtr)) {
+ FOREACH(instancePtr, clsPtr->instances) {
+ if (instancePtr != NULL && !IsRoot(instancePtr)) {
+ AddRef(instancePtr);
+ }
+ }
}
- list = clsPtr->subclasses.list;
- n = clsPtr->subclasses.num;
- clsPtr->subclasses.list = NULL;
- clsPtr->subclasses.num = 0;
- clsPtr->subclasses.size = 0;
- for (i=0 ; i<n ; i++) {
- AddRef(list[i]);
- AddRef(list[i]->thisPtr);
- }
- for (i=0 ; i<n ; i++) {
- if (!(list[i]->thisPtr->flags & OBJECT_DELETED)) {
- list[i]->thisPtr->flags |= OBJECT_DELETED;
- Tcl_DeleteCommandFromToken(interp, list[i]->thisPtr->command);
+ /*
+ * Squelch classes that this class has been mixed into.
+ */
+
+ FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
+ if (mixinSubclassPtr == NULL) {
+ continue;
}
- DelRef(list[i]->thisPtr);
- DelRef(list[i]);
+ if (!Deleted(mixinSubclassPtr->thisPtr)) {
+ Tcl_DeleteCommandFromToken(interp,
+ mixinSubclassPtr->thisPtr->command);
+ }
+ DelRef(mixinSubclassPtr->thisPtr);
+ DelRef(mixinSubclassPtr);
}
- if (list != NULL) {
- ckfree((char *) list);
+ if (clsPtr->mixinSubs.list != NULL) {
+ ckfree(clsPtr->mixinSubs.list);
+ clsPtr->mixinSubs.list = NULL;
+ clsPtr->mixinSubs.num = 0;
}
- insts = clsPtr->instances.list;
- n = clsPtr->instances.num;
- clsPtr->instances.list = NULL;
- clsPtr->instances.num = 0;
- clsPtr->instances.size = 0;
- for (i=0 ; i<n ; i++) {
- AddRef(insts[i]);
+ /*
+ * Squelch subclasses of this class.
+ */
+
+ FOREACH(subclassPtr, clsPtr->subclasses) {
+ if (subclassPtr == NULL || IsRoot(subclassPtr)) {
+ continue;
+ }
+ if (!Deleted(subclassPtr->thisPtr)) {
+ Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
+ }
+ DelRef(subclassPtr->thisPtr);
+ DelRef(subclassPtr);
+ }
+ if (clsPtr->subclasses.list != NULL) {
+ ckfree(clsPtr->subclasses.list);
+ clsPtr->subclasses.list = NULL;
+ clsPtr->subclasses.num = 0;
}
- for (i=0 ; i<n ; i++) {
- if (!(insts[i]->flags & OBJECT_DELETED)) {
- insts[i]->flags |= OBJECT_DELETED;
- Tcl_DeleteCommandFromToken(interp, insts[i]->command);
+
+ /*
+ * Squelch instances of this class (includes objects we're mixed into).
+ */
+
+ if (!IsRootClass(oPtr)) {
+ FOREACH(instancePtr, clsPtr->instances) {
+ if (instancePtr == NULL || IsRoot(instancePtr)) {
+ continue;
+ }
+ if (!Deleted(instancePtr)) {
+ Tcl_DeleteCommandFromToken(interp, instancePtr->command);
+ }
+ DelRef(instancePtr);
}
- DelRef(insts[i]);
}
- if (insts != NULL) {
- ckfree((char *) insts);
+ if (clsPtr->instances.list != NULL) {
+ ckfree(clsPtr->instances.list);
+ clsPtr->instances.list = NULL;
+ clsPtr->instances.num = 0;
}
+ /*
+ * Special: We delete these after everything else.
+ */
+
+ if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
+ Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
+ }
+
+ /*
+ * Squelch method implementation chain caches.
+ */
+
if (clsPtr->constructorChainPtr) {
TclOODeleteChain(clsPtr->constructorChainPtr);
clsPtr->constructorChainPtr = NULL;
@@ -863,30 +1037,35 @@ ReleaseClassContents(
clsPtr->destructorChainPtr = NULL;
}
if (clsPtr->classChainCache) {
- FOREACH_HASH_DECLS;
CallChain *callPtr;
FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) {
TclOODeleteChain(callPtr);
}
Tcl_DeleteHashTable(clsPtr->classChainCache);
- ckfree((char *) clsPtr->classChainCache);
+ ckfree(clsPtr->classChainCache);
clsPtr->classChainCache = NULL;
}
+ /*
+ * Squelch our filter list.
+ */
+
if (clsPtr->filters.num) {
Tcl_Obj *filterObj;
FOREACH(filterObj, clsPtr->filters) {
- Tcl_DecrRefCount(filterObj);
+ TclDecrRefCount(filterObj);
}
- ckfree((char *) clsPtr->filters.list);
+ ckfree(clsPtr->filters.list);
clsPtr->filters.num = 0;
}
+ /*
+ * Squelch our metadata.
+ */
if (clsPtr->metadataPtr != NULL) {
- FOREACH_HASH_DECLS;
Tcl_ObjectMetadataType *metadataTypePtr;
ClientData value;
@@ -894,7 +1073,7 @@ ReleaseClassContents(
metadataTypePtr->deleteProc(value);
}
Tcl_DeleteHashTable(clsPtr->metadataPtr);
- ckfree((char *) clsPtr->metadataPtr);
+ ckfree(clsPtr->metadataPtr);
clsPtr->metadataPtr = NULL;
}
}
@@ -922,7 +1101,7 @@ ObjectNamespaceDeleted(
Class *clsPtr = oPtr->classPtr, *mixinPtr;
Method *mPtr;
Tcl_Obj *filterObj, *variableObj;
- int i, preserved = !(oPtr->flags & OBJECT_DELETED);
+ int i;
/*
* Instruct everyone to no longer use any allocated fields of the object.
@@ -931,27 +1110,19 @@ ObjectNamespaceDeleted(
* point into freed memory, allowing crashes.
*/
- oPtr->flags |= OBJECT_DELETED;
if (oPtr->command) {
Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
}
if (oPtr->myCommand) {
Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
}
- if (preserved) {
- AddRef(oPtr);
- if (clsPtr != NULL) {
- AddRef(clsPtr);
- ReleaseClassContents(NULL, oPtr);
- }
- }
/*
* Splice the object out of its context. After this, we must *not* call
* methods on the object.
*/
- if (!(oPtr->flags & ROOT_OBJECT)) {
+ if (!IsRootObject(oPtr)) {
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
}
@@ -959,14 +1130,14 @@ ObjectNamespaceDeleted(
TclOORemoveFromInstances(oPtr, mixinPtr);
}
if (i) {
- ckfree((char *) oPtr->mixins.list);
+ ckfree(oPtr->mixins.list);
}
FOREACH(filterObj, oPtr->filters) {
- Tcl_DecrRefCount(filterObj);
+ TclDecrRefCount(filterObj);
}
if (i) {
- ckfree((char *) oPtr->filters.list);
+ ckfree(oPtr->filters.list);
}
if (oPtr->methodsPtr) {
@@ -974,24 +1145,21 @@ ObjectNamespaceDeleted(
TclOODelMethodRef(mPtr);
}
Tcl_DeleteHashTable(oPtr->methodsPtr);
- ckfree((char *) oPtr->methodsPtr);
+ ckfree(oPtr->methodsPtr);
}
FOREACH(variableObj, oPtr->variables) {
- Tcl_DecrRefCount(variableObj);
+ TclDecrRefCount(variableObj);
}
if (i) {
- ckfree((char *) oPtr->variables.list);
+ ckfree(oPtr->variables.list);
}
if (oPtr->chainCache) {
TclOODeleteChainCache(oPtr->chainCache);
}
- if (oPtr->cachedNameObj) {
- Tcl_DecrRefCount(oPtr->cachedNameObj);
- oPtr->cachedNameObj = NULL;
- }
+ SquelchCachedName(oPtr);
if (oPtr->metadataPtr != NULL) {
Tcl_ObjectMetadataType *metadataTypePtr;
@@ -1001,60 +1169,59 @@ ObjectNamespaceDeleted(
metadataTypePtr->deleteProc(value);
}
Tcl_DeleteHashTable(oPtr->metadataPtr);
- ckfree((char *) oPtr->metadataPtr);
+ ckfree(oPtr->metadataPtr);
oPtr->metadataPtr = NULL;
}
if (clsPtr != NULL) {
Class *superPtr;
+ Tcl_ObjectMetadataType *metadataTypePtr;
+ ClientData value;
if (clsPtr->metadataPtr != NULL) {
- Tcl_ObjectMetadataType *metadataTypePtr;
- ClientData value;
-
FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
metadataTypePtr->deleteProc(value);
}
Tcl_DeleteHashTable(clsPtr->metadataPtr);
- ckfree((char *) clsPtr->metadataPtr);
+ ckfree(clsPtr->metadataPtr);
clsPtr->metadataPtr = NULL;
}
FOREACH(filterObj, clsPtr->filters) {
- Tcl_DecrRefCount(filterObj);
+ TclDecrRefCount(filterObj);
}
if (i) {
- ckfree((char *) clsPtr->filters.list);
+ ckfree(clsPtr->filters.list);
clsPtr->filters.num = 0;
}
FOREACH(mixinPtr, clsPtr->mixins) {
- if (!(mixinPtr->thisPtr->flags & OBJECT_DELETED)) {
+ if (!Deleted(mixinPtr->thisPtr)) {
TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
}
}
if (i) {
- ckfree((char *) clsPtr->mixins.list);
+ ckfree(clsPtr->mixins.list);
clsPtr->mixins.num = 0;
}
FOREACH(superPtr, clsPtr->superclasses) {
- if (!(superPtr->thisPtr->flags & OBJECT_DELETED)) {
+ if (!Deleted(superPtr->thisPtr)) {
TclOORemoveFromSubclasses(clsPtr, superPtr);
}
}
if (i) {
- ckfree((char *) clsPtr->superclasses.list);
+ ckfree(clsPtr->superclasses.list);
clsPtr->superclasses.num = 0;
}
if (clsPtr->subclasses.list) {
- ckfree((char *) clsPtr->subclasses.list);
+ ckfree(clsPtr->subclasses.list);
clsPtr->subclasses.num = 0;
}
if (clsPtr->instances.list) {
- ckfree((char *) clsPtr->instances.list);
+ ckfree(clsPtr->instances.list);
clsPtr->instances.num = 0;
}
if (clsPtr->mixinSubs.list) {
- ckfree((char *) clsPtr->mixinSubs.list);
+ ckfree(clsPtr->mixinSubs.list);
clsPtr->mixinSubs.num = 0;
}
@@ -1066,10 +1233,10 @@ ObjectNamespaceDeleted(
TclOODelMethodRef(clsPtr->destructorPtr);
FOREACH(variableObj, clsPtr->variables) {
- Tcl_DecrRefCount(variableObj);
+ TclDecrRefCount(variableObj);
}
if (i) {
- ckfree((char *) clsPtr->variables.list);
+ ckfree(clsPtr->variables.list);
}
DelRef(clsPtr);
@@ -1080,12 +1247,6 @@ ObjectNamespaceDeleted(
*/
DelRef(oPtr);
- if (preserved) {
- if (clsPtr) {
- DelRef(clsPtr);
- }
- DelRef(oPtr);
- }
}
/*
@@ -1116,12 +1277,16 @@ TclOORemoveFromInstances(
return;
removeInstance:
- clsPtr->instances.num--;
- if (i < clsPtr->instances.num) {
- clsPtr->instances.list[i] =
- clsPtr->instances.list[clsPtr->instances.num];
+ if (Deleted(clsPtr->thisPtr)) {
+ clsPtr->instances.list[i] = NULL;
+ } else {
+ clsPtr->instances.num--;
+ if (i < clsPtr->instances.num) {
+ clsPtr->instances.list[i] =
+ clsPtr->instances.list[clsPtr->instances.num];
+ }
+ clsPtr->instances.list[clsPtr->instances.num] = NULL;
}
- clsPtr->instances.list[clsPtr->instances.num] = NULL;
}
/*
@@ -1142,14 +1307,15 @@ TclOOAddToInstances(
* assumed that the class is not already
* present as an instance in the class. */
{
+ if (Deleted(clsPtr->thisPtr)) {
+ return;
+ }
if (clsPtr->instances.num >= clsPtr->instances.size) {
clsPtr->instances.size += ALLOC_CHUNK;
if (clsPtr->instances.size == ALLOC_CHUNK) {
- clsPtr->instances.list = (Object **)
- ckalloc(sizeof(Object *) * ALLOC_CHUNK);
+ clsPtr->instances.list = ckalloc(sizeof(Object *) * ALLOC_CHUNK);
} else {
- clsPtr->instances.list = (Object **)
- ckrealloc((char *) clsPtr->instances.list,
+ clsPtr->instances.list = ckrealloc(clsPtr->instances.list,
sizeof(Object *) * clsPtr->instances.size);
}
}
@@ -1184,12 +1350,16 @@ TclOORemoveFromSubclasses(
return;
removeSubclass:
- superPtr->subclasses.num--;
- if (i < superPtr->subclasses.num) {
- superPtr->subclasses.list[i] =
- superPtr->subclasses.list[superPtr->subclasses.num];
+ if (Deleted(superPtr->thisPtr)) {
+ superPtr->subclasses.list[i] = NULL;
+ } else {
+ superPtr->subclasses.num--;
+ if (i < superPtr->subclasses.num) {
+ superPtr->subclasses.list[i] =
+ superPtr->subclasses.list[superPtr->subclasses.num];
+ }
+ superPtr->subclasses.list[superPtr->subclasses.num] = NULL;
}
- superPtr->subclasses.list[superPtr->subclasses.num] = NULL;
}
/*
@@ -1210,14 +1380,15 @@ TclOOAddToSubclasses(
* is assumed that the class is not already
* present as a subclass in the superclass. */
{
+ if (Deleted(superPtr->thisPtr)) {
+ return;
+ }
if (superPtr->subclasses.num >= superPtr->subclasses.size) {
superPtr->subclasses.size += ALLOC_CHUNK;
if (superPtr->subclasses.size == ALLOC_CHUNK) {
- superPtr->subclasses.list = (Class **)
- ckalloc(sizeof(Class *) * ALLOC_CHUNK);
+ superPtr->subclasses.list = ckalloc(sizeof(Class*) * ALLOC_CHUNK);
} else {
- superPtr->subclasses.list = (Class **)
- ckrealloc((char *) superPtr->subclasses.list,
+ superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list,
sizeof(Class *) * superPtr->subclasses.size);
}
}
@@ -1252,12 +1423,16 @@ TclOORemoveFromMixinSubs(
return;
removeSubclass:
- superPtr->mixinSubs.num--;
- if (i < superPtr->mixinSubs.num) {
- superPtr->mixinSubs.list[i] =
- superPtr->mixinSubs.list[superPtr->mixinSubs.num];
+ if (Deleted(superPtr->thisPtr)) {
+ superPtr->mixinSubs.list[i] = NULL;
+ } else {
+ superPtr->mixinSubs.num--;
+ if (i < superPtr->mixinSubs.num) {
+ superPtr->mixinSubs.list[i] =
+ superPtr->mixinSubs.list[superPtr->mixinSubs.num];
+ }
+ superPtr->mixinSubs.list[superPtr->mixinSubs.num] = NULL;
}
- superPtr->mixinSubs.list[superPtr->mixinSubs.num] = NULL;
}
/*
@@ -1278,14 +1453,15 @@ TclOOAddToMixinSubs(
* is assumed that the class is not already
* present as a subclass in the superclass. */
{
+ if (Deleted(superPtr->thisPtr)) {
+ return;
+ }
if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
superPtr->mixinSubs.size += ALLOC_CHUNK;
if (superPtr->mixinSubs.size == ALLOC_CHUNK) {
- superPtr->mixinSubs.list = (Class **)
- ckalloc(sizeof(Class *) * ALLOC_CHUNK);
+ superPtr->mixinSubs.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
} else {
- superPtr->mixinSubs.list = (Class **)
- ckrealloc((char *) superPtr->mixinSubs.list,
+ superPtr->mixinSubs.list = ckrealloc(superPtr->mixinSubs.list,
sizeof(Class *) * superPtr->mixinSubs.size);
}
}
@@ -1312,7 +1488,7 @@ AllocClass(
* (with automatic name) is to be used. */
{
Foundation *fPtr = GetFoundation(interp);
- Class *clsPtr = (Class *) ckalloc(sizeof(Class));
+ Class *clsPtr = ckalloc(sizeof(Class));
/*
* Make an object if we haven't been given one.
@@ -1353,7 +1529,7 @@ AllocClass(
*/
clsPtr->superclasses.num = 1;
- clsPtr->superclasses.list = (Class **) ckalloc(sizeof(Class *));
+ clsPtr->superclasses.list = ckalloc(sizeof(Class *));
clsPtr->superclasses.list[0] = fPtr->objectCls;
/*
@@ -1408,8 +1584,10 @@ Tcl_NewObjectInstance(
if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
TCL_NAMESPACE_ONLY)) {
- Tcl_AppendResult(interp, "can't create object \"", nameStr,
- "\": command already exists with that name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create object \"%s\": command already exists with"
+ " that name", nameStr));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
return NULL;
}
@@ -1449,16 +1627,23 @@ Tcl_NewObjectInstance(
TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
if (contextPtr != NULL) {
- int result, flags;
+ int result;
Tcl_InterpState state;
- AddRef(oPtr);
state = Tcl_SaveInterpState(interp, TCL_OK);
contextPtr->callPtr->flags |= CONSTRUCTOR;
contextPtr->skip = skip;
+
+ /*
+ * Adjust the ensmble tracking record if necessary. [Bug 3514761]
+ */
+
+ if (((Interp*) interp)->ensembleRewrite.sourceObjs) {
+ ((Interp*) interp)->ensembleRewrite.numInsertedObjs += skip-1;
+ ((Interp*) interp)->ensembleRewrite.numRemovedObjs += skip-1;
+ }
result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr,
objc, objv);
- flags = oPtr->flags;
/*
* It's an error if the object was whacked in the constructor.
@@ -1466,13 +1651,13 @@ Tcl_NewObjectInstance(
* errors by accident...) [Bug 2903011]
*/
- if (result != TCL_ERROR && (flags & OBJECT_DELETED)) {
- Tcl_SetResult(interp, "object deleted in constructor",
- TCL_STATIC);
+ if (result != TCL_ERROR && Deleted(oPtr)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "object deleted in constructor", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
result = TCL_ERROR;
}
TclOODeleteContext(contextPtr);
- DelRef(oPtr);
if (result != TCL_OK) {
Tcl_DiscardInterpState(state);
@@ -1481,7 +1666,7 @@ Tcl_NewObjectInstance(
* bad. [Bug 2903011]
*/
- if (!(flags & OBJECT_DELETED)) {
+ if (!Deleted(oPtr)) {
Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
return NULL;
@@ -1523,8 +1708,10 @@ TclNRNewObjectInstance(
if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
TCL_NAMESPACE_ONLY)) {
- Tcl_AppendResult(interp, "can't create object \"", nameStr,
- "\": command already exists with that name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create object \"%s\": command already exists with"
+ " that name", nameStr));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
return TCL_ERROR;
}
@@ -1569,15 +1756,24 @@ TclNRNewObjectInstance(
return TCL_OK;
}
- AddRef(oPtr);
state = Tcl_SaveInterpState(interp, TCL_OK);
contextPtr->callPtr->flags |= CONSTRUCTOR;
contextPtr->skip = skip;
/*
+ * Adjust the ensmble tracking record if necessary. [Bug 3514761]
+ */
+
+ if (((Interp *) interp)->ensembleRewrite.sourceObjs) {
+ ((Interp *) interp)->ensembleRewrite.numInsertedObjs += skip - 1;
+ ((Interp *) interp)->ensembleRewrite.numRemovedObjs += skip - 1;
+ }
+
+ /*
* Fire off the constructors non-recursively.
*/
+ AddRef(oPtr);
TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
objectPtr);
TclPushTailcallPoint(interp);
@@ -1594,7 +1790,6 @@ FinalizeAlloc(
Object *oPtr = data[1];
Tcl_InterpState state = data[2];
Tcl_Object *objectPtr = data[3];
- int flags = oPtr->flags;
/*
* It's an error if the object was whacked in the constructor. Force this
@@ -1602,12 +1797,13 @@ FinalizeAlloc(
* [Bug 2903011]
*/
- if (result != TCL_ERROR && (flags & OBJECT_DELETED)) {
- Tcl_SetResult(interp, "object deleted in constructor", TCL_STATIC);
+ if (result != TCL_ERROR && Deleted(oPtr)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "object deleted in constructor", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
result = TCL_ERROR;
}
TclOODeleteContext(contextPtr);
- DelRef(oPtr);
if (result != TCL_OK) {
Tcl_DiscardInterpState(state);
@@ -1616,13 +1812,15 @@ FinalizeAlloc(
* 2903011]
*/
- if (!(flags & OBJECT_DELETED)) {
+ if (!Deleted(oPtr)) {
Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
+ DelRef(oPtr);
return TCL_ERROR;
}
Tcl_RestoreInterpState(interp, state);
*objectPtr = (Tcl_Object) oPtr;
+ DelRef(oPtr);
return TCL_OK;
}
@@ -1649,20 +1847,18 @@ Tcl_CopyObjectInstance(
FOREACH_HASH_DECLS;
Method *mPtr;
Class *mixinPtr;
- Tcl_Obj *keyPtr, *filterObj;
- int i;
+ CallContext *contextPtr;
+ Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3];
+ int i, result;
/*
- * Sanity checks.
+ * Sanity check.
*/
- if (targetName == NULL && oPtr->classPtr != NULL) {
- Tcl_AppendResult(interp, "must supply a name when copying a class",
- NULL);
- return NULL;
- }
- if (oPtr->flags & ROOT_CLASS) {
- Tcl_AppendResult(interp, "may not clone the class of classes", NULL);
+ if (IsRootClass(oPtr)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not clone the class of classes", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL);
return NULL;
}
@@ -1716,6 +1912,15 @@ Tcl_CopyObjectInstance(
}
/*
+ * Copy the object's variable resolution list to the new object.
+ */
+
+ DUPLICATE(o2Ptr->variables, oPtr->variables, Tcl_Obj *);
+ FOREACH(variableObj, o2Ptr->variables) {
+ Tcl_IncrRefCount(variableObj);
+ }
+
+ /*
* Copy the object's flags to the new object, clearing those that must be
* kept object-local. The duplicate is never deleted at this point, nor is
* it the root of the object system or in the midst of processing a filter
@@ -1723,7 +1928,7 @@ Tcl_CopyObjectInstance(
*/
o2Ptr->flags = oPtr->flags & ~(
- OBJECT_DELETED | ROOT_OBJECT | FILTER_HANDLING);
+ OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
/*
* Copy the object's metadata.
@@ -1775,11 +1980,10 @@ Tcl_CopyObjectInstance(
TclOORemoveFromSubclasses(cls2Ptr, superPtr);
}
if (cls2Ptr->superclasses.num) {
- cls2Ptr->superclasses.list = (Class **)
- ckrealloc((char *) cls2Ptr->superclasses.list,
+ cls2Ptr->superclasses.list = ckrealloc(cls2Ptr->superclasses.list,
sizeof(Class *) * clsPtr->superclasses.num);
} else {
- cls2Ptr->superclasses.list = (Class **)
+ cls2Ptr->superclasses.list =
ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
}
memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
@@ -1799,6 +2003,15 @@ Tcl_CopyObjectInstance(
}
/*
+ * Copy the source class's variable resolution list.
+ */
+
+ DUPLICATE(cls2Ptr->variables, clsPtr->variables, Tcl_Obj *);
+ FOREACH(variableObj, cls2Ptr->variables) {
+ Tcl_IncrRefCount(variableObj);
+ }
+
+ /*
* Duplicate the source class's mixins (which cannot be circular
* references to the duplicate).
*/
@@ -1807,7 +2020,7 @@ Tcl_CopyObjectInstance(
TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr);
}
if (cls2Ptr->mixins.num != 0) {
- ckfree((char *) clsPtr->mixins.list);
+ ckfree(clsPtr->mixins.list);
}
DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
FOREACH(mixinPtr, cls2Ptr->mixins) {
@@ -1866,6 +2079,31 @@ Tcl_CopyObjectInstance(
}
}
+ TclResetRewriteEnsemble(interp, 1);
+ contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL);
+ if (contextPtr) {
+ args[0] = TclOOObjectName(interp, o2Ptr);
+ args[1] = oPtr->fPtr->clonedName;
+ args[2] = TclOOObjectName(interp, oPtr);
+ Tcl_IncrRefCount(args[0]);
+ Tcl_IncrRefCount(args[1]);
+ Tcl_IncrRefCount(args[2]);
+ result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, 3,
+ args);
+ TclDecrRefCount(args[0]);
+ TclDecrRefCount(args[1]);
+ TclDecrRefCount(args[2]);
+ TclOODeleteContext(contextPtr);
+ if (result == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp,
+ "\n (while performing post-copy callback)");
+ }
+ if (result != TCL_OK) {
+ Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+ return NULL;
+ }
+ }
+
return (Tcl_Object) o2Ptr;
}
@@ -2018,7 +2256,7 @@ Tcl_ClassSetMetadata(
if (metadata == NULL) {
return;
}
- clsPtr->metadataPtr = (Tcl_HashTable*) ckalloc(sizeof(Tcl_HashTable));
+ clsPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS);
}
@@ -2098,7 +2336,7 @@ Tcl_ObjectSetMetadata(
if (metadata == NULL) {
return;
}
- oPtr->metadataPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ oPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS);
}
@@ -2241,9 +2479,15 @@ TclOOObjectCmdCore(
Tcl_Obj *methodNamePtr;
int result;
+ /*
+ * If we've no method name, throw this directly into the unknown
+ * processing.
+ */
+
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "method ?arg ...?");
- return TCL_ERROR;
+ flags |= FORCE_UNKNOWN;
+ methodNamePtr = NULL;
+ goto noMapping;
}
/*
@@ -2258,7 +2502,7 @@ TclOOObjectCmdCore(
result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr,
(Tcl_Class *) startClsPtr, mappedMethodName);
if (result != TCL_OK) {
- Tcl_DecrRefCount(mappedMethodName);
+ TclDecrRefCount(mappedMethodName);
if (result == TCL_BREAK) {
goto noMapping;
} else if (result == TCL_ERROR) {
@@ -2274,11 +2518,13 @@ TclOOObjectCmdCore(
Tcl_IncrRefCount(mappedMethodName);
contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
- Tcl_DecrRefCount(mappedMethodName);
+ TclDecrRefCount(mappedMethodName);
if (contextPtr == NULL) {
- Tcl_AppendResult(interp, "impossible to invoke method \"",
- TclGetString(methodNamePtr),
- "\": no defined method or unknown method", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "impossible to invoke method \"%s\": no defined method or"
+ " unknown method", TclGetString(methodNamePtr)));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED",
+ TclGetString(methodNamePtr), NULL);
return TCL_ERROR;
}
} else {
@@ -2290,9 +2536,11 @@ TclOOObjectCmdCore(
contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
flags | (oPtr->flags & FILTER_HANDLING), NULL);
if (contextPtr == NULL) {
- Tcl_AppendResult(interp, "impossible to invoke method \"",
- TclGetString(methodNamePtr),
- "\": no defined method or unknown method", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "impossible to invoke method \"%s\": no defined method or"
+ " unknown method", TclGetString(methodNamePtr)));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(methodNamePtr), NULL);
return TCL_ERROR;
}
}
@@ -2316,9 +2564,10 @@ TclOOObjectCmdCore(
}
}
if (contextPtr->index >= contextPtr->callPtr->numChain) {
- result = TCL_ERROR;
- Tcl_SetResult(interp, "no valid method implementation",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no valid method implementation", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(methodNamePtr), NULL);
TclOODeleteContext(contextPtr);
return TCL_ERROR;
}
@@ -2329,8 +2578,7 @@ TclOOObjectCmdCore(
* for the duration.
*/
- AddRef(oPtr);
- TclNRAddCallback(interp, FinalizeObjectCall, contextPtr,oPtr, NULL,NULL);
+ TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL);
return TclOOInvokeContext(contextPtr, interp, objc, objv);
}
@@ -2340,15 +2588,12 @@ FinalizeObjectCall(
Tcl_Interp *interp,
int result)
{
- register CallContext *contextPtr = data[0];
- register Object *oPtr = data[1];
-
/*
- * Dispose of the call chain and drop the lock on the object's structure.
+ * Dispose of the call chain, which drops the lock on the object's
+ * structure.
*/
- TclOODeleteContext(contextPtr);
- DelRef(oPtr);
+ TclOODeleteContext(data[0]);
return result;
}
@@ -2401,8 +2646,9 @@ Tcl_ObjectContextInvokeNext(
methodType = "method";
}
- Tcl_AppendResult(interp, "no next ", methodType, " implementation",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no next %s implementation", methodType));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
return TCL_ERROR;
}
@@ -2469,8 +2715,9 @@ TclNRObjectContextInvokeNext(
methodType = "method";
}
- Tcl_AppendResult(interp, "no next ", methodType, " implementation",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no next %s implementation", methodType));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
return TCL_ERROR;
}
@@ -2546,8 +2793,10 @@ Tcl_GetObjectFromObj(
return cmdPtr->objClientData;
notAnObject:
- Tcl_AppendResult(interp, TclGetString(objPtr),
- " does not refer to an object", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s does not refer to an object", TclGetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr),
+ NULL);
return NULL;
}
@@ -2692,7 +2941,7 @@ int
Tcl_ObjectDeleted(
Tcl_Object object)
{
- return (((Object *)object)->flags & OBJECT_DELETED) ? 1 : 0;
+ return Deleted(object) ? 1 : 0;
}
Tcl_Object
diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index 80b4eff..31d1113 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -1,5 +1,3 @@
-# $Id: tclOO.decls,v 1.8 2010/09/15 07:33:54 nijtmans Exp $
-
library tclOO
######################################################################
@@ -8,7 +6,7 @@ library tclOO
interface tclOO
hooks tclOOInt
-scspec EXTERN
+scspec TCLOOAPI
declare 0 {
Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
diff --git a/generic/tclOO.h b/generic/tclOO.h
index 6dc0feb..cf253b1 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -4,29 +4,42 @@
* This file contains the public API definitions and some of the function
* declarations for the object-system (NB: not Tcl_Obj, but ::oo).
*
- * Copyright (c) 2006-2008 by Donal K. Fellows
+ * Copyright (c) 2006-2010 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclOO.h,v 1.11 2010/06/02 08:22:15 nijtmans Exp $
*/
#ifndef TCLOO_H_INCLUDED
#define TCLOO_H_INCLUDED
#include "tcl.h"
+#ifndef TCLOOAPI
+# if defined(BUILD_tcl) || defined(BUILD_TclOO)
+# define TCLOOAPI MODULE_SCOPE
+# else
+# define TCLOOAPI extern
+# undef USE_TCLOO_STUBS
+# define USE_TCLOO_STUBS 1
+# endif
+#endif
+
+extern const char *TclOOInitializeStubs(
+ Tcl_Interp *, const char *version);
+#define Tcl_OOInitStubs(interp) TclOOInitializeStubs((interp), TCLOO_VERSION)
+
/*
* Be careful when it comes to versioning; need to make sure that the
* standalone TclOO version matches. Also make sure that this matches the
* version in the files:
*
* tests/oo.test
+ * tests/ooNext2.test
* unix/tclooConfig.sh
* win/tclooConfig.sh
*/
-#define TCLOO_VERSION "0.6.2"
+#define TCLOO_VERSION "1.0"
#define TCLOO_PATCHLEVEL TCLOO_VERSION
/*
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index b26061e..0676618 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -4,12 +4,10 @@
* This file contains implementations of the "simple" commands and
* methods from the object-system core.
*
- * Copyright (c) 2005-2008 by Donal K. Fellows
+ * Copyright (c) 2005-2012 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclOOBasic.c,v 1.24 2010/02/05 13:41:33 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -21,6 +19,8 @@
static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
static int AfterNRDestructor(ClientData data[],
Tcl_Interp *interp, int result);
+static int DecrRefsPostClassConstructor(ClientData data[],
+ Tcl_Interp *interp, int result);
static int FinalizeConstruction(ClientData data[],
Tcl_Interp *interp, int result);
static int FinalizeEval(ClientData data[],
@@ -72,6 +72,74 @@ FinalizeConstruction(
/*
* ----------------------------------------------------------------------
*
+ * TclOO_Class_Constructor --
+ *
+ * Implementation for oo::class constructor.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Class_Constructor(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
+ Tcl_Obj *invoke[3];
+
+ if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "?definitionScript?");
+ return TCL_ERROR;
+ } else if (objc == Tcl_ObjectContextSkippedArgs(context)) {
+ return TCL_OK;
+ }
+
+ /*
+ * Delegate to [oo::define] to do the work.
+ */
+
+ invoke[0] = oPtr->fPtr->defineName;
+ invoke[1] = TclOOObjectName(interp, oPtr);
+ invoke[2] = objv[objc-1];
+
+ /*
+ * Must add references or errors in configuration script will cause
+ * trouble.
+ */
+
+ Tcl_IncrRefCount(invoke[0]);
+ Tcl_IncrRefCount(invoke[1]);
+ Tcl_IncrRefCount(invoke[2]);
+ TclNRAddCallback(interp, DecrRefsPostClassConstructor,
+ invoke[0], invoke[1], invoke[2], NULL);
+
+ /*
+ * Tricky point: do not want the extra reported level in the Tcl stack
+ * trace, so use TCL_EVAL_NOERR.
+ */
+
+ return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL);
+}
+
+static int
+DecrRefsPostClassConstructor(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ TclDecrRefCount((Tcl_Obj *) data[0]);
+ TclDecrRefCount((Tcl_Obj *) data[1]);
+ TclDecrRefCount((Tcl_Obj *) data[2]);
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* TclOO_Class_Create --
*
* Implementation for oo::class->create method.
@@ -100,8 +168,9 @@ TclOO_Class_Create(
if (oPtr->classPtr == NULL) {
Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
- Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
- "\" is not a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "object \"%s\" is not a class", TclGetString(cmdnameObj)));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
return TCL_ERROR;
}
@@ -117,7 +186,8 @@ TclOO_Class_Create(
objName = Tcl_GetStringFromObj(
objv[Tcl_ObjectContextSkippedArgs(context)], &len);
if (len == 0) {
- Tcl_AppendResult(interp, "object name must not be empty", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "object name must not be empty", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
return TCL_ERROR;
}
@@ -163,8 +233,9 @@ TclOO_Class_CreateNs(
if (oPtr->classPtr == NULL) {
Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
- Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
- "\" is not a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "object \"%s\" is not a class", TclGetString(cmdnameObj)));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
return TCL_ERROR;
}
@@ -180,14 +251,16 @@ TclOO_Class_CreateNs(
objName = Tcl_GetStringFromObj(
objv[Tcl_ObjectContextSkippedArgs(context)], &len);
if (len == 0) {
- Tcl_AppendResult(interp, "object name must not be empty", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "object name must not be empty", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
return TCL_ERROR;
}
nsName = Tcl_GetStringFromObj(
objv[Tcl_ObjectContextSkippedArgs(context)+1], &len);
if (len == 0) {
- Tcl_AppendResult(interp, "namespace name must not be empty", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "namespace name must not be empty", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
return TCL_ERROR;
}
@@ -231,8 +304,9 @@ TclOO_Class_New(
if (oPtr->classPtr == NULL) {
Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
- Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
- "\" is not a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "object \"%s\" is not a class", TclGetString(cmdnameObj)));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
return TCL_ERROR;
}
@@ -278,9 +352,9 @@ TclOO_Object_Destroy(
if (contextPtr != NULL) {
contextPtr->callPtr->flags |= DESTRUCTOR;
contextPtr->skip = 0;
- AddRef(oPtr);
- TclNRAddCallback(interp, AfterNRDestructor, oPtr, contextPtr,
- NULL, NULL);
+ TclNRAddCallback(interp, AfterNRDestructor, contextPtr,
+ NULL, NULL, NULL);
+ TclPushTailcallPoint(interp);
return TclOOInvokeContext(contextPtr, interp, 0, NULL);
}
}
@@ -296,14 +370,12 @@ AfterNRDestructor(
Tcl_Interp *interp,
int result)
{
- Object *oPtr = data[0];
- CallContext *contextPtr = data[1];
+ CallContext *contextPtr = data[0];
- TclOODeleteContext(contextPtr);
- if (oPtr->command) {
- Tcl_DeleteCommandFromToken(interp, oPtr->command);
+ if (contextPtr->oPtr->command) {
+ Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command);
}
- DelRef(oPtr);
+ TclOODeleteContext(contextPtr);
return result;
}
@@ -435,9 +507,16 @@ TclOO_Object_Unknown(
Object *oPtr = contextPtr->oPtr;
const char **methodNames;
int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
+ Tcl_Obj *errorMsg;
+
+ /*
+ * If no method name, generate an error asking for a method name. (Only by
+ * overriding *this* method can an object handle the absence of a method
+ * name without an error).
+ */
if (objc < skip+1) {
- Tcl_WrongNumArgs(interp, skip, objv, "methodName ?arg ...?");
+ Tcl_WrongNumArgs(interp, skip, objv, "method ?arg ...?");
return TCL_ERROR;
}
@@ -454,31 +533,34 @@ TclOO_Object_Unknown(
if (numMethodNames == 0) {
Tcl_Obj *tmpBuf = TclOOObjectName(interp, oPtr);
+ const char *piece;
- Tcl_AppendResult(interp, "object \"", TclGetString(tmpBuf), NULL);
if (contextPtr->callPtr->flags & PUBLIC_METHOD) {
- Tcl_AppendResult(interp, "\" has no visible methods", NULL);
+ piece = "visible methods";
} else {
- Tcl_AppendResult(interp, "\" has no methods", NULL);
+ piece = "methods";
}
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "object \"%s\" has no %s", TclGetString(tmpBuf), piece));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[skip]), NULL);
return TCL_ERROR;
}
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[skip]),
- "\": must be ", NULL);
+ errorMsg = Tcl_ObjPrintf("unknown method \"%s\": must be ",
+ TclGetString(objv[skip]));
for (i=0 ; i<numMethodNames-1 ; i++) {
if (i) {
- Tcl_AppendResult(interp, ", ", NULL);
+ Tcl_AppendToObj(errorMsg, ", ", -1);
}
- Tcl_AppendResult(interp, methodNames[i], NULL);
+ Tcl_AppendToObj(errorMsg, methodNames[i], -1);
}
if (i) {
- Tcl_AppendResult(interp, " or ", NULL);
+ Tcl_AppendToObj(errorMsg, " or ", -1);
}
- Tcl_AppendResult(interp, methodNames[i], NULL);
- ckfree((char *) methodNames);
+ Tcl_AppendToObj(errorMsg, methodNames[i], -1);
+ ckfree(methodNames);
+ Tcl_SetObjResult(interp, errorMsg);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[skip]), NULL);
return TCL_ERROR;
@@ -534,8 +616,9 @@ TclOO_Object_LinkVar(
*/
if (strstr(varName, "::") != NULL) {
- Tcl_AppendResult(interp, "variable name \"", varName,
- "\" illegal: must not contain namespace separator", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "variable name \"%s\" illegal: must not contain namespace"
+ " separator", varName));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
return TCL_ERROR;
}
@@ -682,10 +765,11 @@ TclOO_Object_VarName(
/*
* ----------------------------------------------------------------------
*
- * TclOONextObjCmd --
+ * TclOONextObjCmd, TclOONextToObjCmd --
*
- * Implementation of the [next] command. Note that this command is only
- * ever to be used inside the body of a procedure-like method.
+ * Implementation of the [next] and [nextto] commands. Note that these
+ * commands are only ever to be used inside the body of a procedure-like
+ * method.
*
* ----------------------------------------------------------------------
*/
@@ -708,8 +792,9 @@ TclOONextObjCmd(
*/
if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
- Tcl_AppendResult(interp, TclGetString(objv[0]),
- " may only be called from inside a method", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s may only be called from inside a method",
+ TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
return TCL_ERROR;
}
@@ -725,6 +810,100 @@ TclOONextObjCmd(
return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
}
+int
+TclOONextToObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Interp *iPtr = (Interp *) interp;
+ CallFrame *framePtr = iPtr->varFramePtr;
+ Class *classPtr;
+ CallContext *contextPtr;
+ int i;
+ Tcl_Object object;
+
+ /*
+ * Start with sanity checks on the calling context to make sure that we
+ * are invoked from a suitable method context. If so, we can safely
+ * retrieve the handle to the object call context.
+ */
+
+ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s may only be called from inside a method",
+ TclGetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ return TCL_ERROR;
+ }
+ contextPtr = framePtr->clientData;
+
+ /*
+ * Sanity check the arguments; we need the first one to refer to a class.
+ */
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "class ?arg...?");
+ return TCL_ERROR;
+ }
+ object = Tcl_GetObjectFromObj(interp, objv[1]);
+ if (object == NULL) {
+ return TCL_ERROR;
+ }
+ classPtr = ((Object *)object)->classPtr;
+ if (classPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Search for an implementation of a method associated with the current
+ * call on the call chain past the point where we currently are. Do not
+ * allow jumping backwards!
+ */
+
+ for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) {
+ struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
+
+ if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
+ /*
+ * Invoke the (advanced) method call context in the caller
+ * context. Note that this is like [uplevel 1] and not [eval].
+ */
+
+ TclNRAddCallback(interp, RestoreFrame, framePtr, contextPtr,
+ INT2PTR(contextPtr->index), NULL);
+ contextPtr->index = i-1;
+ iPtr->varFramePtr = framePtr->callerVarPtr;
+ return TclNRObjectContextInvokeNext(interp,
+ (Tcl_ObjectContext) contextPtr, objc, objv, 2);
+ }
+ }
+
+ /*
+ * Generate an appropriate error message, depending on whether the value
+ * is on the chain but unreachable, or not on the chain at all.
+ */
+
+ for (i=contextPtr->index ; i>=0 ; i--) {
+ struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
+
+ if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "method implementation by \"%s\" not reachable from here",
+ TclGetString(objv[1])));
+ return TCL_ERROR;
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "method has no non-filter implementation by \"%s\"",
+ TclGetString(objv[1])));
+ return TCL_ERROR;
+}
+
static int
RestoreFrame(
ClientData data[],
@@ -732,8 +911,12 @@ RestoreFrame(
int result)
{
Interp *iPtr = (Interp *) interp;
+ CallContext *contextPtr = data[1];
iPtr->varFramePtr = data[0];
+ if (contextPtr != NULL) {
+ contextPtr->index = PTR2INT(data[2]);
+ }
return result;
}
@@ -756,16 +939,17 @@ TclOOSelfObjCmd(
Tcl_Obj *const *objv)
{
static const char *const subcmds[] = {
- "caller", "class", "filter", "method", "namespace", "next", "object",
- "target", NULL
+ "call", "caller", "class", "filter", "method", "namespace", "next",
+ "object", "target", NULL
};
enum SelfCmds {
- SELF_CALLER, SELF_CLASS, SELF_FILTER, SELF_METHOD, SELF_NS, SELF_NEXT,
- SELF_OBJECT, SELF_TARGET
+ SELF_CALL, SELF_CALLER, SELF_CLASS, SELF_FILTER, SELF_METHOD, SELF_NS,
+ SELF_NEXT, SELF_OBJECT, SELF_TARGET
};
Interp *iPtr = (Interp *) interp;
CallFrame *framePtr = iPtr->varFramePtr;
CallContext *contextPtr;
+ Tcl_Obj *result[3];
int index;
#define CurrentlyInvoked(contextPtr) \
@@ -776,8 +960,9 @@ TclOOSelfObjCmd(
*/
if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
- Tcl_AppendResult(interp, TclGetString(objv[0]),
- " may only be called from inside a method", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s may only be called from inside a method",
+ TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
return TCL_ERROR;
}
@@ -811,7 +996,8 @@ TclOOSelfObjCmd(
Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr;
if (clsPtr == NULL) {
- Tcl_AppendResult(interp, "method not defined by a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method not defined by a class", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
return TCL_ERROR;
}
@@ -831,12 +1017,12 @@ TclOOSelfObjCmd(
return TCL_OK;
case SELF_FILTER:
if (!CurrentlyInvoked(contextPtr).isFilter) {
- Tcl_AppendResult(interp, "not inside a filtering context", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "not inside a filtering context", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
return TCL_ERROR;
} else {
register struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr);
- Tcl_Obj *result[3];
Object *oPtr;
const char *type;
@@ -857,14 +1043,14 @@ TclOOSelfObjCmd(
case SELF_CALLER:
if ((framePtr->callerVarPtr == NULL) ||
!(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){
- Tcl_AppendResult(interp, "caller is not an object", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "caller is not an object", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
return TCL_ERROR;
} else {
CallContext *callerPtr = framePtr->callerVarPtr->clientData;
Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr;
Object *declarerPtr;
- Tcl_Obj *result[3];
if (mPtr->declaringClassPtr != NULL) {
declarerPtr = mPtr->declaringClassPtr->thisPtr;
@@ -875,7 +1061,8 @@ TclOOSelfObjCmd(
* This should be unreachable code.
*/
- Tcl_AppendResult(interp, "method without declarer!", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method without declarer!", -1));
return TCL_ERROR;
}
@@ -896,7 +1083,6 @@ TclOOSelfObjCmd(
Method *mPtr =
contextPtr->callPtr->chain[contextPtr->index+1].mPtr;
Object *declarerPtr;
- Tcl_Obj *result[2];
if (mPtr->declaringClassPtr != NULL) {
declarerPtr = mPtr->declaringClassPtr->thisPtr;
@@ -907,7 +1093,8 @@ TclOOSelfObjCmd(
* This should be unreachable code.
*/
- Tcl_AppendResult(interp, "method without declarer!", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method without declarer!", -1));
return TCL_ERROR;
}
@@ -924,13 +1111,13 @@ TclOOSelfObjCmd(
return TCL_OK;
case SELF_TARGET:
if (!CurrentlyInvoked(contextPtr).isFilter) {
- Tcl_AppendResult(interp, "not inside a filtering context", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "not inside a filtering context", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
return TCL_ERROR;
} else {
Method *mPtr;
Object *declarerPtr;
- Tcl_Obj *result[2];
int i;
for (i=contextPtr->index ; i<contextPtr->callPtr->numChain ; i++){
@@ -951,7 +1138,8 @@ TclOOSelfObjCmd(
* This should be unreachable code.
*/
- Tcl_AppendResult(interp, "method without declarer!", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method without declarer!", -1));
return TCL_ERROR;
}
result[0] = TclOOObjectName(interp, declarerPtr);
@@ -959,6 +1147,11 @@ TclOOSelfObjCmd(
Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
return TCL_OK;
}
+ case SELF_CALL:
+ result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
+ result[1] = Tcl_NewIntObj(contextPtr->index);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
+ return TCL_OK;
}
return TCL_ERROR;
}
@@ -1017,7 +1210,7 @@ TclOOCopyObjectCmd(
Tcl_DStringAppend(&buffer,
iPtr->varFramePtr->nsPtr->fullName, -1);
}
- Tcl_DStringAppend(&buffer, "::", 2);
+ TclDStringAppendLiteral(&buffer, "::");
Tcl_DStringAppend(&buffer, name, -1);
name = Tcl_DStringValue(&buffer);
}
@@ -1038,74 +1231,6 @@ TclOOCopyObjectCmd(
}
/*
- * ----------------------------------------------------------------------
- *
- * TclOOUpcatchCmd --
- *
- * Implementation of the [oo::UpCatch] command, which is a combination of
- * [uplevel 1] and [catch] that makes it easier to write transparent
- * error handling in scripts.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOUpcatchCmd(
- ClientData ignored,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[])
-{
- return Tcl_NRCallObjProc(interp, TclOONRUpcatch, NULL, objc, objv);
-}
-
-static int
-UpcatchCallback(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Interp *iPtr = (Interp *) interp;
- CallFrame *savedFramePtr = data[0];
- Tcl_Obj *resultObj[2];
- int rewind = iPtr->execEnvPtr->rewind;
-
- iPtr->varFramePtr = savedFramePtr;
- if (rewind || Tcl_LimitExceeded(interp)) {
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"UpCatch\" body line %d)", Tcl_GetErrorLine(interp)));
- return TCL_ERROR;
- }
- resultObj[0] = Tcl_GetObjResult(interp);
- resultObj[1] = Tcl_GetReturnOptions(interp, result);
- Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObj));
- return TCL_OK;
-}
-
-int
-TclOONRUpcatch(
- ClientData ignored,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[])
-{
- Interp *iPtr = (Interp *) interp;
- CallFrame *savedFramePtr = iPtr->varFramePtr;
-
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "script");
- return TCL_ERROR;
- }
- if (iPtr->varFramePtr->callerVarPtr != NULL) {
- iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
- }
-
- Tcl_NRAddCallback(interp, UpcatchCallback, savedFramePtr, NULL,NULL,NULL);
- return TclNREvalObjEx(interp, objv[1], TCL_EVAL_NOERR,
- iPtr->cmdFramePtr, 1);
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index e8f9757..a79e4fa 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -4,12 +4,10 @@
* This file contains the method call chain management code for the
* object-system core.
*
- * Copyright (c) 2005-2008 by Donal K. Fellows
+ * Copyright (c) 2005-2012 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclOOCall.c,v 1.15 2009/09/30 03:11:26 dgp Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -39,7 +37,7 @@ struct ChainBuilder {
#define DEFINITE_PROTECTED 0x100000
#define DEFINITE_PUBLIC 0x200000
#define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
-#define SPECIAL (CONSTRUCTOR | DESTRUCTOR)
+#define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
/*
* Function declarations for things defined in this file.
@@ -103,8 +101,13 @@ void
TclOODeleteContext(
CallContext *contextPtr)
{
+ register Object *oPtr = contextPtr->oPtr;
+
TclOODeleteChain(contextPtr->callPtr);
- TclStackFree(contextPtr->oPtr->fPtr->interp, contextPtr);
+ if (oPtr != NULL) {
+ TclStackFree(oPtr->fPtr->interp, contextPtr);
+ DelRef(oPtr);
+ }
}
/*
@@ -130,7 +133,7 @@ TclOODeleteChainCache(
}
}
Tcl_DeleteHashTable(tablePtr);
- ckfree((char *) tablePtr);
+ ckfree(tablePtr);
}
/*
@@ -151,9 +154,9 @@ TclOODeleteChain(
return;
}
if (callPtr->chain != callPtr->staticChain) {
- ckfree((char *) callPtr->chain);
+ ckfree(callPtr->chain);
}
- ckfree((char *) callPtr);
+ ckfree(callPtr);
}
/*
@@ -450,7 +453,7 @@ TclOOGetSortedMethodList(
* heavily sorted when it is long enough to matter.
*/
- strings = (const char **) ckalloc(sizeof(char *) * names.numEntries);
+ strings = ckalloc(sizeof(char *) * names.numEntries);
FOREACH_HASH(namePtr, isWanted, &names) {
if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
@@ -471,7 +474,7 @@ TclOOGetSortedMethodList(
}
*stringsPtr = strings;
} else {
- ckfree((char *) strings);
+ ckfree(strings);
}
}
@@ -517,7 +520,7 @@ TclOOGetSortedClassMethodList(
* heavily sorted when it is long enough to matter.
*/
- strings = (const char **) ckalloc(sizeof(char *) * names.numEntries);
+ strings = ckalloc(sizeof(char *) * names.numEntries);
FOREACH_HASH(namePtr, isWanted, &names) {
if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
@@ -538,7 +541,7 @@ TclOOGetSortedClassMethodList(
}
*stringsPtr = strings;
} else {
- ckfree((char *) strings);
+ ckfree(strings);
}
}
@@ -800,12 +803,12 @@ AddMethodToCallChain(
*/
if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
- callPtr->chain = (struct MInvoke *)
- ckalloc(sizeof(struct MInvoke)*(callPtr->numChain+1));
+ callPtr->chain =
+ ckalloc(sizeof(struct MInvoke) * (callPtr->numChain+1));
memcpy(callPtr->chain, callPtr->staticChain,
sizeof(struct MInvoke) * callPtr->numChain);
} else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
- callPtr->chain = (struct MInvoke *) ckrealloc((char *) callPtr->chain,
+ callPtr->chain = ckrealloc(callPtr->chain,
sizeof(struct MInvoke) * (callPtr->numChain + 1));
}
callPtr->chain[i].mPtr = mPtr;
@@ -986,7 +989,7 @@ TclOOGetCallContext(
doFilters = 1;
}
- callPtr = (CallChain *) ckalloc(sizeof(CallChain));
+ callPtr = ckalloc(sizeof(CallChain));
InitCallChain(callPtr, oPtr, flags);
cb.callChainPtr = callPtr;
@@ -994,6 +997,22 @@ TclOOGetCallContext(
cb.oPtr = oPtr;
/*
+ * If we're working with a forced use of unknown, do that now.
+ */
+
+ if (flags & FORCE_UNKNOWN) {
+ AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
+ &cb, NULL, 0, NULL);
+ callPtr->flags |= OO_UNKNOWN_METHOD;
+ callPtr->epoch = -1;
+ if (callPtr->numChain == 0) {
+ TclOODeleteChain(callPtr);
+ return NULL;
+ }
+ goto returnContext;
+ }
+
+ /*
* Add all defined filters (if any, and if we're going to be processing
* them; they're not processed for constructors, destructors or when we're
* in the middle of processing a filter).
@@ -1051,7 +1070,7 @@ TclOOGetCallContext(
if (hPtr == NULL) {
if (oPtr->flags & USE_CLASS_CACHE) {
if (oPtr->selfCls->classChainCache == NULL) {
- oPtr->selfCls->classChainCache = (Tcl_HashTable *)
+ oPtr->selfCls->classChainCache =
ckalloc(sizeof(Tcl_HashTable));
Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
@@ -1060,8 +1079,7 @@ TclOOGetCallContext(
(char *) methodNameObj, &i);
} else {
if (oPtr->chainCache == NULL) {
- oPtr->chainCache = (Tcl_HashTable *)
- ckalloc(sizeof(Tcl_HashTable));
+ oPtr->chainCache = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitObjHashTable(oPtr->chainCache);
}
@@ -1089,6 +1107,7 @@ TclOOGetCallContext(
returnContext:
contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
contextPtr->oPtr = oPtr;
+ AddRef(oPtr);
contextPtr->callPtr = callPtr;
contextPtr->skip = 2;
contextPtr->index = 0;
@@ -1098,6 +1117,135 @@ TclOOGetCallContext(
/*
* ----------------------------------------------------------------------
*
+ * TclOOGetStereotypeCallChain --
+ *
+ * Construct a call-chain for a method that would be used by a
+ * stereotypical instance of the given class (i.e., where the object has
+ * no definitions special to itself).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+CallChain *
+TclOOGetStereotypeCallChain(
+ Class *clsPtr, /* The object to get the context for. */
+ Tcl_Obj *methodNameObj, /* The name of the method to get the context
+ * for. NULL when getting a constructor or
+ * destructor chain. */
+ int flags) /* What sort of context are we looking for.
+ * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
+ * PRIVATE_METHOD, DESTRUCTOR and
+ * FILTER_HANDLING are useful. */
+{
+ CallChain *callPtr;
+ struct ChainBuilder cb;
+ int i, count;
+ Foundation *fPtr = clsPtr->thisPtr->fPtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashTable doneFilters;
+ Object obj;
+
+ /*
+ * Synthesize a temporary stereotypical object so that we can use existing
+ * machinery to produce the stereotypical call chain.
+ */
+
+ memset(&obj, 0, sizeof(Object));
+ obj.fPtr = fPtr;
+ obj.selfCls = clsPtr;
+ obj.refCount = 1;
+ obj.flags = USE_CLASS_CACHE;
+
+ /*
+ * Check if we can get the chain out of the Tcl_Obj method name or out of
+ * the cache. This is made a bit more complex by the fact that there are
+ * multiple different layers of cache (in the Tcl_Obj, in the object, and
+ * in the class).
+ */
+
+ if (clsPtr->classChainCache != NULL) {
+ hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
+ (char *) methodNameObj);
+ if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
+ const int reuseMask =
+ ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
+
+ callPtr = Tcl_GetHashValue(hPtr);
+ if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
+ callPtr->refCount++;
+ return callPtr;
+ }
+ Tcl_SetHashValue(hPtr, NULL);
+ TclOODeleteChain(callPtr);
+ }
+ } else {
+ hPtr = NULL;
+ }
+
+ callPtr = ckalloc(sizeof(CallChain));
+ memset(callPtr, 0, sizeof(CallChain));
+ callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
+ callPtr->epoch = fPtr->epoch;
+ callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount;
+ callPtr->objectEpoch = clsPtr->thisPtr->epoch;
+ callPtr->refCount = 1;
+ callPtr->chain = callPtr->staticChain;
+
+ cb.callChainPtr = callPtr;
+ cb.filterLength = 0;
+ cb.oPtr = &obj;
+
+ /*
+ * Add all defined filters (if any, and if we're going to be processing
+ * them; they're not processed for constructors, destructors or when we're
+ * in the middle of processing a filter).
+ */
+
+ Tcl_InitObjHashTable(&doneFilters);
+ AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters);
+ Tcl_DeleteHashTable(&doneFilters);
+ count = cb.filterLength = callPtr->numChain;
+
+ /*
+ * Add the actual method implementations.
+ */
+
+ AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL);
+
+ /*
+ * Check to see if the method has no implementation. If so, we probably
+ * need to add in a call to the unknown method. Otherwise, set up the
+ * cacheing of the method implementation (if relevant).
+ */
+
+ if (count == callPtr->numChain) {
+ AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
+ NULL, 0, NULL);
+ callPtr->flags |= OO_UNKNOWN_METHOD;
+ callPtr->epoch = -1;
+ if (count == callPtr->numChain) {
+ TclOODeleteChain(callPtr);
+ return NULL;
+ }
+ } else {
+ if (hPtr == NULL) {
+ if (clsPtr->classChainCache == NULL) {
+ clsPtr->classChainCache = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitObjHashTable(clsPtr->classChainCache);
+ }
+ hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
+ (char *) methodNameObj, &i);
+ }
+ callPtr->refCount++;
+ Tcl_SetHashValue(hPtr, callPtr);
+ StashCallChain(methodNameObj, callPtr);
+ }
+ return callPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* AddClassFiltersToCallContext --
*
* Logic to make extracting all the filters from the class context much
@@ -1255,6 +1403,91 @@ AddSimpleClassChainToCallContext(
}
/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOORenderCallChain --
+ *
+ * Create a description of a call chain. Used in [info object call],
+ * [info class call], and [self call].
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclOORenderCallChain(
+ Tcl_Interp *interp,
+ CallChain *callPtr)
+{
+ Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral;
+ Tcl_Obj *resultObj, *descObjs[4], **objv;
+ Foundation *fPtr = TclOOGetFoundation(interp);
+ int i;
+
+ /*
+ * Allocate the literals (potentially) used in our description.
+ */
+
+ filterLiteral = Tcl_NewStringObj("filter", -1);
+ Tcl_IncrRefCount(filterLiteral);
+ methodLiteral = Tcl_NewStringObj("method", -1);
+ Tcl_IncrRefCount(methodLiteral);
+ objectLiteral = Tcl_NewStringObj("object", -1);
+ Tcl_IncrRefCount(objectLiteral);
+
+ /*
+ * Do the actual construction of the descriptions. They consist of a list
+ * of triples that describe the details of how a method is understood. For
+ * each triple, the first word is the type of invokation ("method" is
+ * normal, "unknown" is special because it adds the method name as an
+ * extra argument when handled by some method types, and "filter" is
+ * special because it's a filter method). The second word is the name of
+ * the method in question (which differs for "unknown" and "filter" types)
+ * and the third word is the full name of the class that declares the
+ * method (or "object" if it is declared on the instance).
+ */
+
+ objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
+ for (i=0 ; i<callPtr->numChain ; i++) {
+ struct MInvoke *miPtr = &callPtr->chain[i];
+
+ descObjs[0] = miPtr->isFilter
+ ? filterLiteral
+ : callPtr->flags & OO_UNKNOWN_METHOD
+ ? fPtr->unknownMethodNameObj
+ : methodLiteral;
+ descObjs[1] = callPtr->flags & CONSTRUCTOR
+ ? fPtr->constructorName
+ : callPtr->flags & DESTRUCTOR
+ ? fPtr->destructorName
+ : miPtr->mPtr->namePtr;
+ descObjs[2] = miPtr->mPtr->declaringClassPtr
+ ? Tcl_GetObjectName(interp,
+ (Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr)
+ : objectLiteral;
+ descObjs[3] = Tcl_NewStringObj(miPtr->mPtr->typePtr->name, -1);
+
+ objv[i] = Tcl_NewListObj(4, descObjs);
+ }
+
+ /*
+ * Drop the local references to the literals; if they're actually used,
+ * they'll live on the description itself.
+ */
+
+ Tcl_DecrRefCount(filterLiteral);
+ Tcl_DecrRefCount(methodLiteral);
+ Tcl_DecrRefCount(objectLiteral);
+
+ /*
+ * Finish building the description and return it.
+ */
+
+ resultObj = Tcl_NewListObj(callPtr->numChain, objv);
+ TclStackFree(interp, objv);
+ return resultObj;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index 697570d..58871c6 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -1,37 +1,10 @@
/*
- * $Id: tclOODecls.h,v 1.16 2010/08/19 04:26:03 nijtmans Exp $
- *
* This file is (mostly) automatically generated from tclOO.decls.
*/
#ifndef _TCLOODECLS
#define _TCLOODECLS
-#undef TCL_STORAGE_CLASS
-#ifdef BUILD_tcl
-# define TCL_STORAGE_CLASS DLLEXPORT
-#else
-# ifdef USE_TCL_STUBS
-# define TCL_STORAGE_CLASS
-# else
-# define TCL_STORAGE_CLASS DLLIMPORT
-# endif
-#endif
-
-/*
- * WARNING: This file is automatically generated by the tools/genStubs.tcl
- * script. Any modifications to the function declarations below should be made
- * in the generic/tclOO.decls script.
- */
-
-#if defined(USE_TCLOO_STUBS)
-extern const char *TclOOInitializeStubs(Tcl_Interp *, const char *version);
-#define Tcl_OOInitStubs(interp) TclOOInitializeStubs((interp),TCLOO_VERSION)
-#else
-#define Tcl_OOInitStubs(interp) \
- Tcl_PkgRequire((interp),"TclOO",TCLOO_VERSION,0)
-#endif
-
/* !BEGIN!: Do not edit below this line. */
/*
@@ -39,101 +12,101 @@ extern const char *TclOOInitializeStubs(Tcl_Interp *, const char *version);
*/
/* 0 */
-EXTERN Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
+TCLOOAPI Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
Tcl_Object sourceObject,
const char *targetName,
const char *targetNamespaceName);
/* 1 */
-EXTERN Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz);
+TCLOOAPI Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz);
/* 2 */
-EXTERN Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object);
+TCLOOAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object);
/* 3 */
-EXTERN Tcl_Command Tcl_GetObjectCommand(Tcl_Object object);
+TCLOOAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object);
/* 4 */
-EXTERN Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp,
+TCLOOAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* 5 */
-EXTERN Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
+TCLOOAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
/* 6 */
-EXTERN Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method);
+TCLOOAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method);
/* 7 */
-EXTERN Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method);
+TCLOOAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method);
/* 8 */
-EXTERN int Tcl_MethodIsPublic(Tcl_Method method);
+TCLOOAPI int Tcl_MethodIsPublic(Tcl_Method method);
/* 9 */
-EXTERN int Tcl_MethodIsType(Tcl_Method method,
+TCLOOAPI int Tcl_MethodIsType(Tcl_Method method,
const Tcl_MethodType *typePtr,
ClientData *clientDataPtr);
/* 10 */
-EXTERN Tcl_Obj * Tcl_MethodName(Tcl_Method method);
+TCLOOAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method);
/* 11 */
-EXTERN Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
+TCLOOAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
Tcl_Object object, Tcl_Obj *nameObj,
int isPublic, const Tcl_MethodType *typePtr,
ClientData clientData);
/* 12 */
-EXTERN Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
+TCLOOAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
Tcl_Obj *nameObj, int isPublic,
const Tcl_MethodType *typePtr,
ClientData clientData);
/* 13 */
-EXTERN Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp,
+TCLOOAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp,
Tcl_Class cls, const char *nameStr,
const char *nsNameStr, int objc,
Tcl_Obj *const *objv, int skip);
/* 14 */
-EXTERN int Tcl_ObjectDeleted(Tcl_Object object);
+TCLOOAPI int Tcl_ObjectDeleted(Tcl_Object object);
/* 15 */
-EXTERN int Tcl_ObjectContextIsFiltering(
+TCLOOAPI int Tcl_ObjectContextIsFiltering(
Tcl_ObjectContext context);
/* 16 */
-EXTERN Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context);
+TCLOOAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context);
/* 17 */
-EXTERN Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context);
+TCLOOAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context);
/* 18 */
-EXTERN int Tcl_ObjectContextSkippedArgs(
+TCLOOAPI int Tcl_ObjectContextSkippedArgs(
Tcl_ObjectContext context);
/* 19 */
-EXTERN ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
+TCLOOAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
const Tcl_ObjectMetadataType *typePtr);
/* 20 */
-EXTERN void Tcl_ClassSetMetadata(Tcl_Class clazz,
+TCLOOAPI void Tcl_ClassSetMetadata(Tcl_Class clazz,
const Tcl_ObjectMetadataType *typePtr,
ClientData metadata);
/* 21 */
-EXTERN ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
+TCLOOAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
const Tcl_ObjectMetadataType *typePtr);
/* 22 */
-EXTERN void Tcl_ObjectSetMetadata(Tcl_Object object,
+TCLOOAPI void Tcl_ObjectSetMetadata(Tcl_Object object,
const Tcl_ObjectMetadataType *typePtr,
ClientData metadata);
/* 23 */
-EXTERN int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
+TCLOOAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
Tcl_ObjectContext context, int objc,
Tcl_Obj *const *objv, int skip);
/* 24 */
-EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
+TCLOOAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
Tcl_Object object);
/* 25 */
-EXTERN void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
+TCLOOAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
/* 26 */
-EXTERN void Tcl_ClassSetConstructor(Tcl_Interp *interp,
+TCLOOAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp,
Tcl_Class clazz, Tcl_Method method);
/* 27 */
-EXTERN void Tcl_ClassSetDestructor(Tcl_Interp *interp,
+TCLOOAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
Tcl_Class clazz, Tcl_Method method);
/* 28 */
-EXTERN Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
+TCLOOAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
Tcl_Object object);
-typedef struct TclOOStubHooks {
+typedef struct {
const struct TclOOIntStubs *tclOOIntStubs;
} TclOOStubHooks;
typedef struct TclOOStubs {
int magic;
- const struct TclOOStubHooks *hooks;
+ const TclOOStubHooks *hooks;
Tcl_Object (*tcl_CopyObjectInstance) (Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 0 */
Tcl_Object (*tcl_GetClassAsObject) (Tcl_Class clazz); /* 1 */
@@ -242,8 +215,4 @@ extern const TclOOStubs *tclOOStubsPtr;
#endif /* defined(USE_TCLOO_STUBS) */
/* !END!: Do not edit above this line. */
-
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
-
#endif /* _TCLOODECLS */
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 1cf0786..bacab38 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -4,12 +4,10 @@
* This file contains the implementation of the ::oo::define command,
* part of the object-system core (NB: not Tcl_Obj, but ::oo).
*
- * Copyright (c) 2006-2008 by Donal K. Fellows
+ * Copyright (c) 2006-2012 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclOODefineCmds.c,v 1.13 2010/03/05 11:36:19 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -19,12 +17,38 @@
#include "tclOOInt.h"
/*
+ * The maximum length of fully-qualified object name to use in an errorinfo
+ * message. Longer than this will be curtailed.
+ */
+
+#define OBJNAME_LENGTH_IN_ERRORINFO_LIMIT 30
+
+/*
+ * Some things that make it easier to declare a slot.
+ */
+
+struct DeclaredSlot {
+ const char *name;
+ const Tcl_MethodType getterType;
+ const Tcl_MethodType setterType;
+};
+
+#define SLOT(name,getter,setter) \
+ {"::oo::" name, \
+ {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \
+ getter, NULL, NULL}, \
+ {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
+ setter, NULL, NULL}}
+
+/*
* Forward declarations.
*/
static inline void BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static Tcl_Command FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
Tcl_Namespace *const namespacePtr);
+static void GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
+ Tcl_Obj *savedNameObj, const char *typeOfSubject);
static inline Class * GetClassInOuterContext(Tcl_Interp *interp,
Tcl_Obj *className, const char *errMsg);
static inline int InitDefineContext(Tcl_Interp *interp,
@@ -34,6 +58,63 @@ static inline void RecomputeClassCacheFlag(Object *oPtr);
static int RenameDeleteMethod(Tcl_Interp *interp, Object *oPtr,
int useClass, Tcl_Obj *const fromPtr,
Tcl_Obj *const toPtr);
+static int ClassFilterGet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ClassFilterSet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ClassMixinGet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ClassMixinSet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ClassSuperGet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ClassSuperSet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ClassVarsGet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ClassVarsSet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ObjFilterGet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ObjFilterSet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ObjMixinGet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ObjMixinSet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ObjVarsGet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int ObjVarsSet(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+
+/*
+ * Now define the slots used in declarations.
+ */
+
+static const struct DeclaredSlot slots[] = {
+ SLOT("define::filter", ClassFilterGet, ClassFilterSet),
+ SLOT("define::mixin", ClassMixinGet, ClassMixinSet),
+ SLOT("define::superclass", ClassSuperGet, ClassSuperSet),
+ SLOT("define::variable", ClassVarsGet, ClassVarsSet),
+ SLOT("objdefine::filter", ObjFilterGet, ObjFilterSet),
+ SLOT("objdefine::mixin", ObjMixinGet, ObjMixinSet),
+ SLOT("objdefine::variable", ObjVarsGet, ObjVarsSet),
+ {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
+};
/*
* ----------------------------------------------------------------------
@@ -131,7 +212,7 @@ TclOOObjectSetFilters(
* No list of filters was supplied, so we're deleting filters.
*/
- ckfree((char *) oPtr->filters.list);
+ ckfree(oPtr->filters.list);
oPtr->filters.list = NULL;
oPtr->filters.num = 0;
RecomputeClassCacheFlag(oPtr);
@@ -144,10 +225,9 @@ TclOOObjectSetFilters(
int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */
if (oPtr->filters.num == 0) {
- filtersList = (Tcl_Obj **) ckalloc(size);
+ filtersList = ckalloc(size);
} else {
- filtersList = (Tcl_Obj **)
- ckrealloc((char *) oPtr->filters.list, size);
+ filtersList = ckrealloc(oPtr->filters.list, size);
}
for (i=0 ; i<numFilters ; i++) {
filtersList[i] = filters[i];
@@ -191,7 +271,7 @@ TclOOClassSetFilters(
* No list of filters was supplied, so we're deleting filters.
*/
- ckfree((char *) classPtr->filters.list);
+ ckfree(classPtr->filters.list);
classPtr->filters.list = NULL;
classPtr->filters.num = 0;
} else {
@@ -203,10 +283,9 @@ TclOOClassSetFilters(
int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */
if (classPtr->filters.num == 0) {
- filtersList = (Tcl_Obj **) ckalloc(size);
+ filtersList = ckalloc(size);
} else {
- filtersList = (Tcl_Obj **)
- ckrealloc((char *) classPtr->filters.list, size);
+ filtersList = ckrealloc(classPtr->filters.list, size);
}
for (i=0 ; i<numFilters ; i++) {
filtersList[i] = filters[i];
@@ -246,7 +325,7 @@ TclOOObjectSetMixins(
FOREACH(mixinPtr, oPtr->mixins) {
TclOORemoveFromInstances(oPtr, mixinPtr);
}
- ckfree((char *) oPtr->mixins.list);
+ ckfree(oPtr->mixins.list);
oPtr->mixins.num = 0;
}
RecomputeClassCacheFlag(oPtr);
@@ -257,12 +336,10 @@ TclOOObjectSetMixins(
TclOORemoveFromInstances(oPtr, mixinPtr);
}
}
- oPtr->mixins.list = (Class **)
- ckrealloc((char *) oPtr->mixins.list,
+ oPtr->mixins.list = ckrealloc(oPtr->mixins.list,
sizeof(Class *) * numMixins);
} else {
- oPtr->mixins.list = (Class **)
- ckalloc(sizeof(Class *) * numMixins);
+ oPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
oPtr->flags &= ~USE_CLASS_CACHE;
}
oPtr->mixins.num = numMixins;
@@ -300,7 +377,7 @@ TclOOClassSetMixins(
FOREACH(mixinPtr, classPtr->mixins) {
TclOORemoveFromMixinSubs(classPtr, mixinPtr);
}
- ckfree((char *) classPtr->mixins.list);
+ ckfree(classPtr->mixins.list);
classPtr->mixins.num = 0;
}
} else {
@@ -308,12 +385,10 @@ TclOOClassSetMixins(
FOREACH(mixinPtr, classPtr->mixins) {
TclOORemoveFromMixinSubs(classPtr, mixinPtr);
}
- classPtr->mixins.list = (Class **)
- ckrealloc((char *) classPtr->mixins.list,
+ classPtr->mixins.list = ckrealloc(classPtr->mixins.list,
sizeof(Class *) * numMixins);
} else {
- classPtr->mixins.list = (Class **)
- ckalloc(sizeof(Class *) * numMixins);
+ classPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
}
classPtr->mixins.num = numMixins;
memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
@@ -348,8 +423,10 @@ RenameDeleteMethod(
if (!useClass) {
if (!oPtr->methodsPtr) {
noSuchMethod:
- Tcl_AppendResult(interp, "method ", TclGetString(fromPtr),
- " does not exist", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "method %s does not exist", TclGetString(fromPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(fromPtr), NULL);
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) fromPtr);
@@ -361,13 +438,16 @@ RenameDeleteMethod(
&isNew);
if (hPtr == newHPtr) {
renameToSelf:
- Tcl_AppendResult(interp, "cannot rename method to itself",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot rename method to itself", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", NULL);
return TCL_ERROR;
} else if (!isNew) {
renameToExisting:
- Tcl_AppendResult(interp, "method called ",
- TclGetString(toPtr), " already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "method called %s already exists",
+ TclGetString(toPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_OVER", NULL);
return TCL_ERROR;
}
}
@@ -434,7 +514,9 @@ TclOOUnknownDefinition(
const char *soughtStr, *matchedStr = NULL;
if (objc < 2) {
- Tcl_AppendResult(interp, "bad call of unknown handler", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad call of unknown handler", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL);
return TCL_ERROR;
}
if (TclOOGetDefineCmdContext(interp) == NULL) {
@@ -478,7 +560,9 @@ TclOOUnknownDefinition(
}
noMatch:
- Tcl_AppendResult(interp, "invalid command name \"",soughtStr,"\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid command name \"%s\"", soughtStr));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", soughtStr, NULL);
return TCL_ERROR;
}
@@ -565,9 +649,10 @@ InitDefineContext(
int result;
if (namespacePtr == NULL) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot process definitions; support namespace deleted",
- NULL);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -600,15 +685,25 @@ TclOOGetDefineCmdContext(
Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
+ Tcl_Object object;
if ((iPtr->varFramePtr == NULL)
|| (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
- Tcl_AppendResult(interp, "this command may only be called from within"
- " the context of an ::oo::define or ::oo::objdefine command",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "this command may only be called from within the context of"
+ " an ::oo::define or ::oo::objdefine command", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return NULL;
+ }
+ object = iPtr->varFramePtr->clientData;
+ if (Tcl_ObjectDeleted(object)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "this command cannot be called when the object has been"
+ " deleted", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return NULL;
}
- return (Tcl_Object) iPtr->varFramePtr->clientData;
+ return object;
}
/*
@@ -645,7 +740,9 @@ GetClassInOuterContext(
return NULL;
}
if (oPtr->classPtr == NULL) {
- Tcl_AppendResult(interp, errMsg, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+ TclGetString(className), NULL);
return NULL;
}
return oPtr->classPtr;
@@ -654,6 +751,44 @@ GetClassInOuterContext(
/*
* ----------------------------------------------------------------------
*
+ * GenerateErrorInfo --
+ * Factored out code to generate part of the error trace messages.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+GenerateErrorInfo(
+ Tcl_Interp *interp, /* Where to store the error info trace. */
+ Object *oPtr, /* What object (or class) was being configured
+ * when the error occurred? */
+ Tcl_Obj *savedNameObj, /* Name of object saved from before script was
+ * evaluated, which is needed if the object
+ * goes away part way through execution. OTOH,
+ * if the object isn't deleted then its
+ * current name (post-execution) has to be
+ * used. This matters, because the object
+ * could have been renamed... */
+ const char *typeOfSubject) /* Part of the message, saying whether it was
+ * an object, class or class-as-object that
+ * was being configured. */
+{
+ int length;
+ Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
+ ? savedNameObj : TclOOObjectName(interp, oPtr);
+ const char *objName = Tcl_GetStringFromObj(realNameObj, &length);
+ int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT;
+ int overflow = (length > limit);
+
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (in definition script for %s \"%.*s%s\" line %d)",
+ typeOfSubject, (overflow ? limit : length), objName,
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* TclOODefineObjCmd --
* Implementation of the "oo::define" command. Works by effectively doing
* the same as 'namespace eval', but with extra magic applied so that the
@@ -685,8 +820,10 @@ TclOODefineObjCmd(
return TCL_ERROR;
}
if (oPtr->classPtr == NULL) {
- Tcl_AppendResult(interp, TclGetString(objv[1]),
- " does not refer to a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s does not refer to a class",TclGetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+ TclGetString(objv[1]), NULL);
return TCL_ERROR;
}
@@ -701,20 +838,15 @@ TclOODefineObjCmd(
AddRef(oPtr);
if (objc == 3) {
+ Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+ Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[2], 0,
((Interp *)interp)->cmdFramePtr, 2);
-
if (result == TCL_ERROR) {
- int length;
- const char *objName = Tcl_GetStringFromObj(objv[1], &length);
- int limit = 60;
- int overflow = (length > limit);
-
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (in definition script for object \"%.*s%s\" line %d)",
- (overflow ? limit : length), objName,
- (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+ GenerateErrorInfo(interp, oPtr, objNameObj, "class");
}
+ TclDecrRefCount(objNameObj);
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
Interp *iPtr = (Interp *) interp;
@@ -820,20 +952,15 @@ TclOOObjDefObjCmd(
AddRef(oPtr);
if (objc == 3) {
+ Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+ Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[2], 0,
((Interp *)interp)->cmdFramePtr, 2);
-
if (result == TCL_ERROR) {
- int length;
- const char *objName = Tcl_GetStringFromObj(objv[1], &length);
- int limit = 60;
- int overflow = (length > limit);
-
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (in definition script for object \"%.*s%s\" line %d)",
- (overflow ? limit : length), objName,
- (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+ GenerateErrorInfo(interp, oPtr, objNameObj, "object");
}
+ TclDecrRefCount(objNameObj);
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
Interp *iPtr = (Interp *) interp;
@@ -939,21 +1066,15 @@ TclOODefineSelfObjCmd(
AddRef(oPtr);
if (objc == 2) {
+ Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+ Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[1], 0,
((Interp *)interp)->cmdFramePtr, 2);
-
if (result == TCL_ERROR) {
- int length;
- const char *objName = Tcl_GetStringFromObj(
- TclOOObjectName(interp, oPtr), &length);
- int limit = 60;
- int overflow = (length > limit);
-
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (in definition script for object \"%.*s%s\" line %d)",
- (overflow ? limit : length), objName,
- (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+ GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
}
+ TclDecrRefCount(objNameObj);
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
Interp *iPtr = (Interp *) interp;
@@ -1044,13 +1165,15 @@ TclOODefineClassObjCmd(
return TCL_ERROR;
}
if (oPtr->flags & ROOT_OBJECT) {
- Tcl_AppendResult(interp,
- "may not modify the class of the root object class", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not modify the class of the root object class", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
if (oPtr->flags & ROOT_CLASS) {
- Tcl_AppendResult(interp,
- "may not modify the class of the class of classes", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not modify the class of the class of classes", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1075,9 +1198,11 @@ TclOODefineClassObjCmd(
*/
if ((oPtr->classPtr==NULL) == TclOOIsReachable(fPtr->classCls, clsPtr)) {
- Tcl_AppendResult(interp, "may not change a ",
- (oPtr->classPtr==NULL ? "non-" : ""), "class object into a ",
- (oPtr->classPtr==NULL ? "" : "non-"), "class object", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "may not change a %sclass object into a %sclass object",
+ (oPtr->classPtr==NULL ? "non-" : ""),
+ (oPtr->classPtr==NULL ? "" : "non-")));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "TRANSMUTATION", NULL);
return TCL_ERROR;
}
@@ -1197,7 +1322,9 @@ TclOODefineDeleteMethodObjCmd(
return TCL_ERROR;
}
if (!isInstanceDeleteMethod && !oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1319,7 +1446,9 @@ TclOODefineExportObjCmd(
}
clsPtr = oPtr->classPtr;
if (!isInstanceExport && !clsPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1335,8 +1464,7 @@ TclOODefineExportObjCmd(
if (isInstanceExport) {
if (!oPtr->methodsPtr) {
- oPtr->methodsPtr = (Tcl_HashTable *)
- ckalloc(sizeof(Tcl_HashTable));
+ oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitObjHashTable(oPtr->methodsPtr);
oPtr->flags &= ~USE_CLASS_CACHE;
}
@@ -1348,7 +1476,7 @@ TclOODefineExportObjCmd(
}
if (isNew) {
- mPtr = (Method *) ckalloc(sizeof(Method));
+ mPtr = ckalloc(sizeof(Method));
memset(mPtr, 0, sizeof(Method));
mPtr->refCount = 1;
mPtr->namePtr = objv[i];
@@ -1380,42 +1508,6 @@ TclOODefineExportObjCmd(
/*
* ----------------------------------------------------------------------
*
- * TclOODefineFilterObjCmd --
- * Implementation of the "filter" subcommand of the "oo::define" and
- * "oo::objdefine" commands.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineFilterObjCmd(
- ClientData clientData,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const *objv)
-{
- int isInstanceFilter = (clientData != NULL);
- Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-
- if (oPtr == NULL) {
- return TCL_ERROR;
- }
- if (!isInstanceFilter && !oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
- return TCL_ERROR;
- }
-
- if (!isInstanceFilter) {
- TclOOClassSetFilters(interp, oPtr->classPtr, objc-1, objv+1);
- } else {
- TclOOObjectSetFilters(oPtr, objc-1, objv+1);
- }
- return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
* TclOODefineForwardObjCmd --
* Implementation of the "forward" subcommand of the "oo::define" and
* "oo::objdefine" commands.
@@ -1446,7 +1538,9 @@ TclOODefineForwardObjCmd(
return TCL_ERROR;
}
if (!isInstanceForward && !oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
@@ -1502,7 +1596,9 @@ TclOODefineMethodObjCmd(
return TCL_ERROR;
}
if (!isInstanceMethod && !oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
@@ -1552,7 +1648,9 @@ TclOODefineMixinObjCmd(
return TCL_ERROR;
}
if (!isInstanceMixin && !oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1));
@@ -1565,7 +1663,9 @@ TclOODefineMixinObjCmd(
goto freeAndError;
}
if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) {
- Tcl_AppendResult(interp, "may not mix a class into itself", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not mix a class into itself", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
goto freeAndError;
}
mixins[i-1] = clsPtr;
@@ -1615,7 +1715,9 @@ TclOODefineRenameMethodObjCmd(
return TCL_ERROR;
}
if (!isInstanceRenameMethod && !oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1642,45 +1744,457 @@ TclOODefineRenameMethodObjCmd(
/*
* ----------------------------------------------------------------------
*
- * TclOODefineSuperclassObjCmd --
- * Implementation of the "superclass" subcommand of the "oo::define"
- * command.
+ * TclOODefineUnexportObjCmd --
+ * Implementation of the "unexport" subcommand of the "oo::define" and
+ * "oo::objdefine" commands.
*
* ----------------------------------------------------------------------
*/
int
-TclOODefineSuperclassObjCmd(
+TclOODefineUnexportObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
+ int isInstanceUnexport = (clientData != NULL);
Object *oPtr;
- Class **superclasses, *superPtr;
- int i, j;
+ Method *mPtr;
+ Tcl_HashEntry *hPtr;
+ Class *clsPtr;
+ int i, isNew, changed = 0;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "className ?className ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
return TCL_ERROR;
}
+ oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ clsPtr = oPtr->classPtr;
+ if (!isInstanceUnexport && !clsPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
+ }
+
+ for (i=1 ; i<objc ; i++) {
+ /*
+ * Unexporting is done by removing the PUBLIC_METHOD flag from the
+ * method record. If there is no such method in this object or class
+ * (i.e. the method comes from something inherited from or that we're
+ * an instance of) then we put in a blank record without that flag;
+ * such records are skipped over by the call chain engine *except* for
+ * their flags member.
+ */
+
+ if (isInstanceUnexport) {
+ if (!oPtr->methodsPtr) {
+ oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitObjHashTable(oPtr->methodsPtr);
+ oPtr->flags &= ~USE_CLASS_CACHE;
+ }
+ hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i],
+ &isNew);
+ } else {
+ hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
+ &isNew);
+ }
+
+ if (isNew) {
+ mPtr = ckalloc(sizeof(Method));
+ memset(mPtr, 0, sizeof(Method));
+ mPtr->refCount = 1;
+ mPtr->namePtr = objv[i];
+ Tcl_IncrRefCount(objv[i]);
+ Tcl_SetHashValue(hPtr, mPtr);
+ } else {
+ mPtr = Tcl_GetHashValue(hPtr);
+ }
+ if (isNew || mPtr->flags & PUBLIC_METHOD) {
+ mPtr->flags &= ~PUBLIC_METHOD;
+ changed = 1;
+ }
+ }
+
/*
- * Get the class to operate on.
+ * Bump the right epoch if we actually changed anything.
*/
- oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (changed) {
+ if (isInstanceUnexport) {
+ oPtr->epoch++;
+ } else {
+ BumpGlobalEpoch(interp, clsPtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_ClassSetConstructor, Tcl_ClassSetDestructor --
+ * How to install a constructor or destructor into a class; API to call
+ * from C.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+Tcl_ClassSetConstructor(
+ Tcl_Interp *interp,
+ Tcl_Class clazz,
+ Tcl_Method method)
+{
+ Class *clsPtr = (Class *) clazz;
+
+ if (method != (Tcl_Method) clsPtr->constructorPtr) {
+ TclOODelMethodRef(clsPtr->constructorPtr);
+ clsPtr->constructorPtr = (Method *) method;
+
+ /*
+ * Remember to invalidate the cached constructor chain for this class.
+ * [Bug 2531577]
+ */
+
+ if (clsPtr->constructorChainPtr) {
+ TclOODeleteChain(clsPtr->constructorChainPtr);
+ clsPtr->constructorChainPtr = NULL;
+ }
+ BumpGlobalEpoch(interp, clsPtr);
+ }
+}
+
+void
+Tcl_ClassSetDestructor(
+ Tcl_Interp *interp,
+ Tcl_Class clazz,
+ Tcl_Method method)
+{
+ Class *clsPtr = (Class *) clazz;
+
+ if (method != (Tcl_Method) clsPtr->destructorPtr) {
+ TclOODelMethodRef(clsPtr->destructorPtr);
+ clsPtr->destructorPtr = (Method *) method;
+ if (clsPtr->destructorChainPtr) {
+ TclOODeleteChain(clsPtr->destructorChainPtr);
+ clsPtr->destructorChainPtr = NULL;
+ }
+ BumpGlobalEpoch(interp, clsPtr);
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineSlots --
+ * Create the "::oo::Slot" class and its standard instances. Class
+ * definition is empty at the stage (added by scripting).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineSlots(
+ Foundation *fPtr)
+{
+ const struct DeclaredSlot *slotInfoPtr;
+ Tcl_Obj *getName = Tcl_NewStringObj("Get", -1);
+ Tcl_Obj *setName = Tcl_NewStringObj("Set", -1);
+ Class *slotCls;
+
+ slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class)
+ fPtr->classCls, "::oo::Slot", NULL, -1, NULL, 0))->classPtr;
+ if (slotCls == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(getName);
+ Tcl_IncrRefCount(setName);
+ for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
+ Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
+ (Tcl_Class) slotCls, slotInfoPtr->name, NULL,-1,NULL,0);
+
+ if (slotObject == NULL) {
+ continue;
+ }
+ Tcl_NewInstanceMethod(fPtr->interp, slotObject, getName, 0,
+ &slotInfoPtr->getterType, NULL);
+ Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0,
+ &slotInfoPtr->setterType, NULL);
+ }
+ Tcl_DecrRefCount(getName);
+ Tcl_DecrRefCount(setName);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ClassFilterGet, ClassFilterSet --
+ * Implementation of the "filter" slot accessors of the "oo::define"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+ClassFilterGet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ Tcl_Obj *resultObj, *filterObj;
+ int i;
+
+ if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ NULL);
+ return TCL_ERROR;
+ }
if (oPtr == NULL) {
return TCL_ERROR;
+ } else if (!oPtr->classPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
}
- if (oPtr->classPtr == NULL) {
- Tcl_AppendResult(interp, "only classes may have superclasses defined",
+
+ resultObj = Tcl_NewObj();
+ FOREACH(filterObj, oPtr->classPtr->filters) {
+ Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+static int
+ClassFilterSet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ int filterc;
+ Tcl_Obj **filterv;
+
+ if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "filterList");
+ return TCL_ERROR;
+ }
+ objv += Tcl_ObjectContextSkippedArgs(context);
+
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ } else if (!oPtr->classPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
+ } else if (Tcl_ListObjGetElements(interp, objv[0], &filterc,
+ &filterv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ TclOOClassSetFilters(interp, oPtr->classPtr, filterc, filterv);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ClassMixinGet, ClassMixinSet --
+ * Implementation of the "mixin" slot accessors of the "oo::define"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+ClassMixinGet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ Tcl_Obj *resultObj;
+ Class *mixinPtr;
+ int i;
+
+ if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
NULL);
return TCL_ERROR;
}
- if (oPtr->flags & ROOT_OBJECT) {
- Tcl_AppendResult(interp,
- "may not modify the superclass of the root object", NULL);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ } else if (!oPtr->classPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(mixinPtr, oPtr->classPtr->mixins) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ TclOOObjectName(interp, mixinPtr->thisPtr));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+
+}
+
+static int
+ClassMixinSet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ int mixinc, i;
+ Tcl_Obj **mixinv;
+ Class **mixins;
+
+ if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "mixinList");
+ return TCL_ERROR;
+ }
+ objv += Tcl_ObjectContextSkippedArgs(context);
+
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ } else if (!oPtr->classPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
+ } else if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
+ &mixinv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);
+
+ for (i=0 ; i<mixinc ; i++) {
+ mixins[i] = GetClassInOuterContext(interp, mixinv[i],
+ "may only mix in classes");
+ if (mixins[i] == NULL) {
+ goto freeAndError;
+ }
+ if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not mix a class into itself", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
+ goto freeAndError;
+ }
+ }
+
+ TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins);
+ TclStackFree(interp, mixins);
+ return TCL_OK;
+
+ freeAndError:
+ TclStackFree(interp, mixins);
+ return TCL_ERROR;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ClassSuperGet, ClassSuperSet --
+ * Implementation of the "superclass" slot accessors of the "oo::define"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+ClassSuperGet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ Tcl_Obj *resultObj;
+ Class *superPtr;
+ int i;
+
+ if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ NULL);
+ return TCL_ERROR;
+ }
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ } else if (!oPtr->classPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(superPtr, oPtr->classPtr->superclasses) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ TclOOObjectName(interp, superPtr->thisPtr));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+static int
+ClassSuperSet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ int superc, i, j;
+ Tcl_Obj **superv;
+ Class **superclasses, *superPtr;
+
+ if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "superclassList");
+ return TCL_ERROR;
+ }
+ objv += Tcl_ObjectContextSkippedArgs(context);
+
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ } else if (!oPtr->classPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
+ } else if (oPtr == oPtr->fPtr->objectCls->thisPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not modify the superclass of the root object", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
+ } else if (Tcl_ListObjGetElements(interp, objv[0], &superc,
+ &superv) != TCL_OK) {
return TCL_ERROR;
}
@@ -1688,34 +2202,34 @@ TclOODefineSuperclassObjCmd(
* Allocate some working space.
*/
- superclasses = (Class **) ckalloc(sizeof(Class *) * (objc-1));
+ superclasses = (Class **) ckalloc(sizeof(Class *) * superc);
/*
* Parse the arguments to get the class to use as superclasses.
*/
- for (i=0 ; i<objc-1 ; i++) {
- Class *clsPtr = GetClassInOuterContext(interp, objv[i+1],
+ for (i=0 ; i<superc ; i++) {
+ superclasses[i] = GetClassInOuterContext(interp, superv[i],
"only a class can be a superclass");
-
- if (clsPtr == NULL) {
+ if (superclasses[i] == NULL) {
goto failedAfterAlloc;
}
for (j=0 ; j<i ; j++) {
- if (superclasses[j] == clsPtr) {
- Tcl_AppendResult(interp,
- "class should only be a direct superclass once",NULL);
+ if (superclasses[j] == superclasses[i]) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "class should only be a direct superclass once", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", NULL);
goto failedAfterAlloc;
}
}
- if (TclOOIsReachable(oPtr->classPtr, clsPtr)) {
- Tcl_AppendResult(interp,
- "attempt to form circular dependency graph", NULL);
+ if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to form circular dependency graph", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
failedAfterAlloc:
ckfree((char *) superclasses);
return TCL_ERROR;
}
- superclasses[i] = clsPtr;
}
/*
@@ -1732,7 +2246,7 @@ TclOODefineSuperclassObjCmd(
ckfree((char *) oPtr->classPtr->superclasses.list);
}
oPtr->classPtr->superclasses.list = superclasses;
- oPtr->classPtr->superclasses.num = objc-1;
+ oPtr->classPtr->superclasses.num = superc;
FOREACH(superPtr, oPtr->classPtr->superclasses) {
TclOOAddToSubclasses(oPtr->classPtr, superPtr);
}
@@ -1744,92 +2258,141 @@ TclOODefineSuperclassObjCmd(
/*
* ----------------------------------------------------------------------
*
- * TclOODefineUnexportObjCmd --
- * Implementation of the "unexport" subcommand of the "oo::define" and
- * "oo::objdefine" commands.
+ * ClassVarsGet, ClassVarsSet --
+ * Implementation of the "variable" slot accessors of the "oo::define"
+ * command.
*
* ----------------------------------------------------------------------
*/
-int
-TclOODefineUnexportObjCmd(
+static int
+ClassVarsGet(
ClientData clientData,
Tcl_Interp *interp,
+ Tcl_ObjectContext context,
int objc,
Tcl_Obj *const *objv)
{
- int isInstanceUnexport = (clientData != NULL);
- Object *oPtr;
- Method *mPtr;
- Tcl_HashEntry *hPtr;
- Class *clsPtr;
- int i, isNew, changed = 0;
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ Tcl_Obj *resultObj, *variableObj;
+ int i;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
+ if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ NULL);
return TCL_ERROR;
}
-
- oPtr = (Object *) TclOOGetDefineCmdContext(interp);
if (oPtr == NULL) {
return TCL_ERROR;
+ } else if (!oPtr->classPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
}
- clsPtr = oPtr->classPtr;
- if (!isInstanceUnexport && !clsPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+
+ resultObj = Tcl_NewObj();
+ FOREACH(variableObj, oPtr->classPtr->variables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+static int
+ClassVarsSet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ int varc;
+ Tcl_Obj **varv, *variableObj;
+ int i;
+
+ if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "filterList");
return TCL_ERROR;
}
+ objv += Tcl_ObjectContextSkippedArgs(context);
- for (i=1 ; i<objc ; i++) {
- /*
- * Unexporting is done by removing the PUBLIC_METHOD flag from the
- * method record. If there is no such method in this object or class
- * (i.e. the method comes from something inherited from or that we're
- * an instance of) then we put in a blank record without that flag;
- * such records are skipped over by the call chain engine *except* for
- * their flags member.
- */
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ } else if (!oPtr->classPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
+ } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
+ &varv) != TCL_OK) {
+ return TCL_ERROR;
+ }
- if (isInstanceUnexport) {
- if (!oPtr->methodsPtr) {
- oPtr->methodsPtr = (Tcl_HashTable *)
- ckalloc(sizeof(Tcl_HashTable));
- Tcl_InitObjHashTable(oPtr->methodsPtr);
- oPtr->flags &= ~USE_CLASS_CACHE;
- }
- hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i],
- &isNew);
- } else {
- hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
- &isNew);
+ for (i=0 ; i<varc ; i++) {
+ const char *varName = Tcl_GetString(varv[i]);
+
+ if (strstr(varName, "::") != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid declared variable name \"%s\": must not %s",
+ varName, "contain namespace separators"));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
+ return TCL_ERROR;
}
+ if (Tcl_StringMatch(varName, "*(*)")) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid declared variable name \"%s\": must not %s",
+ varName, "refer to an array element"));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
+ return TCL_ERROR;
+ }
+ }
- if (isNew) {
- mPtr = (Method *) ckalloc(sizeof(Method));
- memset(mPtr, 0, sizeof(Method));
- mPtr->refCount = 1;
- mPtr->namePtr = objv[i];
- Tcl_IncrRefCount(objv[i]);
- Tcl_SetHashValue(hPtr, mPtr);
+ for (i=0 ; i<varc ; i++) {
+ Tcl_IncrRefCount(varv[i]);
+ }
+ FOREACH(variableObj, oPtr->classPtr->variables) {
+ Tcl_DecrRefCount(variableObj);
+ }
+ if (i != varc) {
+ if (varc == 0) {
+ ckfree((char *) oPtr->classPtr->variables.list);
+ } else if (i) {
+ oPtr->classPtr->variables.list = (Tcl_Obj **)
+ ckrealloc((char *) oPtr->classPtr->variables.list,
+ sizeof(Tcl_Obj *) * varc);
} else {
- mPtr = Tcl_GetHashValue(hPtr);
- }
- if (isNew || mPtr->flags & PUBLIC_METHOD) {
- mPtr->flags &= ~PUBLIC_METHOD;
- changed = 1;
+ oPtr->classPtr->variables.list = (Tcl_Obj **)
+ ckalloc(sizeof(Tcl_Obj *) * varc);
}
}
- /*
- * Bump the right epoch if we actually changed anything.
- */
+ oPtr->classPtr->variables.num = 0;
+ if (varc > 0) {
+ int created, n;
+ Tcl_HashTable uniqueTable;
- if (changed) {
- if (isInstanceUnexport) {
- oPtr->epoch++;
- } else {
- BumpGlobalEpoch(interp, clsPtr);
+ Tcl_InitObjHashTable(&uniqueTable);
+ for (i=n=0 ; i<varc ; i++) {
+ Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
+ if (created) {
+ oPtr->classPtr->variables.list[n++] = varv[i];
+ } else {
+ Tcl_DecrRefCount(varv[i]);
+ }
}
+ oPtr->classPtr->variables.num = n;
+
+ /*
+ * Shouldn't be necessary, but maintain num/list invariant.
+ */
+
+ oPtr->classPtr->variables.list = (Tcl_Obj **)
+ ckrealloc((char *) oPtr->classPtr->variables.list,
+ sizeof(Tcl_Obj *) * n);
+ Tcl_DeleteHashTable(&uniqueTable);
}
return TCL_OK;
}
@@ -1837,139 +2400,279 @@ TclOODefineUnexportObjCmd(
/*
* ----------------------------------------------------------------------
*
- * TclOODefineVariablesObjCmd --
- * Implementation of the "variable" subcommand of the "oo::define" and
- * "oo::objdefine" commands.
+ * ObjectFilterGet, ObjectFilterSet --
+ * Implementation of the "filter" slot accessors of the "oo::objdefine"
+ * command.
*
* ----------------------------------------------------------------------
*/
-int
-TclOODefineVariablesObjCmd(
+static int
+ObjFilterGet(
ClientData clientData,
Tcl_Interp *interp,
+ Tcl_ObjectContext context,
int objc,
Tcl_Obj *const *objv)
{
- int isInstanceVars = (clientData != NULL);
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
- Tcl_Obj *variableObj;
+ Tcl_Obj *resultObj, *filterObj;
int i;
- if (oPtr == NULL) {
+ if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ NULL);
+ return TCL_ERROR;
+ } else if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(filterObj, oPtr->filters) {
+ Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+static int
+ObjFilterSet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ int filterc;
+ Tcl_Obj **filterv;
+
+ if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "filterList");
+ return TCL_ERROR;
+ } else if (oPtr == NULL) {
return TCL_ERROR;
}
- if (!isInstanceVars && !oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ objv += Tcl_ObjectContextSkippedArgs(context);
+ if (Tcl_ListObjGetElements(interp, objv[0], &filterc,
+ &filterv) != TCL_OK) {
return TCL_ERROR;
}
- for (i=1 ; i<objc ; i++) {
- const char *varName = Tcl_GetString(objv[i]);
+ TclOOObjectSetFilters(oPtr, filterc, filterv);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ObjectMixinGet, ObjectMixinSet --
+ * Implementation of the "mixin" slot accessors of the "oo::objdefine"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
- if (strstr(varName, "::") != NULL) {
- Tcl_AppendResult(interp, "invalid declared variable name \"",
- varName, "\": must not contain namespace separators",
- NULL);
- return TCL_ERROR;
- }
- if (Tcl_StringMatch(varName, "*(*)")) {
- Tcl_AppendResult(interp, "invalid declared variable name \"",
- varName, "\": must not refer to an array element", NULL);
- return TCL_ERROR;
- }
+static int
+ObjMixinGet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ Tcl_Obj *resultObj;
+ Class *mixinPtr;
+ int i;
+
+ if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ NULL);
+ return TCL_ERROR;
+ } else if (oPtr == NULL) {
+ return TCL_ERROR;
}
- for (i=1 ; i<objc ; i++) {
- Tcl_IncrRefCount(objv[i]);
+
+ resultObj = Tcl_NewObj();
+ FOREACH(mixinPtr, oPtr->mixins) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ TclOOObjectName(interp, mixinPtr->thisPtr));
}
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
- if (!isInstanceVars) {
- FOREACH(variableObj, oPtr->classPtr->variables) {
- Tcl_DecrRefCount(variableObj);
- }
- if (i != objc-1) {
- if (objc == 1) {
- ckfree((char *) oPtr->classPtr->variables.list);
- } else if (i) {
- oPtr->classPtr->variables.list = (Tcl_Obj **)
- ckrealloc((char *) oPtr->classPtr->variables.list,
- sizeof(Tcl_Obj *) * (objc-1));
- } else {
- oPtr->classPtr->variables.list = (Tcl_Obj **)
- ckalloc(sizeof(Tcl_Obj *) * (objc-1));
- }
- }
- if (objc > 1) {
- memcpy(oPtr->classPtr->variables.list, objv+1,
- sizeof(Tcl_Obj *) * (objc-1));
- }
- oPtr->classPtr->variables.num = objc-1;
- } else {
- FOREACH(variableObj, oPtr->variables) {
- Tcl_DecrRefCount(variableObj);
- }
- if (i != objc-1) {
- if (objc == 1) {
- ckfree((char *) oPtr->variables.list);
- } else if (i) {
- oPtr->variables.list = (Tcl_Obj **)
- ckrealloc((char *) oPtr->variables.list,
- sizeof(Tcl_Obj *) * (objc-1));
- } else {
- oPtr->variables.list = (Tcl_Obj **)
- ckalloc(sizeof(Tcl_Obj *) * (objc-1));
- }
- }
- if (objc > 1) {
- memcpy(oPtr->variables.list, objv+1, sizeof(Tcl_Obj *)*(objc-1));
+static int
+ObjMixinSet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ int mixinc;
+ Tcl_Obj **mixinv;
+ Class **mixins;
+ int i;
+
+ if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "mixinList");
+ return TCL_ERROR;
+ } else if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ objv += Tcl_ObjectContextSkippedArgs(context);
+ if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
+ &mixinv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);
+
+ for (i=0 ; i<mixinc ; i++) {
+ mixins[i] = GetClassInOuterContext(interp, mixinv[i],
+ "may only mix in classes");
+ if (mixins[i] == NULL) {
+ TclStackFree(interp, mixins);
+ return TCL_ERROR;
}
- oPtr->variables.num = objc-1;
}
+
+ TclOOObjectSetMixins(oPtr, mixinc, mixins);
+ TclStackFree(interp, mixins);
return TCL_OK;
}
-void
-Tcl_ClassSetConstructor(
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ObjectVarsGet, ObjectVarsSet --
+ * Implementation of the "variable" slot accessors of the "oo::objdefine"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+ObjVarsGet(
+ ClientData clientData,
Tcl_Interp *interp,
- Tcl_Class clazz,
- Tcl_Method method)
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
{
- Class *clsPtr = (Class *) clazz;
-
- if (method != (Tcl_Method) clsPtr->constructorPtr) {
- TclOODelMethodRef(clsPtr->constructorPtr);
- clsPtr->constructorPtr = (Method *) method;
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ Tcl_Obj *resultObj, *variableObj;
+ int i;
- /*
- * Remember to invalidate the cached constructor chain for this class.
- * [Bug 2531577]
- */
+ if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ NULL);
+ return TCL_ERROR;
+ } else if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
- if (clsPtr->constructorChainPtr) {
- TclOODeleteChain(clsPtr->constructorChainPtr);
- clsPtr->constructorChainPtr = NULL;
- }
- BumpGlobalEpoch(interp, clsPtr);
+ resultObj = Tcl_NewObj();
+ FOREACH(variableObj, oPtr->variables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
}
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
}
-void
-Tcl_ClassSetDestructor(
+static int
+ObjVarsSet(
+ ClientData clientData,
Tcl_Interp *interp,
- Tcl_Class clazz,
- Tcl_Method method)
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
{
- Class *clsPtr = (Class *) clazz;
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ int varc, i;
+ Tcl_Obj **varv, *variableObj;
- if (method != (Tcl_Method) clsPtr->destructorPtr) {
- TclOODelMethodRef(clsPtr->destructorPtr);
- clsPtr->destructorPtr = (Method *) method;
- if (clsPtr->destructorChainPtr) {
- TclOODeleteChain(clsPtr->destructorChainPtr);
- clsPtr->destructorChainPtr = NULL;
+ if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "variableList");
+ return TCL_ERROR;
+ } else if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ objv += Tcl_ObjectContextSkippedArgs(context);
+ if (Tcl_ListObjGetElements(interp, objv[0], &varc,
+ &varv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ for (i=0 ; i<varc ; i++) {
+ const char *varName = Tcl_GetString(varv[i]);
+
+ if (strstr(varName, "::") != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid declared variable name \"%s\": must not %s",
+ varName, "contain namespace separators"));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
+ return TCL_ERROR;
}
- BumpGlobalEpoch(interp, clsPtr);
+ if (Tcl_StringMatch(varName, "*(*)")) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid declared variable name \"%s\": must not %s",
+ varName, "refer to an array element"));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
+ return TCL_ERROR;
+ }
+ }
+ for (i=0 ; i<varc ; i++) {
+ Tcl_IncrRefCount(varv[i]);
+ }
+
+ FOREACH(variableObj, oPtr->variables) {
+ Tcl_DecrRefCount(variableObj);
}
+ if (i != varc) {
+ if (varc == 0) {
+ ckfree((char *) oPtr->variables.list);
+ } else if (i) {
+ oPtr->variables.list = (Tcl_Obj **)
+ ckrealloc((char *) oPtr->variables.list,
+ sizeof(Tcl_Obj *) * varc);
+ } else {
+ oPtr->variables.list = (Tcl_Obj **)
+ ckalloc(sizeof(Tcl_Obj *) * varc);
+ }
+ }
+ oPtr->variables.num = 0;
+ if (varc > 0) {
+ int created, n;
+ Tcl_HashTable uniqueTable;
+
+ Tcl_InitObjHashTable(&uniqueTable);
+ for (i=n=0 ; i<varc ; i++) {
+ Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
+ if (created) {
+ oPtr->variables.list[n++] = varv[i];
+ } else {
+ Tcl_DecrRefCount(varv[i]);
+ }
+ }
+ oPtr->variables.num = n;
+
+ /*
+ * Shouldn't be necessary, but maintain num/list invariant.
+ */
+
+ oPtr->variables.list = (Tcl_Obj **)
+ ckrealloc((char *) oPtr->variables.list,
+ sizeof(Tcl_Obj *) * n);
+ Tcl_DeleteHashTable(&uniqueTable);
+ }
+ return TCL_OK;
}
/*
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index b8679b3..5be9b01 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -4,12 +4,10 @@
* This file contains the implementation of the ::oo-related [info]
* subcommands.
*
- * Copyright (c) 2006-2008 by Donal K. Fellows
+ * Copyright (c) 2006-2011 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclOOInfo.c,v 1.14 2010/03/24 13:21:11 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -19,6 +17,7 @@
#include "tclOOInt.h"
static inline Class * GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static Tcl_ObjCmdProc InfoObjectCallCmd;
static Tcl_ObjCmdProc InfoObjectClassCmd;
static Tcl_ObjCmdProc InfoObjectDefnCmd;
static Tcl_ObjCmdProc InfoObjectFiltersCmd;
@@ -30,6 +29,7 @@ static Tcl_ObjCmdProc InfoObjectMixinsCmd;
static Tcl_ObjCmdProc InfoObjectNsCmd;
static Tcl_ObjCmdProc InfoObjectVarsCmd;
static Tcl_ObjCmdProc InfoObjectVariablesCmd;
+static Tcl_ObjCmdProc InfoClassCallCmd;
static Tcl_ObjCmdProc InfoClassConstrCmd;
static Tcl_ObjCmdProc InfoClassDefnCmd;
static Tcl_ObjCmdProc InfoClassDestrCmd;
@@ -43,45 +43,45 @@ static Tcl_ObjCmdProc InfoClassSubsCmd;
static Tcl_ObjCmdProc InfoClassSupersCmd;
static Tcl_ObjCmdProc InfoClassVariablesCmd;
-struct NameProcMap { const char *name; Tcl_ObjCmdProc *proc; };
-
/*
* List of commands that are used to implement the [info object] subcommands.
*/
-static const struct NameProcMap infoObjectCmds[] = {
- {"::oo::InfoObject::class", InfoObjectClassCmd},
- {"::oo::InfoObject::definition", InfoObjectDefnCmd},
- {"::oo::InfoObject::filters", InfoObjectFiltersCmd},
- {"::oo::InfoObject::forward", InfoObjectForwardCmd},
- {"::oo::InfoObject::isa", InfoObjectIsACmd},
- {"::oo::InfoObject::methods", InfoObjectMethodsCmd},
- {"::oo::InfoObject::methodtype", InfoObjectMethodTypeCmd},
- {"::oo::InfoObject::mixins", InfoObjectMixinsCmd},
- {"::oo::InfoObject::namespace", InfoObjectNsCmd},
- {"::oo::InfoObject::variables", InfoObjectVariablesCmd},
- {"::oo::InfoObject::vars", InfoObjectVarsCmd},
- {NULL, NULL}
+static const EnsembleImplMap infoObjectCmds[] = {
+ {"call", InfoObjectCallCmd, NULL, NULL, NULL, 0},
+ {"class", InfoObjectClassCmd, TclCompileInfoObjectClassCmd, NULL, NULL, 0},
+ {"definition", InfoObjectDefnCmd, NULL, NULL, NULL, 0},
+ {"filters", InfoObjectFiltersCmd, NULL, NULL, NULL, 0},
+ {"forward", InfoObjectForwardCmd, NULL, NULL, NULL, 0},
+ {"isa", InfoObjectIsACmd, TclCompileInfoObjectIsACmd, NULL, NULL, 0},
+ {"methods", InfoObjectMethodsCmd, NULL, NULL, NULL, 0},
+ {"methodtype", InfoObjectMethodTypeCmd, NULL, NULL, NULL, 0},
+ {"mixins", InfoObjectMixinsCmd, NULL, NULL, NULL, 0},
+ {"namespace", InfoObjectNsCmd, TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
+ {"variables", InfoObjectVariablesCmd, NULL, NULL, NULL, 0},
+ {"vars", InfoObjectVarsCmd, NULL, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
};
/*
* List of commands that are used to implement the [info class] subcommands.
*/
-static const struct NameProcMap infoClassCmds[] = {
- {"::oo::InfoClass::constructor", InfoClassConstrCmd},
- {"::oo::InfoClass::definition", InfoClassDefnCmd},
- {"::oo::InfoClass::destructor", InfoClassDestrCmd},
- {"::oo::InfoClass::filters", InfoClassFiltersCmd},
- {"::oo::InfoClass::forward", InfoClassForwardCmd},
- {"::oo::InfoClass::instances", InfoClassInstancesCmd},
- {"::oo::InfoClass::methods", InfoClassMethodsCmd},
- {"::oo::InfoClass::methodtype", InfoClassMethodTypeCmd},
- {"::oo::InfoClass::mixins", InfoClassMixinsCmd},
- {"::oo::InfoClass::subclasses", InfoClassSubsCmd},
- {"::oo::InfoClass::superclasses", InfoClassSupersCmd},
- {"::oo::InfoClass::variables", InfoClassVariablesCmd},
- {NULL, NULL}
+static const EnsembleImplMap infoClassCmds[] = {
+ {"call", InfoClassCallCmd, NULL, NULL, NULL, 0},
+ {"constructor", InfoClassConstrCmd, NULL, NULL, NULL, 0},
+ {"definition", InfoClassDefnCmd, NULL, NULL, NULL, 0},
+ {"destructor", InfoClassDestrCmd, NULL, NULL, NULL, 0},
+ {"filters", InfoClassFiltersCmd, NULL, NULL, NULL, 0},
+ {"forward", InfoClassForwardCmd, NULL, NULL, NULL, 0},
+ {"instances", InfoClassInstancesCmd, NULL, NULL, NULL, 0},
+ {"methods", InfoClassMethodsCmd, NULL, NULL, NULL, 0},
+ {"methodtype", InfoClassMethodTypeCmd, NULL, NULL, NULL, 0},
+ {"mixins", InfoClassMixinsCmd, NULL, NULL, NULL, 0},
+ {"subclasses", InfoClassSubsCmd, NULL, NULL, NULL, 0},
+ {"superclasses", InfoClassSupersCmd, NULL, NULL, NULL, 0},
+ {"variables", InfoClassVariablesCmd, NULL, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
};
/*
@@ -99,58 +99,27 @@ void
TclOOInitInfo(
Tcl_Interp *interp)
{
- Tcl_Namespace *nsPtr;
Tcl_Command infoCmd;
- int i;
+ Tcl_Obj *mapDict;
/*
- * Build the ensemble used to implement [info object].
+ * Build the ensembles used to implement [info object] and [info class].
*/
- nsPtr = Tcl_CreateNamespace(interp, "::oo::InfoObject", NULL, NULL);
- Tcl_CreateEnsemble(interp, nsPtr->fullName, nsPtr, TCL_ENSEMBLE_PREFIX);
- Tcl_Export(interp, nsPtr, "[a-z]*", 1);
- for (i=0 ; infoObjectCmds[i].name!=NULL ; i++) {
- Tcl_CreateObjCommand(interp, infoObjectCmds[i].name,
- infoObjectCmds[i].proc, NULL, NULL);
- }
-
- /*
- * Build the ensemble used to implement [info class].
- */
-
- nsPtr = Tcl_CreateNamespace(interp, "::oo::InfoClass", NULL, NULL);
- Tcl_CreateEnsemble(interp, nsPtr->fullName, nsPtr, TCL_ENSEMBLE_PREFIX);
- Tcl_Export(interp, nsPtr, "[a-z]*", 1);
- for (i=0 ; infoClassCmds[i].name!=NULL ; i++) {
- Tcl_CreateObjCommand(interp, infoClassCmds[i].name,
- infoClassCmds[i].proc, NULL, NULL);
- }
+ TclMakeEnsemble(interp, "::oo::InfoObject", infoObjectCmds);
+ TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds);
/*
* Install into the master [info] ensemble.
*/
infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
- if (infoCmd != NULL && Tcl_IsEnsemble(infoCmd)) {
- Tcl_Obj *mapDict, *objectObj, *classObj;
-
- Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
- if (mapDict != NULL) {
- objectObj = Tcl_NewStringObj("object", -1);
- classObj = Tcl_NewStringObj("class", -1);
-
- Tcl_IncrRefCount(objectObj);
- Tcl_IncrRefCount(classObj);
- Tcl_DictObjPut(NULL, mapDict, objectObj,
- Tcl_NewStringObj("::oo::InfoObject", -1));
- Tcl_DictObjPut(NULL, mapDict, classObj,
- Tcl_NewStringObj("::oo::InfoClass", -1));
- Tcl_DecrRefCount(objectObj);
- Tcl_DecrRefCount(classObj);
- Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
- }
- }
+ Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
+ Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1),
+ Tcl_NewStringObj("::oo::InfoObject", -1));
+ Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1),
+ Tcl_NewStringObj("::oo::InfoClass", -1));
+ Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
}
/*
@@ -175,8 +144,8 @@ GetClassFromObj(
return NULL;
}
if (oPtr->classPtr == NULL) {
- Tcl_AppendResult(interp, "\"", TclGetString(objPtr),
- "\" is not a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
TclGetString(objPtr), NULL);
return NULL;
@@ -218,30 +187,22 @@ InfoObjectClassCmd(
TclOOObjectName(interp, oPtr->selfCls->thisPtr));
return TCL_OK;
} else {
- Object *o2Ptr;
- Class *mixinPtr;
+ Class *mixinPtr, *o2clsPtr;
int i;
- o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
- if (o2Ptr == NULL) {
- return TCL_ERROR;
- }
- if (o2Ptr->classPtr == NULL) {
- Tcl_AppendResult(interp, "object \"", TclGetString(objv[2]),
- "\" is not a class", NULL);
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
- TclGetString(objv[2]), NULL);
+ o2clsPtr = GetClassFromObj(interp, objv[2]);
+ if (o2clsPtr == NULL) {
return TCL_ERROR;
}
FOREACH(mixinPtr, oPtr->mixins) {
- if (TclOOIsReachable(o2Ptr->classPtr, mixinPtr)) {
+ if (TclOOIsReachable(o2clsPtr, mixinPtr)) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
return TCL_OK;
}
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(
- TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)));
+ TclOOIsReachable(o2clsPtr, oPtr->selfCls)));
return TCL_OK;
}
}
@@ -285,16 +246,16 @@ InfoObjectDefnCmd(
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
- Tcl_AppendResult(interp,
- "definition not available for this kind of method", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "definition not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -396,17 +357,17 @@ InfoObjectForwardCmd(
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
if (prefixObj == NULL) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"prefix argument list not available for this kind of method",
- NULL);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -497,7 +458,9 @@ InfoObjectIsACmd(
return TCL_ERROR;
}
if (o2Ptr->classPtr == NULL) {
- Tcl_AppendResult(interp, "non-classes cannot be mixins", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "non-classes cannot be mixins", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL);
return TCL_ERROR;
} else {
Class *mixinPtr;
@@ -521,7 +484,9 @@ InfoObjectIsACmd(
return TCL_ERROR;
}
if (o2Ptr->classPtr == NULL) {
- Tcl_AppendResult(interp, "non-classes cannot be types", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "non-classes cannot be types", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL);
return TCL_ERROR;
}
if (TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)) {
@@ -605,7 +570,7 @@ InfoObjectMethodsCmd(
Tcl_NewStringObj(names[i], -1));
}
if (numNames > 0) {
- ckfree((char *) names);
+ ckfree(names);
}
} else if (oPtr->methodsPtr) {
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
@@ -655,8 +620,8 @@ InfoObjectMethodTypeCmd(
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -882,8 +847,9 @@ InfoClassConstrCmd(
}
procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr);
if (procPtr == NULL) {
- Tcl_AppendResult(interp,
- "definition not available for this kind of method", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "definition not available for this kind of method", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL);
return TCL_ERROR;
}
@@ -940,16 +906,16 @@ InfoClassDefnCmd(
}
hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
- Tcl_AppendResult(interp,
- "definition not available for this kind of method", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "definition not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -1009,8 +975,9 @@ InfoClassDestrCmd(
}
procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr);
if (procPtr == NULL) {
- Tcl_AppendResult(interp,
- "definition not available for this kind of method", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "definition not available for this kind of method", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL);
return TCL_ERROR;
}
@@ -1087,17 +1054,17 @@ InfoClassForwardCmd(
}
hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
if (prefixObj == NULL) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"prefix argument list not available for this kind of method",
- NULL);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -1223,7 +1190,7 @@ InfoClassMethodsCmd(
Tcl_NewStringObj(names[i], -1));
}
if (numNames > 0) {
- ckfree((char *) names);
+ ckfree(names);
}
} else {
FOREACH_HASH_DECLS;
@@ -1271,8 +1238,8 @@ InfoClassMethodTypeCmd(
hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -1462,6 +1429,95 @@ InfoClassVariablesCmd(
}
/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectCallCmd --
+ *
+ * Implements [info object call $objName $methodName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectCallCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Object *oPtr;
+ CallContext *contextPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
+ return TCL_ERROR;
+ }
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get the call context and render its call chain.
+ */
+
+ contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL);
+ if (contextPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot construct any call chain", -1));
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp,
+ TclOORenderCallChain(interp, contextPtr->callPtr));
+ TclOODeleteContext(contextPtr);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassCallCmd --
+ *
+ * Implements [info class call $clsName $methodName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassCallCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Class *clsPtr;
+ CallChain *callPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get an render the stereotypical call chain.
+ */
+
+ callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD);
+ if (callPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot construct any call chain", -1));
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr));
+ TclOODeleteChain(callPtr);
+ return TCL_OK;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 56da45d..ab54964 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -4,12 +4,10 @@
* This file contains the structure definitions and some of the function
* declarations for the object-system (NB: not Tcl_Obj, but ::oo).
*
- * Copyright (c) 2006 by Donal K. Fellows
+ * Copyright (c) 2006-2012 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclOOInt.h,v 1.18 2010/04/27 12:36:21 nijtmans Exp $
*/
#ifndef TCL_OO_INTERNAL_H
@@ -216,6 +214,8 @@ typedef struct Object {
* class of classes, and should be treated
* specially during teardown (and in a few
* other spots). */
+#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the
+ * unknown method handler at that point. */
/*
* And the definition of a class. Note that every class also has an associated
@@ -320,6 +320,9 @@ typedef struct Foundation {
* constructor. */
Tcl_Obj *destructorName; /* Shared object containing the "name" of a
* destructor. */
+ Tcl_Obj *clonedName; /* Shared object containing the name of a
+ * "<cloned>" pseudo-constructor. */
+ Tcl_Obj *defineName; /* Fully qualified name of oo::define. */
} Foundation;
/*
@@ -368,7 +371,7 @@ typedef struct CallContext {
} CallContext;
/*
- * Bits for the 'flags' field of the call context.
+ * Bits for the 'flags' field of the call chain.
*/
#define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */
@@ -379,21 +382,6 @@ typedef struct CallContext {
#define DESTRUCTOR 0x10 /* This is a destructor. */
/*
- * Assorted flags for call frames. Note that bits 1 and 2 are already taken by
- * Tcl itself.
- */
-
-#if 0
-#define FRAME_IS_METHOD 0x4 /* The frame is a method body, and the frame's
- * clientData field contains a CallContext
- * reference. */
-#define FRAME_IS_OO_DEFINE 0x8 /* The frame is part of the inside workings of
- * the [oo::define] command; the clientData
- * field contains an Object reference that has
- * been confirmed to refer to a class. */
-#endif
-
-/*
* Structure containing definition information about basic class methods.
*/
@@ -428,30 +416,18 @@ MODULE_SCOPE int TclOODefineDestructorObjCmd(ClientData clientData,
MODULE_SCOPE int TclOODefineExportObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
-MODULE_SCOPE int TclOODefineFilterObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineForwardObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineMethodObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
-MODULE_SCOPE int TclOODefineMixinObjCmd(ClientData clientData,
- Tcl_Interp *interp, const int objc,
- Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineRenameMethodObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
-MODULE_SCOPE int TclOODefineSuperclassObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineUnexportObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
-MODULE_SCOPE int TclOODefineVariablesObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineClassObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
@@ -467,6 +443,9 @@ MODULE_SCOPE int TclOOCopyObjectCmd(ClientData clientData,
MODULE_SCOPE int TclOONextObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOONextToObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
MODULE_SCOPE int TclOOSelfObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
@@ -475,6 +454,9 @@ MODULE_SCOPE int TclOOSelfObjCmd(ClientData clientData,
* Method implementations (in tclOOBasic.c).
*/
+MODULE_SCOPE int TclOO_Class_Constructor(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int TclOO_Class_Create(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
@@ -513,6 +495,7 @@ MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp,
const char *nsNameStr, int objc,
Tcl_Obj *const *objv, int skip,
Tcl_Object *objectPtr);
+MODULE_SCOPE int TclOODefineSlots(Foundation *fPtr);
MODULE_SCOPE void TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void TclOODeleteChainCache(Tcl_HashTable *tablePtr);
MODULE_SCOPE void TclOODeleteContext(CallContext *contextPtr);
@@ -520,6 +503,8 @@ MODULE_SCOPE void TclOODelMethodRef(Method *method);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
Tcl_Obj *methodNameObj, int flags,
Tcl_Obj *cacheInThisObj);
+MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
+ Tcl_Obj *methodNameObj, int flags);
MODULE_SCOPE Foundation *TclOOGetFoundation(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj * TclOOGetFwdFromMethod(Method *mPtr);
MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr);
@@ -538,20 +523,17 @@ MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp,
Tcl_Obj *const *objv, int skip);
MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
const DeclaredClassMethod *dcm);
-MODULE_SCOPE int TclOONRUpcatch(ClientData ignored, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
MODULE_SCOPE void TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void TclOORemoveFromMixinSubs(Class *subPtr,
Class *mixinPtr);
MODULE_SCOPE void TclOORemoveFromSubclasses(Class *subPtr,
Class *superPtr);
+MODULE_SCOPE Tcl_Obj * TclOORenderCallChain(Tcl_Interp *interp,
+ CallChain *callPtr);
MODULE_SCOPE void TclOOStashContext(Tcl_Obj *objPtr,
CallContext *contextPtr);
MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
-MODULE_SCOPE int TclOOUpcatchCmd(ClientData ignored,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
/*
* Include all the private API, generated from tclOO.decls.
diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h
index b60fa7d..acafb18 100644
--- a/generic/tclOOIntDecls.h
+++ b/generic/tclOOIntDecls.h
@@ -1,29 +1,10 @@
/*
- * $Id: tclOOIntDecls.h,v 1.14 2010/08/19 04:26:04 nijtmans Exp $
- *
* This file is (mostly) automatically generated from tclOO.decls.
*/
#ifndef _TCLOOINTDECLS
#define _TCLOOINTDECLS
-#undef TCL_STORAGE_CLASS
-#ifdef BUILD_tcl
-# define TCL_STORAGE_CLASS DLLEXPORT
-#else
-# ifdef USE_TCL_STUBS
-# define TCL_STORAGE_CLASS
-# else
-# define TCL_STORAGE_CLASS DLLIMPORT
-# endif
-#endif
-
-/*
- * WARNING: This file is automatically generated by the tools/genStubs.tcl
- * script. Any modifications to the function declarations below should be made
- * in the generic/tclOO.decls script.
- */
-
/* !BEGIN!: Do not edit below this line. */
/*
@@ -31,46 +12,46 @@
*/
/* 0 */
-EXTERN Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp);
+TCLOOAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp);
/* 1 */
-EXTERN Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
+TCLOOAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
Object *oPtr, int flags, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
const Tcl_MethodType *typePtr,
ClientData clientData, Proc **procPtrPtr);
/* 2 */
-EXTERN Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp,
+TCLOOAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp,
Class *clsPtr, int flags, Tcl_Obj *nameObj,
const char *namePtr, Tcl_Obj *argsObj,
Tcl_Obj *bodyObj,
const Tcl_MethodType *typePtr,
ClientData clientData, Proc **procPtrPtr);
/* 3 */
-EXTERN Method * TclOONewProcInstanceMethod(Tcl_Interp *interp,
+TCLOOAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp,
Object *oPtr, int flags, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
ProcedureMethod **pmPtrPtr);
/* 4 */
-EXTERN Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
+TCLOOAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
int flags, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
ProcedureMethod **pmPtrPtr);
/* 5 */
-EXTERN int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
+TCLOOAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv,
int publicOnly, Class *startCls);
/* 6 */
-EXTERN int TclOOIsReachable(Class *targetPtr, Class *startPtr);
+TCLOOAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr);
/* 7 */
-EXTERN Method * TclOONewForwardMethod(Tcl_Interp *interp,
+TCLOOAPI Method * TclOONewForwardMethod(Tcl_Interp *interp,
Class *clsPtr, int isPublic,
Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
/* 8 */
-EXTERN Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp,
+TCLOOAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp,
Object *oPtr, int isPublic, Tcl_Obj *nameObj,
Tcl_Obj *prefixObj);
/* 9 */
-EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
+TCLOOAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
Tcl_Object oPtr,
TclOO_PreCallProc *preCallPtr,
TclOO_PostCallProc *postCallPtr,
@@ -79,7 +60,7 @@ EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
int flags, void **internalTokenPtr);
/* 10 */
-EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
+TCLOOAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
Tcl_Class clsPtr,
TclOO_PreCallProc *preCallPtr,
TclOO_PostCallProc *postCallPtr,
@@ -88,28 +69,28 @@ EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
int flags, void **internalTokenPtr);
/* 11 */
-EXTERN int TclOOInvokeObject(Tcl_Interp *interp,
+TCLOOAPI int TclOOInvokeObject(Tcl_Interp *interp,
Tcl_Object object, Tcl_Class startCls,
int publicPrivate, int objc,
Tcl_Obj *const *objv);
/* 12 */
-EXTERN void TclOOObjectSetFilters(Object *oPtr, int numFilters,
+TCLOOAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters,
Tcl_Obj *const *filters);
/* 13 */
-EXTERN void TclOOClassSetFilters(Tcl_Interp *interp,
+TCLOOAPI void TclOOClassSetFilters(Tcl_Interp *interp,
Class *classPtr, int numFilters,
Tcl_Obj *const *filters);
/* 14 */
-EXTERN void TclOOObjectSetMixins(Object *oPtr, int numMixins,
+TCLOOAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins,
Class *const *mixins);
/* 15 */
-EXTERN void TclOOClassSetMixins(Tcl_Interp *interp,
+TCLOOAPI void TclOOClassSetMixins(Tcl_Interp *interp,
Class *classPtr, int numMixins,
Class *const *mixins);
typedef struct TclOOIntStubs {
int magic;
- const struct TclOOIntStubHooks *hooks;
+ void *hooks;
Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */
Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 1 */
@@ -179,8 +160,4 @@ extern const TclOOIntStubs *tclOOIntStubsPtr;
#endif /* defined(USE_TCLOO_STUBS) */
/* !END!: Do not edit above this line. */
-
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
-
#endif /* _TCLOOINTDECLS */
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 1255f1d..28820e0 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -3,12 +3,10 @@
*
* This file contains code to create and manage methods.
*
- * Copyright (c) 2005-2008 by Donal K. Fellows
+ * Copyright (c) 2005-2011 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclOOMethod.c,v 1.28 2010/09/26 14:16:26 msofer Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -41,6 +39,8 @@ typedef struct {
Tcl_Obj *nameObj; /* The "name" of the command. */
Command cmd; /* The command structure. Mostly bogus. */
ExtraFrameInfo efi; /* Extra information used for [info frame]. */
+ Command *oldCmdPtr; /* Saved cmdPtr so that we can be safe after a
+ * recursive call returns. */
struct PNI pni; /* Specialist information used in the efi
* field for this type of call. */
} PMFrameData;
@@ -157,19 +157,19 @@ Tcl_NewInstanceMethod(
int isNew;
if (nameObj == NULL) {
- mPtr = (Method *) ckalloc(sizeof(Method));
+ mPtr = ckalloc(sizeof(Method));
mPtr->namePtr = NULL;
mPtr->refCount = 1;
goto populate;
}
if (!oPtr->methodsPtr) {
- oPtr->methodsPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitObjHashTable(oPtr->methodsPtr);
oPtr->flags &= ~USE_CLASS_CACHE;
}
hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew);
if (isNew) {
- mPtr = (Method *) ckalloc(sizeof(Method));
+ mPtr = ckalloc(sizeof(Method));
mPtr->namePtr = nameObj;
mPtr->refCount = 1;
Tcl_IncrRefCount(nameObj);
@@ -225,14 +225,14 @@ Tcl_NewMethod(
int isNew;
if (nameObj == NULL) {
- mPtr = (Method *) ckalloc(sizeof(Method));
+ mPtr = ckalloc(sizeof(Method));
mPtr->namePtr = NULL;
mPtr->refCount = 1;
goto populate;
}
hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew);
if (isNew) {
- mPtr = (Method *) ckalloc(sizeof(Method));
+ mPtr = ckalloc(sizeof(Method));
mPtr->refCount = 1;
mPtr->namePtr = nameObj;
Tcl_IncrRefCount(nameObj);
@@ -280,7 +280,7 @@ TclOODelMethodRef(
Tcl_DecrRefCount(mPtr->namePtr);
}
- ckfree((char *) mPtr);
+ ckfree(mPtr);
}
}
@@ -344,7 +344,7 @@ TclOONewProcInstanceMethod(
if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
return NULL;
}
- pmPtr = (ProcedureMethod *) ckalloc(sizeof(ProcedureMethod));
+ pmPtr = ckalloc(sizeof(ProcedureMethod));
memset(pmPtr, 0, sizeof(ProcedureMethod));
pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
pmPtr->flags = flags & USE_DECLARER_NS;
@@ -353,7 +353,7 @@ TclOONewProcInstanceMethod(
method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj,
argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
if (method == NULL) {
- ckfree((char *) pmPtr);
+ ckfree(pmPtr);
} else if (pmPtrPtr != NULL) {
*pmPtrPtr = pmPtr;
}
@@ -405,7 +405,7 @@ TclOONewProcMethod(
procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
}
- pmPtr = (ProcedureMethod *) ckalloc(sizeof(ProcedureMethod));
+ pmPtr = ckalloc(sizeof(ProcedureMethod));
memset(pmPtr, 0, sizeof(ProcedureMethod));
pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
pmPtr->flags = flags & USE_DECLARER_NS;
@@ -418,7 +418,7 @@ TclOONewProcMethod(
Tcl_DecrRefCount(argsObj);
}
if (method == NULL) {
- ckfree((char *) pmPtr);
+ ckfree(pmPtr);
} else if (pmPtrPtr != NULL) {
*pmPtrPtr = pmPtr;
}
@@ -499,12 +499,12 @@ TclOOMakeProcInstanceMethod(
if (context.line
&& (context.nline >= 4) && (context.line[3] >= 0)) {
int isNew;
- CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
+ CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
Tcl_HashEntry *hPtr;
cfPtr->level = -1;
cfPtr->type = context.type;
- cfPtr->line = (int *) ckalloc(sizeof(int));
+ cfPtr->line = ckalloc(sizeof(int));
cfPtr->line[0] = context.line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
@@ -612,12 +612,12 @@ TclOOMakeProcMethod(
if (context.line
&& (context.nline >= 4) && (context.line[3] >= 0)) {
int isNew;
- CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
+ CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
Tcl_HashEntry *hPtr;
cfPtr->level = -1;
cfPtr->type = context.type;
- cfPtr->line = (int *) ckalloc(sizeof(int));
+ cfPtr->line = ckalloc(sizeof(int));
cfPtr->line[0] = context.line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
@@ -711,6 +711,13 @@ InvokeProcedureMethod(
result = pmPtr->preCallProc(pmPtr->clientData, interp, context,
(Tcl_CallFrame *) fdPtr->framePtr, &isFinished);
if (isFinished || result != TCL_OK) {
+ /*
+ * Restore the old cmdPtr so that a subsequent use of [info frame]
+ * won't crash on us. [Bug 3001438]
+ */
+
+ pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr;
+
Tcl_PopCallFrame(interp);
TclStackFree(interp, fdPtr->framePtr);
if (--pmPtr->refCount < 1) {
@@ -752,6 +759,13 @@ FinalizePMCall(
}
/*
+ * Restore the old cmdPtr so that a subsequent use of [info frame] won't
+ * crash on us. [Bug 3001438]
+ */
+
+ pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr;
+
+ /*
* Scrap the special frame data now that we're done with it. Note that we
* are inlining DeleteProcedureMethod() here; this location is highly
* sensitive when it comes to performance!
@@ -820,6 +834,14 @@ PushMethodCallFrame(
}
/*
+ * Save the old cmdPtr so that when this recursive call returns, we can
+ * restore it. To do otherwise causes crashes in [info frame] after we
+ * return from a recursive call. [Bug 3001438]
+ */
+
+ fdPtr->oldCmdPtr = pmPtr->procPtr->cmdPtr;
+
+ /*
* Compile the body. This operation may fail.
*/
@@ -845,7 +867,7 @@ PushMethodCallFrame(
result = TclProcCompileProc(interp, pmPtr->procPtr,
pmPtr->procPtr->bodyPtr, nsPtr, "body of method", namePtr);
if (result != TCL_OK) {
- return result;
+ goto failureReturn;
}
/*
@@ -856,7 +878,7 @@ PushMethodCallFrame(
result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
(Tcl_Namespace *) nsPtr, FRAME_IS_PROC|FRAME_IS_METHOD);
if (result != TCL_OK) {
- return result;
+ goto failureReturn;
}
fdPtr->framePtr->clientData = contextPtr;
@@ -891,6 +913,15 @@ PushMethodCallFrame(
}
return TCL_OK;
+
+ /*
+ * Restore the old cmdPtr so that a subsequent use of [info frame] won't
+ * crash on us. [Bug 3001438]
+ */
+
+ failureReturn:
+ pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr;
+ return result;
}
/*
@@ -929,7 +960,7 @@ ProcedureMethodVarResolver(
Tcl_Var *varPtr)
{
int result;
- Tcl_ResolvedVarInfo *rPtr;
+ Tcl_ResolvedVarInfo *rPtr = NULL;
result = ProcedureMethodCompiledVarResolver(interp, varName,
strlen(varName), contextNs, &rPtr);
@@ -939,6 +970,14 @@ ProcedureMethodVarResolver(
}
*varPtr = rPtr->fetchProc(interp, rPtr);
+
+ /*
+ * Must not retain reference to resolved information. [Bug 3105999]
+ */
+
+ if (rPtr != NULL) {
+ rPtr->deleteProc(rPtr);
+ }
return (*varPtr? TCL_OK : TCL_CONTINUE);
}
@@ -956,8 +995,6 @@ ProcedureMethodCompiledVarConnect(
int i, isNew, cacheIt, varLen, len;
const char *match, *varName;
- varName = TclGetStringFromObj(infoPtr->variableObj, &varLen);
-
/*
* Check that the variable is being requested in a context that is also a
* method call; if not (i.e. we're evaluating in the object's namespace or
@@ -984,6 +1021,7 @@ ProcedureMethodCompiledVarConnect(
* either.
*/
+ varName = TclGetStringFromObj(infoPtr->variableObj, &varLen);
if (contextPtr->callPtr->chain[contextPtr->index]
.mPtr->declaringClassPtr != NULL) {
FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
@@ -1017,6 +1055,14 @@ ProcedureMethodCompiledVarConnect(
}
if (cacheIt) {
infoPtr->cachedObjectVar = TclVarHashGetValue(hPtr);
+
+ /*
+ * We must keep a reference to the variable so everything will
+ * continue to work correctly even if it is unset; being unset does
+ * not end the life of the variable at this level. [Bug 3185009]
+ */
+
+ VarHashRefCount(infoPtr->cachedObjectVar)++;
}
return TclVarHashGetValue(hPtr);
}
@@ -1027,8 +1073,16 @@ ProcedureMethodCompiledVarDelete(
{
OOResVarInfo *infoPtr = (OOResVarInfo *) rPtr;
+ /*
+ * Release the reference to the variable if we were holding it.
+ */
+
+ if (infoPtr->cachedObjectVar) {
+ VarHashRefCount(infoPtr->cachedObjectVar)--;
+ TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL);
+ }
Tcl_DecrRefCount(infoPtr->variableObj);
- ckfree((char *) infoPtr);
+ ckfree(infoPtr);
}
static int
@@ -1053,7 +1107,7 @@ ProcedureMethodCompiledVarResolver(
return TCL_CONTINUE;
}
- infoPtr = (OOResVarInfo *) ckalloc(sizeof(OOResVarInfo));
+ infoPtr = ckalloc(sizeof(OOResVarInfo));
infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect;
infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete;
infoPtr->cachedObjectVar = NULL;
@@ -1150,15 +1204,6 @@ ConstructorErrorHandler(
const char *objectName, *kindName;
int objectNameLen;
- if (Tcl_GetErrorLine(interp) == (int) 0xDEADBEEF) {
- /*
- * Horrible hack to deal with certain constructors that must not add
- * information to the error trace.
- */
-
- return;
- }
-
if (mPtr->declaringObjectPtr != NULL) {
declarerPtr = mPtr->declaringObjectPtr;
kindName = "object";
@@ -1224,7 +1269,7 @@ DeleteProcedureMethodRecord(
if (pmPtr->deleteClientdataProc) {
pmPtr->deleteClientdataProc(pmPtr->clientData);
}
- ckfree((char *) pmPtr);
+ ckfree(pmPtr);
}
static void
@@ -1245,8 +1290,7 @@ CloneProcedureMethod(
ClientData *newClientData)
{
ProcedureMethod *pmPtr = clientData;
- ProcedureMethod *pm2Ptr = (ProcedureMethod *)
- ckalloc(sizeof(ProcedureMethod));
+ ProcedureMethod *pm2Ptr = ckalloc(sizeof(ProcedureMethod));
memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
pm2Ptr->refCount = 1;
@@ -1285,12 +1329,13 @@ TclOONewForwardInstanceMethod(
return NULL;
}
if (prefixLen < 1) {
- Tcl_AppendResult(interp, "method forward prefix must be non-empty",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method forward prefix must be non-empty", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
return NULL;
}
- fmPtr = (ForwardMethod *) ckalloc(sizeof(ForwardMethod));
+ fmPtr = ckalloc(sizeof(ForwardMethod));
fmPtr->prefixObj = prefixObj;
Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0);
@@ -1326,12 +1371,13 @@ TclOONewForwardMethod(
return NULL;
}
if (prefixLen < 1) {
- Tcl_AppendResult(interp, "method forward prefix must be non-empty",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method forward prefix must be non-empty", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
return NULL;
}
- fmPtr = (ForwardMethod *) ckalloc(sizeof(ForwardMethod));
+ fmPtr = ckalloc(sizeof(ForwardMethod));
fmPtr->prefixObj = prefixObj;
Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0);
@@ -1415,7 +1461,7 @@ DeleteForwardMethod(
ForwardMethod *fmPtr = clientData;
Tcl_DecrRefCount(fmPtr->prefixObj);
- ckfree((char *) fmPtr);
+ ckfree(fmPtr);
}
static int
@@ -1425,7 +1471,7 @@ CloneForwardMethod(
ClientData *newClientData)
{
ForwardMethod *fmPtr = clientData;
- ForwardMethod *fm2Ptr = (ForwardMethod *) ckalloc(sizeof(ForwardMethod));
+ ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod));
fm2Ptr->prefixObj = fmPtr->prefixObj;
fm2Ptr->fullyQualified = fmPtr->fullyQualified;
diff --git a/generic/tclOOStubInit.c b/generic/tclOOStubInit.c
index ed1c4cd..900ab22 100644
--- a/generic/tclOOStubInit.c
+++ b/generic/tclOOStubInit.c
@@ -1,6 +1,4 @@
/*
- * $Id: tclOOStubInit.c,v 1.12 2010/08/21 16:30:26 nijtmans Exp $
- *
* This file is (mostly) automatically generated from tclOO.decls.
* It is compiled and linked in with the tclOO package proper.
*/
diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c
index 5a8c743..55f2378 100644
--- a/generic/tclOOStubLib.c
+++ b/generic/tclOOStubLib.c
@@ -1,5 +1,4 @@
/*
- * $Id: tclOOStubLib.c,v 1.5 2010/01/25 20:26:18 nijtmans Exp $
* ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17
*/
@@ -54,8 +53,9 @@ TclOOInitializeStubs(
if (clientData == NULL) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Error loading ", packageName, " package; ",
- "package not present or incomplete", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error loading %s package; package not present or incomplete",
+ packageName));
return NULL;
} else {
const TclOOStubs * const stubsPtr = clientData;
@@ -77,9 +77,9 @@ TclOOInitializeStubs(
error:
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Error loading ", packageName, " package",
- " (requested version '", version, "', loaded version '",
- actualVersion, "'): ", errMsg, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error loading %s package"
+ " (requested version '%s', loaded version '%s'): %s",
+ packageName, version, actualVersion, errMsg));
return NULL;
}
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 0aed0c2..74cb29e 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -12,8 +12,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclObj.c,v 1.175 2010/09/27 19:42:38 msofer Exp $
*/
#include "tclInt.h"
@@ -55,9 +53,9 @@ char *tclEmptyStringRep = &tclEmptyString;
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
/*
- * Structure for tracking the source file and line number where a given Tcl_Obj
- * was allocated. We also track the pointer to the Tcl_Obj itself, for sanity
- * checking purposes.
+ * Structure for tracking the source file and line number where a given
+ * Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself,
+ * for sanity checking purposes.
*/
typedef struct ObjData {
@@ -81,7 +79,7 @@ typedef struct ObjData {
typedef struct ThreadSpecificData {
Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj
* generated by a call to the function
- * EvalTokensStandard() from a literal text
+ * TclSubstTokens() from a literal text
* where bs+nl sequences occured in it, if
* any. I.e. this table keeps track of
* invisible and stripped continuation lines.
@@ -164,6 +162,10 @@ typedef struct PendingObjData {
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
PendingObjData *const contextPtr = &pendingObjData
+#elif HAVE_FAST_TSD
+static __thread PendingObjData pendingObjData;
+#define ObjInitDeletionContext(contextPtr) \
+ PendingObjData *const contextPtr = &pendingObjData
#else
static Tcl_ThreadDataKey pendingObjDataKey;
#define ObjInitDeletionContext(contextPtr) \
@@ -460,12 +462,12 @@ TclFinalizeThreadObjects(void)
ObjData *objData = Tcl_GetHashValue(hPtr);
if (objData != NULL) {
- ckfree((char *) objData);
+ ckfree(objData);
}
}
Tcl_DeleteHashTable(tablePtr);
- ckfree((char *) tablePtr);
+ ckfree(tablePtr);
tsdPtr->objThreadMap = NULL;
}
#endif
@@ -541,7 +543,7 @@ TclGetContLineTable(void)
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->lineCLPtr) {
- tsdPtr->lineCLPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
}
@@ -576,8 +578,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 = ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
if (!newEntry) {
/*
@@ -816,7 +817,7 @@ TclThreadFinalizeContLines(
Tcl_DeleteHashEntry(hPtr);
}
Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
- ckfree((char *) tsdPtr->lineCLPtr);
+ ckfree(tsdPtr->lineCLPtr);
tsdPtr->lineCLPtr = NULL;
}
@@ -1106,8 +1107,7 @@ TclDbInitNewObj(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tsdPtr->objThreadMap == NULL) {
- tsdPtr->objThreadMap = (Tcl_HashTable *)
- ckalloc(sizeof(Tcl_HashTable));
+ tsdPtr->objThreadMap = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
}
tablePtr = tsdPtr->objThreadMap;
@@ -1120,7 +1120,7 @@ TclDbInitNewObj(
* Record the debugging information.
*/
- objData = (ObjData *) ckalloc(sizeof(ObjData));
+ objData = ckalloc(sizeof(ObjData));
objData->objPtr = objPtr;
objData->file = file;
objData->line = line;
@@ -1279,7 +1279,7 @@ TclAllocateFreeObjects(void)
* Purify apparently can't figure that out, and fires a false alarm.
*/
- basePtr = (char *) ckalloc(bytesToAlloc);
+ basePtr = ckalloc(bytesToAlloc);
prevPtr = NULL;
objPtr = (Tcl_Obj *) basePtr;
@@ -1330,7 +1330,7 @@ TclFreeObj(
ObjInitDeletionContext(context);
if (objPtr->refCount < -1) {
- Tcl_Panic("Reference count for %lx was negative", objPtr);
+ Tcl_Panic("Reference count for %p was negative", objPtr);
}
/*
@@ -1353,7 +1353,7 @@ TclFreeObj(
}
Tcl_MutexLock(&tclObjMutex);
- ckfree((char *) objPtr);
+ ckfree(objPtr);
Tcl_MutexUnlock(&tclObjMutex);
TclIncrObjsFreed();
ObjDeletionLock(context);
@@ -1365,7 +1365,7 @@ TclFreeObj(
TclFreeIntRep(objToFree);
Tcl_MutexLock(&tclObjMutex);
- ckfree((char *) objToFree);
+ ckfree(objToFree);
Tcl_MutexUnlock(&tclObjMutex);
TclIncrObjsFreed();
}
@@ -1486,7 +1486,7 @@ TclFreeObj(
}
}
}
-#endif
+#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
@@ -1512,7 +1512,6 @@ TclObjBeingDeleted(
{
return (objPtr->length == -1);
}
-
/*
*----------------------------------------------------------------------
@@ -1706,7 +1705,6 @@ Tcl_InvalidateStringRep(
{
TclInvalidateStringRep(objPtr);
}
-
/*
*----------------------------------------------------------------------
@@ -2267,6 +2265,8 @@ Tcl_GetDoubleFromObj(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"floating point value is Not a Number", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN",
+ NULL);
}
return TCL_ERROR;
}
@@ -2354,8 +2354,8 @@ UpdateStringOfDouble(
Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
len = strlen(buffer);
- objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
- strcpy(objPtr->bytes, buffer);
+ objPtr->bytes = ckalloc(len + 1);
+ memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->length = len;
}
@@ -2550,8 +2550,8 @@ UpdateStringOfInt(
len = TclFormatInt(buffer, objPtr->internalRep.longValue);
- objPtr->bytes = ckalloc((unsigned) len + 1);
- strcpy(objPtr->bytes, buffer);
+ objPtr->bytes = ckalloc(len + 1);
+ memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->length = len;
}
@@ -2763,12 +2763,9 @@ Tcl_GetLongFromObj(
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg;
-
- TclNewLiteralStringObj(msg, "expected integer but got \"");
- Tcl_AppendObjToObj(msg, objPtr);
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -2856,7 +2853,7 @@ UpdateStringOfWideInt(
sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
len = strlen(buffer);
- objPtr->bytes = ckalloc((unsigned) len + 1);
+ objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, len + 1);
objPtr->length = len;
}
@@ -3067,12 +3064,9 @@ Tcl_GetWideIntFromObj(
}
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg;
-
- TclNewLiteralStringObj(msg, "expected integer but got \"");
- Tcl_AppendObjToObj(msg, objPtr);
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3168,7 +3162,7 @@ FreeBignum(
UNPACK_BIGNUM(objPtr, toFree);
mp_clear(&toFree);
if ((long) objPtr->internalRep.ptrAndLongRep.value < 0) {
- ckfree((char *) objPtr->internalRep.ptrAndLongRep.ptr);
+ ckfree(objPtr->internalRep.ptrAndLongRep.ptr);
}
objPtr->typePtr = NULL;
}
@@ -3253,13 +3247,13 @@ UpdateStringOfBignum(
Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
}
- stringVal = ckalloc((size_t) size);
+ stringVal = ckalloc(size);
status = mp_toradix_n(&bignumVal, stringVal, 10, size);
if (status != MP_OKAY) {
Tcl_Panic("conversion failure in UpdateStringOfBignum");
}
objPtr->bytes = stringVal;
- objPtr->length = size - 1; /* size includes a trailing null byte */
+ objPtr->length = size - 1; /* size includes a trailing NUL byte. */
}
/*
@@ -3401,12 +3395,9 @@ GetBignumFromObj(
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg;
-
- TclNewLiteralStringObj(msg, "expected integer but got \"");
- Tcl_AppendObjToObj(msg, objPtr);
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3566,6 +3557,24 @@ Tcl_SetBignumObj(
TclSetBignumIntRep(objPtr, bignumValue);
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetBignumIntRep --
+ *
+ * Install a bignum into the internal representation of an object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Object internal representation is updated and object type is set. The
+ * bignum value is cleared, since ownership has transferred to the
+ * object.
+ *
+ *----------------------------------------------------------------------
+ */
+
void
TclSetBignumIntRep(
Tcl_Obj *objPtr,
@@ -3576,8 +3585,9 @@ TclSetBignumIntRep(
/*
* Clear the mp_int value.
- * Don't call mp_clear() because it would free the digit array
- * we just packed into the Tcl_Obj.
+ *
+ * Don't call mp_clear() because it would free the digit array we just
+ * packed into the Tcl_Obj.
*/
bignumValue->dp = NULL;
@@ -3590,9 +3600,17 @@ TclSetBignumIntRep(
*
* TclGetNumberFromObj --
*
+ * Extracts a number (of any possible numeric type) from an object.
+ *
* Results:
+ * Whether the extraction worked. The type is stored in the variable
+ * referred to by the typePtr argument, and a pointer to the
+ * representation is stored in the variable referred to by the
+ * clientDataPtr.
*
* Side effects:
+ * Can allocate thread-specific data for handling the copy-out space for
+ * bignums; this space is shared within a thread.
*
*----------------------------------------------------------------------
*/
@@ -3611,18 +3629,18 @@ TclGetNumberFromObj(
} else {
*typePtr = TCL_NUMBER_DOUBLE;
}
- *clientDataPtr = &(objPtr->internalRep.doubleValue);
+ *clientDataPtr = &objPtr->internalRep.doubleValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
*typePtr = TCL_NUMBER_LONG;
- *clientDataPtr = &(objPtr->internalRep.longValue);
+ *clientDataPtr = &objPtr->internalRep.longValue;
return TCL_OK;
}
#ifndef NO_WIDE_TYPE
if (objPtr->typePtr == &tclWideIntType) {
*typePtr = TCL_NUMBER_WIDE;
- *clientDataPtr = &(objPtr->internalRep.wideValue);
+ *clientDataPtr = &objPtr->internalRep.wideValue;
return TCL_OK;
}
#endif
@@ -3686,23 +3704,21 @@ Tcl_DbIncrRefCount(
*/
if (!TclInExit()) {
- Tcl_HashTable *tablePtr;
- Tcl_HashEntry *hPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
+ Tcl_HashEntry *hPtr;
- tablePtr = tsdPtr->objThreadMap;
if (!tablePtr) {
Tcl_Panic("object table not initialized");
}
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (!hPtr) {
- Tcl_Panic("%s%s",
- "Trying to incr ref count of "
- "Tcl_Obj allocated in another thread");
+ Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
+ "incr ref count");
}
}
-# endif
-#endif
+# endif /* TCL_THREADS */
+#endif /* TCL_MEM_DEBUG */
++(objPtr)->refCount;
}
@@ -3751,19 +3767,17 @@ Tcl_DbDecrRefCount(
*/
if (!TclInExit()) {
- Tcl_HashTable *tablePtr;
- Tcl_HashEntry *hPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
+ Tcl_HashEntry *hPtr;
- tablePtr = tsdPtr->objThreadMap;
if (!tablePtr) {
Tcl_Panic("object table not initialized");
}
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (!hPtr) {
- Tcl_Panic("%s%s",
- "Trying to decr ref count of "
- "Tcl_Obj allocated in another thread");
+ Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
+ "decr ref count");
}
/*
@@ -3774,14 +3788,15 @@ Tcl_DbDecrRefCount(
ObjData *objData = Tcl_GetHashValue(hPtr);
if (objData != NULL) {
- ckfree((char *) objData);
+ ckfree(objData);
}
Tcl_DeleteHashEntry(hPtr);
}
}
-# endif
-#endif
+# endif /* TCL_THREADS */
+#endif /* TCL_MEM_DEBUG */
+
if (--(objPtr)->refCount <= 0) {
TclFreeObj(objPtr);
}
@@ -3831,22 +3846,21 @@ Tcl_DbIsShared(
*/
if (!TclInExit()) {
- Tcl_HashTable *tablePtr;
- Tcl_HashEntry *hPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- tablePtr = tsdPtr->objThreadMap;
+ Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
+ Tcl_HashEntry *hPtr;
+
if (!tablePtr) {
Tcl_Panic("object table not initialized");
}
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (!hPtr) {
- Tcl_Panic("%s%s",
- "Trying to check shared status of"
- "Tcl_Obj allocated in another thread");
+ Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
+ "check shared status");
}
}
-# endif
-#endif
+# endif /* TCL_THREADS */
+#endif /* TCL_MEM_DEBUG */
#ifdef TCL_COMPILE_STATS
Tcl_MutexLock(&tclObjMutex);
@@ -3858,7 +3872,7 @@ Tcl_DbIsShared(
tclObjsShared[0]++;
}
Tcl_MutexUnlock(&tclObjMutex);
-#endif
+#endif /* TCL_COMPILE_STATS */
return ((objPtr)->refCount > 1);
}
@@ -3912,11 +3926,10 @@ AllocObjEntry(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key to store in the hash table entry. */
{
- Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
- Tcl_HashEntry *hPtr;
+ Tcl_Obj *objPtr = keyPtr;
+ Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry));
- hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)));
- hPtr->key.oneWordValue = (char *) objPtr;
+ hPtr->key.objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
hPtr->clientData = NULL;
@@ -4009,7 +4022,7 @@ TclFreeObjEntry(
Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
Tcl_DecrRefCount(objPtr);
- ckfree((char *) hPtr);
+ ckfree(hPtr);
}
/*
@@ -4204,7 +4217,7 @@ TclSetCmdNameObj(
}
cmdPtr->refCount++;
- resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
+ resPtr = ckalloc(sizeof(ResolvedCmdName));
resPtr->cmdPtr = cmdPtr;
resPtr->cmdEpoch = cmdPtr->cmdEpoch;
resPtr->refCount = 1;
@@ -4280,7 +4293,7 @@ FreeCmdNameInternalRep(
Command *cmdPtr = resPtr->cmdPtr;
TclCleanupCommandMacro(cmdPtr);
- ckfree((char *) resPtr);
+ ckfree(resPtr);
}
}
objPtr->typePtr = NULL;
@@ -4353,6 +4366,10 @@ SetCmdNameFromAny(
Namespace *currNsPtr;
register ResolvedCmdName *resPtr;
+ if (interp == NULL) {
+ return TCL_ERROR;
+ }
+
/*
* Find the Command structure, if any, that describes the command called
* "name". Build a ResolvedCmdName that holds a cached pointer to this
@@ -4373,7 +4390,7 @@ SetCmdNameFromAny(
if (cmdPtr) {
cmdPtr->refCount++;
- resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
+ resPtr = objPtr->internalRep.otherValuePtr;
if ((objPtr->typePtr == &tclCmdNameType)
&& resPtr && (resPtr->refCount == 1)) {
/*
@@ -4387,7 +4404,7 @@ SetCmdNameFromAny(
}
} else {
TclFreeIntRep(objPtr);
- resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
+ resPtr = ckalloc(sizeof(ResolvedCmdName));
resPtr->refCount = 1;
objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
@@ -4445,11 +4462,8 @@ Tcl_RepresentationCmd(
int objc,
Tcl_Obj *const objv[])
{
- char refcountBuffer[TCL_INTEGER_SPACE+1];
- char objPtrBuffer[TCL_INTEGER_SPACE+3];
- char internalRepBuffer[2*(TCL_INTEGER_SPACE+2)+2];
-#define TCLOBJ_TRUNCATE_STRINGREP 16
- char stringRepBuffer[TCLOBJ_TRUNCATE_STRINGREP+1];
+ char ptrBuffer[2*TCL_INTEGER_SPACE+6];
+ Tcl_Obj *descObj;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
@@ -4462,27 +4476,30 @@ Tcl_RepresentationCmd(
* "1872361827361287"
*/
- sprintf(refcountBuffer, "%d", objv[1]->refCount);
- sprintf(objPtrBuffer, "%p", (void *)objv[1]);
- Tcl_AppendResult(interp, "value is a ", objv[1]->typePtr ?
- objv[1]->typePtr->name : "pure string", " with a refcount of ",
- refcountBuffer, ", object pointer at ", objPtrBuffer, NULL);
+ sprintf(ptrBuffer, "%p", (void *) objv[1]);
+ descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d,"
+ " object pointer at %s",
+ objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
+ objv[1]->refCount, ptrBuffer);
+
if (objv[1]->typePtr) {
- sprintf(internalRepBuffer, "%p:%p",
- (void *)objv[1]->internalRep.twoPtrValue.ptr1,
- (void *)objv[1]->internalRep.twoPtrValue.ptr2);
- Tcl_AppendResult(interp, ", internal representation ",
- internalRepBuffer, NULL);
+ sprintf(ptrBuffer, "%p:%p",
+ (void *) objv[1]->internalRep.twoPtrValue.ptr1,
+ (void *) objv[1]->internalRep.twoPtrValue.ptr2);
+ Tcl_AppendPrintfToObj(descObj, ", internal representation %s",
+ ptrBuffer);
}
+
if (objv[1]->bytes) {
- strncpy(stringRepBuffer, objv[1]->bytes, TCLOBJ_TRUNCATE_STRINGREP);
- stringRepBuffer[TCLOBJ_TRUNCATE_STRINGREP] = 0;
- Tcl_AppendResult(interp, ", string representation \"",
- stringRepBuffer, objv[1]->length > TCLOBJ_TRUNCATE_STRINGREP ?
- "\"..." : "\".", NULL);
+ Tcl_AppendToObj(descObj, ", string representation \"", -1);
+ Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length,
+ 16, "...");
+ Tcl_AppendToObj(descObj, "\"", -1);
} else {
- Tcl_AppendResult(interp, ", no string representation.", NULL);
+ Tcl_AppendToObj(descObj, ", no string representation", -1);
}
+
+ Tcl_SetObjResult(interp, descObj);
return TCL_OK;
}
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index b3a5ed6..b87a8df 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -11,19 +11,23 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclPanic.c,v 1.14 2009/07/22 19:54:50 nijtmans Exp $
*/
#include "tclInt.h"
-#undef Tcl_Panic
+#if defined(_WIN32) || defined(__CYGWIN__)
+ MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
+#endif
/*
* The panicProc variable contains a pointer to an application specific panic
* procedure.
*/
+#if defined(__CYGWIN__)
+static Tcl_PanicProc *panicProc = tclWinDebugPanic;
+#else
static Tcl_PanicProc *panicProc = NULL;
+#endif
/*
*----------------------------------------------------------------------
@@ -45,6 +49,10 @@ void
Tcl_SetPanicProc(
Tcl_PanicProc *proc)
{
+#if defined(_WIN32)
+ /* tclWinDebugPanic only installs if there is no panicProc yet. */
+ if ((proc != tclWinDebugPanic) || (panicProc == NULL))
+#endif
panicProc = proc;
}
@@ -85,12 +93,31 @@ Tcl_PanicVA(
if (panicProc != NULL) {
panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
+#ifdef _WIN32
+ } else if (IsDebuggerPresent()) {
+ tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
+#endif
} else {
fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
arg8);
fprintf(stderr, "\n");
fflush(stderr);
+#if defined(_WIN32) || defined(__CYGWIN__)
+# if defined(__GNUC__)
+ __builtin_trap();
+# elif defined(_WIN64)
+ __debugbreak();
+# elif defined(_MSC_VER)
+ _asm {int 3}
+# else
+ DebugBreak();
+# endif
+#endif
+#if defined(_WIN32)
+ ExitProcess(1);
+#else
abort();
+#endif
}
}
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 0e55549..08615a7 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -11,10 +11,10 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
*/
-
+
#include "tclInt.h"
+#include "tclParse.h"
/*
* The following table provides parsing information about each possible 8-bit
@@ -42,18 +42,7 @@
* TYPE_BRACE - Character is a curly brace (either left or right).
*/
-#define TYPE_NORMAL 0
-#define TYPE_SPACE 0x1
-#define TYPE_COMMAND_END 0x2
-#define TYPE_SUBS 0x4
-#define TYPE_QUOTE 0x8
-#define TYPE_CLOSE_PAREN 0x10
-#define TYPE_CLOSE_BRACK 0x20
-#define TYPE_BRACE 0x40
-
-#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
-
-static const char charTypeTable[] = {
+const char tclCharTypeTable[] = {
/*
* Negative character values, from -128 to -1:
*/
@@ -269,7 +258,8 @@ Tcl_ParseCommand(
if ((start == NULL) && (numBytes != 0)) {
if (interp != NULL) {
- Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't parse a NULL pointer", -1));
}
return TCL_ERROR;
}
@@ -434,7 +424,7 @@ Tcl_ParseCommand(
}
if (isLiteral) {
- int elemCount = 0, code = TCL_OK, nakedbs = 0;
+ int elemCount = 0, code = TCL_OK, literal = 1;
const char *nextElem, *listEnd, *elemStart;
/*
@@ -456,33 +446,24 @@ Tcl_ParseCommand(
*/
while (nextElem < listEnd) {
- int size, brace;
+ int size;
code = TclFindElement(NULL, nextElem, listEnd - nextElem,
- &elemStart, &nextElem, &size, &brace);
- if (code != TCL_OK) {
+ &elemStart, &nextElem, &size, &literal);
+ if ((code != TCL_OK) || !literal) {
break;
}
- if (!brace) {
- const char *s;
-
- for(s=elemStart;size>0;s++,size--) {
- if ((*s)=='\\') {
- nakedbs = 1;
- break;
- }
- }
- }
if (elemStart < listEnd) {
elemCount++;
}
}
- if ((code != TCL_OK) || nakedbs) {
+ if ((code != TCL_OK) || !literal) {
/*
- * Some list element could not be parsed, or contained
- * naked backslashes. This means the literal string was
- * not in fact a valid nor canonical list. Defer the
+ * Some list element could not be parsed, or is not
+ * present as a literal substring of the script. The
+ * compiler cannot handle list elements that get generated
+ * by a call to TclCopyAndCollapse(). Defer the
* handling of this to compile/eval time, where code is
* already in place to report the "attempt to expand a
* non-list" error or expand lists that require
@@ -506,6 +487,7 @@ Tcl_ParseCommand(
* tokens representing the expanded list.
*/
+ const char *listStart;
int growthNeeded = wordIndex + 2*elemCount
- parsePtr->numTokens;
@@ -525,14 +507,12 @@ Tcl_ParseCommand(
* word value.
*/
- nextElem = tokenPtr[1].start;
- while (isspace(UCHAR(*nextElem))) {
- nextElem++;
- }
+ listStart = nextElem = tokenPtr[1].start;
while (nextElem < listEnd) {
+ int quoted;
+
tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
tokenPtr->numComponents = 1;
- tokenPtr->start = nextElem;
tokenPtr++;
tokenPtr->type = TCL_TOKEN_TEXT;
@@ -540,14 +520,13 @@ Tcl_ParseCommand(
TclFindElement(NULL, nextElem, listEnd - nextElem,
&(tokenPtr->start), &nextElem,
&(tokenPtr->size), NULL);
- if (tokenPtr->start + tokenPtr->size == listEnd) {
- tokenPtr[-1].size = listEnd - tokenPtr[-1].start;
- } else {
- tokenPtr[-1].size = tokenPtr->start
- + tokenPtr->size - tokenPtr[-1].start;
- tokenPtr[-1].size += (isspace(UCHAR(
- tokenPtr->start[tokenPtr->size])) == 0);
- }
+
+ quoted = (tokenPtr->start[-1] == '{'
+ || tokenPtr->start[-1] == '"')
+ && tokenPtr->start > listStart;
+ tokenPtr[-1].start = tokenPtr->start - quoted;
+ tokenPtr[-1].size = tokenPtr->start + tokenPtr->size
+ - tokenPtr[-1].start + quoted;
tokenPtr++;
}
@@ -590,14 +569,14 @@ Tcl_ParseCommand(
}
if (src[-1] == '"') {
if (interp != NULL) {
- Tcl_SetResult(interp, "extra characters after close-quote",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra characters after close-quote", -1));
}
parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
} else {
if (interp != NULL) {
- Tcl_SetResult(interp, "extra characters after close-brace",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra characters after close-brace", -1));
}
parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
}
@@ -617,6 +596,30 @@ Tcl_ParseCommand(
/*
*----------------------------------------------------------------------
*
+ * TclIsSpaceProc --
+ *
+ * Report whether byte is in the set of whitespace characters used by
+ * Tcl to separate words in scripts or elements in lists.
+ *
+ * Results:
+ * Returns 1, if byte is in the set, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclIsSpaceProc(
+ char byte)
+{
+ return CHAR_TYPE(byte) & (TYPE_SPACE) || byte == '\n';
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ParseWhiteSpace --
*
* Scans up to numBytes bytes starting at src, consuming white space
@@ -732,17 +735,17 @@ int
TclParseHex(
const char *src, /* First character to parse. */
int numBytes, /* Max number of byes to scan */
- Tcl_UniChar *resultPtr) /* Points to storage provided by caller where
- * the Tcl_UniChar resulting from the
+ int *resultPtr) /* Points to storage provided by caller where
+ * the character resulting from the
* conversion is to be written. */
{
- Tcl_UniChar result = 0;
+ int result = 0;
register const char *p = src;
while (numBytes--) {
unsigned char digit = UCHAR(*p);
- if (!isxdigit(digit)) {
+ if (!isxdigit(digit) || (result > 0x10fff)) {
break;
}
@@ -796,7 +799,8 @@ TclParseBackslash(
* written there. */
{
register const char *p = src+1;
- Tcl_UniChar result;
+ Tcl_UniChar unichar;
+ int result;
int count;
char buf[TCL_UTF_MAX];
@@ -853,7 +857,7 @@ TclParseBackslash(
result = 0xb;
break;
case 'x':
- count += TclParseHex(p+1, numBytes-1, &result);
+ count += TclParseHex(p+1, (numBytes > 3) ? 2 : numBytes-2, &result);
if (count == 2) {
/*
* No hexadigits -> This is just "x".
@@ -868,7 +872,7 @@ TclParseBackslash(
}
break;
case 'u':
- count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result);
+ count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-2, &result);
if (count == 2) {
/*
* No hexadigits -> This is just "u".
@@ -876,6 +880,15 @@ TclParseBackslash(
result = 'u';
}
break;
+ case 'U':
+ count += TclParseHex(p+1, (numBytes > 9) ? 8 : numBytes-2, &result);
+ if (count == 2) {
+ /*
+ * No hexadigits -> This is just "U".
+ */
+ result = 'U';
+ }
+ break;
case '\n':
count--;
do {
@@ -894,17 +907,17 @@ TclParseBackslash(
*/
if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
- result = UCHAR(*p - '0');
+ result = *p - '0';
p++;
if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */
|| (UCHAR(*p) >= '8')) {
break;
}
count = 3;
- result = UCHAR((result << 3) + (*p - '0'));
+ result = (result << 3) + (*p - '0');
p++;
if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */
- || (UCHAR(*p) >= '8')) {
+ || (UCHAR(*p) >= '8') || (result >= 0x20)) {
break;
}
count = 4;
@@ -920,14 +933,15 @@ TclParseBackslash(
*/
if (Tcl_UtfCharComplete(p, numBytes - 1)) {
- count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */
+ count = Tcl_UtfToUniChar(p, &unichar) + 1; /* +1 for '\' */
} else {
char utfBytes[TCL_UTF_MAX];
memcpy(utfBytes, p, (size_t) (numBytes - 1));
utfBytes[numBytes - 1] = '\0';
- count = Tcl_UtfToUniChar(utfBytes, &result) + 1;
+ count = Tcl_UtfToUniChar(utfBytes, &unichar) + 1;
}
+ result = unichar;
break;
}
@@ -935,7 +949,7 @@ TclParseBackslash(
if (readPtr != NULL) {
*readPtr = count;
}
- return Tcl_UniCharToUtf((int) result, dst);
+ return Tcl_UniCharToUtf(result, dst);
}
/*
@@ -1104,7 +1118,7 @@ ParseTokens(
}
/*
- * This is a variable reference. Call Tcl_ParseVarName to do all
+ * This is a variable reference. Call Tcl_ParseVarName to do all
* the dirty work of parsing the name.
*/
@@ -1128,7 +1142,7 @@ ParseTokens(
}
/*
- * Command substitution. Call Tcl_ParseCommand recursively (and
+ * Command substitution. Call Tcl_ParseCommand recursively (and
* repeatedly) to parse the nested command(s), then throw away the
* parse information.
*/
@@ -1162,8 +1176,8 @@ ParseTokens(
}
if (numBytes == 0) {
if (parsePtr->interp != NULL) {
- Tcl_SetResult(parsePtr->interp,
- "missing close-bracket", TCL_STATIC);
+ Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+ "missing close-bracket", -1));
}
parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
parsePtr->term = tokenPtr->start;
@@ -1281,7 +1295,7 @@ Tcl_FreeParse(
* call to Tcl_ParseCommand. */
{
if (parsePtr->tokenPtr != parsePtr->staticTokens) {
- ckfree((char *) parsePtr->tokenPtr);
+ ckfree(parsePtr->tokenPtr);
parsePtr->tokenPtr = parsePtr->staticTokens;
}
}
@@ -1398,8 +1412,8 @@ Tcl_ParseVarName(
}
if (numBytes == 0) {
if (parsePtr->interp != NULL) {
- Tcl_SetResult(parsePtr->interp,
- "missing close-brace for variable name", TCL_STATIC);
+ Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+ "missing close-brace for variable name", -1));
}
parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
parsePtr->term = tokenPtr->start-1;
@@ -1466,8 +1480,8 @@ Tcl_ParseVarName(
}
if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){
if (parsePtr->interp != NULL) {
- Tcl_SetResult(parsePtr->interp, "missing )",
- TCL_STATIC);
+ Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+ "missing )", -1));
}
parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
parsePtr->term = src;
@@ -1742,7 +1756,8 @@ Tcl_ParseBraces(
goto error;
}
- Tcl_SetResult(parsePtr->interp, "missing close-brace", TCL_STATIC);
+ Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+ "missing close-brace", -1));
/*
* Guess if the problem is due to comments by searching the source string
@@ -1763,9 +1778,9 @@ Tcl_ParseBraces(
openBrace = 0;
break;
case '#' :
- if (openBrace && isspace(UCHAR(src[-1]))) {
- Tcl_AppendResult(parsePtr->interp,
- ": possible unbalanced brace in comment", NULL);
+ if (openBrace && TclIsSpaceProc(src[-1])) {
+ Tcl_AppendToObj(Tcl_GetObjResult(parsePtr->interp),
+ ": possible unbalanced brace in comment", -1);
goto error;
}
break;
@@ -1844,7 +1859,8 @@ Tcl_ParseQuotedString(
}
if (*parsePtr->term != '"') {
if (parsePtr->interp != NULL) {
- Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
+ Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+ "missing \"", -1));
}
parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
parsePtr->term = start;
@@ -1876,10 +1892,10 @@ Tcl_ParseQuotedString(
* None.
*
* Side effects:
-
* The Tcl_Parse struct '*parsePtr' is filled with parse results.
* The caller is expected to eventually call Tcl_FreeParse() to properly
* cleanup the value written there.
+ *
* If a parse error occurs, the Tcl_InterpState value '*statePtr' is
* filled with the state created by that error. When *statePtr is written
* to, the caller is expected to make the required calls to either
@@ -2155,7 +2171,7 @@ TclSubstTokens(
if (isLiteral) {
maxNumCL = NUM_STATIC_POS;
- clPosition = (int *) ckalloc(maxNumCL * sizeof(int));
+ clPosition = ckalloc(maxNumCL * sizeof(int));
}
adjust = 0;
@@ -2173,8 +2189,8 @@ TclSubstTokens(
break;
case TCL_TOKEN_BS:
- appendByteLength = Tcl_UtfBackslash(tokenPtr->start, NULL,
- utfCharBytes);
+ appendByteLength = TclParseBackslash(tokenPtr->start,
+ tokenPtr->size, NULL, utfCharBytes);
append = utfCharBytes;
/*
@@ -2205,7 +2221,7 @@ TclSubstTokens(
if (numCL >= maxNumCL) {
maxNumCL *= 2;
- clPosition = (int *) ckrealloc((char *) clPosition,
+ clPosition = ckrealloc(clPosition,
maxNumCL * sizeof(int));
}
clPosition[numCL] = clPos;
@@ -2363,7 +2379,7 @@ TclSubstTokens(
*/
if (maxNumCL) {
- ckfree((char *) clPosition);
+ ckfree(clPosition);
}
} else {
Tcl_ResetResult(interp);
diff --git a/generic/tclParse.h b/generic/tclParse.h
new file mode 100644
index 0000000..20c609c
--- /dev/null
+++ b/generic/tclParse.h
@@ -0,0 +1,17 @@
+/*
+ * Minimal set of shared macro definitions and declarations so that multiple
+ * source files can make use of the parsing table in tclParse.c
+ */
+
+#define TYPE_NORMAL 0
+#define TYPE_SPACE 0x1
+#define TYPE_COMMAND_END 0x2
+#define TYPE_SUBS 0x4
+#define TYPE_QUOTE 0x8
+#define TYPE_CLOSE_PAREN 0x10
+#define TYPE_CLOSE_BRACK 0x20
+#define TYPE_BRACE 0x40
+
+#define CHAR_TYPE(c) (tclCharTypeTable+128)[(int)(c)]
+
+MODULE_SCOPE const char tclCharTypeTable[];
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index fd4651f..2b9ff87 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclPathObj.c,v 1.89 2010/09/22 00:57:11 hobbs Exp $
*/
#include "tclInt.h"
@@ -29,6 +27,8 @@ static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static int FindSplitPos(const char *path, int separator);
static int IsSeparatorOrNull(int ch);
static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr);
+static int MakePathFromNormalized(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr);
/*
* Define the 'path' object type, which Tcl uses to represent file paths
@@ -94,9 +94,7 @@ typedef struct FsPath {
* generated during the correct filesystem
* epoch. The epoch changes when
* filesystem-mounts are changed. */
- struct FilesystemRecord *fsRecPtr;
- /* Pointer to the filesystem record entry to
- * use for this path. */
+ const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */
} FsPath;
/*
@@ -154,14 +152,8 @@ typedef struct FsPath {
Tcl_Obj *
TclFSNormalizeAbsolutePath(
Tcl_Interp *interp, /* Interpreter to use */
- Tcl_Obj *pathPtr, /* Absolute path to normalize */
- ClientData *clientDataPtr) /* If non-NULL, then may be set to the
- * fs-specific clientData for this path. This
- * will happen when that extra information can
- * be calculated efficiently as a side-effect
- * of normalization. */
+ Tcl_Obj *pathPtr) /* Absolute path to normalize */
{
- ClientData clientData = NULL;
const char *dirSep, *oldDirSep;
int first = 1; /* Set to zero once we've passed the first
* directory separator - we can't use '..' to
@@ -271,6 +263,14 @@ TclFSNormalizeAbsolutePath(
}
if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
linkObj = Tcl_FSLink(retVal, NULL, 0);
+
+ /* Safety check in case driver caused sharing */
+ if (Tcl_IsShared(retVal)) {
+ TclDecrRefCount(retVal);
+ retVal = Tcl_DuplicateObj(retVal);
+ Tcl_IncrRefCount(retVal);
+ }
+
if (linkObj != NULL) {
/*
* Got a link. Need to check if the link is relative
@@ -295,11 +295,6 @@ TclFSNormalizeAbsolutePath(
break;
}
}
- if (Tcl_IsShared(retVal)) {
- TclDecrRefCount(retVal);
- retVal = Tcl_DuplicateObj(retVal);
- Tcl_IncrRefCount(retVal);
- }
/*
* We want the trailing slash.
@@ -315,7 +310,12 @@ TclFSNormalizeAbsolutePath(
*/
TclDecrRefCount(retVal);
- retVal = linkObj;
+ if (Tcl_IsShared(linkObj)) {
+ retVal = Tcl_DuplicateObj(linkObj);
+ TclDecrRefCount(linkObj);
+ } else {
+ retVal = linkObj;
+ }
linkStr = Tcl_GetStringFromObj(retVal, &curLen);
/*
@@ -427,17 +427,14 @@ TclFSNormalizeAbsolutePath(
* for normalizing a path.
*/
- TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData);
+ TclFSNormalizeToUniquePath(interp, retVal, 0);
/*
* Since we know it is a normalized path, we can actually convert this
* object into an FsPath for greater efficiency
*/
- TclFSMakePathFromNormalized(interp, retVal, clientData);
- if (clientDataPtr != NULL) {
- *clientDataPtr = clientData;
- }
+ MakePathFromNormalized(interp, retVal);
/*
* This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs.
@@ -569,8 +566,7 @@ TclPathPart(
if (pathPtr->typePtr == &tclFsPathType) {
FsPath *fsPathPtr = PATHOBJ(pathPtr);
- if (TclFSEpochOk(fsPathPtr->filesystemEpoch)
- && (PATHFLAGS(pathPtr) != 0)) {
+ if (PATHFLAGS(pathPtr) != 0) {
switch (portion) {
case TCL_PATH_DIRNAME: {
/*
@@ -832,44 +828,39 @@ Tcl_FSJoinPath(
* reference count. */
int elements) /* Number of elements to use (-1 = all) */
{
- Tcl_Obj *res;
- int i;
- const Tcl_Filesystem *fsPtr = NULL;
+ Tcl_Obj *copy, *res;
+ int objc;
+ Tcl_Obj **objv;
- if (elements < 0) {
- if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
- return NULL;
- }
- } else {
- /*
- * Just make sure it is a valid list.
- */
-
- int listTest;
-
- if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) {
- return NULL;
- }
+ if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) {
+ return NULL;
+ }
- /*
- * Correct this if it is too large, otherwise we will waste our time
- * joining null elements to the path.
- */
+ elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
+ copy = TclListObjCopy(NULL, listObj);
+ Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
+ res = TclJoinPath(elements, objv);
+ Tcl_DecrRefCount(copy);
+ return res;
+}
- if (elements > listTest) {
- elements = listTest;
- }
- }
+Tcl_Obj *
+TclJoinPath(
+ int elements,
+ Tcl_Obj * const objv[])
+{
+ Tcl_Obj *res;
+ int i;
+ const Tcl_Filesystem *fsPtr = NULL;
res = NULL;
for (i = 0; i < elements; i++) {
- Tcl_Obj *elt, *driveName = NULL;
int driveNameLength, strEltLen, length;
Tcl_PathType type;
char *strElt, *ptr;
-
- Tcl_ListObjIndex(NULL, listObj, i, &elt);
+ Tcl_Obj *driveName = NULL;
+ Tcl_Obj *elt = objv[i];
/*
* This is a special case where we can be much more efficient, where
@@ -883,9 +874,8 @@ Tcl_FSJoinPath(
if ((i == (elements-2)) && (i == 0)
&& (elt->typePtr == &tclFsPathType)
&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))) {
- Tcl_Obj *tailObj;
+ Tcl_Obj *tailObj = objv[i+1];
- Tcl_ListObjIndex(NULL, listObj, i+1, &tailObj);
type = TclGetPathType(tailObj, NULL, NULL, NULL);
if (type == TCL_PATH_RELATIVE) {
const char *str;
@@ -1077,11 +1067,17 @@ Tcl_FSJoinPath(
if (sep != NULL) {
separator = TclGetString(sep)[0];
}
+ /* Safety check in case the VFS driver caused sharing */
+ if (Tcl_IsShared(res)) {
+ TclDecrRefCount(res);
+ res = Tcl_DuplicateObj(res);
+ Tcl_IncrRefCount(res);
+ }
}
if (length > 0 && ptr[length -1] != '/') {
Tcl_AppendToObj(res, &separator, 1);
- length++;
+ Tcl_GetStringFromObj(res, &length);
}
Tcl_SetObjLength(res, length + (int) strlen(strElt));
@@ -1158,7 +1154,6 @@ Tcl_FSConvertToPathType(
UpdateStringOfFsPath(pathPtr);
}
FreeFsPathInternalRep(pathPtr);
- pathPtr->typePtr = NULL;
}
return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
@@ -1177,7 +1172,6 @@ Tcl_FSConvertToPathType(
* UpdateStringOfFsPath(pathPtr);
* }
* FreeFsPathInternalRep(pathPtr);
- * pathPtr->typePtr = NULL;
* return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
* }
* }
@@ -1270,7 +1264,6 @@ TclNewFSPathObj(
{
FsPath *fsPathPtr;
Tcl_Obj *pathPtr;
- ThreadSpecificData *tsdPtr;
const char *p;
int state = 0, count = 0;
@@ -1298,10 +1291,8 @@ TclNewFSPathObj(
return pathPtr;
}
- tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
pathPtr = Tcl_NewObj();
- fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+ fsPathPtr = ckalloc(sizeof(FsPath));
/*
* Set up the path.
@@ -1313,8 +1304,8 @@ TclNewFSPathObj(
fsPathPtr->cwdPtr = dirPtr;
Tcl_IncrRefCount(dirPtr);
fsPathPtr->nativePathPtr = NULL;
- fsPathPtr->fsRecPtr = NULL;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ fsPathPtr->fsPtr = NULL;
+ fsPathPtr->filesystemEpoch = 0;
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
@@ -1373,37 +1364,20 @@ AppendPath(
const char *bytes;
Tcl_Obj *copy = Tcl_DuplicateObj(head);
- bytes = Tcl_GetStringFromObj(copy, &numBytes);
-
/*
- * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the
- * Windows special case? Perhaps we should just check if cwd is a root
- * volume. We should never get numBytes == 0 in this code path.
+ * This is likely buggy when dealing with virtual filesystem drivers
+ * that use some character other than "/" as a path separator. I know
+ * of no evidence that such a foolish thing exists. This solution was
+ * chosen so that "JoinPath" operations that pass through either path
+ * intrep produce the same results; that is, bugward compatibility. If
+ * we need to fix that bug here, it needs fixing in TclJoinPath() too.
*/
-
- switch (tclPlatform) {
- case TCL_PLATFORM_UNIX:
- if (bytes[numBytes-1] != '/') {
- Tcl_AppendToObj(copy, "/", 1);
- }
- break;
-
- case TCL_PLATFORM_WINDOWS:
- /*
- * We need the extra 'numBytes != 2', and ':' checks because a volume
- * relative path doesn't get a '/'. For example 'glob C:*cat*.exe'
- * will return 'C:cat32.exe'
- */
-
- if (bytes[numBytes-1] != '/' && bytes[numBytes-1] != '\\') {
- if (numBytes!= 2 || bytes[1] != ':') {
- Tcl_AppendToObj(copy, "/", 1);
- }
- }
- break;
+ bytes = Tcl_GetStringFromObj(tail, &numBytes);
+ if (numBytes == 0) {
+ Tcl_AppendToObj(copy, "/", 1);
+ } else {
+ TclpNativeJoinPath(copy, bytes);
}
-
- Tcl_AppendObjToObj(copy, tail);
return copy;
}
@@ -1441,8 +1415,7 @@ TclFSMakePathRelative(
if (pathPtr->typePtr == &tclFsPathType) {
FsPath *fsPathPtr = PATHOBJ(pathPtr);
- if (PATHFLAGS(pathPtr) != 0
- && fsPathPtr->cwdPtr == cwdPtr) {
+ if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {
return fsPathPtr->normPathPtr;
}
}
@@ -1486,7 +1459,7 @@ TclFSMakePathRelative(
/*
*---------------------------------------------------------------------------
*
- * TclFSMakePathFromNormalized --
+ * MakePathFromNormalized --
*
* Like SetFsPathFromAny, but assumes the given object is an absolute
* normalized path. Only for internal use.
@@ -1500,15 +1473,12 @@ TclFSMakePathRelative(
*---------------------------------------------------------------------------
*/
-int
-TclFSMakePathFromNormalized(
+static int
+MakePathFromNormalized(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
- Tcl_Obj *pathPtr, /* The object to convert. */
- ClientData nativeRep) /* The native rep for the object, if known
- * else NULL. */
+ Tcl_Obj *pathPtr) /* The object to convert. */
{
FsPath *fsPathPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
if (pathPtr->typePtr == &tclFsPathType) {
return TCL_OK;
@@ -1522,9 +1492,10 @@ TclFSMakePathFromNormalized(
if (pathPtr->bytes == NULL) {
if (pathPtr->typePtr->updateStringProc == NULL) {
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "can't find object"
- "string representation", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't find object string representation", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF",
+ NULL);
}
return TCL_ERROR;
}
@@ -1533,7 +1504,7 @@ TclFSMakePathFromNormalized(
TclFreeIntRep(pathPtr);
}
- fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+ fsPathPtr = ckalloc(sizeof(FsPath));
/*
* It's a pure normalized absolute path.
@@ -1547,9 +1518,10 @@ TclFSMakePathFromNormalized(
fsPathPtr->normPathPtr = pathPtr;
fsPathPtr->cwdPtr = NULL;
- fsPathPtr->nativePathPtr = nativeRep;
- fsPathPtr->fsRecPtr = NULL;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ fsPathPtr->nativePathPtr = NULL;
+ fsPathPtr->fsPtr = NULL;
+ /* Remember the epoch under which we decided pathPtr was normalized */
+ fsPathPtr->filesystemEpoch = TclFSEpoch();
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
@@ -1588,14 +1560,13 @@ Tcl_FSNewNativePath(
const Tcl_Filesystem *fromFilesystem,
ClientData clientData)
{
- Tcl_Obj *pathPtr;
+ Tcl_Obj *pathPtr = NULL;
FsPath *fsPathPtr;
- FilesystemRecord *fsFromPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
- pathPtr = TclFSInternalToNormalized(fromFilesystem, clientData,
- &fsFromPtr);
+ if (fromFilesystem->internalToNormalizedProc != NULL) {
+ pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData);
+ }
if (pathPtr == NULL) {
return NULL;
}
@@ -1615,7 +1586,7 @@ Tcl_FSNewNativePath(
TclFreeIntRep(pathPtr);
}
- fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+ fsPathPtr = ckalloc(sizeof(FsPath));
fsPathPtr->translatedPathPtr = NULL;
@@ -1626,9 +1597,8 @@ Tcl_FSNewNativePath(
fsPathPtr->normPathPtr = pathPtr;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = clientData;
- fsPathPtr->fsRecPtr = fsFromPtr;
- fsPathPtr->fsRecPtr->fileRefCount++;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ fsPathPtr->fsPtr = fromFilesystem;
+ fsPathPtr->filesystemEpoch = TclFSEpoch();
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
@@ -1686,6 +1656,12 @@ Tcl_FSGetTranslatedPath(
retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
&srcFsPathPtr->normPathPtr);
srcFsPathPtr->translatedPathPtr = retObj;
+ if (translatedCwdPtr->typePtr == &tclFsPathType) {
+ srcFsPathPtr->filesystemEpoch
+ = PATHOBJ(translatedCwdPtr)->filesystemEpoch;
+ } else {
+ srcFsPathPtr->filesystemEpoch = 0;
+ }
Tcl_IncrRefCount(retObj);
Tcl_DecrRefCount(translatedCwdPtr);
} else {
@@ -1740,7 +1716,7 @@ Tcl_FSGetTranslatedStringPath(
if (transPtr != NULL) {
int len;
const char *orig = Tcl_GetStringFromObj(transPtr, &len);
- char *result = ckalloc((unsigned) len+1);
+ char *result = ckalloc(len+1);
memcpy(result, orig, (size_t) len+1);
TclDecrRefCount(transPtr);
@@ -1788,8 +1764,7 @@ Tcl_FSGetNormalizedPath(
*/
Tcl_Obj *dir, *copy;
- int cwdLen, pathType;
- ClientData clientData = NULL;
+ int tailLen, cwdLen, pathType;
pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
@@ -1801,7 +1776,12 @@ Tcl_FSGetNormalizedPath(
UpdateStringOfFsPath(pathPtr);
}
- copy = AppendPath(dir, fsPathPtr->normPathPtr);
+ Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
+ if (tailLen) {
+ copy = AppendPath(dir, fsPathPtr->normPathPtr);
+ } else {
+ copy = Tcl_DuplicateObj(dir);
+ }
Tcl_IncrRefCount(dir);
Tcl_IncrRefCount(copy);
@@ -1822,7 +1802,7 @@ Tcl_FSGetNormalizedPath(
* 2385549] ...
*/
- Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy, NULL);
+ Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy);
Tcl_DecrRefCount(copy);
copy = newCopy;
@@ -1837,8 +1817,7 @@ Tcl_FSGetNormalizedPath(
* will actually start off directly after that separator.
*/
- TclFSNormalizeToUniquePath(interp, copy, cwdLen-1,
- (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
+ TclFSNormalizeToUniquePath(interp, copy, cwdLen-1);
}
/* Now we need to construct the new path object. */
@@ -1881,15 +1860,6 @@ Tcl_FSGetNormalizedPath(
TclDecrRefCount(dir);
}
- if (clientData != NULL) {
- /*
- * This may be unnecessary. It appears that the
- * TclFSNormalizeToUniquePath call above should have already set
- * this up. Not changing out of fear of the unknown.
- */
-
- fsPathPtr->nativePathPtr = clientData;
- }
PATHFLAGS(pathPtr) = 0;
}
@@ -1903,7 +1873,6 @@ Tcl_FSGetNormalizedPath(
UpdateStringOfFsPath(pathPtr);
}
FreeFsPathInternalRep(pathPtr);
- pathPtr->typePtr = NULL;
if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) {
return NULL;
}
@@ -1911,7 +1880,6 @@ Tcl_FSGetNormalizedPath(
} else if (fsPathPtr->normPathPtr == NULL) {
int cwdLen;
Tcl_Obj *copy;
- ClientData clientData = NULL;
copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);
@@ -1923,17 +1891,12 @@ Tcl_FSGetNormalizedPath(
* of the previously normalized 'dir'. This should be much faster!
*/
- TclFSNormalizeToUniquePath(interp, copy, cwdLen-1,
- (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
+ TclFSNormalizeToUniquePath(interp, copy, cwdLen-1);
fsPathPtr->normPathPtr = copy;
Tcl_IncrRefCount(fsPathPtr->normPathPtr);
- if (clientData != NULL) {
- fsPathPtr->nativePathPtr = clientData;
- }
}
}
if (fsPathPtr->normPathPtr == NULL) {
- ClientData clientData = NULL;
Tcl_Obj *useThisCwd = NULL;
int pureNormalized = 1;
@@ -2015,12 +1978,7 @@ Tcl_FSGetNormalizedPath(
*/
fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp,
- absolutePath,
- (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
- if (0 && (clientData != NULL)) {
- fsPathPtr->nativePathPtr =
- fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc(clientData);
- }
+ absolutePath);
/*
* Check if path is pure normalized (this can only be the case if it
@@ -2111,7 +2069,7 @@ Tcl_FSGetInternalRep(
* not easily achievable with the current implementation.
*/
- if (srcFsPathPtr->fsRecPtr == NULL) {
+ if (srcFsPathPtr->fsPtr == NULL) {
/*
* This only usually happens in wrappers like TclpStat which create a
* string object and pass it to TclpObjStat. Code which calls the
@@ -2131,7 +2089,7 @@ Tcl_FSGetInternalRep(
*/
srcFsPathPtr = PATHOBJ(pathPtr);
- if (srcFsPathPtr->fsRecPtr == NULL) {
+ if (srcFsPathPtr->fsPtr == NULL) {
return NULL;
}
}
@@ -2143,7 +2101,7 @@ Tcl_FSGetInternalRep(
* for this is we ask what filesystem this path belongs to.
*/
- if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) {
+ if (fsPtr != srcFsPathPtr->fsPtr) {
const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr);
if (actualFs == fsPtr) {
@@ -2156,7 +2114,7 @@ Tcl_FSGetInternalRep(
Tcl_FSCreateInternalRepProc *proc;
char *nativePathPtr;
- proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc;
+ proc = srcFsPathPtr->fsPtr->createInternalRepProc;
if (proc == NULL) {
return NULL;
}
@@ -2214,7 +2172,6 @@ TclFSEnsureEpochOk(
UpdateStringOfFsPath(pathPtr);
}
FreeFsPathInternalRep(pathPtr);
- pathPtr->typePtr = NULL;
if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
return TCL_ERROR;
}
@@ -2225,8 +2182,8 @@ TclFSEnsureEpochOk(
* Check whether the object is already assigned to a fs.
*/
- if (srcFsPathPtr->fsRecPtr != NULL) {
- *fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr;
+ if (srcFsPathPtr->fsPtr != NULL) {
+ *fsPtrPtr = srcFsPathPtr->fsPtr;
}
return TCL_OK;
}
@@ -2250,10 +2207,9 @@ TclFSEnsureEpochOk(
void
TclFSSetPathDetails(
Tcl_Obj *pathPtr,
- FilesystemRecord *fsRecPtr,
+ const Tcl_Filesystem *fsPtr,
ClientData clientData)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
FsPath *srcFsPathPtr;
/*
@@ -2267,10 +2223,9 @@ TclFSSetPathDetails(
}
srcFsPathPtr = PATHOBJ(pathPtr);
- srcFsPathPtr->fsRecPtr = fsRecPtr;
+ srcFsPathPtr->fsPtr = fsPtr;
srcFsPathPtr->nativePathPtr = clientData;
- srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
- fsRecPtr->fileRefCount++;
+ srcFsPathPtr->filesystemEpoch = TclFSEpoch();
}
/*
@@ -2359,10 +2314,6 @@ SetFsPathFromAny(
FsPath *fsPathPtr;
Tcl_Obj *transPtr;
char *name;
-#if defined(__CYGWIN__) && defined(__WIN32__)
- int copied = 0;
-#endif
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
if (pathPtr->typePtr == &tclFsPathType) {
return TCL_OK;
@@ -2389,7 +2340,6 @@ SetFsPathFromAny(
*/
if (name[0] == '~') {
- char *expandedUser;
Tcl_DString temp;
int split;
char separator = '/';
@@ -2422,9 +2372,11 @@ SetFsPathFromAny(
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't find HOME environment "
- "variable to expand path", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't find HOME environment variable to"
+ " expand path", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
+ "HOMELESS", NULL);
}
return TCL_ERROR;
}
@@ -2439,9 +2391,10 @@ SetFsPathFromAny(
Tcl_DStringInit(&temp);
if (TclpGetUserHome(name+1, &temp) == NULL) {
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "user \"", name+1,
- "\" doesn't exist", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "user \"%s\" doesn't exist", name+1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
+ NULL);
}
Tcl_DStringFree(&temp);
if (split != len) {
@@ -2454,8 +2407,7 @@ SetFsPathFromAny(
}
}
- expandedUser = Tcl_DStringValue(&temp);
- transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));
+ transPtr = TclDStringToObj(&temp);
if (split != len) {
/*
@@ -2500,51 +2452,29 @@ SetFsPathFromAny(
transPtr = joined;
}
}
- Tcl_DStringFree(&temp);
} else {
- transPtr = Tcl_FSJoinToPath(pathPtr, 0, NULL);
+ transPtr = TclJoinPath(1, &pathPtr);
}
-#if defined(__CYGWIN__) && defined(__WIN32__)
- {
- char winbuf[MAX_PATH+1];
-
- /*
- * In the Cygwin world, call conv_to_win32_path in order to use the
- * mount table to translate the file name into something Windows will
- * understand. Take care when converting empty strings!
- */
-
- name = Tcl_GetStringFromObj(transPtr, &len);
- if (len > 0) {
- cygwin_conv_to_win32_path(name, winbuf);
- TclWinNoBackslash(winbuf);
- if (Tcl_IsShared(transPtr)) {
- copied = 1;
- transPtr = Tcl_DuplicateObj(transPtr);
- Tcl_IncrRefCount(transPtr);
- }
- Tcl_SetStringObj(transPtr, winbuf, -1);
- }
- }
-#endif /* __CYGWIN__ && __WIN32__ */
-
/*
* Now we have a translated filename in 'transPtr'. This will have forward
* slashes on Windows, and will not contain any ~user sequences.
*/
- fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+ fsPathPtr = ckalloc(sizeof(FsPath));
fsPathPtr->translatedPathPtr = transPtr;
if (transPtr != pathPtr) {
Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
+ /* Redo translation when $env(HOME) changes */
+ fsPathPtr->filesystemEpoch = TclFSEpoch();
+ } else {
+ fsPathPtr->filesystemEpoch = 0;
}
fsPathPtr->normPathPtr = NULL;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = NULL;
- fsPathPtr->fsRecPtr = NULL;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ fsPathPtr->fsPtr = NULL;
/*
* Free old representation before installing our new one.
@@ -2554,12 +2484,6 @@ SetFsPathFromAny(
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
pathPtr->typePtr = &tclFsPathType;
-#if defined(__CYGWIN__) && defined(__WIN32__)
- if (copied) {
- Tcl_DecrRefCount(transPtr);
- }
-#endif
-
return TCL_OK;
}
@@ -2583,27 +2507,17 @@ FreeFsPathInternalRep(
if (fsPathPtr->cwdPtr != NULL) {
TclDecrRefCount(fsPathPtr->cwdPtr);
}
- if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsRecPtr != NULL) {
+ if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) {
Tcl_FSFreeInternalRepProc *freeProc =
- fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc;
+ fsPathPtr->fsPtr->freeInternalRepProc;
if (freeProc != NULL) {
freeProc(fsPathPtr->nativePathPtr);
fsPathPtr->nativePathPtr = NULL;
}
}
- if (fsPathPtr->fsRecPtr != NULL) {
- fsPathPtr->fsRecPtr->fileRefCount--;
- if (fsPathPtr->fsRecPtr->fileRefCount <= 0) {
- /*
- * It has been unregistered already.
- */
-
- ckfree((char *) fsPathPtr->fsRecPtr);
- }
- }
- ckfree((char *) fsPathPtr);
+ ckfree(fsPathPtr);
pathPtr->typePtr = NULL;
}
@@ -2613,41 +2527,41 @@ DupFsPathInternalRep(
Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */
{
FsPath *srcFsPathPtr = PATHOBJ(srcPtr);
- FsPath *copyFsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+ FsPath *copyFsPathPtr = ckalloc(sizeof(FsPath));
SETPATHOBJ(copyPtr, copyFsPathPtr);
- if (srcFsPathPtr->translatedPathPtr != NULL) {
+ if (srcFsPathPtr->translatedPathPtr == srcPtr) {
+ /* Cycle in src -> make cycle in copy. */
+ copyFsPathPtr->translatedPathPtr = copyPtr;
+ } else {
copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
- if (copyFsPathPtr->translatedPathPtr != copyPtr) {
+ if (copyFsPathPtr->translatedPathPtr != NULL) {
Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
}
- } else {
- copyFsPathPtr->translatedPathPtr = NULL;
}
- if (srcFsPathPtr->normPathPtr != NULL) {
+ if (srcFsPathPtr->normPathPtr == srcPtr) {
+ /* Cycle in src -> make cycle in copy. */
+ copyFsPathPtr->normPathPtr = copyPtr;
+ } else {
copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
- if (copyFsPathPtr->normPathPtr != copyPtr) {
+ if (copyFsPathPtr->normPathPtr != NULL) {
Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
}
- } else {
- copyFsPathPtr->normPathPtr = NULL;
}
- if (srcFsPathPtr->cwdPtr != NULL) {
- copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
+ copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
+ if (copyFsPathPtr->cwdPtr != NULL) {
Tcl_IncrRefCount(copyFsPathPtr->cwdPtr);
- } else {
- copyFsPathPtr->cwdPtr = NULL;
}
copyFsPathPtr->flags = srcFsPathPtr->flags;
- if (srcFsPathPtr->fsRecPtr != NULL
+ if (srcFsPathPtr->fsPtr != NULL
&& srcFsPathPtr->nativePathPtr != NULL) {
Tcl_FSDupInternalRepProc *dupProc =
- srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
+ srcFsPathPtr->fsPtr->dupInternalRepProc;
if (dupProc != NULL) {
copyFsPathPtr->nativePathPtr =
@@ -2658,11 +2572,8 @@ DupFsPathInternalRep(
} else {
copyFsPathPtr->nativePathPtr = NULL;
}
- copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr;
+ copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr;
copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
- if (copyFsPathPtr->fsRecPtr != NULL) {
- copyFsPathPtr->fsRecPtr->fileRefCount++;
- }
copyPtr->typePtr = &tclFsPathType;
}
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index cbefbc1..83fb818 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclPipe.c,v 1.24 2010/06/14 12:58:13 nijtmans Exp $
*/
#include "tclInt.h"
@@ -108,9 +106,12 @@ FileForRedirect(
if (msg) {
Tcl_SetObjResult(interp, msg);
} else {
- Tcl_AppendResult(interp, "channel \"",
- Tcl_GetChannelName(chan), "\" wasn't opened for ",
- ((writing) ? "writing" : "reading"), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for %s",
+ Tcl_GetChannelName(chan),
+ ((writing) ? "writing" : "reading")));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "BADCHAN", NULL);
}
return NULL;
}
@@ -141,9 +142,10 @@ FileForRedirect(
file = TclpOpenFile(name, flags);
Tcl_DStringFree(&nameString);
if (file == NULL) {
- Tcl_AppendResult(interp, "couldn't ",
- ((writing) ? "write" : "read"), " file \"", spec, "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't %s file \"%s\": %s",
+ (writing ? "write" : "read"), spec,
+ Tcl_PosixError(interp)));
return NULL;
}
*closePtr = 1;
@@ -151,8 +153,9 @@ FileForRedirect(
return file;
badLastArg:
- Tcl_AppendResult(interp, "can't specify \"", arg,
- "\" as last word in command", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't specify \"%s\" as last word in command", arg));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "SYNTAX", NULL);
return NULL;
}
@@ -185,7 +188,7 @@ Tcl_DetachPids(
Tcl_MutexLock(&pipeMutex);
for (i = 0; i < numPids; i++) {
- detPtr = (Detached *) ckalloc(sizeof(Detached));
+ detPtr = ckalloc(sizeof(Detached));
detPtr->pid = pidPtr[i];
detPtr->nextPtr = detList;
detList = detPtr;
@@ -235,7 +238,7 @@ Tcl_ReapDetachedProcs(void)
} else {
prevPtr->nextPtr = detPtr->nextPtr;
}
- ckfree((char *) detPtr);
+ ckfree(detPtr);
detPtr = nextPtr;
}
Tcl_MutexUnlock(&pipeMutex);
@@ -283,7 +286,7 @@ TclCleanupChildren(
for (i = 0; i < numPids; i++) {
/*
* We need to get the resolved pid before we wait on it as the windows
- * implimentation of Tcl_WaitPid deletes the information such that any
+ * implementation of Tcl_WaitPid deletes the information such that any
* following calls to TclpGetPid fail.
*/
@@ -303,8 +306,8 @@ TclCleanupChildren(
msg =
"child process lost (is SIGCHLD ignored or trapped?)";
}
- Tcl_AppendResult(interp, "error waiting for process to exit: ",
- msg, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error waiting for process to exit: %s", msg));
}
continue;
}
@@ -334,16 +337,19 @@ TclCleanupChildren(
p = Tcl_SignalMsg(WTERMSIG(waitStatus));
Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
Tcl_SignalId(WTERMSIG(waitStatus)), p, NULL);
- Tcl_AppendResult(interp, "child killed: ", p, "\n", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "child killed: %s\n", p));
} else if (WIFSTOPPED(waitStatus)) {
p = Tcl_SignalMsg(WSTOPSIG(waitStatus));
Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
Tcl_SignalId(WSTOPSIG(waitStatus)), p, NULL);
- Tcl_AppendResult(interp, "child suspended: ", p, "\n",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "child suspended: %s\n", p));
} else {
- Tcl_AppendResult(interp,
- "child wait status didn't make sense\n", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "child wait status didn't make sense\n", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "ODDWAITRESULT", msg1, NULL);
}
}
}
@@ -371,8 +377,9 @@ TclCleanupChildren(
result = TCL_ERROR;
Tcl_DecrRefCount(objPtr);
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error reading stderr output file: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading stderr output file: %s",
+ Tcl_PosixError(interp)));
} else if (count > 0) {
anyErrorInfo = 1;
Tcl_SetObjResult(interp, objPtr);
@@ -390,7 +397,8 @@ TclCleanupChildren(
*/
if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) {
- Tcl_AppendResult(interp, "child process exited abnormally", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "child process exited abnormally", -1));
}
return result;
}
@@ -539,8 +547,10 @@ TclCreatePipeline(
}
if (*p == '\0') {
if ((i == (lastBar + 1)) || (i == (argc - 1))) {
- Tcl_SetResult(interp, "illegal use of | or |& in command",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal use of | or |& in command", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "PIPESYNTAX", NULL);
goto error;
}
}
@@ -565,8 +575,11 @@ TclCreatePipeline(
if (*inputLiteral == '\0') {
inputLiteral = ((i + 1) == argc) ? NULL : argv[i + 1];
if (inputLiteral == NULL) {
- Tcl_AppendResult(interp, "can't specify \"", argv[i],
- "\" as last word in command", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't specify \"%s\" as last word in command",
+ argv[i]));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "PIPESYNTAX", NULL);
goto error;
}
skip = 2;
@@ -673,8 +686,11 @@ TclCreatePipeline(
*/
if (i != argc-1) {
- Tcl_AppendResult(interp, "must specify \"", argv[i],
- "\" as last word in command", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "must specify \"%s\" as last word in command",
+ argv[i]));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "PIPESYNTAX", NULL);
goto error;
}
errorFile = outputFile;
@@ -713,8 +729,10 @@ TclCreatePipeline(
* We had a bar followed only by redirections.
*/
- Tcl_SetResult(interp, "illegal use of | or |& in command",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal use of | or |& in command", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX",
+ NULL);
goto error;
}
@@ -728,9 +746,9 @@ TclCreatePipeline(
inputFile = TclpCreateTempFile(inputLiteral);
if (inputFile == NULL) {
- Tcl_AppendResult(interp,
- "couldn't create input file for command: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create input file for command: %s",
+ Tcl_PosixError(interp)));
goto error;
}
inputClose = 1;
@@ -741,9 +759,9 @@ TclCreatePipeline(
*/
if (TclpCreatePipe(&inputFile, inPipePtr) == 0) {
- Tcl_AppendResult(interp,
- "couldn't create input pipe for command: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create input pipe for command: %s",
+ Tcl_PosixError(interp)));
goto error;
}
inputClose = 1;
@@ -770,9 +788,9 @@ TclCreatePipeline(
*/
if (TclpCreatePipe(outPipePtr, &outputFile) == 0) {
- Tcl_AppendResult(interp,
- "couldn't create output pipe for command: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create output pipe for command: %s",
+ Tcl_PosixError(interp)));
goto error;
}
outputClose = 1;
@@ -810,9 +828,9 @@ TclCreatePipeline(
errorFile = TclpCreateTempFile(NULL);
if (errorFile == NULL) {
- Tcl_AppendResult(interp,
- "couldn't create error file for command: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create error file for command: %s",
+ Tcl_PosixError(interp)));
goto error;
}
*errFilePtr = errorFile;
@@ -837,7 +855,7 @@ TclCreatePipeline(
*/
Tcl_ReapDetachedProcs();
- pidPtr = (Tcl_Pid *) ckalloc((unsigned) (cmdCount * sizeof(Tcl_Pid)));
+ pidPtr = ckalloc(cmdCount * sizeof(Tcl_Pid));
curInFile = inputFile;
@@ -883,8 +901,8 @@ TclCreatePipeline(
} else {
argv[lastArg] = NULL;
if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) {
- Tcl_AppendResult(interp, "couldn't create pipe: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create pipe: %s", Tcl_PosixError(interp)));
goto error;
}
}
@@ -990,7 +1008,7 @@ TclCreatePipeline(
Tcl_DetachPids(1, &pidPtr[i]);
}
}
- ckfree((char *) pidPtr);
+ ckfree(pidPtr);
}
numPids = -1;
goto cleanup;
@@ -1063,13 +1081,19 @@ Tcl_OpenCommandChannel(
if (flags & TCL_ENFORCE_MODE) {
if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
- Tcl_AppendResult(interp, "can't read output from command:"
- " standard output was redirected", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't read output from command:"
+ " standard output was redirected", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "BADREDIRECT", NULL);
goto error;
}
if ((flags & TCL_STDIN) && (inPipe == NULL)) {
- Tcl_AppendResult(interp, "can't write input to command:"
- " standard input was redirected", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't write input to command:"
+ " standard input was redirected", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "BADREDIRECT", NULL);
goto error;
}
}
@@ -1078,8 +1102,9 @@ Tcl_OpenCommandChannel(
numPids, pidPtr);
if (channel == NULL) {
- Tcl_AppendResult(interp, "pipe for command could not be created",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "pipe for command could not be created", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "NOPIPE", NULL);
goto error;
}
return channel;
@@ -1087,7 +1112,7 @@ Tcl_OpenCommandChannel(
error:
if (numPids > 0) {
Tcl_DetachPids(numPids, pidPtr);
- ckfree((char *) pidPtr);
+ ckfree(pidPtr);
}
if (inPipe != NULL) {
TclpCloseFile(inPipe);
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 82a683c..5b09ddb 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -10,8 +10,6 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclPkg.c,v 1.44 2010/08/31 20:48:17 nijtmans Exp $
- *
* TIP #268.
* Heavily rewritten to handle the extend version numbers, and extended
* package requirements.
@@ -156,8 +154,10 @@ Tcl_PkgProvideEx(
}
return TCL_OK;
}
- Tcl_AppendResult(interp, "conflicting versions provided for package \"",
- name, "\": ", pkgPtr->version, ", then ", version, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "conflicting versions provided for package \"%s\": %s, then %s",
+ name, pkgPtr->version, version));
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
return TCL_ERROR;
}
@@ -285,9 +285,10 @@ Tcl_PkgRequireEx(
*/
tclEmptyStringRep = &tclEmptyString;
- Tcl_AppendResult(interp, "Cannot load package \"", name,
- "\" in standalone executable: This package is not "
- "compiled with stub support", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Cannot load package \"%s\" in standalone executable:"
+ " This package is not compiled with stub support", name));
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNSTUBBED", NULL);
return NULL;
}
@@ -355,6 +356,10 @@ PkgRequireCore(
char *script, *pkgVersionI;
Tcl_DString command;
+ if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) {
+ return NULL;
+ }
+
/*
* It can take up to three passes to find the package: one pass to run the
* "package unknown" script, one to run the "package ifneeded" script for
@@ -374,10 +379,12 @@ PkgRequireCore(
*/
if (pkgPtr->clientData != NULL) {
- Tcl_AppendResult(interp, "circular package dependency: "
- "attempt to provide ", name, " ",
- (char *) pkgPtr->clientData, " requires ", name, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "circular package dependency:"
+ " attempt to provide %s %s requires %s",
+ name, (char *) pkgPtr->clientData, name));
AddRequirementsToResult(interp, reqc, reqv);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
return NULL;
}
@@ -424,7 +431,9 @@ PkgRequireCore(
}
}
- /* We have found a version which is better than our max. */
+ /*
+ * We have found a version which is better than our max.
+ */
if (reqc > 0) {
/* Check satisfaction of requirements. */
@@ -491,10 +500,12 @@ PkgRequireCore(
Tcl_ResetResult(interp);
if (pkgPtr->version == NULL) {
code = TCL_ERROR;
- Tcl_AppendResult(interp, "attempt to provide package ",
- name, " ", versionToProvide,
- " failed: no version of package ", name,
- " provided", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "attempt to provide package %s %s failed:"
+ " no version of package %s provided",
+ name, versionToProvide, name));
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
+ NULL);
} else {
char *pvi, *vi;
@@ -512,21 +523,24 @@ PkgRequireCore(
ckfree(vi);
if (res != 0) {
code = TCL_ERROR;
- Tcl_AppendResult(interp,
- "attempt to provide package ", name, " ",
- versionToProvide, " failed: package ",
- name, " ", pkgPtr->version,
- " provided instead", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "attempt to provide package %s %s failed:"
+ " package %s %s provided instead",
+ name, versionToProvide,
+ name, pkgPtr->version));
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
+ "WRONGPROVIDE", NULL);
}
}
}
} else if (code != TCL_ERROR) {
Tcl_Obj *codePtr = Tcl_NewIntObj(code);
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "attempt to provide package ", name,
- " ", versionToProvide, " failed: bad return code: ",
- TclGetString(codePtr), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "attempt to provide package %s %s failed:"
+ " bad return code: %s",
+ name, versionToProvide, TclGetString(codePtr)));
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
TclDecrRefCount(codePtr);
code = TCL_ERROR;
}
@@ -583,11 +597,9 @@ PkgRequireCore(
Tcl_DStringFree(&command);
if ((code != TCL_OK) && (code != TCL_ERROR)) {
- Tcl_Obj *codePtr = Tcl_NewIntObj(code);
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad return code: ",
- TclGetString(codePtr), NULL);
- Tcl_DecrRefCount(codePtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad return code: %d", code));
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
code = TCL_ERROR;
}
if (code == TCL_ERROR) {
@@ -600,7 +612,9 @@ PkgRequireCore(
}
if (pkgPtr->version == NULL) {
- Tcl_AppendResult(interp, "can't find package ", name, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't find package %s", name));
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
AddRequirementsToResult(interp, reqc, reqv);
return NULL;
}
@@ -610,27 +624,29 @@ PkgRequireCore(
* provided version meets the current requirements.
*/
- if (reqc == 0) {
- satisfies = 1;
- } else {
+ if (reqc != 0) {
CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL);
satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
ckfree(pkgVersionI);
- }
- if (satisfies) {
- if (clientDataPtr) {
- const void **ptr = (const void **) clientDataPtr;
- *ptr = pkgPtr->clientData;
+ if (!satisfies) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "version conflict for package \"%s\": have %s, need",
+ name, pkgPtr->version));
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
+ NULL);
+ AddRequirementsToResult(interp, reqc, reqv);
+ return NULL;
}
- return pkgPtr->version;
}
- Tcl_AppendResult(interp, "version conflict for package \"", name,
- "\": have ", pkgPtr->version, ", need", NULL);
- AddRequirementsToResult(interp, reqc, reqv);
- return NULL;
+ if (clientDataPtr) {
+ const void **ptr = (const void **) clientDataPtr;
+
+ *ptr = pkgPtr->clientData;
+ }
+ return pkgPtr->version;
}
/*
@@ -709,10 +725,11 @@ Tcl_PkgPresentEx(
}
if (version != NULL) {
- Tcl_AppendResult(interp, "package ", name, " ", version,
- " is not present", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "package %s %s is not present", name, version));
} else {
- Tcl_AppendResult(interp, "package ", name, " is not present", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "package %s is not present", name));
}
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, NULL);
return NULL;
@@ -793,9 +810,9 @@ Tcl_PackageObjCmd(
pkgPtr->availPtr = availPtr->nextPtr;
Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
- ckfree((char *) availPtr);
+ ckfree(availPtr);
}
- ckfree((char *) pkgPtr);
+ ckfree(pkgPtr);
}
break;
}
@@ -838,7 +855,8 @@ Tcl_PackageObjCmd(
if (res == 0){
if (objc == 4) {
ckfree(argv3i);
- Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(availPtr->script, -1));
return TCL_OK;
}
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
@@ -851,7 +869,7 @@ Tcl_PackageObjCmd(
return TCL_OK;
}
if (availPtr == NULL) {
- availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
+ availPtr = ckalloc(sizeof(PkgAvail));
DupBlock(availPtr->version, argv3, (unsigned) length + 1);
if (prevPtr == NULL) {
@@ -870,18 +888,25 @@ Tcl_PackageObjCmd(
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
- }
- tablePtr = &iPtr->packageTable;
- for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&search)) {
- pkgPtr = Tcl_GetHashValue(hPtr);
- if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
+ } else {
+ Tcl_Obj *resultObj;
+
+ resultObj = Tcl_NewObj();
+ tablePtr = &iPtr->packageTable;
+ for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ pkgPtr = Tcl_GetHashValue(hPtr);
+ if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
+ Tcl_ListObjAppendElement(NULL,resultObj, Tcl_NewStringObj(
+ Tcl_GetHashKey(tablePtr, hPtr), -1));
+ }
}
+ Tcl_SetObjResult(interp, resultObj);
}
break;
case PKG_PRESENT: {
const char *name;
+
if (objc < 3) {
goto require;
}
@@ -936,7 +961,8 @@ Tcl_PackageObjCmd(
if (hPtr != NULL) {
pkgPtr = Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
- Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(pkgPtr->version, -1));
}
}
return TCL_OK;
@@ -998,7 +1024,8 @@ Tcl_PackageObjCmd(
if (objc == 2) {
if (iPtr->packageUnknown != NULL) {
- Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(iPtr->packageUnknown, -1));
}
} else if (objc == 3) {
if (iPtr->packageUnknown != NULL) {
@@ -1086,23 +1113,27 @@ Tcl_PackageObjCmd(
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "package");
return TCL_ERROR;
- }
- argv2 = TclGetString(objv[2]);
- hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
- if (hPtr != NULL) {
- pkgPtr = Tcl_GetHashValue(hPtr);
- for (availPtr = pkgPtr->availPtr; availPtr != NULL;
- availPtr = availPtr->nextPtr) {
- Tcl_AppendElement(interp, availPtr->version);
+ } else {
+ Tcl_Obj *resultObj = Tcl_NewObj();
+
+ argv2 = TclGetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
+ if (hPtr != NULL) {
+ pkgPtr = Tcl_GetHashValue(hPtr);
+ for (availPtr = pkgPtr->availPtr; availPtr != NULL;
+ availPtr = availPtr->nextPtr) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(availPtr->version, -1));
+ }
}
+ Tcl_SetObjResult(interp, resultObj);
}
break;
case PKG_VSATISFIES: {
char *argv2i = NULL;
if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "version ?requirement ...?");
+ Tcl_WrongNumArgs(interp, 2, objv, "version ?requirement ...?");
return TCL_ERROR;
}
@@ -1156,7 +1187,7 @@ FindPackage(
hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew);
if (isNew) {
- pkgPtr = (Package *) ckalloc(sizeof(Package));
+ pkgPtr = ckalloc(sizeof(Package));
pkgPtr->version = NULL;
pkgPtr->availPtr = NULL;
pkgPtr->clientData = NULL;
@@ -1204,9 +1235,9 @@ TclFreePackageInfo(
pkgPtr->availPtr = availPtr->nextPtr;
Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
- ckfree((char *) availPtr);
+ ckfree(availPtr);
}
- ckfree((char *) pkgPtr);
+ ckfree(pkgPtr);
}
Tcl_DeleteHashTable(&iPtr->packageTable);
if (iPtr->packageUnknown != NULL) {
@@ -1328,8 +1359,9 @@ CheckVersionAndConvert(
error:
ckfree(ibuf);
- Tcl_AppendResult(interp, "expected version number but got \"", string,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected version number but got \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
return TCL_ERROR;
}
@@ -1590,8 +1622,9 @@ CheckRequirement(
* More dashes found after the first. This is wrong.
*/
- Tcl_AppendResult(interp, "expected versionMin-versionMax but got \"",
- string, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected versionMin-versionMax but got \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", NULL);
return TCL_ERROR;
}
@@ -1642,19 +1675,17 @@ AddRequirementsToResult(
Tcl_Obj *const reqv[]) /* 0 means to use the latest version
* available. */
{
- if (reqc > 0) {
- int i;
+ Tcl_Obj *result = Tcl_GetObjResult(interp);
+ int i, length;
- for (i = 0; i < reqc; i++) {
- int length;
- const char *v = Tcl_GetStringFromObj(reqv[i], &length);
+ for (i = 0; i < reqc; i++) {
+ const char *v = Tcl_GetStringFromObj(reqv[i], &length);
- if ((length & 0x1) && (v[length/2] == '-')
- && (strncmp(v, v+((length+1)/2), length/2) == 0)) {
- Tcl_AppendResult(interp, " exactly ", v+((length+1)/2), NULL);
- } else {
- Tcl_AppendResult(interp, " ", v, NULL);
- }
+ if ((length & 0x1) && (v[length/2] == '-')
+ && (strncmp(v, v+((length+1)/2), length/2) == 0)) {
+ Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2));
+ } else {
+ Tcl_AppendPrintfToObj(result, " %s", v);
}
}
}
@@ -1683,15 +1714,15 @@ AddRequirementsToDString(
Tcl_Obj *const reqv[]) /* 0 means to use the latest version
* available. */
{
- if (reqc > 0) {
- int i;
+ int i;
+ if (reqc > 0) {
for (i = 0; i < reqc; i++) {
- Tcl_DStringAppend(dsPtr, " ", 1);
- Tcl_DStringAppend(dsPtr, TclGetString(reqv[i]), -1);
+ TclDStringAppendLiteral(dsPtr, " ");
+ TclDStringAppendObj(dsPtr, reqv[i]);
}
} else {
- Tcl_DStringAppend(dsPtr, " 0-", -1);
+ TclDStringAppendLiteral(dsPtr, " 0-");
}
}
diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c
index abc66ad..466d535 100644
--- a/generic/tclPkgConfig.c
+++ b/generic/tclPkgConfig.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclPkgConfig.c,v 1.6 2010/02/24 10:32:17 dkf Exp $
*/
/* Note, the definitions in this module are influenced by the following C
@@ -24,7 +22,7 @@
* - TCL_COMPILE_STATS OSCMa bytecode compiler statistics.
*
* - TCL_CFG_DO64BIT NSCMdt tcl is compiled for a 64bit system.
- * - TCL_CFG_DEBUG NSCMdt tcl is compiled with symbol info on.
+ * - NDEBUG NSCMdt tcl is compiled with symbol info off.
* - TCL_CFG_OPTIMIZED NSCMdt tcl is compiled with cc optimizations on
* - TCL_CFG_PROFILED NSCMdt tcl is compiled with profiling info.
*
@@ -72,7 +70,7 @@
# define CFG_64 "0"
#endif
-#ifdef TCL_CFG_DEBUG
+#ifndef NDEBUG
# define CFG_DEBUG "1"
#else
# define CFG_DEBUG "0"
diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h
index 2ca31d5..e9b92fe 100644
--- a/generic/tclPlatDecls.h
+++ b/generic/tclPlatDecls.h
@@ -5,8 +5,6 @@
*
* Copyright (c) 1998-1999 by Scriptics Corporation.
* All rights reserved.
- *
- * RCS: @(#) $Id: tclPlatDecls.h,v 1.40 2010/08/19 04:26:03 nijtmans Exp $
*/
#ifndef _TCLPLATDECLS
@@ -33,7 +31,7 @@
* TCHAR is needed here for win32, so if it is not defined yet do it here.
* This way, we don't need to include <tchar.h> just for one define.
*/
-#if defined(_WIN32) && !defined(_TCHAR_DEFINED)
+#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(_TCHAR_DEFINED)
# if defined(_UNICODE)
typedef wchar_t TCHAR;
# else
@@ -48,7 +46,7 @@
* Exported function declarations:
*/
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len,
Tcl_DString *dsPtr);
@@ -71,9 +69,9 @@ EXTERN int Tcl_MacOSXOpenVersionedBundleResources(
typedef struct TclPlatStubs {
int magic;
- const struct TclPlatStubHooks *hooks;
+ void *hooks;
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
#endif /* WIN */
@@ -97,7 +95,7 @@ extern const TclPlatStubs *tclPlatStubsPtr;
* Inline function declarations:
*/
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#define Tcl_WinUtfToTChar \
(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
diff --git a/generic/tclPort.h b/generic/tclPort.h
index e9d6046..7021b8d 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclPort.h,v 1.18 2010/01/22 13:02:50 nijtmans Exp $
*/
#ifndef _TCLPORT
@@ -27,16 +25,6 @@
# include "tclUnixPort.h"
#endif
-#if defined(__CYGWIN__)
-# define USE_PUTENV 1
-# define USE_PUTENV_FOR_UNSET 1
-/* On Cygwin, the environment is imported from the Cygwin DLL. */
- DLLIMPORT extern char **__cygwin_environ;
- DLLIMPORT extern int cygwin_conv_to_win32_path(const char *, char *);
-# define environ __cygwin_environ
-# define timezone _timezone
-#endif
-
#if !defined(LLONG_MIN)
# ifdef TCL_WIDE_INT_IS_LONG
# define LLONG_MIN LONG_MIN
diff --git a/generic/tclPosixStr.c b/generic/tclPosixStr.c
index a507650..411eb27 100644
--- a/generic/tclPosixStr.c
+++ b/generic/tclPosixStr.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclPosixStr.c,v 1.17 2010/06/28 08:50:12 nijtmans Exp $
*/
#include "tclInt.h"
@@ -37,7 +35,7 @@ const char *
Tcl_ErrnoId(void)
{
switch (errno) {
-#ifdef E2BIG
+#if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW))
case E2BIG: return "E2BIG";
#endif
#ifdef EACCES
@@ -205,7 +203,7 @@ Tcl_ErrnoId(void)
#ifdef ELIBEXEC
case ELIBEXEC: return "ELIBEXEC";
#endif
-#ifdef ELIBMAX
+#if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED))
case ELIBMAX: return "ELIBMAX";
#endif
#ifdef ELIBSCN
@@ -496,7 +494,7 @@ Tcl_ErrnoMsg(
int err) /* Error number (such as in errno variable). */
{
switch (err) {
-#ifdef E2BIG
+#if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW))
case E2BIG: return "argument list too long";
#endif
#ifdef EACCES
@@ -664,7 +662,7 @@ Tcl_ErrnoMsg(
#ifdef ELIBEXEC
case ELIBEXEC: return "cannot exec a shared library directly";
#endif
-#ifdef ELIBMAX
+#if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED))
case ELIBMAX: return
"attempting to link in more shared libraries than system limit";
#endif
diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c
index f90e4bc..0bd8f93 100644
--- a/generic/tclPreserve.c
+++ b/generic/tclPreserve.c
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclPreserve.c,v 1.12 2009/01/09 11:21:46 dkf Exp $
*/
#include "tclInt.h"
@@ -91,7 +89,7 @@ TclFinalizePreserve(void)
{
Tcl_MutexLock(&preserveMutex);
if (spaceAvl != 0) {
- ckfree((char *) refArray);
+ ckfree(refArray);
refArray = NULL;
inUse = 0;
spaceAvl = 0;
@@ -146,8 +144,7 @@ Tcl_Preserve(
if (inUse == spaceAvl) {
spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE;
- refArray = (Reference *) ckrealloc((char *) refArray,
- spaceAvl * sizeof(Reference));
+ refArray = ckrealloc(refArray, spaceAvl * sizeof(Reference));
}
/*
@@ -227,9 +224,9 @@ Tcl_Release(
Tcl_MutexUnlock(&preserveMutex);
if (mustFree) {
if (freeProc == TCL_DYNAMIC) {
- ckfree((char *) clientData);
+ ckfree(clientData);
} else {
- freeProc((char *) clientData);
+ freeProc(clientData);
}
}
return;
@@ -240,7 +237,7 @@ Tcl_Release(
* Reference not found. This is a bug in the caller.
*/
- Tcl_Panic("Tcl_Release couldn't find reference for 0x%x", clientData);
+ Tcl_Panic("Tcl_Release couldn't find reference for %p", clientData);
}
/*
@@ -280,7 +277,7 @@ Tcl_EventuallyFree(
continue;
}
if (refPtr->mustFree) {
- Tcl_Panic("Tcl_EventuallyFree called twice for 0x%x", clientData);
+ Tcl_Panic("Tcl_EventuallyFree called twice for %p", clientData);
}
refPtr->mustFree = 1;
refPtr->freeProc = freeProc;
@@ -294,9 +291,9 @@ Tcl_EventuallyFree(
*/
if (freeProc == TCL_DYNAMIC) {
- ckfree((char *) clientData);
+ ckfree(clientData);
} else {
- freeProc((char *)clientData);
+ freeProc(clientData);
}
}
@@ -330,9 +327,8 @@ TclHandleCreate(
* be tracked for deletion. Must not be
* NULL. */
{
- HandleStruct *handlePtr;
+ HandleStruct *handlePtr = ckalloc(sizeof(HandleStruct));
- handlePtr = (HandleStruct *) ckalloc(sizeof(HandleStruct));
handlePtr->ptr = ptr;
#ifdef TCL_MEM_DEBUG
handlePtr->ptr2 = ptr;
@@ -372,16 +368,16 @@ TclHandleFree(
handlePtr = (HandleStruct *) handle;
#ifdef TCL_MEM_DEBUG
if (handlePtr->refCount == 0x61616161) {
- Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
+ Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
}
if (handlePtr->ptr2 != handlePtr->ptr) {
- Tcl_Panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
+ Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
handlePtr, handlePtr->ptr2, handlePtr->ptr);
}
#endif
handlePtr->ptr = NULL;
if (handlePtr->refCount == 0) {
- ckfree((char *) handlePtr);
+ ckfree(handlePtr);
}
}
@@ -415,10 +411,10 @@ TclHandlePreserve(
handlePtr = (HandleStruct *) handle;
#ifdef TCL_MEM_DEBUG
if (handlePtr->refCount == 0x61616161) {
- Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
+ Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
}
if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
- Tcl_Panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
+ Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
handlePtr, handlePtr->ptr2, handlePtr->ptr);
}
#endif
@@ -456,16 +452,16 @@ TclHandleRelease(
handlePtr = (HandleStruct *) handle;
#ifdef TCL_MEM_DEBUG
if (handlePtr->refCount == 0x61616161) {
- Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
+ Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
}
if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
- Tcl_Panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
+ Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
handlePtr, handlePtr->ptr2, handlePtr->ptr);
}
#endif
handlePtr->refCount--;
if ((handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
- ckfree((char *) handlePtr);
+ ckfree(handlePtr);
}
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 315af88..933e7d2 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -11,8 +11,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclProc.c,v 1.182 2010/09/27 19:42:38 msofer Exp $
*/
#include "tclInt.h"
@@ -154,20 +152,25 @@ Tcl_ProcObjCmd(
&nsPtr, &altNsPtr, &cxtNsPtr, &procName);
if (nsPtr == NULL) {
- Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": unknown namespace", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\": unknown namespace",
+ fullName));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
return TCL_ERROR;
}
if (procName == NULL) {
- Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": bad procedure name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\": bad procedure name",
+ fullName));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
return TCL_ERROR;
}
if ((nsPtr != iPtr->globalNsPtr)
&& (procName != NULL) && (procName[0] == ':')) {
- Tcl_AppendResult(interp, "can't create procedure \"", procName,
- "\" in non-global namespace with name starting with \":\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\" in non-global namespace with"
+ " name starting with \":\"", procName));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
return TCL_ERROR;
}
@@ -193,7 +196,7 @@ Tcl_ProcObjCmd(
Tcl_DStringInit(&ds);
if (nsPtr != iPtr->globalNsPtr) {
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
- Tcl_DStringAppend(&ds, "::", 2);
+ TclDStringAppendLiteral(&ds, "::");
}
Tcl_DStringAppend(&ds, procName, -1);
@@ -255,11 +258,11 @@ Tcl_ProcObjCmd(
&& (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
int isNew;
Tcl_HashEntry *hePtr;
- CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
+ CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
- cfPtr->line = (int *) ckalloc(sizeof(int));
+ cfPtr->line = ckalloc(sizeof(int));
cfPtr->line[0] = contextPtr->line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
@@ -287,9 +290,9 @@ Tcl_ProcObjCmd(
Tcl_DecrRefCount(cfOldPtr->data.eval.path);
cfOldPtr->data.eval.path = NULL;
}
- ckfree((char *) cfOldPtr->line);
+ ckfree(cfOldPtr->line);
cfOldPtr->line = NULL;
- ckfree((char *) cfOldPtr);
+ ckfree(cfOldPtr);
}
Tcl_SetHashValue(hePtr, cfPtr);
}
@@ -332,7 +335,9 @@ Tcl_ProcObjCmd(
}
if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) {
- procArgs += 4;
+ int numBytes;
+
+ procArgs +=4;
while (*procArgs != '\0') {
if (*procArgs != ' ') {
goto done;
@@ -344,12 +349,9 @@ Tcl_ProcObjCmd(
* The argument list is just "args"; check the body
*/
- procBody = TclGetString(objv[3]);
- while (*procBody != '\0') {
- if (!isspace(UCHAR(*procBody))) {
- goto done;
- }
- procBody++;
+ procBody = Tcl_GetStringFromObj(objv[3], &numBytes);
+ if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) {
+ goto done;
}
/*
@@ -462,7 +464,7 @@ TclCreateProc(
Tcl_IncrRefCount(bodyPtr);
- procPtr = (Proc *) ckalloc(sizeof(Proc));
+ procPtr = ckalloc(sizeof(Proc));
procPtr->iPtr = iPtr;
procPtr->refCount = 1;
procPtr->bodyPtr = bodyPtr;
@@ -493,6 +495,8 @@ TclCreateProc(
"procedure \"%s\": arg list contains %d entries, "
"precompiled header expects %d", procName, numArgs,
procPtr->numArgs));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "BYTECODELIES", NULL);
goto procError;
}
localPtr = procPtr->firstLocalPtr;
@@ -515,15 +519,20 @@ TclCreateProc(
goto procError;
}
if (fieldCount > 2) {
- ckfree((char *) fieldValues);
- Tcl_AppendResult(interp,
- "too many fields in argument specifier \"",
- argArray[i], "\"", NULL);
+ ckfree(fieldValues);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "too many fields in argument specifier \"%s\"",
+ argArray[i]));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "FORMALARGUMENTFORMAT", NULL);
goto procError;
}
if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
- ckfree((char *) fieldValues);
- Tcl_AppendResult(interp, "argument with no name", NULL);
+ ckfree(fieldValues);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "argument with no name", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "FORMALARGUMENTFORMAT", NULL);
goto procError;
}
@@ -547,17 +556,21 @@ TclCreateProc(
} while (*q != '\0');
q--;
if (*q == ')') { /* We have an array element. */
- Tcl_AppendResult(interp, "formal parameter \"",
- fieldValues[0],
- "\" is an array element", NULL);
- ckfree((char *) fieldValues);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "formal parameter \"%s\" is an array element",
+ fieldValues[0]));
+ ckfree(fieldValues);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "FORMALARGUMENTFORMAT", NULL);
goto procError;
}
} else if ((*p == ':') && (*(p+1) == ':')) {
- Tcl_AppendResult(interp, "formal parameter \"",
- fieldValues[0],
- "\" is not a simple name", NULL);
- ckfree((char *) fieldValues);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "formal parameter \"%s\" is not a simple name",
+ fieldValues[0]));
+ ckfree(fieldValues);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "FORMALARGUMENTFORMAT", NULL);
goto procError;
}
p++;
@@ -584,7 +597,9 @@ TclCreateProc(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": formal parameter %d is "
"inconsistent with precompiled body", procName, i));
- ckfree((char *) fieldValues);
+ ckfree(fieldValues);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "BYTECODELIES", NULL);
goto procError;
}
@@ -603,7 +618,9 @@ TclCreateProc(
"procedure \"%s\": formal parameter \"%s\" has "
"default value inconsistent with precompiled body",
procName, fieldValues[0]));
- ckfree((char *) fieldValues);
+ ckfree(fieldValues);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "BYTECODELIES", NULL);
goto procError;
}
}
@@ -621,9 +638,7 @@ TclCreateProc(
* local variables for the argument.
*/
- localPtr = (CompiledLocal *) ckalloc((unsigned)
- (sizeof(CompiledLocal) - sizeof(localPtr->name)
- + nameLength + 1));
+ localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameLength+1);
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
} else {
@@ -643,7 +658,7 @@ TclCreateProc(
} else {
localPtr->defValuePtr = NULL;
}
- strcpy(localPtr->name, fieldValues[0]);
+ memcpy(localPtr->name, fieldValues[0], nameLength + 1);
if ((i == numArgs - 1)
&& (localPtr->nameLength == 4)
&& (localPtr->name[0] == 'a')
@@ -652,11 +667,11 @@ TclCreateProc(
}
}
- ckfree((char *) fieldValues);
+ ckfree(fieldValues);
}
*procPtrPtr = procPtr;
- ckfree((char *) argArray);
+ ckfree(argArray);
return TCL_OK;
procError:
@@ -673,12 +688,12 @@ TclCreateProc(
Tcl_DecrRefCount(defPtr);
}
- ckfree((char *) localPtr);
+ ckfree(localPtr);
}
- ckfree((char *) procPtr);
+ ckfree(procPtr);
}
if (argArray != NULL) {
- ckfree((char *) argArray);
+ ckfree(argArray);
}
return TCL_ERROR;
}
@@ -757,8 +772,8 @@ TclGetFrame(
return result;
levelError:
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
return -1;
}
@@ -889,9 +904,8 @@ TclObjGetFrame(
return result;
levelError:
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LEVEL", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
return -1;
}
@@ -1109,6 +1123,8 @@ ProcWrongNumArgs(
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
} else {
+ ((Interp *) interp)->ensembleRewrite.numInsertedObjs -= skip - 1;
+
#ifdef AVOID_HACKS_FOR_ITCL
desiredObjs[0] = framePtr->objv[skip-1];
#else
@@ -1250,7 +1266,7 @@ InitResolvedLocals(
if (localPtr->resolveInfo->deleteProc) {
localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
} else {
- ckfree((char *) localPtr->resolveInfo);
+ ckfree(localPtr->resolveInfo);
}
localPtr->resolveInfo = NULL;
}
@@ -1344,7 +1360,7 @@ TclFreeLocalCache(
}
}
}
- ckfree((char *) localCachePtr);
+ ckfree(localCachePtr);
}
static void
@@ -1368,9 +1384,9 @@ InitLocalCache(
* for future calls.
*/
- localCachePtr = (LocalCache *) ckalloc(sizeof(LocalCache)
- + (localCt-1)*sizeof(Tcl_Obj *)
- + numArgs*sizeof(Var));
+ localCachePtr = ckalloc(sizeof(LocalCache)
+ + (localCt - 1) * sizeof(Tcl_Obj *)
+ + numArgs * sizeof(Var));
namePtr = &localCachePtr->varName0;
varPtr = (Var *) (namePtr + localCt);
@@ -1772,6 +1788,7 @@ TclNRInterpProcCore(
}
#endif /*TCL_COMPILE_DEBUG*/
+#ifdef USE_DTRACE
if (TCL_DTRACE_PROC_ARGS_ENABLED()) {
int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
const char *a[10];
@@ -1801,6 +1818,15 @@ TclNRInterpProcCore(
iPtr->varFramePtr->objc - l - 1,
(Tcl_Obj **)(iPtr->varFramePtr->objv + l + 1));
}
+ if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
+ int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+
+ TCL_DTRACE_PROC_ENTRY(l < iPtr->varFramePtr->objc ?
+ TclGetString(iPtr->varFramePtr->objv[l]) : NULL,
+ iPtr->varFramePtr->objc - l - 1,
+ (Tcl_Obj **)(iPtr->varFramePtr->objv + l + 1));
+ }
+#endif /* USE_DTRACE */
/*
* Invoke the commands in the procedure's body.
@@ -1856,10 +1882,10 @@ InterpProcNR2(
* transform to an error now.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "invoked \"",
- ((result == TCL_BREAK) ? "break" : "continue"),
- "\" outside of a loop", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invoked \"%s\" outside of a loop",
+ ((result == TCL_BREAK) ? "break" : "continue")));
+ Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL);
result = TCL_ERROR;
/*
@@ -1975,15 +2001,16 @@ TclProcCompileProc(
if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
if ((Interp *) *codePtr->interpHandle != iPtr) {
- Tcl_AppendResult(interp,
- "a precompiled script jumped interps", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "a precompiled script jumped interps", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "CROSSINTERPBYTECODE", NULL);
return TCL_ERROR;
}
codePtr->compileEpoch = iPtr->compileEpoch;
codePtr->nsPtr = nsPtr;
} else {
- bodyPtr->typePtr->freeIntRepProc(bodyPtr);
- bodyPtr->typePtr = NULL;
+ TclFreeIntRep(bodyPtr);
}
}
@@ -2038,8 +2065,16 @@ TclProcCompileProc(
procPtr->lastLocalPtr = lastPtr;
while (clPtr) {
CompiledLocal *toFree = clPtr;
+
clPtr = clPtr->nextPtr;
- ckfree((char *) toFree);
+ if (toFree->resolveInfo) {
+ if (toFree->resolveInfo->deleteProc) {
+ toFree->resolveInfo->deleteProc(toFree->resolveInfo);
+ } else {
+ ckfree(toFree->resolveInfo);
+ }
+ }
+ ckfree(toFree);
}
procPtr->numCompiledLocals = procPtr->numArgs;
}
@@ -2182,7 +2217,7 @@ TclProcCleanupProc(
if (resVarInfo->deleteProc) {
resVarInfo->deleteProc(resVarInfo);
} else {
- ckfree((char *) resVarInfo);
+ ckfree(resVarInfo);
}
}
@@ -2190,10 +2225,10 @@ TclProcCleanupProc(
defPtr = localPtr->defValuePtr;
Tcl_DecrRefCount(defPtr);
}
- ckfree((char *) localPtr);
+ ckfree(localPtr);
localPtr = nextPtr;
}
- ckfree((char *) procPtr);
+ ckfree(procPtr);
/*
* TIP #280: Release the location data associated with this Proc
@@ -2201,7 +2236,7 @@ TclProcCleanupProc(
* procbody structures created by tbcload.
*/
- if (!iPtr) {
+ if (iPtr == NULL) {
return;
}
@@ -2212,13 +2247,15 @@ TclProcCleanupProc(
cfPtr = Tcl_GetHashValue(hePtr);
- if (cfPtr->type == TCL_LOCATION_SOURCE) {
- Tcl_DecrRefCount(cfPtr->data.eval.path);
- cfPtr->data.eval.path = NULL;
+ if (cfPtr) {
+ if (cfPtr->type == TCL_LOCATION_SOURCE) {
+ Tcl_DecrRefCount(cfPtr->data.eval.path);
+ cfPtr->data.eval.path = NULL;
+ }
+ ckfree(cfPtr->line);
+ cfPtr->line = NULL;
+ ckfree(cfPtr);
}
- ckfree((char *) cfPtr->line);
- cfPtr->line = NULL;
- ckfree((char *) cfPtr);
Tcl_DeleteHashEntry(hePtr);
}
@@ -2449,21 +2486,26 @@ SetLambdaFromAny(
{
Interp *iPtr = (Interp *) interp;
const char *name;
- Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr;
- int objc, result;
+ Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
+ int isNew, objc, result;
+ CmdFrame *cfPtr = NULL;
Proc *procPtr;
+ if (interp == NULL) {
+ return TCL_ERROR;
+ }
+
/*
* Convert objPtr to list type first; if it cannot be converted, or if its
* length is not 2, then it cannot be converted to lambdaType.
*/
- result = TclListObjGetElements(interp, objPtr, &objc, &objv);
+ result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
- TclNewLiteralStringObj(errPtr, "can't interpret \"");
- Tcl_AppendObjToObj(errPtr, objPtr);
- Tcl_AppendToObj(errPtr, "\" as a lambda expression", -1);
- Tcl_SetObjResult(interp, errPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't interpret \"%s\" as a lambda expression",
+ Tcl_GetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL);
return TCL_ERROR;
}
@@ -2541,19 +2583,19 @@ SetLambdaFromAny(
if (contextPtr->line
&& (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) {
- int isNew, buf[2];
- CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
+ int buf[2];
/*
* Move from approximation (line of list cmd word) to actual
* location (line of 2nd list element).
*/
+ cfPtr = ckalloc(sizeof(CmdFrame));
TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
- cfPtr->line = (int *) ckalloc(sizeof(int));
+ cfPtr->line = ckalloc(sizeof(int));
cfPtr->line[0] = buf[1];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
@@ -2564,9 +2606,6 @@ SetLambdaFromAny(
cfPtr->cmd.str.cmd = NULL;
cfPtr->cmd.str.len = 0;
-
- Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr,
- procPtr, &isNew), cfPtr);
}
/*
@@ -2578,6 +2617,8 @@ SetLambdaFromAny(
}
TclStackFree(interp, contextPtr);
}
+ Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr,
+ &isNew), cfPtr);
/*
* Set the namespace for this lambda: given by objv[2] understood as a
@@ -2605,7 +2646,7 @@ SetLambdaFromAny(
* conversion to lambdaType.
*/
- objPtr->typePtr->freeIntRepProc(objPtr);
+ TclFreeIntRep(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
@@ -2889,26 +2930,28 @@ Tcl_DisassembleObjCmd(
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "procName");
return TCL_ERROR;
- } else {
- procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
- if (procPtr == NULL) {
- Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
- "\" isn't a procedure", NULL);
- return TCL_ERROR;
- }
+ }
- /*
- * Compile (if uncompiled) and disassemble a procedure.
- */
+ procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
+ if (procPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
- result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
- if (result != TCL_OK) {
- return result;
- }
- TclPopStackFrame(interp);
- codeObjPtr = procPtr->bodyPtr;
- break;
+ /*
+ * Compile (if uncompiled) and disassemble a procedure.
+ */
+
+ result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
+ if (result != TCL_OK) {
+ return result;
}
+ TclPopStackFrame(interp);
+ codeObjPtr = procPtr->bodyPtr;
+ break;
case DISAS_SCRIPT:
/*
* Compile and disassemble a script.
@@ -2941,8 +2984,10 @@ Tcl_DisassembleObjCmd(
return TCL_ERROR;
}
if (oPtr->classPtr == NULL) {
- Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
- "\" is not a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+ TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
@@ -2974,14 +3019,18 @@ Tcl_DisassembleObjCmd(
methodBody:
if (hPtr == NULL) {
unknownMethod:
- Tcl_AppendResult(interp, "unknown method \"",
- TclGetString(objv[3]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(objv[3]), NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
- Tcl_AppendResult(interp,
- "body not available for this kind of method", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "body not available for this kind of method", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "METHODTYPE", NULL);
return TCL_ERROR;
}
if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
@@ -3014,7 +3063,10 @@ Tcl_DisassembleObjCmd(
if (((ByteCode *) codeObjPtr->internalRep.otherValuePtr)->flags
& TCL_BYTECODE_PRECOMPILED) {
- Tcl_AppendResult(interp,"may not disassemble prebuilt bytecode",NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not disassemble prebuilt bytecode", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "BYTECODE", NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(codeObjPtr));
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 6848960..6c1dc08 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclRegexp.c,v 1.34 2010/02/24 10:32:17 dkf Exp $
*/
#include "tclInt.h"
@@ -716,14 +714,14 @@ TclRegError(
int status) /* Status code to report. */
{
char buf[100]; /* ample in practice */
- char cbuf[100]; /* lots in practice */
+ char cbuf[TCL_INTEGER_SPACE];
size_t n;
const char *p;
Tcl_ResetResult(interp);
n = TclReError(status, NULL, buf, sizeof(buf));
p = (n > sizeof(buf)) ? "..." : "";
- Tcl_AppendResult(interp, msg, buf, p, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p));
sprintf(cbuf, "%d", status);
(void) TclReError(REG_ITOA, NULL, cbuf, sizeof(cbuf));
@@ -907,7 +905,7 @@ CompileRegexp(
* This is a new expression, so compile it and add it to the cache.
*/
- regexpPtr = (TclRegexp *) ckalloc(sizeof(TclRegexp));
+ regexpPtr = ckalloc(sizeof(TclRegexp));
regexpPtr->objPtr = NULL;
regexpPtr->string = NULL;
regexpPtr->details.rm_extend.rm_so = -1;
@@ -934,7 +932,7 @@ CompileRegexp(
* Clean up and report errors in the interpreter, if possible.
*/
- ckfree((char *)regexpPtr);
+ ckfree(regexpPtr);
if (interp) {
TclRegError(interp,
"couldn't compile regular expression pattern: ", status);
@@ -949,10 +947,8 @@ CompileRegexp(
*/
if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) {
- regexpPtr->globObjPtr = Tcl_NewStringObj(Tcl_DStringValue(&stringBuf),
- Tcl_DStringLength(&stringBuf));
+ regexpPtr->globObjPtr = TclDStringToObj(&stringBuf);
Tcl_IncrRefCount(regexpPtr->globObjPtr);
- Tcl_DStringFree(&stringBuf);
} else {
regexpPtr->globObjPtr = NULL;
}
@@ -962,7 +958,7 @@ CompileRegexp(
* the entire pattern.
*/
- regexpPtr->matches = (regmatch_t *)
+ regexpPtr->matches =
ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
/*
@@ -989,8 +985,8 @@ CompileRegexp(
tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
}
- tsdPtr->patterns[0] = ckalloc((unsigned) length+1);
- strcpy(tsdPtr->patterns[0], string);
+ tsdPtr->patterns[0] = ckalloc(length + 1);
+ memcpy(tsdPtr->patterns[0], string, (unsigned) length + 1);
tsdPtr->patLengths[0] = length;
tsdPtr->regexps[0] = regexpPtr;
@@ -1022,9 +1018,9 @@ FreeRegexp(
TclDecrRefCount(regexpPtr->globObjPtr);
}
if (regexpPtr->matches) {
- ckfree((char *) regexpPtr->matches);
+ ckfree(regexpPtr->matches);
}
- ckfree((char *) regexpPtr);
+ ckfree(regexpPtr);
}
/*
diff --git a/generic/tclRegexp.h b/generic/tclRegexp.h
index bd26b85..3b2433e 100644
--- a/generic/tclRegexp.h
+++ b/generic/tclRegexp.h
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclRegexp.h,v 1.16 2008/05/02 10:27:08 dkf Exp $
*/
#ifndef _TCLREGEXP
diff --git a/generic/tclResolve.c b/generic/tclResolve.c
index 7a86427..974737e 100644
--- a/generic/tclResolve.c
+++ b/generic/tclResolve.c
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclResolve.c,v 1.12 2010/01/29 16:17:20 nijtmans Exp $
*/
#include "tclInt.h"
@@ -67,6 +65,7 @@ Tcl_AddInterpResolvers(
{
Interp *iPtr = (Interp *) interp;
ResolverScheme *resPtr;
+ unsigned len;
/*
* Since we're adding a new name resolution scheme, we must force all code
@@ -102,9 +101,10 @@ Tcl_AddInterpResolvers(
* list, so that it overrides existing schemes.
*/
- resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
- resPtr->name = (char *) ckalloc((unsigned)(strlen(name) + 1));
- strcpy(resPtr->name, name);
+ resPtr = ckalloc(sizeof(ResolverScheme));
+ len = strlen(name) + 1;
+ resPtr->name = ckalloc(len);
+ memcpy(resPtr->name, name, len);
resPtr->cmdResProc = cmdProc;
resPtr->varResProc = varProc;
resPtr->compiledVarResProc = compiledVarProc;
@@ -226,7 +226,7 @@ Tcl_RemoveInterpResolvers(
*prevPtrPtr = resPtr->nextPtr;
ckfree(resPtr->name);
- ckfree((char *) resPtr);
+ ckfree(resPtr);
return 1;
}
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 18aae6c..9707f20 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclResult.c,v 1.62 2010/09/22 00:57:11 hobbs Exp $
*/
#include "tclInt.h"
@@ -77,7 +75,7 @@ Tcl_SaveInterpState(
int status) /* status code for current operation */
{
Interp *iPtr = (Interp *) interp;
- InterpState *statePtr = (InterpState *) ckalloc(sizeof(InterpState));
+ InterpState *statePtr = ckalloc(sizeof(InterpState));
statePtr->status = status;
statePtr->flags = iPtr->flags & ERR_ALREADY_LOGGED;
@@ -207,7 +205,7 @@ Tcl_DiscardInterpState(
Tcl_DecrRefCount(statePtr->errorStack);
}
Tcl_DecrRefCount(statePtr->objResult);
- ckfree((char *) statePtr);
+ ckfree(statePtr);
}
/*
@@ -333,7 +331,7 @@ Tcl_RestoreResult(
*/
if (iPtr->appendResult != NULL) {
- ckfree((char *) iPtr->appendResult);
+ ckfree(iPtr->appendResult);
}
iPtr->appendResult = statePtr->appendResult;
@@ -382,12 +380,10 @@ Tcl_DiscardResult(
if (statePtr->result == statePtr->appendResult) {
ckfree(statePtr->appendResult);
+ } else if (statePtr->freeProc == TCL_DYNAMIC) {
+ ckfree(statePtr->result);
} else if (statePtr->freeProc) {
- if (statePtr->freeProc == TCL_DYNAMIC) {
- ckfree(statePtr->result);
- } else {
- statePtr->freeProc(statePtr->result);
- }
+ statePtr->freeProc(statePtr->result);
}
}
@@ -430,13 +426,13 @@ Tcl_SetResult(
int length = strlen(result);
if (length > TCL_RESULT_SIZE) {
- iPtr->result = ckalloc((unsigned) length+1);
+ iPtr->result = ckalloc(length + 1);
iPtr->freeProc = TCL_DYNAMIC;
} else {
iPtr->result = iPtr->resultSpace;
iPtr->freeProc = 0;
}
- strcpy(iPtr->result, result);
+ memcpy(iPtr->result, result, (unsigned) length+1);
} else {
iPtr->result = (char *) result;
iPtr->freeProc = freeProc;
@@ -587,7 +583,7 @@ Tcl_GetObjResult(
* result, then reset the string result.
*/
- if (*(iPtr->result) != 0) {
+ if (iPtr->result[0] != 0) {
ResetObjResult(iPtr);
objResultPtr = iPtr->objResultPtr;
@@ -603,7 +599,7 @@ Tcl_GetObjResult(
iPtr->freeProc = 0;
}
iPtr->result = iPtr->resultSpace;
- iPtr->resultSpace[0] = 0;
+ iPtr->result[0] = 0;
}
return iPtr->objResultPtr;
}
@@ -650,14 +646,14 @@ Tcl_AppendResultVA(
* calls to Tcl_GetStringResult() itself. [Patch 1041072 discussion]
*/
-#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
+#ifdef USE_INTERP_RESULT
/*
* Ensure that the interp->result is legal so old Tcl 7.* code still
* works. There's still embarrasingly much of it about...
*/
(void) Tcl_GetStringResult(interp);
-#endif /* USE_DIRECT_INTERP_RESULT_ACCESS */
+#endif /* USE_INTERP_RESULT */
}
/*
@@ -833,7 +829,7 @@ SetupAppendBuffer(
} else {
totalSpace *= 2;
}
- new = ckalloc((unsigned) totalSpace);
+ new = ckalloc(totalSpace);
strcpy(new, iPtr->result);
if (iPtr->appendResult != NULL) {
ckfree(iPtr->appendResult);
@@ -982,14 +978,15 @@ ResetObjResult(
TclNewObj(objResultPtr);
Tcl_IncrRefCount(objResultPtr);
iPtr->objResultPtr = objResultPtr;
- } else if (objResultPtr->bytes != tclEmptyStringRep) {
- if (objResultPtr->bytes != NULL) {
- ckfree((char *) objResultPtr->bytes);
+ } else {
+ if (objResultPtr->bytes != tclEmptyStringRep) {
+ if (objResultPtr->bytes) {
+ ckfree(objResultPtr->bytes);
+ }
+ objResultPtr->bytes = tclEmptyStringRep;
+ objResultPtr->length = 0;
}
- objResultPtr->bytes = tclEmptyStringRep;
- objResultPtr->length = 0;
TclFreeIntRep(objResultPtr);
- objResultPtr->typePtr = NULL;
}
}
@@ -1107,9 +1104,7 @@ Tcl_SetObjErrorCode(
*
* Tcl_GetErrorLine --
*
- * Results:
- *
- * Side effects:
+ * Returns the line number associated with the current error.
*
*----------------------------------------------------------------------
*/
@@ -1126,9 +1121,7 @@ Tcl_GetErrorLine(
*
* Tcl_SetErrorLine --
*
- * Results:
- *
- * Side effects:
+ * Sets the line number associated with the current error.
*
*----------------------------------------------------------------------
*/
@@ -1275,7 +1268,8 @@ TclProcessReturn(
Tcl_DecrRefCount(iPtr->errorInfo);
iPtr->errorInfo = NULL;
}
- Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], &valuePtr);
+ Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
+ &valuePtr);
if (valuePtr != NULL) {
int infoLen;
@@ -1286,7 +1280,8 @@ TclProcessReturn(
iPtr->flags |= ERR_ALREADY_LOGGED;
}
}
- Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
+ Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK],
+ &valuePtr);
if (valuePtr != NULL) {
int len, valueObjc;
Tcl_Obj **valueObjv;
@@ -1299,26 +1294,36 @@ TclProcessReturn(
Tcl_IncrRefCount(newObj);
iPtr->errorStack = newObj;
}
+
/*
* List extraction done after duplication to avoid moving the rug
* if someone does [return -errorstack [info errorstack]]
*/
- if (Tcl_ListObjGetElements(interp, valuePtr, &valueObjc, &valueObjv) == TCL_ERROR) {
+
+ if (Tcl_ListObjGetElements(interp, valuePtr, &valueObjc,
+ &valueObjv) == TCL_ERROR) {
return TCL_ERROR;
}
iPtr->resetErrorStack = 0;
Tcl_ListObjLength(interp, iPtr->errorStack, &len);
- /* reset while keeping the list intrep as much as possible */
- Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc, valueObjv);
+
+ /*
+ * Reset while keeping the list intrep as much as possible.
+ */
+
+ Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc,
+ valueObjv);
}
- Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE], &valuePtr);
+ Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE],
+ &valuePtr);
if (valuePtr != NULL) {
Tcl_SetObjErrorCode(interp, valuePtr);
} else {
Tcl_SetErrorCode(interp, "NONE", NULL);
}
- Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE], &valuePtr);
+ Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE],
+ &valuePtr);
if (valuePtr != NULL) {
TclGetIntFromObj(NULL, valuePtr, &iPtr->errorLine);
}
@@ -1391,10 +1396,9 @@ TclMergeReturnOptions(
* Value is not a legal dictionary.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad ", compare,
- " value: expected dictionary but got \"",
- TclGetString(objv[1]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad %s value: expected dictionary but got \"%s\"",
+ compare, TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS",
NULL);
goto error;
@@ -1423,7 +1427,8 @@ TclMergeReturnOptions(
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_CODE], &valuePtr);
if (valuePtr != NULL) {
- if (TCL_ERROR == TclGetCompletionCodeFromObj(interp, valuePtr, &code)) {
+ if (TclGetCompletionCodeFromObj(interp, valuePtr,
+ &code) == TCL_ERROR) {
goto error;
}
Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]);
@@ -1441,10 +1446,9 @@ TclMergeReturnOptions(
* Value is not a legal level.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad -level value: "
- "expected non-negative integer but got \"",
- TclGetString(valuePtr), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad -level value: expected non-negative integer but got"
+ " \"%s\"", TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", NULL);
goto error;
}
@@ -1463,10 +1467,10 @@ TclMergeReturnOptions(
/*
* Value is not a list, which is illegal for -errorcode.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad -errorcode value: "
- "expected a list but got \"",
- TclGetString(valuePtr), "\"", NULL);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad -errorcode value: expected a list but got \"%s\"",
+ TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE",
NULL);
goto error;
@@ -1485,21 +1489,24 @@ TclMergeReturnOptions(
/*
* Value is not a list, which is illegal for -errorstack.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad -errorstack value: "
- "expected a list but got \"",
- TclGetString(valuePtr), "\"", NULL);
- Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK", NULL);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad -errorstack value: expected a list but got \"%s\"",
+ TclGetString(valuePtr)));
+ Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK",
+ NULL);
goto error;
}
if (length % 2) {
/*
* Errorstack must always be an even-sized list
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "forbidden odd-sized list for -errorstack: \"",
- TclGetString(valuePtr), "\"", NULL);
- Tcl_SetErrorCode(interp, "TCL", "RESULT", "ODDSIZEDLIST_ERRORSTACK", NULL);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "forbidden odd-sized list for -errorstack: \"%s\"",
+ TclGetString(valuePtr)));
+ Tcl_SetErrorCode(interp, "TCL", "RESULT",
+ "ODDSIZEDLIST_ERRORSTACK", NULL);
goto error;
}
}
@@ -1597,6 +1604,31 @@ Tcl_GetReturnOptions(
/*
*-------------------------------------------------------------------------
*
+ * TclNoErrorStack --
+ *
+ * Removes the -errorstack entry from an options dict to avoid reference
+ * cycles.
+ *
+ * Results:
+ * The (unshared) argument options dict, modified in -place.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclNoErrorStack(
+ Tcl_Interp *interp,
+ Tcl_Obj *options)
+{
+ Tcl_Obj **keys = GetKeys();
+
+ Tcl_DictObjRemove(interp, options, keys[KEY_ERRORSTACK]);
+ return options;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
* Tcl_SetReturnOptions --
*
* Accepts an interp and a dictionary of return options, and sets the
@@ -1625,9 +1657,8 @@ Tcl_SetReturnOptions(
Tcl_IncrRefCount(options);
if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv)
|| (objc % 2)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "expected dict but got \"",
- TclGetString(options), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected dict but got \"%s\"", TclGetString(options)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", NULL);
code = TCL_ERROR;
} else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv,
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 6d23950..ef7eedf 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclScan.c,v 1.35 2010/03/05 14:34:04 dkf Exp $
*/
#include "tclInt.h"
@@ -103,10 +101,9 @@ BuildCharSet(
end += Tcl_UtfToUniChar(end, &ch);
}
- cset->chars = (Tcl_UniChar *)
- ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
+ cset->chars = ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
if (nranges > 0) {
- cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);
+ cset->ranges = ckalloc(sizeof(struct Range) * nranges);
} else {
cset->ranges = NULL;
}
@@ -226,9 +223,9 @@ static void
ReleaseCharSet(
CharSet *cset)
{
- ckfree((char *)cset->chars);
+ ckfree(cset->chars);
if (cset->ranges) {
- ckfree((char *)cset->ranges);
+ ckfree(cset->ranges);
}
}
@@ -264,6 +261,10 @@ ValidateFormat(
int objIndex, xpgSize, nspace = numVars;
int *nassign = TclStackAlloc(interp, nspace * sizeof(int));
char buf[TCL_UTF_MAX+1];
+ Tcl_Obj *errorMsg; /* Place to build an error messages. Note that
+ * these are messy operations because we do
+ * not want to use the formatting engine;
+ * we're inside there! */
/*
* Initialize an array that records the number of times a variable is
@@ -331,9 +332,10 @@ ValidateFormat(
gotSequential = 1;
if (gotXpg) {
mixedXPG:
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot mix \"%\" and \"%n$\" conversion specifiers",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL);
goto error;
}
@@ -377,9 +379,10 @@ ValidateFormat(
switch (ch) {
case 'c':
if (flags & SCAN_WIDTH) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"field width may not be specified in %c conversion",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL);
goto error;
}
/*
@@ -390,9 +393,12 @@ ValidateFormat(
if (flags & (SCAN_LONGER|SCAN_BIG)) {
invalidFieldSize:
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendResult(interp,
- "field size modifier may not be specified in %", buf,
- " conversion", NULL);
+ errorMsg = Tcl_NewStringObj(
+ "field size modifier may not be specified in %", -1);
+ Tcl_AppendToObj(errorMsg, buf, -1);
+ Tcl_AppendToObj(errorMsg, " conversion", -1);
+ Tcl_SetObjResult(interp, errorMsg);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL);
goto error;
}
/*
@@ -409,8 +415,9 @@ ValidateFormat(
break;
case 'u':
if (flags & SCAN_BIG) {
- Tcl_SetResult(interp,
- "unsigned bignum scans are invalid", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unsigned bignum scans are invalid", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
goto error;
}
break;
@@ -445,13 +452,18 @@ ValidateFormat(
}
break;
badSet:
- Tcl_SetResult(interp, "unmatched [ in format string",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unmatched [ in format string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL);
goto error;
default:
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendResult(interp, "bad scan conversion character \"", buf,
- "\"", NULL);
+ errorMsg = Tcl_NewStringObj(
+ "bad scan conversion character \"", -1);
+ Tcl_AppendToObj(errorMsg, buf, -1);
+ Tcl_AppendToObj(errorMsg, "\"", -1);
+ Tcl_SetObjResult(interp, errorMsg);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
goto error;
}
if (!(flags & SCAN_SUPPRESS)) {
@@ -495,9 +507,10 @@ ValidateFormat(
}
for (i = 0; i < numVars; i++) {
if (nassign[i] > 1) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"variable is assigned by multiple \"%n$\" conversion specifiers",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL);
goto error;
} else if (!xpgSize && (nassign[i] == 0)) {
/*
@@ -505,9 +518,10 @@ ValidateFormat(
* and/or numVars != 0), then too many vars were given
*/
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"variable is not assigned by any conversion specifiers",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL);
goto error;
}
}
@@ -517,12 +531,14 @@ ValidateFormat(
badIndex:
if (gotXpg) {
- Tcl_SetResult(interp, "\"%n$\" argument index out of range",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"%n$\" argument index out of range", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL);
} else {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"different numbers of variable names and field specifiers",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL);
}
error:
@@ -592,7 +608,7 @@ Tcl_ScanObjCmd(
*/
if (totalVars > 0) {
- objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * totalVars);
+ objs = ckalloc(sizeof(Tcl_Obj *) * totalVars);
for (i = 0; i < totalVars; i++) {
objs[i] = NULL;
}
@@ -994,9 +1010,14 @@ Tcl_ScanObjCmd(
continue;
}
result++;
- if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0) == NULL) {
- Tcl_AppendResult(interp, "couldn't set variable \"",
- TclGetString(objv[i+3]), "\"", NULL);
+
+ /*
+ * In case of multiple errors in setting variables, just report
+ * the first one.
+ */
+
+ if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i],
+ (code == TCL_OK) ? TCL_LEAVE_ERR_MSG : 0) == NULL) {
code = TCL_ERROR;
}
Tcl_DecrRefCount(objs[i]);
@@ -1022,7 +1043,7 @@ Tcl_ScanObjCmd(
}
}
if (objs != NULL) {
- ckfree((char *) objs);
+ ckfree(objs);
}
if (code == TCL_OK) {
if (underflow && (nconversions == 0)) {
@@ -1042,7 +1063,7 @@ Tcl_ScanObjCmd(
}
return code;
}
-
+
/*
* Local Variables:
* mode: c
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index d0a5345..2d534a68 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -1,6 +1,4 @@
/*
- *----------------------------------------------------------------------
- *
* tclStrToD.c --
*
* This file contains a collection of procedures for managing conversions
@@ -13,10 +11,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclStrToD.c,v 1.46 2010/05/21 12:43:29 nijtmans Exp $
- *
- *----------------------------------------------------------------------
*/
#include "tclInt.h"
@@ -41,6 +35,11 @@
#endif
/*
+ * Rounding controls. (Thanks a lot, Intel!)
+ */
+
+#ifdef __i386
+/*
* gcc on x86 needs access to rounding controls, because of a questionable
* feature where it retains intermediate results as IEEE 'long double' values
* somewhat unpredictably. It is tempting to include fpu_control.h, but that
@@ -48,41 +47,65 @@
* and ix86-isms are factored out here.
*/
-#if defined(__GNUC__) && defined(__i386)
-typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__)));
-#define _FPU_GETCW(cw) __asm__ __volatile__ ("fnstcw %0" : "=m" (*&cw))
-#define _FPU_SETCW(cw) __asm__ __volatile__ ("fldcw %0" : : "m" (*&cw))
+#if defined(__GNUC__)
+typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__)));
+
+#define _FPU_GETCW(cw) __asm__ __volatile__ ("fnstcw %0" : "=m" (*&cw))
+#define _FPU_SETCW(cw) __asm__ __volatile__ ("fldcw %0" : : "m" (*&cw))
# define FPU_IEEE_ROUNDING 0x027f
# define ADJUST_FPU_CONTROL_WORD
-#endif
+#define TCL_IEEE_DOUBLE_ROUNDING \
+ fpu_control_t roundTo53Bits = FPU_IEEE_ROUNDING; \
+ fpu_control_t oldRoundingMode; \
+ _FPU_GETCW(oldRoundingMode); \
+ _FPU_SETCW(roundTo53Bits)
+#define TCL_DEFAULT_DOUBLE_ROUNDING \
+ _FPU_SETCW(oldRoundingMode)
-/* Sun ProC needs sunmath for rounding control on x86 like gcc above.
- *
- *
+/*
+ * Sun ProC needs sunmath for rounding control on x86 like gcc above.
*/
-#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
+#elif defined(__sun)
#include <sunmath.h>
+#define TCL_IEEE_DOUBLE_ROUNDING \
+ ieee_flags("set","precision","double",NULL)
+#define TCL_DEFAULT_DOUBLE_ROUNDING \
+ ieee_flags("clear","precision",NULL,NULL)
+
+/*
+ * Other platforms are assumed to always operate in full IEEE mode, so we make
+ * the macros to go in and out of that mode do nothing.
+ */
+
+#else /* !__GNUC__ && !__sun */
+#define TCL_IEEE_DOUBLE_ROUNDING ((void) 0)
+#define TCL_DEFAULT_DOUBLE_ROUNDING ((void) 0)
+#endif
+#else /* !__i386 */
+#define TCL_IEEE_DOUBLE_ROUNDING ((void) 0)
+#define TCL_DEFAULT_DOUBLE_ROUNDING ((void) 0)
#endif
/*
- * MIPS floating-point units need special settings in control registers
- * to use gradual underflow as we expect. This fix is for the MIPSpro
- * compiler.
+ * MIPS floating-point units need special settings in control registers to use
+ * gradual underflow as we expect. This fix is for the MIPSpro compiler.
*/
+
#if defined(__sgi) && defined(_COMPILER_VERSION)
#include <sys/fpu.h>
#endif
+
/*
* HP's PA_RISC architecture uses 7ff4000000000000 to represent a quiet NaN.
* Everyone else uses 7ff8000000000000. (Why, HP, why?)
*/
#ifdef __hppa
-# define NAN_START 0x7ff4
-# define NAN_MASK (((Tcl_WideUInt) 1) << 50)
+# define NAN_START 0x7ff4
+# define NAN_MASK (((Tcl_WideUInt) 1) << 50)
#else
-# define NAN_START 0x7ff8
-# define NAN_MASK (((Tcl_WideUInt) 1) << 51)
+# define NAN_START 0x7ff8
+# define NAN_MASK (((Tcl_WideUInt) 1) << 51)
#endif
/*
@@ -90,6 +113,65 @@ typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__)));
* runtime).
*/
+/* Magic constants */
+
+#define LOG10_2 0.3010299956639812
+#define TWO_OVER_3LOG10 0.28952965460216784
+#define LOG10_3HALVES_PLUS_FUDGE 0.1760912590558
+
+/*
+ * Definitions of the parts of an IEEE754-format floating point number.
+ */
+
+#define SIGN_BIT 0x80000000
+ /* Mask for the sign bit in the first word of
+ * a double. */
+#define EXP_MASK 0x7ff00000
+ /* Mask for the exponent field in the first
+ * word of a double. */
+#define EXP_SHIFT 20 /* Shift count to make the exponent an
+ * integer. */
+#define HIDDEN_BIT (((Tcl_WideUInt) 0x00100000) << 32)
+ /* Hidden 1 bit for the significand. */
+#define HI_ORDER_SIG_MASK 0x000fffff
+ /* Mask for the high-order part of the
+ * significand in the first word of a
+ * double. */
+#define SIG_MASK (((Tcl_WideUInt) HI_ORDER_SIG_MASK << 32) \
+ | 0xffffffff)
+ /* Mask for the 52-bit significand. */
+#define FP_PRECISION 53 /* Number of bits of significand plus the
+ * hidden bit. */
+#define EXPONENT_BIAS 0x3ff /* Bias of the exponent 0. */
+
+/*
+ * Derived quantities.
+ */
+
+#define TEN_PMAX 22 /* floor(FP_PRECISION*log(2)/log(5)) */
+#define QUICK_MAX 14 /* floor((FP_PRECISION-1)*log(2)/log(10))-1 */
+#define BLETCH 0x10 /* Highest power of two that is greater than
+ * DBL_MAX_10_EXP, divided by 16. */
+#define DIGIT_GROUP 8 /* floor(DIGIT_BIT*log(2)/log(10)) */
+
+/*
+ * Union used to dismantle floating point numbers.
+ */
+
+typedef union Double {
+ struct {
+#ifdef WORDS_BIGENDIAN
+ int word0;
+ int word1;
+#else
+ int word1;
+ int word0;
+#endif
+ } w;
+ double d;
+ Tcl_WideUInt q;
+} Double;
+
static int maxpow10_wide; /* The powers of ten that can be represented
* exactly as wide integers. */
static Tcl_WideUInt *pow10_wide;
@@ -105,13 +187,11 @@ static int log2FLT_RADIX; /* Logarithm of the floating point radix. */
static int mantBits; /* Number of bits in a double's significand */
static mp_int pow5[9]; /* Table of powers of 5**(2**n), up to
* 5**256 */
-static double tiny = 0.0; /* The smallest representable double */
+static double tiny = 0.0; /* The smallest representable double. */
static int maxDigits; /* The maximum number of digits to the left of
* the decimal point of a double. */
static int minDigits; /* The maximum number of digits to the right
* of the decimal point in a double. */
-static int mantDIGIT; /* Number of mp_digit's needed to hold the
- * significand of a double. */
static const double pow_10_2_n[] = { /* Inexact higher powers of ten. */
1.0,
100.0,
@@ -123,35 +203,171 @@ static const double pow_10_2_n[] = { /* Inexact higher powers of ten. */
1.0e+128,
1.0e+256
};
+
static int n770_fp; /* Flag is 1 on Nokia N770 floating point.
* Nokia's floating point has the words
* reversed: if big-endian is 7654 3210,
* and little-endian is 0123 4567,
* then Nokia's FP is 4567 0123;
- * little-endian within the 32-bit words
- * but big-endian between them. */
+ * little-endian within the 32-bit words but
+ * big-endian between them. */
+
+/*
+ * Table of powers of 5 that are small enough to fit in an mp_digit.
+ */
+
+static const mp_digit dpow5[13] = {
+ 1, 5, 25, 125,
+ 625, 3125, 15625, 78125,
+ 390625, 1953125, 9765625, 48828125,
+ 244140625
+};
+
+/*
+ * Table of powers: pow5_13[n] = 5**(13*2**(n+1))
+ */
+
+static mp_int pow5_13[5]; /* Table of powers: 5**13, 5**26, 5**52,
+ * 5**104, 5**208 */
+static const double tens[] = {
+ 1e00, 1e01, 1e02, 1e03, 1e04, 1e05, 1e06, 1e07, 1e08, 1e09,
+ 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
+ 1e20, 1e21, 1e22
+};
+
+static const int itens [] = {
+ 1,
+ 10,
+ 100,
+ 1000,
+ 10000,
+ 100000,
+ 1000000,
+ 10000000,
+ 100000000
+};
+
+static const double bigtens[] = {
+ 1e016, 1e032, 1e064, 1e128, 1e256
+};
+#define N_BIGTENS 5
+
+static const int log2pow5[27] = {
+ 01, 3, 5, 7, 10, 12, 14, 17, 19, 21,
+ 24, 26, 28, 31, 33, 35, 38, 40, 42, 45,
+ 47, 49, 52, 54, 56, 59, 61
+};
+#define N_LOG2POW5 27
+
+static const Tcl_WideUInt wuipow5[27] = {
+ (Tcl_WideUInt) 1, /* 5**0 */
+ (Tcl_WideUInt) 5,
+ (Tcl_WideUInt) 25,
+ (Tcl_WideUInt) 125,
+ (Tcl_WideUInt) 625,
+ (Tcl_WideUInt) 3125, /* 5**5 */
+ (Tcl_WideUInt) 3125*5,
+ (Tcl_WideUInt) 3125*25,
+ (Tcl_WideUInt) 3125*125,
+ (Tcl_WideUInt) 3125*625,
+ (Tcl_WideUInt) 3125*3125, /* 5**10 */
+ (Tcl_WideUInt) 3125*3125*5,
+ (Tcl_WideUInt) 3125*3125*25,
+ (Tcl_WideUInt) 3125*3125*125,
+ (Tcl_WideUInt) 3125*3125*625,
+ (Tcl_WideUInt) 3125*3125*3125, /* 5**15 */
+ (Tcl_WideUInt) 3125*3125*3125*5,
+ (Tcl_WideUInt) 3125*3125*3125*25,
+ (Tcl_WideUInt) 3125*3125*3125*125,
+ (Tcl_WideUInt) 3125*3125*3125*625,
+ (Tcl_WideUInt) 3125*3125*3125*3125, /* 5**20 */
+ (Tcl_WideUInt) 3125*3125*3125*3125*5,
+ (Tcl_WideUInt) 3125*3125*3125*3125*25,
+ (Tcl_WideUInt) 3125*3125*3125*3125*125,
+ (Tcl_WideUInt) 3125*3125*3125*3125*625,
+ (Tcl_WideUInt) 3125*3125*3125*3125*3125, /* 5**25 */
+ (Tcl_WideUInt) 3125*3125*3125*3125*3125*5 /* 5**26 */
+};
/*
* Static functions defined in this file.
*/
-static double AbsoluteValue(double v, int *signum);
-static int AccumulateDecimalDigit(unsigned, int,
+static int AccumulateDecimalDigit(unsigned, int,
Tcl_WideUInt *, mp_int *, int);
-static double BignumToBiasedFrExp(const mp_int *big, int *machexp);
-static int GetIntegerTimesPower(double v, mp_int *r, int *e);
static double MakeHighPrecisionDouble(int signum,
mp_int *significand, int nSigDigs, int exponent);
static double MakeLowPrecisionDouble(int signum,
Tcl_WideUInt significand, int nSigDigs,
int exponent);
+#ifdef IEEE_FLOATING_POINT
static double MakeNaN(int signum, Tcl_WideUInt tag);
-static Tcl_WideUInt Nokia770Twiddle(Tcl_WideUInt w);
-static double Pow10TimesFrExp(int exponent, double fraction,
- int *machexp);
+#endif
static double RefineApproximation(double approx,
mp_int *exactSignificand, int exponent);
+static void MulPow5(mp_int *, unsigned, mp_int *);
+static int NormalizeRightward(Tcl_WideUInt *);
+static int RequiredPrecision(Tcl_WideUInt);
+static void DoubleToExpAndSig(double, Tcl_WideUInt *, int *,
+ int *);
+static void TakeAbsoluteValue(Double *, int *);
+static char * FormatInfAndNaN(Double *, int *, char **);
+static char * FormatZero(int *, char **);
+static int ApproximateLog10(Tcl_WideUInt, int, int);
+static int BetterLog10(double, int, int *);
+static void ComputeScale(int, int, int *, int *, int *, int *);
+static void SetPrecisionLimits(int, int, int *, int *, int *,
+ int *);
+static char * BumpUp(char *, char *, int *);
+static int AdjustRange(double *, int);
+static char * ShorteningQuickFormat(double, int, int, double,
+ char *, int *);
+static char * StrictQuickFormat(double, int, int, double,
+ char *, int *);
+static char * QuickConversion(double, int, int, int, int, int, int,
+ int *, char **);
+static void CastOutPowersOf2(int *, int *, int *);
+static char * ShorteningInt64Conversion(Double *, int, Tcl_WideUInt,
+ int, int, int, int, int, int, int, int, int,
+ int, int, int *, char **);
+static char * StrictInt64Conversion(Double *, int, Tcl_WideUInt,
+ int, int, int, int, int, int,
+ int, int, int *, char **);
+static int ShouldBankerRoundUpPowD(mp_int *, int, int);
+static int ShouldBankerRoundUpToNextPowD(mp_int *, mp_int *,
+ int, int, int, mp_int *);
+static char * ShorteningBignumConversionPowD(Double *dPtr,
+ int convType, Tcl_WideUInt bw, int b2, int b5,
+ int m2plus, int m2minus, int m5,
+ int sd, int k, int len,
+ int ilim, int ilim1, int *decpt,
+ char **endPtr);
+static char * StrictBignumConversionPowD(Double *dPtr, int convType,
+ Tcl_WideUInt bw, int b2, int b5,
+ int sd, int k, int len,
+ int ilim, int ilim1, int *decpt,
+ char **endPtr);
+static int ShouldBankerRoundUp(mp_int *, mp_int *, int);
+static int ShouldBankerRoundUpToNext(mp_int *, mp_int *,
+ mp_int *, int, int, mp_int *);
+static char * ShorteningBignumConversion(Double *dPtr, int convType,
+ Tcl_WideUInt bw, int b2,
+ int m2plus, int m2minus,
+ int s2, int s5, int k, int len,
+ int ilim, int ilim1, int *decpt,
+ char **endPtr);
+static char * StrictBignumConversion(Double *dPtr, int convType,
+ Tcl_WideUInt bw, int b2,
+ int s2, int s5, int k, int len,
+ int ilim, int ilim1, int *decpt,
+ char **endPtr);
+static double BignumToBiasedFrExp(const mp_int *big, int *machexp);
+static double Pow10TimesFrExp(int exponent, double fraction,
+ int *machexp);
static double SafeLdExp(double fraction, int exponent);
+#ifdef IEEE_FLOATING_POINT
+static Tcl_WideUInt Nokia770Twiddle(Tcl_WideUInt w);
+#endif
/*
*----------------------------------------------------------------------
@@ -281,38 +497,38 @@ TclParseNumber(
} state = INITIAL;
enum State acceptState = INITIAL;
- int signum = 0; /* Sign of the number being parsed */
+ int signum = 0; /* Sign of the number being parsed. */
Tcl_WideUInt significandWide = 0;
/* Significand of the number being parsed (if
- * no overflow) */
+ * no overflow). */
mp_int significandBig; /* Significand of the number being parsed (if
- * it overflows significandWide) */
- int significandOverflow = 0;/* Flag==1 iff significandBig is used */
+ * it overflows significandWide). */
+ int significandOverflow = 0;/* Flag==1 iff significandBig is used. */
Tcl_WideUInt octalSignificandWide = 0;
/* Significand of an octal number; needed
* because we don't know whether a number with
* a leading zero is octal or decimal until
- * we've scanned forward to a '.' or 'e' */
+ * we've scanned forward to a '.' or 'e'. */
mp_int octalSignificandBig; /* Significand of octal number once
- * octalSignificandWide overflows */
+ * octalSignificandWide overflows. */
int octalSignificandOverflow = 0;
- /* Flag==1 if octalSignificandBig is used */
+ /* Flag==1 if octalSignificandBig is used. */
int numSigDigs = 0; /* Number of significant digits in the decimal
- * significand */
+ * significand. */
int numTrailZeros = 0; /* Number of trailing zeroes at the current
* point in the parse. */
int numDigitsAfterDp = 0; /* Number of digits scanned after the decimal
- * point */
+ * point. */
int exponentSignum = 0; /* Signum of the exponent of a floating point
- * number */
- long exponent = 0; /* Exponent of a floating point number */
- const char *p; /* Pointer to next character to scan */
- size_t len; /* Number of characters remaining after p */
+ * number. */
+ long exponent = 0; /* Exponent of a floating point number. */
+ const char *p; /* Pointer to next character to scan. */
+ size_t len; /* Number of characters remaining after p. */
const char *acceptPoint; /* Pointer to position after last character in
- * an acceptable number */
+ * an acceptable number. */
size_t acceptLen; /* Number of characters following that
* point. */
- int status = TCL_OK; /* Status to return to caller */
+ int status = TCL_OK; /* Status to return to caller. */
char d = 0; /* Last hexadecimal digit scanned; initialized
* to avoid a compiler warning. */
int shift = 0; /* Amount to shift when accumulating binary */
@@ -344,7 +560,7 @@ TclParseNumber(
* I, N, and whitespace.
*/
- if (isspace(UCHAR(c))) {
+ if (TclIsSpaceProc(c)) {
if (flags & TCL_PARSE_NO_WHITESPACE) {
goto endgame;
}
@@ -402,9 +618,9 @@ TclParseNumber(
case ZERO:
/*
* Scanned a leading zero (perhaps with a + or -). Acceptable
- * inputs are digits, period, X, b, and E. If 8 or 9 is encountered,
- * the number can't be octal. This state and the OCTAL state
- * differ only in whether they recognize 'X' and 'b'.
+ * inputs are digits, period, X, b, and E. If 8 or 9 is
+ * encountered, the number can't be octal. This state and the
+ * OCTAL state differ only in whether they recognize 'X' and 'b'.
*/
acceptState = state;
@@ -864,7 +1080,7 @@ TclParseNumber(
}
/* FALLTHROUGH */
case sNANPAREN:
- if (isspace(UCHAR(c))) {
+ if (TclIsSpaceProc(c)) {
break;
}
if (numSigDigs < 13) {
@@ -874,7 +1090,10 @@ TclParseNumber(
d = 10 + c - 'a';
} else if (c >= 'A' && c <= 'F') {
d = 10 + c - 'A';
+ } else {
+ goto endgame;
}
+ numSigDigs++;
significandWide = (significandWide << 4) + d;
state = sNANHEX;
break;
@@ -915,7 +1134,7 @@ TclParseNumber(
* Accept trailing whitespace.
*/
- while (len != 0 && isspace(UCHAR(*p))) {
+ while (len != 0 && TclIsSpaceProc(*p)) {
p++;
len--;
}
@@ -998,7 +1217,7 @@ TclParseNumber(
case OCTAL:
/*
- * Returning an octal integer. Final scaling step
+ * Returning an octal integer. Final scaling step.
*/
shift = 3 * numTrailZeros;
@@ -1059,7 +1278,7 @@ TclParseNumber(
case DECIMAL:
significandOverflow = AccumulateDecimalDigit(0, numTrailZeros-1,
&significandWide, &significandBig, significandOverflow);
- if (!significandOverflow && (significandWide > MOST_BITS+signum)) {
+ if (!significandOverflow && (significandWide > MOST_BITS+signum)){
significandOverflow = 1;
TclBNInitBignumFromWideUInt(&significandBig, significandWide);
}
@@ -1115,16 +1334,16 @@ TclParseNumber(
objPtr->typePtr = &tclDoubleType;
if (exponentSignum) {
- exponent = - exponent;
+ exponent = -exponent;
}
if (!significandOverflow) {
objPtr->internalRep.doubleValue = MakeLowPrecisionDouble(
signum, significandWide, numSigDigs,
- (numTrailZeros + exponent - numDigitsAfterDp));
+ numTrailZeros + exponent - numDigitsAfterDp);
} else {
objPtr->internalRep.doubleValue = MakeHighPrecisionDouble(
signum, &significandBig, numSigDigs,
- (numTrailZeros + exponent - numDigitsAfterDp));
+ numTrailZeros + exponent - numDigitsAfterDp);
}
break;
@@ -1141,12 +1360,12 @@ TclParseNumber(
#ifdef IEEE_FLOATING_POINT
case sNAN:
case sNANFINISH:
- objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
+ objPtr->internalRep.doubleValue = MakeNaN(signum,significandWide);
objPtr->typePtr = &tclDoubleType;
break;
#endif
case INITIAL:
- /* This case only to silence compiler warning */
+ /* This case only to silence compiler warning. */
Tcl_Panic("TclParseNumber: state INITIAL can't happen here");
}
}
@@ -1157,11 +1376,9 @@ TclParseNumber(
if (status != TCL_OK) {
if (interp != NULL) {
- Tcl_Obj *msg;
+ Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"",
+ expected);
- TclNewLiteralStringObj(msg, "expected ");
- Tcl_AppendToObj(msg, expected, -1);
- Tcl_AppendToObj(msg, " but got \"", -1);
Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
Tcl_AppendToObj(msg, "\"", -1);
if (state == BAD_OCTAL) {
@@ -1218,7 +1435,7 @@ AccumulateDecimalDigit(
Tcl_WideUInt w;
/*
- * Try wide multiplication first
+ * Try wide multiplication first.
*/
if (!bignumFlag) {
@@ -1231,10 +1448,10 @@ AccumulateDecimalDigit(
*wideRepPtr = digit;
return 0;
} else if (numZeros >= maxpow10_wide
- || w > ((~(Tcl_WideUInt)0)-digit)/pow10_wide[numZeros+1]) {
+ || w > ((~(Tcl_WideUInt)0)-digit)/pow10_wide[numZeros+1]) {
/*
- * Wide multiplication will overflow. Expand the
- * number to a bignum and fall through into the bignum case.
+ * Wide multiplication will overflow. Expand the number to a
+ * bignum and fall through into the bignum case.
*/
TclBNInitBignumFromWideUInt(bignumRepPtr, w);
@@ -1242,6 +1459,7 @@ AccumulateDecimalDigit(
/*
* Wide multiplication.
*/
+
*wideRepPtr = w * pow10_wide[numZeros+1] + digit;
return 0;
}
@@ -1309,12 +1527,12 @@ AccumulateDecimalDigit(
static double
MakeLowPrecisionDouble(
int signum, /* 1 if the number is negative, 0 otherwise */
- Tcl_WideUInt significand, /* Significand of the number */
- int numSigDigs, /* Number of digits in the significand */
- int exponent) /* Power of ten */
+ Tcl_WideUInt significand, /* Significand of the number. */
+ int numSigDigs, /* Number of digits in the significand. */
+ int exponent) /* Power of ten. */
{
- double retval; /* Value of the number */
- mp_int significandBig; /* Significand expressed as a bignum */
+ double retval; /* Value of the number. */
+ mp_int significandBig; /* Significand expressed as a bignum. */
/*
* With gcc on x86, the floating point rounding mode is double-extended.
@@ -1324,15 +1542,7 @@ MakeLowPrecisionDouble(
* ulp, so we need to change rounding mode to 53-bits.
*/
-#if defined(__GNUC__) && defined(__i386)
- fpu_control_t roundTo53Bits = 0x027f;
- fpu_control_t oldRoundingMode;
- _FPU_GETCW(oldRoundingMode);
- _FPU_SETCW(roundTo53Bits);
-#endif
-#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
- ieee_flags("set","precision","double",NULL);
-#endif
+ TCL_IEEE_DOUBLE_ROUNDING;
/*
* Test for the easy cases.
@@ -1347,10 +1557,12 @@ MakeLowPrecisionDouble(
* without special handling.
*/
- retval = (double)(Tcl_WideInt)significand * pow10vals[exponent];
+ retval = (double)
+ ((Tcl_WideInt)significand * pow10vals[exponent]);
goto returnValue;
} else {
int diff = DBL_DIG - numSigDigs;
+
if (exponent-diff <= mmaxpow) {
/*
* 10**exponent is not an exact integer, but
@@ -1359,8 +1571,8 @@ MakeLowPrecisionDouble(
* with only one roundoff.
*/
- volatile double factor =
- (double)(Tcl_WideInt)significand * pow10vals[diff];
+ volatile double factor = (double)
+ ((Tcl_WideInt)significand * pow10vals[diff]);
retval = factor * pow10vals[exponent-diff];
goto returnValue;
}
@@ -1373,7 +1585,8 @@ MakeLowPrecisionDouble(
* only one rounding.
*/
- retval = (double)(Tcl_WideInt)significand / pow10vals[-exponent];
+ retval = (double)
+ ((Tcl_WideInt)significand / pow10vals[-exponent]);
goto returnValue;
}
}
@@ -1402,12 +1615,7 @@ MakeLowPrecisionDouble(
* On gcc on x86, restore the floating point mode word.
*/
-#if defined(__GNUC__) && defined(__i386)
- _FPU_SETCW(oldRoundingMode);
-#endif
-#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
- ieee_flags("clear","precision",NULL,NULL);
-#endif
+ TCL_DEFAULT_DOUBLE_ROUNDING;
return retval;
}
@@ -1432,13 +1640,13 @@ MakeLowPrecisionDouble(
static double
MakeHighPrecisionDouble(
- int signum, /* 1=negative, 0=nonnegative */
- mp_int *significand, /* Exact significand of the number */
- int numSigDigs, /* Number of significant digits */
- int exponent) /* Power of 10 by which to multiply */
+ int signum, /* 1=negative, 0=nonnegative. */
+ mp_int *significand, /* Exact significand of the number. */
+ int numSigDigs, /* Number of significant digits. */
+ int exponent) /* Power of 10 by which to multiply. */
{
double retval;
- int machexp; /* Machine exponent of a power of 10 */
+ int machexp; /* Machine exponent of a power of 10. */
/*
* With gcc on x86, the floating point rounding mode is double-extended.
@@ -1448,15 +1656,7 @@ MakeHighPrecisionDouble(
* ulp, so we need to change rounding mode to 53-bits.
*/
-#if defined(__GNUC__) && defined(__i386)
- fpu_control_t roundTo53Bits = 0x027f;
- fpu_control_t oldRoundingMode;
- _FPU_GETCW(oldRoundingMode);
- _FPU_SETCW(roundTo53Bits);
-#endif
-#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
- ieee_flags("set","precision","double",NULL);
-#endif
+ TCL_IEEE_DOUBLE_ROUNDING;
/*
* Quick checks for over/underflow.
@@ -1515,12 +1715,8 @@ MakeHighPrecisionDouble(
* On gcc on x86, restore the floating point mode word.
*/
-#if defined(__GNUC__) && defined(__i386)
- _FPU_SETCW(oldRoundingMode);
-#endif
-#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
- ieee_flags("clear","precision",NULL,NULL);
-#endif
+ TCL_DEFAULT_DOUBLE_ROUNDING;
+
return retval;
}
@@ -1539,8 +1735,8 @@ MakeHighPrecisionDouble(
#ifdef IEEE_FLOATING_POINT
static double
MakeNaN(
- int signum, /* Sign bit (1=negative, 0=nonnegative */
- Tcl_WideUInt tags) /* Tag bits to put in the NaN */
+ int signum, /* Sign bit (1=negative, 0=nonnegative. */
+ Tcl_WideUInt tags) /* Tag bits to put in the NaN. */
{
union {
Tcl_WideUInt iv;
@@ -1578,28 +1774,28 @@ MakeNaN(
static double
RefineApproximation(
- double approxResult, /* Approximate result of conversion */
- mp_int *exactSignificand, /* Integer significand */
- int exponent) /* Power of 10 to multiply by significand */
+ double approxResult, /* Approximate result of conversion. */
+ mp_int *exactSignificand, /* Integer significand. */
+ int exponent) /* Power of 10 to multiply by significand. */
{
int M2, M5; /* Powers of 2 and of 5 needed to put the
* decimal and binary numbers over a common
* denominator. */
- double significand; /* Sigificand of the binary number */
- int binExponent; /* Exponent of the binary number */
+ double significand; /* Sigificand of the binary number. */
+ int binExponent; /* Exponent of the binary number. */
int msb; /* Most significant bit position of an
- * intermediate result */
+ * intermediate result. */
int nDigits; /* Number of mp_digit's in an intermediate
- * result */
+ * result. */
mp_int twoMv; /* Approx binary value expressed as an exact
- * integer scaled by the multiplier 2M */
+ * integer scaled by the multiplier 2M. */
mp_int twoMd; /* Exact decimal value expressed as an exact
- * integer scaled by the multiplier 2M */
- int scale; /* Scale factor for M */
- int multiplier; /* Power of two to scale M */
+ * integer scaled by the multiplier 2M. */
+ int scale; /* Scale factor for M. */
+ int multiplier; /* Power of two to scale M. */
double num, den; /* Numerator and denominator of the correction
- * term */
- double quot; /* Correction term */
+ * term. */
+ double quot; /* Correction term. */
double minincr; /* Lower bound on the absolute value of the
* correction term. */
int i;
@@ -1629,8 +1825,8 @@ RefineApproximation(
M5 = 0;
} else {
M5 = -exponent;
- if ((M5-1) > M2) {
- M2 = M5-1;
+ if (M5 - 1 > M2) {
+ M2 = M5 - 1;
}
}
@@ -1669,7 +1865,7 @@ RefineApproximation(
mp_init_copy(&twoMd, exactSignificand);
for (i=0; i<=8; ++i) {
- if ((M5+exponent) & (1 << i)) {
+ if ((M5 + exponent) & (1 << i)) {
mp_mul(&twoMd, pow5+i, &twoMd);
}
}
@@ -1679,7 +1875,7 @@ RefineApproximation(
/*
* The result, 2Mv-2Md, needs to be divided by 2M to yield a correction
* term. Because 2M may well overflow a double, we need to scale the
- * denominator by a factor of 2**binExponent-mantBits
+ * denominator by a factor of 2**binExponent-mantBits.
*/
scale = binExponent - mantBits - 1;
@@ -1734,411 +1930,2387 @@ RefineApproximation(
/*
*----------------------------------------------------------------------
*
- * TclDoubleDigits --
+ * MultPow5 --
+ *
+ * Multiply a bignum by a power of 5.
+ *
+ * Side effects:
+ * Stores base*5**n in result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static void
+MulPow5(
+ mp_int *base, /* Number to multiply. */
+ unsigned n, /* Power of 5 to multiply by. */
+ mp_int *result) /* Place to store the result. */
+{
+ mp_int *p = base;
+ int n13 = n / 13;
+ int r = n % 13;
+
+ if (r != 0) {
+ mp_mul_d(p, dpow5[r], result);
+ p = result;
+ }
+ r = 0;
+ while (n13 != 0) {
+ if (n13 & 1) {
+ mp_mul(p, pow5_13+r, result);
+ p = result;
+ }
+ n13 >>= 1;
+ ++r;
+ }
+ if (p != result) {
+ mp_copy(p, result);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NormalizeRightward --
*
- * Converts a double to a string of digits.
+ * Shifts a number rightward until it is odd (that is, until the least
+ * significant bit is nonzero.
*
* Results:
- * Returns the position of the character in the string after which the
- * decimal point should appear. Since the string contains only
- * significant digits, the position may be less than zero or greater than
- * the length of the string.
+ * Returns the number of bit positions by which the number was shifted.
*
* Side effects:
- * Stores the digits in the given buffer and sets 'signum' according to
- * the sign of the number.
+ * Shifts the number in place; *wPtr is replaced by the shifted number.
*
*----------------------------------------------------------------------
+ */
+
+inline static int
+NormalizeRightward(
+ Tcl_WideUInt *wPtr) /* INOUT: Number to shift. */
+{
+ int rv = 0;
+ Tcl_WideUInt w = *wPtr;
+ if (!(w & (Tcl_WideUInt) 0xffffffff)) {
+ w >>= 32; rv += 32;
+ }
+ if (!(w & (Tcl_WideUInt) 0xffff)) {
+ w >>= 16; rv += 16;
+ }
+ if (!(w & (Tcl_WideUInt) 0xff)) {
+ w >>= 8; rv += 8;
+ }
+ if (!(w & (Tcl_WideUInt) 0xf)) {
+ w >>= 4; rv += 4;
+ }
+ if (!(w & 0x3)) {
+ w >>= 2; rv += 2;
+ }
+ if (!(w & 0x1)) {
+ w >>= 1; ++rv;
+ }
+ *wPtr = w;
+ return rv;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RequiredPrecision --
+ *
+ * Determines the number of bits needed to hold an intger.
+ *
+ * Results:
+ * Returns the position of the most significant bit (0 - 63). Returns 0
+ * if the number is zero.
+ *
+ *----------------------------------------------------------------------
*/
-int
-TclDoubleDigits(
- char *buffer, /* Buffer in which to store the result, must
- * have at least 18 chars */
- double v, /* Number to convert. Must be finite, and not
- * NaN */
- int *signum) /* Output: 1 if the number is negative.
- * Should handle -0 correctly on the IEEE
- * architecture. */
+static int
+RequiredPrecision(
+ Tcl_WideUInt w) /* Number to interrogate. */
{
- int e; /* Power of FLT_RADIX that satisfies
- * v = f * FLT_RADIX**e */
- int lowOK, highOK;
- mp_int r; /* Scaled significand. */
- mp_int s; /* Divisor such that v = r / s */
- int smallestSig; /* Flag == 1 iff v's significand is the
- * smallest that can be represented. */
- mp_int mplus; /* Scaled epsilon: (r + 2* mplus) == v(+)
- * where v(+) is the floating point successor
- * of v. */
- mp_int mminus; /* Scaled epsilon: (r - 2*mminus) == v(-)
- * where v(-) is the floating point
- * predecessor of v. */
- mp_int temp;
- int rfac2 = 0; /* Powers of 2 and 5 by which large */
- int rfac5 = 0; /* integers should be scaled. */
- int sfac2 = 0;
- int sfac5 = 0;
- int mplusfac2 = 0;
- int mminusfac2 = 0;
- char c;
- int i, k, n;
+ int rv;
+ unsigned long wi;
+
+ if (w & ((Tcl_WideUInt) 0xffffffff << 32)) {
+ wi = (unsigned long) (w >> 32); rv = 32;
+ } else {
+ wi = (unsigned long) w; rv = 0;
+ }
+ if (wi & 0xffff0000) {
+ wi >>= 16; rv += 16;
+ }
+ if (wi & 0xff00) {
+ wi >>= 8; rv += 8;
+ }
+ if (wi & 0xf0) {
+ wi >>= 4; rv += 4;
+ }
+ if (wi & 0xc) {
+ wi >>= 2; rv += 2;
+ }
+ if (wi & 0x2) {
+ wi >>= 1; ++rv;
+ }
+ if (wi & 0x1) {
+ ++rv;
+ }
+ return rv;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DoubleToExpAndSig --
+ *
+ * Separates a 'double' into exponent and significand.
+ *
+ * Side effects:
+ * Stores the significand in '*significand' and the exponent in '*expon'
+ * so that dv == significand * 2.0**expon, and significand is odd. Also
+ * stores the position of the leftmost 1-bit in 'significand' in 'bits'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static void
+DoubleToExpAndSig(
+ double dv, /* Number to convert. */
+ Tcl_WideUInt *significand, /* OUTPUT: Significand of the number. */
+ int *expon, /* OUTPUT: Exponent to multiply the number
+ * by. */
+ int *bits) /* OUTPUT: Number of significant bits. */
+{
+ Double d; /* Number being converted. */
+ Tcl_WideUInt z; /* Significand under construction. */
+ int de; /* Exponent of the number. */
+ int k; /* Bit count. */
+
+ d.d = dv;
/*
- * Split the number into absolute value and signum.
+ * Extract exponent and significand.
*/
- v = AbsoluteValue(v, signum);
+ de = (d.w.word0 & EXP_MASK) >> EXP_SHIFT;
+ z = d.q & SIG_MASK;
+ if (de != 0) {
+ z |= HIDDEN_BIT;
+ k = NormalizeRightward(&z);
+ *bits = FP_PRECISION - k;
+ *expon = k + (de - EXPONENT_BIAS) - (FP_PRECISION-1);
+ } else {
+ k = NormalizeRightward(&z);
+ *expon = k + (de - EXPONENT_BIAS) - (FP_PRECISION-1) + 1;
+ *bits = RequiredPrecision(z);
+ }
+ *significand = z;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TakeAbsoluteValue --
+ *
+ * Takes the absolute value of a 'double' including 0, Inf and NaN
+ *
+ * Side effects:
+ * The 'double' in *d is replaced with its absolute value. The signum is
+ * stored in 'sign': 1 for negative, 0 for nonnegative.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static void
+TakeAbsoluteValue(
+ Double *d, /* Number to replace with absolute value. */
+ int *sign) /* Place to put the signum. */
+{
+ if (d->w.word0 & SIGN_BIT) {
+ *sign = 1;
+ d->w.word0 &= ~SIGN_BIT;
+ } else {
+ *sign = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FormatInfAndNaN --
+ *
+ * Bailout for formatting infinities and Not-A-Number.
+ *
+ * Results:
+ * Returns one of the strings 'Infinity' and 'NaN'. The string returned
+ * must be freed by the caller using 'ckfree'.
+ *
+ * Side effects:
+ * Stores 9999 in *decpt, and sets '*endPtr' to designate the terminating
+ * NUL byte of the string if 'endPtr' is not NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static char *
+FormatInfAndNaN(
+ Double *d, /* Exceptional number to format. */
+ int *decpt, /* Decimal point to set to a bogus value. */
+ char **endPtr) /* Pointer to the end of the formatted data */
+{
+ char *retval;
+
+ *decpt = 9999;
+ if (!(d->w.word1) && !(d->w.word0 & HI_ORDER_SIG_MASK)) {
+ retval = ckalloc(9);
+ strcpy(retval, "Infinity");
+ if (endPtr) {
+ *endPtr = retval + 8;
+ }
+ } else {
+ retval = ckalloc(4);
+ strcpy(retval, "NaN");
+ if (endPtr) {
+ *endPtr = retval + 3;
+ }
+ }
+ return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FormatZero --
+ *
+ * Bailout to format a zero floating-point number.
+ *
+ * Results:
+ * Returns the constant string "0"
+ *
+ * Side effects:
+ * Stores 1 in '*decpt' and puts a pointer to the NUL byte terminating
+ * the string in '*endPtr' if 'endPtr' is not NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static char *
+FormatZero(
+ int *decpt, /* Location of the decimal point. */
+ char **endPtr) /* Pointer to the end of the formatted data */
+{
+ char *retval = ckalloc(2);
+
+ strcpy(retval, "0");
+ if (endPtr) {
+ *endPtr = retval+1;
+ }
+ *decpt = 0;
+ return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ApproximateLog10 --
+ *
+ * Computes a two-term Taylor series approximation to the common log of a
+ * number, and computes the number's binary log.
+ *
+ * Results:
+ * Return an approximation to floor(log10(bw*2**be)) that is either exact
+ * or 1 too high.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static int
+ApproximateLog10(
+ Tcl_WideUInt bw, /* Integer significand of the number. */
+ int be, /* Power of two to scale bw. */
+ int bbits) /* Number of bits of precision in bw. */
+{
+ int i; /* Log base 2 of the number. */
+ int k; /* Floor(Log base 10 of the number) */
+ double ds; /* Mantissa of the number. */
+ Double d2;
/*
- * Handle zero specially.
+ * Compute i and d2 such that d = d2*2**i, and 1 < d2 < 2.
+ * Compute an approximation to log10(d),
+ * log10(d) ~ log10(2) * i + log10(1.5)
+ * + (significand-1.5)/(1.5 * log(10))
*/
- if (v == 0.0) {
- *buffer++ = '0';
- *buffer++ = '\0';
- return 1;
+ d2.q = bw << (FP_PRECISION - bbits) & SIG_MASK;
+ d2.w.word0 |= (EXPONENT_BIAS) << EXP_SHIFT;
+ i = be + bbits - 1;
+ ds = (d2.d - 1.5) * TWO_OVER_3LOG10
+ + LOG10_3HALVES_PLUS_FUDGE + LOG10_2 * i;
+ k = (int) ds;
+ if (k > ds) {
+ --k;
}
+ return k;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BetterLog10 --
+ *
+ * Improves the result of ApproximateLog10 for numbers in the range
+ * 1 .. 10**(TEN_PMAX)-1
+ *
+ * Side effects:
+ * Sets k_check to 0 if the new result is known to be exact, and to 1 if
+ * it may still be one too high.
+ *
+ * Results:
+ * Returns the improved approximation to log10(d).
+ *
+ *----------------------------------------------------------------------
+ */
+inline static int
+BetterLog10(
+ double d, /* Original number to format. */
+ int k, /* Characteristic(Log base 10) of the
+ * number. */
+ int *k_check) /* Flag == 1 if k is inexact. */
+{
/*
- * Find a large integer r, and integer e, such that
- * v = r * FLT_RADIX**e
- * and r is as small as possible. Also determine whether the significand
- * is the smallest possible.
+ * Performance hack. If k is in the range 0..TEN_PMAX, then we can use a
+ * powers-of-ten table to check it.
*/
- smallestSig = GetIntegerTimesPower(v, &r, &e);
+ if (k >= 0 && k <= TEN_PMAX) {
+ if (d < tens[k]) {
+ k--;
+ }
+ *k_check = 0;
+ } else {
+ *k_check = 1;
+ }
+ return k;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeScale --
+ *
+ * Prepares to format a floating-point number as decimal.
+ *
+ * Parameters:
+ * floor(log10*x) is k (or possibly k-1). floor(log2(x) is i. The
+ * significand of x requires bbits bits to represent.
+ *
+ * Results:
+ * Determines integers b2, b5, s2, s5 so that sig*2**b2*5**b5/2**s2*2**s5
+ * exactly represents the value of the x/10**k. This value will lie in
+ * the range [1 .. 10), and allows for computing successive digits by
+ * multiplying sig%10 by 10.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static void
+ComputeScale(
+ int be, /* Exponent part of number: d = bw * 2**be. */
+ int k, /* Characteristic of log10(number). */
+ int *b2, /* OUTPUT: Power of 2 in the numerator. */
+ int *b5, /* OUTPUT: Power of 5 in the numerator. */
+ int *s2, /* OUTPUT: Power of 2 in the denominator. */
+ int *s5) /* OUTPUT: Power of 5 in the denominator. */
+{
+ /*
+ * Scale numerator and denominator powers of 2 so that the input binary
+ * number is the ratio of integers.
+ */
- lowOK = highOK = (mp_iseven(&r));
+ if (be <= 0) {
+ *b2 = 0;
+ *s2 = -be;
+ } else {
+ *b2 = be;
+ *s2 = 0;
+ }
/*
- * We are going to want to develop integers r, s, mplus, and mminus such
- * that v = r / s, v(+)-v / 2 = mplus / s; v-v(-) / 2 = mminus / s and
- * then scale either s or r, mplus, mminus by an appropriate power of ten.
- *
- * We actually do this by keeping track of the powers of 2 and 5 by which
- * f is multiplied to yield v and by which 1 is multiplied to yield s,
- * mplus, and mminus.
+ * Scale numerator and denominator so that the output decimal number is
+ * the ratio of integers.
*/
- if (e >= 0) {
- int bits = e * log2FLT_RADIX;
+ if (k >= 0) {
+ *b5 = 0;
+ *s5 = k;
+ *s2 += k;
+ } else {
+ *b2 -= k;
+ *b5 = -k;
+ *s5 = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetPrecisionLimits --
+ *
+ * Determines how many digits of significance should be computed (and,
+ * hence, how much memory need be allocated) for formatting a floating
+ * point number.
+ *
+ * Given that 'k' is floor(log10(x)):
+ * if 'shortest' format is used, there will be at most 18 digits in the
+ * result.
+ * if 'F' format is used, there will be at most 'ndigits' + k + 1 digits
+ * if 'E' format is used, there will be exactly 'ndigits' digits.
+ *
+ * Side effects:
+ * Adjusts '*ndigitsPtr' to have a valid value. Stores the maximum memory
+ * allocation needed in *iPtr. Sets '*iLimPtr' to the limiting number of
+ * digits to convert if k has been guessed correctly, and '*iLim1Ptr' to
+ * the limiting number of digits to convert if k has been guessed to be
+ * one too high.
+ *
+ *----------------------------------------------------------------------
+ */
- if (!smallestSig) {
- /*
- * Normal case, m+ and m- are both FLT_RADIX**e
- */
+inline static void
+SetPrecisionLimits(
+ int convType, /* Type of conversion: TCL_DD_SHORTEST,
+ * TCL_DD_STEELE0, TCL_DD_E_FMT,
+ * TCL_DD_F_FMT. */
+ int k, /* Floor(log10(number to convert)) */
+ int *ndigitsPtr, /* IN/OUT: Number of digits requested (will be
+ * adjusted if needed). */
+ int *iPtr, /* OUT: Maximum number of digits to return. */
+ int *iLimPtr, /* OUT: Number of digits of significance if
+ * the bignum method is used.*/
+ int *iLim1Ptr) /* OUT: Number of digits of significance if
+ * the quick method is used. */
+{
+ switch (convType) {
+ case TCL_DD_SHORTEST0:
+ case TCL_DD_STEELE0:
+ *iLimPtr = *iLim1Ptr = -1;
+ *iPtr = 18;
+ *ndigitsPtr = 0;
+ break;
+ case TCL_DD_E_FORMAT:
+ if (*ndigitsPtr <= 0) {
+ *ndigitsPtr = 1;
+ }
+ *iLimPtr = *iLim1Ptr = *iPtr = *ndigitsPtr;
+ break;
+ case TCL_DD_F_FORMAT:
+ *iPtr = *ndigitsPtr + k + 1;
+ *iLimPtr = *iPtr;
+ *iLim1Ptr = *iPtr - 1;
+ if (*iPtr <= 0) {
+ *iPtr = 1;
+ }
+ break;
+ default:
+ *iPtr = -1;
+ *iLimPtr = -1;
+ *iLim1Ptr = -1;
+ Tcl_Panic("impossible conversion type in TclDoubleDigits");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BumpUp --
+ *
+ * Increases a string of digits ending in a series of nines to designate
+ * the next higher number. xxxxb9999... -> xxxx(b+1)0000...
+ *
+ * Results:
+ * Returns a pointer to the end of the adjusted string.
+ *
+ * Side effects:
+ * In the case that the string consists solely of '999999', sets it to
+ * "1" and moves the decimal point (*kPtr) one place to the right.
+ *
+ *----------------------------------------------------------------------
+ */
- rfac2 = bits + 1;
- sfac2 = 1;
- mplusfac2 = bits;
- mminusfac2 = bits;
- } else {
- /*
- * If f is equal to the smallest significand, then we need another
- * factor of FLT_RADIX in s to cope with stepping to the next
- * smaller exponent when going to e's predecessor.
- */
+inline static char *
+BumpUp(
+ char *s, /* Cursor pointing one past the end of the
+ * string. */
+ char *retval, /* Start of the string of digits. */
+ int *kPtr) /* Position of the decimal point. */
+{
+ while (*--s == '9') {
+ if (s == retval) {
+ ++(*kPtr);
+ *s = '1';
+ return s+1;
+ }
+ }
+ ++*s;
+ ++s;
+ return s;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustRange --
+ *
+ * Rescales a 'double' in preparation for formatting it using the 'quick'
+ * double-to-string method.
+ *
+ * Results:
+ * Returns the precision that has been lost in the prescaling as a count
+ * of units in the least significant place.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static int
+AdjustRange(
+ double *dPtr, /* INOUT: Number to adjust. */
+ int k) /* IN: floor(log10(d)) */
+{
+ int ieps; /* Number of roundoff errors that have
+ * accumulated. */
+ double d = *dPtr; /* Number to adjust. */
+ double ds;
+ int i, j, j1;
+
+ ieps = 2;
+
+ if (k > 0) {
+ /*
+ * The number must be reduced to bring it into range.
+ */
+
+ ds = tens[k & 0xf];
+ j = k >> 4;
+ if (j & BLETCH) {
+ j &= (BLETCH-1);
+ d /= bigtens[N_BIGTENS - 1];
+ ieps++;
+ }
+ i = 0;
+ for (; j != 0; j>>=1) {
+ if (j & 1) {
+ ds *= bigtens[i];
+ ++ieps;
+ }
+ ++i;
+ }
+ d /= ds;
+ } else if ((j1 = -k) != 0) {
+ /*
+ * The number must be increased to bring it into range.
+ */
+
+ d *= tens[j1 & 0xf];
+ i = 0;
+ for (j = j1>>4; j; j>>=1) {
+ if (j & 1) {
+ ieps++;
+ d *= bigtens[i];
+ }
+ ++i;
+ }
+ }
- rfac2 = bits + log2FLT_RADIX + 1;
- sfac2 = 1 + log2FLT_RADIX;
- mplusfac2 = bits + log2FLT_RADIX;
- mminusfac2 = bits;
+ *dPtr = d;
+ return ieps;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ShorteningQuickFormat --
+ *
+ * Returns a 'quick' format of a double precision number to a string of
+ * digits, preferring a shorter string of digits if the shorter string is
+ * still within 1/2 ulp of the number.
+ *
+ * Results:
+ * Returns the string of digits. Returns NULL if the 'quick' method fails
+ * and the bignum method must be used.
+ *
+ * Side effects:
+ * Stores the position of the decimal point at '*kPtr'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static char *
+ShorteningQuickFormat(
+ double d, /* Number to convert. */
+ int k, /* floor(log10(d)) */
+ int ilim, /* Number of significant digits to return. */
+ double eps, /* Estimated roundoff error. */
+ char *retval, /* Buffer to receive the digit string. */
+ int *kPtr) /* Pointer to stash the position of the
+ * decimal point. */
+{
+ char *s = retval; /* Cursor in the return value. */
+ int digit; /* Current digit. */
+ int i;
+
+ eps = 0.5 / tens[ilim-1] - eps;
+ i = 0;
+ for (;;) {
+ /*
+ * Convert a digit.
+ */
+
+ digit = (int) d;
+ d -= digit;
+ *s++ = '0' + digit;
+
+ /*
+ * Truncate the conversion if the string of digits is within 1/2 ulp
+ * of the actual value.
+ */
+
+ if (d < eps) {
+ *kPtr = k;
+ return s;
+ }
+ if ((1. - d) < eps) {
+ *kPtr = k;
+ return BumpUp(s, retval, kPtr);
+ }
+
+ /*
+ * Bail out if the conversion fails to converge to a sufficiently
+ * precise value.
+ */
+
+ if (++i >= ilim) {
+ return NULL;
+ }
+
+ /*
+ * Bring the next digit to the integer part.
+ */
+
+ eps *= 10;
+ d *= 10.0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StrictQuickFormat --
+ *
+ * Convert a double precision number of a string of a precise number of
+ * digits, using the 'quick' double precision method.
+ *
+ * Results:
+ * Returns the digit string, or NULL if the bignum method must be used to
+ * do the formatting.
+ *
+ * Side effects:
+ * Stores the position of the decimal point in '*kPtr'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static char *
+StrictQuickFormat(
+ double d, /* Number to convert. */
+ int k, /* floor(log10(d)) */
+ int ilim, /* Number of significant digits to return. */
+ double eps, /* Estimated roundoff error. */
+ char *retval, /* Start of the digit string. */
+ int *kPtr) /* Pointer to stash the position of the
+ * decimal point. */
+{
+ char *s = retval; /* Cursor in the return value. */
+ int digit; /* Current digit of the answer. */
+ int i;
+
+ eps *= tens[ilim-1];
+ i = 1;
+ for (;;) {
+ /*
+ * Extract a digit.
+ */
+
+ digit = (int) d;
+ d -= digit;
+ if (d == 0.0) {
+ ilim = i;
}
+ *s++ = '0' + digit;
+
+ /*
+ * When the given digit count is reached, handle trailing strings of 0
+ * and 9.
+ */
+
+ if (i == ilim) {
+ if (d > 0.5 + eps) {
+ *kPtr = k;
+ return BumpUp(s, retval, kPtr);
+ } else if (d < 0.5 - eps) {
+ while (*--s == '0') {
+ /* do nothing */
+ }
+ s++;
+ *kPtr = k;
+ return s;
+ } else {
+ return NULL;
+ }
+ }
+
+ /*
+ * Advance to the next digit.
+ */
+
+ ++i;
+ d *= 10.0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * QuickConversion --
+ *
+ * Converts a floating point number the 'quick' way, when only a limited
+ * number of digits is required and floating point arithmetic can
+ * therefore be used for the intermediate results.
+ *
+ * Results:
+ * Returns the converted string, or NULL if the bignum method must be
+ * used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static char *
+QuickConversion(
+ double e, /* Number to format. */
+ int k, /* floor(log10(d)), approximately. */
+ int k_check, /* 0 if k is exact, 1 if it may be too high */
+ int flags, /* Flags passed to dtoa:
+ * TCL_DD_SHORTEN_FLAG */
+ int len, /* Length of the return value. */
+ int ilim, /* Number of digits to store. */
+ int ilim1, /* Number of digits to store if we misguessed
+ * k. */
+ int *decpt, /* OUTPUT: Location of the decimal point. */
+ char **endPtr) /* OUTPUT: Pointer to the terminal null
+ * byte. */
+{
+ int ieps; /* Number of 1-ulp roundoff errors that have
+ * accumulated in the calculation. */
+ Double eps; /* Estimated roundoff error. */
+ char *retval; /* Returned string. */
+ char *end; /* Pointer to the terminal null byte in the
+ * returned string. */
+ volatile double d; /* Workaround for a bug in mingw gcc 3.4.5 */
+
+ /*
+ * Bring d into the range [1 .. 10).
+ */
+
+ ieps = AdjustRange(&e, k);
+ d = e;
+
+ /*
+ * If the guessed value of k didn't get d into range, adjust it by one. If
+ * that leaves us outside the range in which quick format is accurate,
+ * bail out.
+ */
+
+ if (k_check && d < 1. && ilim > 0) {
+ if (ilim1 < 0) {
+ return NULL;
+ }
+ ilim = ilim1;
+ --k;
+ d *= 10.0;
+ ++ieps;
+ }
+
+ /*
+ * Compute estimated roundoff error.
+ */
+
+ eps.d = ieps * d + 7.;
+ eps.w.word0 -= (FP_PRECISION-1) << EXP_SHIFT;
+
+ /*
+ * Handle the peculiar case where the result has no significant digits.
+ */
+
+ retval = ckalloc(len + 1);
+ if (ilim == 0) {
+ d -= 5.;
+ if (d > eps.d) {
+ *retval = '1';
+ *decpt = k;
+ return retval;
+ } else if (d < -eps.d) {
+ *decpt = k;
+ return retval;
+ } else {
+ ckfree(retval);
+ return NULL;
+ }
+ }
+
+ /*
+ * Format the digit string.
+ */
+
+ if (flags & TCL_DD_SHORTEN_FLAG) {
+ end = ShorteningQuickFormat(d, k, ilim, eps.d, retval, decpt);
} else {
+ end = StrictQuickFormat(d, k, ilim, eps.d, retval, decpt);
+ }
+ if (end == NULL) {
+ ckfree(retval);
+ return NULL;
+ }
+ *end = '\0';
+ if (endPtr != NULL) {
+ *endPtr = end;
+ }
+ return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CastOutPowersOf2 --
+ *
+ * Adjust the factors 'b2', 'm2', and 's2' to cast out common powers of 2
+ * from numerator and denominator in preparation for the 'bignum' method
+ * of floating point conversion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static void
+CastOutPowersOf2(
+ int *b2, /* Power of 2 to multiply the significand. */
+ int *m2, /* Power of 2 to multiply 1/2 ulp. */
+ int *s2) /* Power of 2 to multiply the common
+ * denominator. */
+{
+ int i;
+
+ if (*m2 > 0 && *s2 > 0) { /* Find the smallest power of 2 in the
+ * numerator. */
+ if (*m2 < *s2) { /* Find the lowest common denominator. */
+ i = *m2;
+ } else {
+ i = *s2;
+ }
+ *b2 -= i; /* Reduce to lowest terms. */
+ *m2 -= i;
+ *s2 -= i;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ShorteningInt64Conversion --
+ *
+ * Converts a double-precision number to the shortest string of digits
+ * that reconverts exactly to the given number, or to 'ilim' digits if
+ * that will yield a shorter result. The numerator and denominator in
+ * David Gay's conversion algorithm are known to fit in Tcl_WideUInt,
+ * giving considerably faster arithmetic than mp_int's.
+ *
+ * Results:
+ * Returns the string of significant decimal digits, in newly allocated
+ * memory
+ *
+ * Side effects:
+ * Stores the location of the decimal point in '*decpt' and the location
+ * of the terminal null byte in '*endPtr'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static char *
+ShorteningInt64Conversion(
+ Double *dPtr, /* Original number to convert. */
+ int convType, /* Type of conversion (shortest, Steele,
+ * E format, F format). */
+ Tcl_WideUInt bw, /* Integer significand. */
+ int b2, int b5, /* Scale factor for the significand in the
+ * numerator. */
+ int m2plus, int m2minus, int m5,
+ /* Scale factors for 1/2 ulp in the numerator
+ * (will be different if bw == 1. */
+ int s2, int s5, /* Scale factors for the denominator. */
+ int k, /* Number of output digits before the decimal
+ * point. */
+ int len, /* Number of digits to allocate. */
+ int ilim, /* Number of digits to convert if b >= s */
+ int ilim1, /* Number of digits to convert if b < s */
+ int *decpt, /* OUTPUT: Position of the decimal point. */
+ char **endPtr) /* OUTPUT: Position of the terminal '\0' at
+ * the end of the returned string. */
+{
+ char *retval = ckalloc(len + 1);
+ /* Output buffer. */
+ Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
+ /* Numerator of the fraction being
+ * converted. */
+ Tcl_WideUInt S = wuipow5[s5] << s2;
+ /* Denominator of the fraction being
+ * converted. */
+ Tcl_WideUInt mplus, mminus; /* Ranges for testing whether the result is
+ * within roundoff of being exact. */
+ int digit; /* Current output digit. */
+ char *s = retval; /* Cursor in the output buffer. */
+ int i; /* Current position in the output buffer. */
+
+ /*
+ * Adjust if the logarithm was guessed wrong.
+ */
+
+ if (b < S) {
+ b = 10 * b;
+ ++m2plus; ++m2minus; ++m5;
+ ilim = ilim1;
+ --k;
+ }
+
+ /*
+ * Compute roundoff ranges.
+ */
+
+ mplus = wuipow5[m5] << m2plus;
+ mminus = wuipow5[m5] << m2minus;
+
+ /*
+ * Loop through the digits.
+ */
+
+ i = 1;
+ for (;;) {
+ digit = (int)(b / S);
+ if (digit > 10) {
+ Tcl_Panic("wrong digit!");
+ }
+ b = b % S;
+
/*
- * v has digits after the binary point
+ * Does the current digit put us on the low side of the exact value
+ * but within within roundoff of being exact?
*/
- if (e <= DBL_MIN_EXP-DBL_MANT_DIG || !smallestSig) {
+ if (b < mplus || (b == mplus
+ && convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) {
/*
- * Either f isn't the smallest significand or e is the smallest
- * exponent. mplus and mminus will both be 1.
+ * Make sure we shouldn't be rounding *up* instead, in case the
+ * next number above is closer.
*/
- rfac2 = 1;
- sfac2 = 1 - e * log2FLT_RADIX;
- mplusfac2 = 0;
- mminusfac2 = 0;
- } else {
+ if (2 * b > S || (2 * b == S && (digit & 1) != 0)) {
+ ++digit;
+ if (digit == 10) {
+ *s++ = '9';
+ s = BumpUp(s, retval, &k);
+ break;
+ }
+ }
+
/*
- * f is the smallest significand, but e is not the smallest
- * exponent. We need to scale by FLT_RADIX again to cope with the
- * fact that v's predecessor has a smaller exponent.
+ * Stash the current digit.
*/
- rfac2 = 1 + log2FLT_RADIX;
- sfac2 = 1 + log2FLT_RADIX * (1 - e);
- mplusfac2 = FLT_RADIX;
- mminusfac2 = 0;
+ *s++ = '0' + digit;
+ break;
}
+
+ /*
+ * Does one plus the current digit put us within roundoff of the
+ * number?
+ */
+
+ if (b > S - mminus || (b == S - mminus
+ && convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) {
+ if (digit == 9) {
+ *s++ = '9';
+ s = BumpUp(s, retval, &k);
+ break;
+ }
+ ++digit;
+ *s++ = '0' + digit;
+ break;
+ }
+
+ /*
+ * Have we converted all the requested digits?
+ */
+
+ *s++ = '0' + digit;
+ if (i == ilim) {
+ if (2*b > S || (2*b == S && (digit & 1) != 0)) {
+ s = BumpUp(s, retval, &k);
+ }
+ break;
+ }
+
+ /*
+ * Advance to the next digit.
+ */
+
+ b = 10 * b;
+ mplus = 10 * mplus;
+ mminus = 10 * mminus;
+ ++i;
}
/*
- * Estimate the highest power of ten that will be needed to hold the
- * result.
+ * Endgame - store the location of the decimal point and the end of the
+ * string.
*/
- k = (int) ceil(log(v) / log(10.));
- if (k >= 0) {
- sfac2 += k;
- sfac5 = k;
- } else {
- rfac2 -= k;
- mplusfac2 -= k;
- mminusfac2 -= k;
- rfac5 = -k;
+ *s = '\0';
+ *decpt = k;
+ if (endPtr) {
+ *endPtr = s;
+ }
+ return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StrictInt64Conversion --
+ *
+ * Converts a double-precision number to a fixed-length string of 'ilim'
+ * digits that reconverts exactly to the given number. ('ilim' should be
+ * replaced with 'ilim1' in the case where log10(d) has been
+ * overestimated). The numerator and denominator in David Gay's
+ * conversion algorithm are known to fit in Tcl_WideUInt, giving
+ * considerably faster arithmetic than mp_int's.
+ *
+ * Results:
+ * Returns the string of significant decimal digits, in newly allocated
+ * memory
+ *
+ * Side effects:
+ * Stores the location of the decimal point in '*decpt' and the location
+ * of the terminal null byte in '*endPtr'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static char *
+StrictInt64Conversion(
+ Double *dPtr, /* Original number to convert. */
+ int convType, /* Type of conversion (shortest, Steele,
+ * E format, F format). */
+ Tcl_WideUInt bw, /* Integer significand. */
+ int b2, int b5, /* Scale factor for the significand in the
+ * numerator. */
+ int s2, int s5, /* Scale factors for the denominator. */
+ int k, /* Number of output digits before the decimal
+ * point. */
+ int len, /* Number of digits to allocate. */
+ int ilim, /* Number of digits to convert if b >= s */
+ int ilim1, /* Number of digits to convert if b < s */
+ int *decpt, /* OUTPUT: Position of the decimal point. */
+ char **endPtr) /* OUTPUT: Position of the terminal '\0' at
+ * the end of the returned string. */
+{
+ char *retval = ckalloc(len + 1);
+ /* Output buffer. */
+ Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
+ /* Numerator of the fraction being
+ * converted. */
+ Tcl_WideUInt S = wuipow5[s5] << s2;
+ /* Denominator of the fraction being
+ * converted. */
+ int digit; /* Current output digit. */
+ char *s = retval; /* Cursor in the output buffer. */
+ int i; /* Current position in the output buffer. */
+
+ /*
+ * Adjust if the logarithm was guessed wrong.
+ */
+
+ if (b < S) {
+ b = 10 * b;
+ ilim = ilim1;
+ --k;
}
/*
- * Scale r, s, mplus, mminus by the appropriate powers of 2 and 5.
+ * Loop through the digits.
*/
- mp_init_set(&mplus, 1);
- for (i=0 ; i<=8 ; ++i) {
- if (rfac5 & (1 << i)) {
- mp_mul(&mplus, pow5+i, &mplus);
+ i = 1;
+ for (;;) {
+ digit = (int)(b / S);
+ if (digit > 10) {
+ Tcl_Panic("wrong digit!");
+ }
+ b = b % S;
+
+ /*
+ * Have we converted all the requested digits?
+ */
+
+ *s++ = '0' + digit;
+ if (i == ilim) {
+ if (2*b > S || (2*b == S && (digit & 1) != 0)) {
+ s = BumpUp(s, retval, &k);
+ } else {
+ while (*--s == '0') {
+ /* do nothing */
+ }
+ ++s;
+ }
+ break;
}
+
+ /*
+ * Advance to the next digit.
+ */
+
+ b = 10 * b;
+ ++i;
+ }
+
+ /*
+ * Endgame - store the location of the decimal point and the end of the
+ * string.
+ */
+
+ *s = '\0';
+ *decpt = k;
+ if (endPtr) {
+ *endPtr = s;
+ }
+ return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ShouldBankerRoundUpPowD --
+ *
+ * Test whether bankers' rounding should round a digit up. Assumption is
+ * made that the denominator of the fraction being tested is a power of
+ * 2**DIGIT_BIT.
+ *
+ * Results:
+ * Returns 1 iff the fraction is more than 1/2, or if the fraction is
+ * exactly 1/2 and the digit is odd.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static int
+ShouldBankerRoundUpPowD(
+ mp_int *b, /* Numerator of the fraction. */
+ int sd, /* Denominator is 2**(sd*DIGIT_BIT). */
+ int isodd) /* 1 if the digit is odd, 0 if even. */
+{
+ int i;
+ static const mp_digit topbit = 1 << (DIGIT_BIT - 1);
+
+ if (b->used < sd || (b->dp[sd-1] & topbit) == 0) {
+ return 0;
+ }
+ if (b->dp[sd-1] != topbit) {
+ return 1;
}
- mp_mul(&r, &mplus, &r);
- mp_mul_2d(&r, rfac2, &r);
- mp_init_copy(&mminus, &mplus);
- mp_mul_2d(&mplus, mplusfac2, &mplus);
- mp_mul_2d(&mminus, mminusfac2, &mminus);
- mp_init_set(&s, 1);
- for (i=0 ; i<=8 ; ++i) {
- if (sfac5 & (1 << i)) {
- mp_mul(&s, pow5+i, &s);
+ for (i = sd-2; i >= 0; --i) {
+ if (b->dp[i] != 0) {
+ return 1;
}
}
- mp_mul_2d(&s, sfac2, &s);
+ return isodd;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ShouldBankerRoundUpToNextPowD --
+ *
+ * Tests whether bankers' rounding will round down in the "denominator is
+ * a power of 2**MP_DIGIT" case.
+ *
+ * Results:
+ * Returns 1 if the rounding will be performed - which increases the
+ * digit by one - and 0 otherwise.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static int
+ShouldBankerRoundUpToNextPowD(
+ mp_int *b, /* Numerator of the fraction. */
+ mp_int *m, /* Numerator of the rounding tolerance. */
+ int sd, /* Common denominator is 2**(sd*DIGIT_BIT). */
+ int convType, /* Conversion type: STEELE defeats
+ * round-to-even (not sure why one wants to do
+ * this; I copied it from Gay). FIXME */
+ int isodd, /* 1 if the integer significand is odd. */
+ mp_int *temp) /* Work area for the calculation. */
+{
+ int i;
/*
- * It is possible for k to be off by one because we used an inexact
- * logarithm.
+ * Compare B and S-m - which is the same as comparing B+m and S - which we
+ * do by computing b+m and doing a bitwhack compare against
+ * 2**(DIGIT_BIT*sd)
*/
- mp_init(&temp);
- mp_add(&r, &mplus, &temp);
- i = mp_cmp_mag(&temp, &s);
- if (i>0 || (highOK && i==0)) {
- mp_mul_d(&s, 10, &s);
- k++;
- } else {
- mp_mul_d(&temp, 10, &temp);
- i = mp_cmp_mag(&temp, &s);
- if (i<0 || (highOK && i==0)) {
- mp_mul_d(&r, 10, &r);
- mp_mul_d(&mplus, 10, &mplus);
- mp_mul_d(&mminus, 10, &mminus);
- k--;
+ mp_add(b, m, temp);
+ if (temp->used <= sd) { /* Too few digits to be > s */
+ return 0;
+ }
+ if (temp->used > sd+1 || temp->dp[sd] > 1) {
+ /* >= 2s */
+ return 1;
+ }
+ for (i = sd-1; i >= 0; --i) {
+ /* Check for ==s */
+ if (temp->dp[i] != 0) { /* > s */
+ return 1;
}
}
+ if (convType == TCL_DD_STEELE0) {
+ /* Biased rounding. */
+ return 0;
+ }
+ return isodd;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ShorteningBignumConversionPowD --
+ *
+ * Converts a double-precision number to the shortest string of digits
+ * that reconverts exactly to the given number, or to 'ilim' digits if
+ * that will yield a shorter result. The denominator in David Gay's
+ * conversion algorithm is known to be a power of 2**DIGIT_BIT, and hence
+ * the division in the main loop may be replaced by a digit shift and
+ * mask.
+ *
+ * Results:
+ * Returns the string of significant decimal digits, in newly allocated
+ * memory
+ *
+ * Side effects:
+ * Stores the location of the decimal point in '*decpt' and the location
+ * of the terminal null byte in '*endPtr'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static char *
+ShorteningBignumConversionPowD(
+ Double *dPtr, /* Original number to convert. */
+ int convType, /* Type of conversion (shortest, Steele,
+ * E format, F format). */
+ Tcl_WideUInt bw, /* Integer significand. */
+ int b2, int b5, /* Scale factor for the significand in the
+ * numerator. */
+ int m2plus, int m2minus, int m5,
+ /* Scale factors for 1/2 ulp in the numerator
+ * (will be different if bw == 1). */
+ int sd, /* Scale factor for the denominator. */
+ int k, /* Number of output digits before the decimal
+ * point. */
+ int len, /* Number of digits to allocate. */
+ int ilim, /* Number of digits to convert if b >= s */
+ int ilim1, /* Number of digits to convert if b < s */
+ int *decpt, /* OUTPUT: Position of the decimal point. */
+ char **endPtr) /* OUTPUT: Position of the terminal '\0' at
+ * the end of the returned string. */
+{
+ char *retval = ckalloc(len + 1);
+ /* Output buffer. */
+ mp_int b; /* Numerator of the fraction being
+ * converted. */
+ mp_int mplus, mminus; /* Bounds for roundoff. */
+ mp_digit digit; /* Current output digit. */
+ char *s = retval; /* Cursor in the output buffer. */
+ int i; /* Index in the output buffer. */
+ mp_int temp;
+ int r1;
+
+ /*
+ * b = bw * 2**b2 * 5**b5
+ * mminus = 5**m5
+ */
+
+ TclBNInitBignumFromWideUInt(&b, bw);
+ mp_init_set_int(&mminus, 1);
+ MulPow5(&b, b5, &b);
+ mp_mul_2d(&b, b2, &b);
+
+ /*
+ * Adjust if the logarithm was guessed wrong.
+ */
+
+ if (b.used <= sd) {
+ mp_mul_d(&b, 10, &b);
+ ++m2plus; ++m2minus; ++m5;
+ ilim = ilim1;
+ --k;
+ }
+
+ /*
+ * mminus = 5**m5 * 2**m2minus
+ * mplus = 5**m5 * 2**m2plus
+ */
+
+ mp_mul_2d(&mminus, m2minus, &mminus);
+ MulPow5(&mminus, m5, &mminus);
+ if (m2plus > m2minus) {
+ mp_init_copy(&mplus, &mminus);
+ mp_mul_2d(&mplus, m2plus-m2minus, &mplus);
+ }
+ mp_init(&temp);
/*
- * At this point, k contains the power of ten by which we're scaling the
- * result. r/s is at least 1/10 and strictly less than ten, and v = r/s *
- * 10**k. mplus and mminus give the rounding limits.
+ * Loop through the digits. Do division and mod by s == 2**(sd*DIGIT_BIT)
+ * by mp_digit extraction.
*/
+ i = 0;
for (;;) {
- int tc1, tc2;
+ if (b.used <= sd) {
+ digit = 0;
+ } else {
+ digit = b.dp[sd];
+ if (b.used > sd+1 || digit >= 10) {
+ Tcl_Panic("wrong digit!");
+ }
+ --b.used; mp_clamp(&b);
+ }
+
+ /*
+ * Does the current digit put us on the low side of the exact value
+ * but within within roundoff of being exact?
+ */
- mp_mul_d(&r, 10, &r);
- mp_div(&r, &s, &temp, &r); /* temp = 10r / s; r = 10r mod s */
- i = temp.dp[0];
- mp_mul_d(&mplus, 10, &mplus);
+ r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus);
+ if (r1 == MP_LT || (r1 == MP_EQ
+ && convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) {
+ /*
+ * Make sure we shouldn't be rounding *up* instead, in case the
+ * next number above is closer.
+ */
+
+ if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) {
+ ++digit;
+ if (digit == 10) {
+ *s++ = '9';
+ s = BumpUp(s, retval, &k);
+ break;
+ }
+ }
+
+ /*
+ * Stash the last digit.
+ */
+
+ *s++ = '0' + digit;
+ break;
+ }
+
+ /*
+ * Does one plus the current digit put us within roundoff of the
+ * number?
+ */
+
+ if (ShouldBankerRoundUpToNextPowD(&b, &mminus, sd, convType,
+ dPtr->w.word1 & 1, &temp)) {
+ if (digit == 9) {
+ *s++ = '9';
+ s = BumpUp(s, retval, &k);
+ break;
+ }
+ ++digit;
+ *s++ = '0' + digit;
+ break;
+ }
+
+ /*
+ * Have we converted all the requested digits?
+ */
+
+ *s++ = '0' + digit;
+ if (i == ilim) {
+ if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) {
+ s = BumpUp(s, retval, &k);
+ }
+ break;
+ }
+
+ /*
+ * Advance to the next digit.
+ */
+
+ mp_mul_d(&b, 10, &b);
mp_mul_d(&mminus, 10, &mminus);
- tc1 = mp_cmp_mag(&r, &mminus);
- if (lowOK) {
- tc1 = (tc1 <= 0);
- } else {
- tc1 = (tc1 < 0);
+ if (m2plus > m2minus) {
+ mp_mul_2d(&mminus, m2plus-m2minus, &mplus);
}
- mp_add(&r, &mplus, &temp);
- tc2 = mp_cmp_mag(&temp, &s);
- if (highOK) {
- tc2 = (tc2 >= 0);
+ ++i;
+ }
+
+ /*
+ * Endgame - store the location of the decimal point and the end of the
+ * string.
+ */
+
+ if (m2plus > m2minus) {
+ mp_clear(&mplus);
+ }
+ mp_clear_multi(&b, &mminus, &temp, NULL);
+ *s = '\0';
+ *decpt = k;
+ if (endPtr) {
+ *endPtr = s;
+ }
+ return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StrictBignumConversionPowD --
+ *
+ * Converts a double-precision number to a fixed-lengt string of 'ilim'
+ * digits (or 'ilim1' if log10(d) has been overestimated). The
+ * denominator in David Gay's conversion algorithm is known to be a power
+ * of 2**DIGIT_BIT, and hence the division in the main loop may be
+ * replaced by a digit shift and mask.
+ *
+ * Results:
+ * Returns the string of significant decimal digits, in newly allocated
+ * memory.
+ *
+ * Side effects:
+ * Stores the location of the decimal point in '*decpt' and the location
+ * of the terminal null byte in '*endPtr'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static char *
+StrictBignumConversionPowD(
+ Double *dPtr, /* Original number to convert. */
+ int convType, /* Type of conversion (shortest, Steele,
+ * E format, F format). */
+ Tcl_WideUInt bw, /* Integer significand. */
+ int b2, int b5, /* Scale factor for the significand in the
+ * numerator. */
+ int sd, /* Scale factor for the denominator. */
+ int k, /* Number of output digits before the decimal
+ * point. */
+ int len, /* Number of digits to allocate. */
+ int ilim, /* Number of digits to convert if b >= s */
+ int ilim1, /* Number of digits to convert if b < s */
+ int *decpt, /* OUTPUT: Position of the decimal point. */
+ char **endPtr) /* OUTPUT: Position of the terminal '\0' at
+ * the end of the returned string. */
+{
+ char *retval = ckalloc(len + 1);
+ /* Output buffer. */
+ mp_int b; /* Numerator of the fraction being
+ * converted. */
+ mp_digit digit; /* Current output digit. */
+ char *s = retval; /* Cursor in the output buffer. */
+ int i; /* Index in the output buffer. */
+ mp_int temp;
+
+ /*
+ * b = bw * 2**b2 * 5**b5
+ */
+
+ TclBNInitBignumFromWideUInt(&b, bw);
+ MulPow5(&b, b5, &b);
+ mp_mul_2d(&b, b2, &b);
+
+ /*
+ * Adjust if the logarithm was guessed wrong.
+ */
+
+ if (b.used <= sd) {
+ mp_mul_d(&b, 10, &b);
+ ilim = ilim1;
+ --k;
+ }
+ mp_init(&temp);
+
+ /*
+ * Loop through the digits. Do division and mod by s == 2**(sd*DIGIT_BIT)
+ * by mp_digit extraction.
+ */
+
+ i = 1;
+ for (;;) {
+ if (b.used <= sd) {
+ digit = 0;
} else {
- tc2 = (tc2 > 0);
+ digit = b.dp[sd];
+ if (b.used > sd+1 || digit >= 10) {
+ Tcl_Panic("wrong digit!");
+ }
+ --b.used;
+ mp_clamp(&b);
}
- if (!tc1) {
- if (!tc2) {
- *buffer++ = '0' + i;
- } else {
- c = (char) (i + '1');
- break;
+
+ /*
+ * Have we converted all the requested digits?
+ */
+
+ *s++ = '0' + digit;
+ if (i == ilim) {
+ if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) {
+ s = BumpUp(s, retval, &k);
}
+ while (*--s == '0') {
+ /* do nothing */
+ }
+ ++s;
+ break;
+ }
+
+ /*
+ * Advance to the next digit.
+ */
+
+ mp_mul_d(&b, 10, &b);
+ ++i;
+ }
+
+ /*
+ * Endgame - store the location of the decimal point and the end of the
+ * string.
+ */
+
+ mp_clear_multi(&b, &temp, NULL);
+ *s = '\0';
+ *decpt = k;
+ if (endPtr) {
+ *endPtr = s;
+ }
+ return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ShouldBankerRoundUp --
+ *
+ * Tests whether a digit should be rounded up or down when finishing
+ * bignum-based floating point conversion.
+ *
+ * Results:
+ * Returns 1 if the number needs to be rounded up, 0 otherwise.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static int
+ShouldBankerRoundUp(
+ mp_int *twor, /* 2x the remainder from thd division that
+ * produced the last digit. */
+ mp_int *S, /* Denominator. */
+ int isodd) /* Flag == 1 if the last digit is odd. */
+{
+ int r = mp_cmp_mag(twor, S);
+
+ switch (r) {
+ case MP_LT:
+ return 0;
+ case MP_EQ:
+ return isodd;
+ case MP_GT:
+ return 1;
+ }
+ Tcl_Panic("in ShouldBankerRoundUp, trichotomy fails!");
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ShouldBankerRoundUpToNext --
+ *
+ * Tests whether the remainder is great enough to force rounding to the
+ * next higher digit.
+ *
+ * Results:
+ * Returns 1 if the number should be rounded up, 0 otherwise.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static int
+ShouldBankerRoundUpToNext(
+ mp_int *b, /* Remainder from the division that produced
+ * the last digit. */
+ mp_int *m, /* Numerator of the rounding tolerance. */
+ mp_int *S, /* Denominator. */
+ int convType, /* Conversion type: STEELE0 defeats
+ * round-to-even. (Not sure why one would want
+ * this; I coped it from Gay). FIXME */
+ int isodd, /* 1 if the integer significand is odd. */
+ mp_int *temp) /* Work area needed for the calculation. */
+{
+ int r;
+
+ /*
+ * Compare b and S-m: this is the same as comparing B+m and S.
+ */
+
+ mp_add(b, m, temp);
+ r = mp_cmp_mag(temp, S);
+ switch(r) {
+ case MP_LT:
+ return 0;
+ case MP_EQ:
+ if (convType == TCL_DD_STEELE0) {
+ return 0;
} else {
- if (!tc2) {
- c = (char) (i + '0');
- } else {
- mp_mul_2d(&r, 1, &r);
- n = mp_cmp_mag(&r, &s);
- if (n < 0) {
- c = (char) (i + '0');
- } else {
- c = (char) (i + '1');
+ return isodd;
+ }
+ case MP_GT:
+ return 1;
+ }
+ Tcl_Panic("in ShouldBankerRoundUpToNext, trichotomy fails!");
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ShorteningBignumConversion --
+ *
+ * Convert a floating point number to a variable-length digit string
+ * using the multiprecision method.
+ *
+ * Results:
+ * Returns the string of digits.
+ *
+ * Side effects:
+ * Stores the position of the decimal point in *decpt. Stores a pointer
+ * to the end of the number in *endPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+inline static char *
+ShorteningBignumConversion(
+ Double *dPtr, /* Original number being converted. */
+ int convType, /* Conversion type. */
+ Tcl_WideUInt bw, /* Integer significand and exponent. */
+ int b2, /* Scale factor for the significand. */
+ int m2plus, int m2minus, /* Scale factors for 1/2 ulp in numerator. */
+ int s2, int s5, /* Scale factors for denominator. */
+ int k, /* Guessed position of the decimal point. */
+ int len, /* Size of the digit buffer to allocate. */
+ int ilim, /* Number of digits to convert if b >= s */
+ int ilim1, /* Number of digits to convert if b < s */
+ int *decpt, /* OUTPUT: Position of the decimal point. */
+ char **endPtr) /* OUTPUT: Pointer to the end of the number */
+{
+ char *retval = ckalloc(len+1);
+ /* Buffer of digits to return. */
+ char *s = retval; /* Cursor in the return value. */
+ mp_int b; /* Numerator of the result. */
+ mp_int mminus; /* 1/2 ulp below the result. */
+ mp_int mplus; /* 1/2 ulp above the result. */
+ mp_int S; /* Denominator of the result. */
+ mp_int dig; /* Current digit of the result. */
+ int digit; /* Current digit of the result. */
+ mp_int temp; /* Work area. */
+ int minit = 1; /* Fudge factor for when we misguess k. */
+ int i;
+ int r1;
+
+ /*
+ * b = bw * 2**b2 * 5**b5
+ * S = 2**s2 * 5*s5
+ */
+
+ TclBNInitBignumFromWideUInt(&b, bw);
+ mp_mul_2d(&b, b2, &b);
+ mp_init_set_int(&S, 1);
+ MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
+
+ /*
+ * Handle the case where we guess the position of the decimal point wrong.
+ */
+
+ if (mp_cmp_mag(&b, &S) == MP_LT) {
+ mp_mul_d(&b, 10, &b);
+ minit = 10;
+ ilim =ilim1;
+ --k;
+ }
+
+ /*
+ * mminus = 2**m2minus * 5**m5
+ */
+
+ mp_init_set_int(&mminus, minit);
+ mp_mul_2d(&mminus, m2minus, &mminus);
+ if (m2plus > m2minus) {
+ mp_init_copy(&mplus, &mminus);
+ mp_mul_2d(&mplus, m2plus-m2minus, &mplus);
+ }
+ mp_init(&temp);
+
+ /*
+ * Loop through the digits.
+ */
+
+ mp_init(&dig);
+ i = 1;
+ for (;;) {
+ mp_div(&b, &S, &dig, &b);
+ if (dig.used > 1 || dig.dp[0] >= 10) {
+ Tcl_Panic("wrong digit!");
+ }
+ digit = dig.dp[0];
+
+ /*
+ * Does the current digit leave us with a remainder small enough to
+ * round to it?
+ */
+
+ r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus);
+ if (r1 == MP_LT || (r1 == MP_EQ
+ && convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) {
+ mp_mul_2d(&b, 1, &b);
+ if (ShouldBankerRoundUp(&b, &S, digit&1)) {
+ ++digit;
+ if (digit == 10) {
+ *s++ = '9';
+ s = BumpUp(s, retval, &k);
+ break;
}
}
+ *s++ = '0' + digit;
+ break;
+ }
+
+ /*
+ * Does the current digit leave us with a remainder large enough to
+ * commit to rounding up to the next higher digit?
+ */
+
+ if (ShouldBankerRoundUpToNext(&b, &mminus, &S, convType,
+ dPtr->w.word1 & 1, &temp)) {
+ ++digit;
+ if (digit == 10) {
+ *s++ = '9';
+ s = BumpUp(s, retval, &k);
+ break;
+ }
+ *s++ = '0' + digit;
+ break;
+ }
+
+ /*
+ * Have we converted all the requested digits?
+ */
+
+ *s++ = '0' + digit;
+ if (i == ilim) {
+ mp_mul_2d(&b, 1, &b);
+ if (ShouldBankerRoundUp(&b, &S, digit&1)) {
+ s = BumpUp(s, retval, &k);
+ }
break;
}
- };
- *buffer++ = c;
- *buffer++ = '\0';
+
+ /*
+ * Advance to the next digit.
+ */
+
+ if (s5 > 0) {
+ /*
+ * Can possibly shorten the denominator.
+ */
+
+ mp_mul_2d(&b, 1, &b);
+ mp_mul_2d(&mminus, 1, &mminus);
+ if (m2plus > m2minus) {
+ mp_mul_2d(&mplus, 1, &mplus);
+ }
+ mp_div_d(&S, 5, &S, NULL);
+ --s5;
+
+ /*
+ * IDEA: It might possibly be a win to fall back to int64
+ * arithmetic here if S < 2**64/10. But it's a win only for
+ * a fairly narrow range of magnitudes so perhaps not worth
+ * bothering. We already know that we shorten the
+ * denominator by at least 1 mp_digit, perhaps 2, as we do
+ * the conversion for 17 digits of significance.
+ * Possible savings:
+ * 10**26 1 trip through loop before fallback possible
+ * 10**27 1 trip
+ * 10**28 2 trips
+ * 10**29 3 trips
+ * 10**30 4 trips
+ * 10**31 5 trips
+ * 10**32 6 trips
+ * 10**33 7 trips
+ * 10**34 8 trips
+ * 10**35 9 trips
+ * 10**36 10 trips
+ * 10**37 11 trips
+ * 10**38 12 trips
+ * 10**39 13 trips
+ * 10**40 14 trips
+ * 10**41 15 trips
+ * 10**42 16 trips
+ * thereafter no gain.
+ */
+ } else {
+ mp_mul_d(&b, 10, &b);
+ mp_mul_d(&mminus, 10, &mminus);
+ if (m2plus > m2minus) {
+ mp_mul_2d(&mplus, 10, &mplus);
+ }
+ }
+
+ ++i;
+ }
/*
- * Free memory, and return.
+ * Endgame - store the location of the decimal point and the end of the
+ * string.
*/
- mp_clear_multi(&r, &s, &mplus, &mminus, &temp, NULL);
- return k;
+ if (m2plus > m2minus) {
+ mp_clear(&mplus);
+ }
+ mp_clear_multi(&b, &mminus, &temp, &dig, &S, NULL);
+ *s = '\0';
+ *decpt = k;
+ if (endPtr) {
+ *endPtr = s;
+ }
+ return retval;
}
/*
*----------------------------------------------------------------------
*
- * AbsoluteValue --
+ * StrictBignumConversion --
*
- * Splits a 'double' into its absolute value and sign.
+ * Convert a floating point number to a fixed-length digit string using
+ * the multiprecision method.
*
* Results:
- * Returns the absolute value.
+ * Returns the string of digits.
*
* Side effects:
- * Stores the signum in '*signum'.
+ * Stores the position of the decimal point in *decpt. Stores a pointer
+ * to the end of the number in *endPtr.
*
*----------------------------------------------------------------------
*/
-static double
-AbsoluteValue(
- double v, /* Number to split */
- int *signum) /* (Output) Sign of the number 1=-, 0=+ */
+inline static char *
+StrictBignumConversion(
+ Double *dPtr, /* Original number being converted. */
+ int convType, /* Conversion type. */
+ Tcl_WideUInt bw, /* Integer significand and exponent. */
+ int b2, /* Scale factor for the significand. */
+ int s2, int s5, /* Scale factors for denominator. */
+ int k, /* Guessed position of the decimal point. */
+ int len, /* Size of the digit buffer to allocate. */
+ int ilim, /* Number of digits to convert if b >= s */
+ int ilim1, /* Number of digits to convert if b < s */
+ int *decpt, /* OUTPUT: Position of the decimal point. */
+ char **endPtr) /* OUTPUT: Pointer to the end of the number */
{
+ char *retval = ckalloc(len+1);
+ /* Buffer of digits to return. */
+ char *s = retval; /* Cursor in the return value. */
+ mp_int b; /* Numerator of the result. */
+ mp_int S; /* Denominator of the result. */
+ mp_int dig; /* Current digit of the result. */
+ int digit; /* Current digit of the result. */
+ mp_int temp; /* Work area. */
+ int g; /* Size of the current digit ground. */
+ int i, j;
+
/*
- * Take the absolute value of the number, and report the number's sign.
- * Take special steps to preserve signed zeroes in IEEE floating point.
- * (We can't use fpclassify, because that's a C9x feature and we still
- * have to build on C89 compilers.)
+ * b = bw * 2**b2 * 5**b5
+ * S = 2**s2 * 5*s5
*/
-#ifndef IEEE_FLOATING_POINT
- if (v >= 0.0) {
- *signum = 0;
- } else {
- *signum = 1;
- v = -v;
+ mp_init_multi(&temp, &dig, NULL);
+ TclBNInitBignumFromWideUInt(&b, bw);
+ mp_mul_2d(&b, b2, &b);
+ mp_init_set_int(&S, 1);
+ MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
+
+ /*
+ * Handle the case where we guess the position of the decimal point wrong.
+ */
+
+ if (mp_cmp_mag(&b, &S) == MP_LT) {
+ mp_mul_d(&b, 10, &b);
+ ilim =ilim1;
+ --k;
}
-#else
- union {
- Tcl_WideUInt iv;
- double dv;
- } bitwhack;
- bitwhack.dv = v;
- if (n770_fp) {
- bitwhack.iv = Nokia770Twiddle(bitwhack.iv);
+
+ /*
+ * Convert the leading digit.
+ */
+
+ i = 0;
+ mp_div(&b, &S, &dig, &b);
+ if (dig.used > 1 || dig.dp[0] >= 10) {
+ Tcl_Panic("wrong digit!");
}
- if (bitwhack.iv & ((Tcl_WideUInt) 1 << 63)) {
- *signum = 1;
- bitwhack.iv &= ~((Tcl_WideUInt) 1 << 63);
- if (n770_fp) {
- bitwhack.iv = Nokia770Twiddle(bitwhack.iv);
+ digit = dig.dp[0];
+
+ /*
+ * Is a single digit all that was requested?
+ */
+
+ *s++ = '0' + digit;
+ if (++i >= ilim) {
+ mp_mul_2d(&b, 1, &b);
+ if (ShouldBankerRoundUp(&b, &S, digit&1)) {
+ s = BumpUp(s, retval, &k);
}
- v = bitwhack.dv;
} else {
- *signum = 0;
+ for (;;) {
+ /*
+ * Shift by a group of digits.
+ */
+
+ g = ilim - i;
+ if (g > DIGIT_GROUP) {
+ g = DIGIT_GROUP;
+ }
+ if (s5 >= g) {
+ mp_div_d(&S, dpow5[g], &S, NULL);
+ s5 -= g;
+ } else if (s5 > 0) {
+ mp_div_d(&S, dpow5[s5], &S, NULL);
+ mp_mul_d(&b, dpow5[g - s5], &b);
+ s5 = 0;
+ } else {
+ mp_mul_d(&b, dpow5[g], &b);
+ }
+ mp_mul_2d(&b, g, &b);
+
+ /*
+ * As with the shortening bignum conversion, it's possible at this
+ * point that we will have reduced the denominator to less than
+ * 2**64/10, at which point it would be possible to fall back to
+ * to int64 arithmetic. But the potential payoff is tremendously
+ * less - unless we're working in F format - because we know that
+ * three groups of digits will always suffice for %#.17e, the
+ * longest format that doesn't introduce empty precision.
+ *
+ * Extract the next group of digits.
+ */
+
+ mp_div(&b, &S, &dig, &b);
+ if (dig.used > 1) {
+ Tcl_Panic("wrong digit!");
+ }
+ digit = dig.dp[0];
+ for (j = g-1; j >= 0; --j) {
+ int t = itens[j];
+
+ *s++ = digit / t + '0';
+ digit %= t;
+ }
+ i += g;
+
+ /*
+ * Have we converted all the requested digits?
+ */
+
+ if (i == ilim) {
+ mp_mul_2d(&b, 1, &b);
+ if (ShouldBankerRoundUp(&b, &S, digit&1)) {
+ s = BumpUp(s, retval, &k);
+ }
+ break;
+ }
+ }
}
-#endif
- return v;
+ while (*--s == '0') {
+ /* do nothing */
+ }
+ ++s;
+
+ /*
+ * Endgame - store the location of the decimal point and the end of the
+ * string.
+ */
+
+ mp_clear_multi(&b, &S, &temp, &dig, NULL);
+ *s = '\0';
+ *decpt = k;
+ if (endPtr) {
+ *endPtr = s;
+ }
+ return retval;
}
/*
*----------------------------------------------------------------------
*
- * GetIntegerTimesPower --
+ * TclDoubleDigits --
*
- * Converts a floating point number to an exact integer times a power of
- * the floating point radix.
+ * Core of Tcl's conversion of double-precision floating point numbers to
+ * decimal.
*
* Results:
- * Returns 1 if it converted the smallest significand, 0 otherwise.
+ * Returns a newly-allocated string of digits.
*
* Side effects:
- * Initializes the integer value (does not just assign it), and stores
- * the exponent.
+ * Sets *decpt to the index of the character in the string before the
+ * place that the decimal point should go. If 'endPtr' is not NULL, sets
+ * endPtr to point to the terminating '\0' byte of the string. Sets *sign
+ * to 1 if a minus sign should be printed with the number, or 0 if a plus
+ * sign (or no sign) should appear.
+ *
+ * This function is a service routine that produces the string of digits for
+ * floating-point-to-decimal conversion. It can do a number of things
+ * according to the 'flags' argument. Valid values for 'flags' include:
+ * TCL_DD_SHORTEST - This is the default for floating point conversion if
+ * ::tcl_precision is 0. It constructs the shortest string of
+ * digits that will reconvert to the given number when scanned.
+ * For floating point numbers that are exactly between two
+ * decimal numbers, it resolves using the 'round to even' rule.
+ * With this value, the 'ndigits' parameter is ignored.
+ * TCL_DD_STEELE - This value is not recommended and may be removed in
+ * the future. It follows the conversion algorithm outlined in
+ * "How to Print Floating-Point Numbers Accurately" by Guy
+ * L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90,
+ * pp. 112-126]. This rule has the effect of rendering 1e23 as
+ * 9.9999999999999999e22 - which is a 'better' approximation in
+ * the sense that it will reconvert correctly even if a
+ * subsequent input conversion is 'round up' or 'round down'
+ * rather than 'round to nearest', but is surprising otherwise.
+ * TCL_DD_E_FORMAT - This value is used to prepare numbers for %e format
+ * conversion (or for default floating->string if tcl_precision
+ * is not 0). It constructs a string of at most 'ndigits' digits,
+ * choosing the one that is closest to the given number (and
+ * resolving ties with 'round to even'). It is allowed to return
+ * fewer than 'ndigits' if the number converts exactly; if the
+ * TCL_DD_E_FORMAT|TCL_DD_SHORTEN_FLAG is supplied instead, it
+ * also returns fewer digits if the shorter string will still
+ * reconvert without loss to the given input number. In any case,
+ * strings of trailing zeroes are suppressed.
+ * TCL_DD_F_FORMAT - This value is used to prepare numbers for %f format
+ * conversion. It requests that conversion proceed until
+ * 'ndigits' digits after the decimal point have been converted.
+ * It is possible for this format to result in a zero-length
+ * string if the number is sufficiently small. Again, it is
+ * permissible for TCL_DD_F_FORMAT to return fewer digits for a
+ * number that converts exactly, and changing the argument to
+ * TCL_DD_F_FORMAT|TCL_DD_SHORTEN_FLAG will allow the routine
+ * also to return fewer digits if the shorter string will still
+ * reconvert without loss to the given input number. Strings of
+ * trailing zeroes are suppressed.
+ *
+ * To any of these flags may be OR'ed TCL_DD_NO_QUICK; this flag requires
+ * all calculations to be done in exact arithmetic. Normally, E and F
+ * format with fewer than about 14 digits will be done with a quick
+ * floating point approximation and fall back on the exact arithmetic
+ * only if the input number is close enough to the midpoint between two
+ * decimal strings that more precision is needed to resolve which string
+ * is correct.
+ *
+ * The value stored in the 'decpt' argument on return may be negative
+ * (indicating that the decimal point falls to the left of the string) or
+ * greater than the length of the string. In addition, the value -9999 is used
+ * as a sentinel to indicate that the string is one of the special values
+ * "Infinity" and "NaN", and that no decimal point should be inserted.
*
*----------------------------------------------------------------------
*/
-static int
-GetIntegerTimesPower(
- double v, /* Value to convert */
- mp_int *rPtr, /* (Output) Integer value */
- int *ePtr) /* (Output) Power of FLT_RADIX by which r must
- * be multiplied to yield v*/
+char *
+TclDoubleDigits(
+ double dv, /* Number to convert. */
+ int ndigits, /* Number of digits requested. */
+ int flags, /* Conversion flags. */
+ int *decpt, /* OUTPUT: Position of the decimal point. */
+ int *sign, /* OUTPUT: 1 if the result is negative. */
+ char **endPtr) /* OUTPUT: If not NULL, receives a pointer to
+ * one character beyond the end of the
+ * returned string. */
{
- double a, f;
- int e, i, n;
+ int convType = (flags & TCL_DD_CONVERSION_TYPE_MASK);
+ /* Type of conversion being performed:
+ * TCL_DD_SHORTEST0, TCL_DD_STEELE0,
+ * TCL_DD_E_FORMAT, or TCL_DD_F_FORMAT. */
+ Double d; /* Union for deconstructing doubles. */
+ Tcl_WideUInt bw; /* Integer significand. */
+ int be; /* Power of 2 by which b must be multiplied */
+ int bbits; /* Number of bits needed to represent b. */
+ int denorm; /* Flag == 1 iff the input number was
+ * denormalized. */
+ int k; /* Estimate of floor(log10(d)). */
+ int k_check; /* Flag == 1 if d is near enough to a power of
+ * ten that k must be checked. */
+ int b2, b5, s2, s5; /* Powers of 2 and 5 in the numerator and
+ * denominator of intermediate results. */
+ int ilim = -1, ilim1 = -1; /* Number of digits to convert, and number to
+ * convert if log10(d) has been
+ * overestimated. */
+ char *retval; /* Return value from this function. */
+ int i = -1;
+
+ /*
+ * Put the input number into a union for bit-whacking.
+ */
+
+ d.d = dv;
/*
- * Develop f and e such that v = f * FLT_RADIX**e, with
- * 1.0/FLT_RADIX <= f < 1.
+ * Handle the cases of negative numbers (by taking the absolute value:
+ * this includes -Inf and -NaN!), infinity, Not a Number, and zero.
*/
- f = frexp(v, &e);
-#if FLT_RADIX > 2
- n = e % log2FLT_RADIX;
- if (n > 0) {
- n -= log2FLT_RADIX;
- e += 1;
- f *= ldexp(1.0, n);
+ TakeAbsoluteValue(&d, sign);
+ if ((d.w.word0 & EXP_MASK) == EXP_MASK) {
+ return FormatInfAndNaN(&d, decpt, endPtr);
}
- e = (e - n) / log2FLT_RADIX;
-#endif
- if (f == 1.0) {
- f = 1.0 / FLT_RADIX;
- e += 1;
+ if (d.d == 0.0) {
+ return FormatZero(decpt, endPtr);
}
/*
- * If the original number was denormalized, adjust e and f to be denormal
- * as well.
+ * Unpack the floating point into a wide integer and an exponent.
+ * Determine the number of bits that the big integer requires, and compute
+ * a quick approximation (which may be one too high) of ceil(log10(d.d)).
*/
- if (e < DBL_MIN_EXP) {
- n = mantBits + (e - DBL_MIN_EXP)*log2FLT_RADIX;
- f = ldexp(f, (e - DBL_MIN_EXP)*log2FLT_RADIX);
- e = DBL_MIN_EXP;
- n = (n + DIGIT_BIT - 1) / DIGIT_BIT;
- } else {
- n = mantDIGIT;
- }
+ denorm = ((d.w.word0 & EXP_MASK) == 0);
+ DoubleToExpAndSig(d.d, &bw, &be, &bbits);
+ k = ApproximateLog10(bw, be, bbits);
+ k = BetterLog10(d.d, k, &k_check);
+
+ /* At this point, we have:
+ * d is the number to convert.
+ * bw are significand and exponent: d == bw*2**be,
+ * bbits is the length of bw: 2**bbits-1 <= bw < 2**bbits
+ * k is either ceil(log10(d)) or ceil(log10(d))+1. k_check is 0 if we
+ * know that k is exactly ceil(log10(d)) and 1 if we need to check.
+ * We want a rational number
+ * r = b * 10**(1-k) = bw * 2**b2 * 5**b5 / (2**s2 / 5**s5),
+ * with b2, b5, s2, s5 >= 0. Note that the most significant decimal
+ * digit is floor(r) and that successive digits can be obtained by
+ * setting r <- 10*floor(r) (or b <= 10 * (b % S)). Find appropriate
+ * b2, b5, s2, s5.
+ */
+
+ ComputeScale(be, k, &b2, &b5, &s2, &s5);
+
+ /*
+ * Correct an incorrect caller-supplied 'ndigits'. Also determine:
+ * i = The maximum number of decimal digits that will be returned in the
+ * formatted string. This is k + 1 + ndigits for F format, 18 for
+ * shortest and Steele, and ndigits for E format.
+ * ilim = The number of significant digits to convert if k has been
+ * guessed correctly. This is -1 for shortest and Steele (which
+ * stop when all significance has been lost), 'ndigits' for E
+ * format, and 'k + 1 + ndigits' for F format.
+ * ilim1 = The minimum number of significant digits to convert if k has
+ * been guessed 1 too high. This, too, is -1 for shortest and
+ * Steele, and 'ndigits' for E format, but it's 'ndigits-1' for F
+ * format.
+ */
+
+ SetPrecisionLimits(convType, k, &ndigits, &i, &ilim, &ilim1);
/*
- * Now extract the base-2**DIGIT_BIT digits of f into a multi-precision
- * integer r. Preserve the invariant v = r * 2**rfac2 * FLT_RADIX**e by
- * adjusting e.
+ * Try to do low-precision conversion in floating point rather than
+ * resorting to expensive multiprecision arithmetic.
*/
- a = f;
- n = mantDIGIT;
- mp_init_size(rPtr, n);
- rPtr->used = n;
- rPtr->sign = MP_ZPOS;
- i = (mantBits % DIGIT_BIT);
- if (i == 0) {
- i = DIGIT_BIT;
+ if (ilim >= 0 && ilim <= QUICK_MAX && !(flags & TCL_DD_NO_QUICK)) {
+ retval = QuickConversion(d.d, k, k_check, flags, i, ilim, ilim1,
+ decpt, endPtr);
+ if (retval != NULL) {
+ return retval;
+ }
}
- while (n > 0) {
- a *= ldexp(1.0, i);
- i = DIGIT_BIT;
- rPtr->dp[--n] = (mp_digit) a;
- a -= (mp_digit) a;
+
+ /*
+ * For shortening conversions, determine the upper and lower bounds for
+ * the remainder at which we can stop.
+ * m+ = (2**m2plus * 5**m5) / (2**s2 * 5**s5) is the limit on the high
+ * side, and
+ * m- = (2**m2minus * 5**m5) / (2**s2 * 5**s5) is the limit on the low
+ * side.
+ * We may need to increase s2 to put m2plus, m2minus, b2 over a common
+ * denominator.
+ */
+
+ if (flags & TCL_DD_SHORTEN_FLAG) {
+ int m2minus = b2;
+ int m2plus;
+ int m5 = b5;
+ int len = i;
+
+ /*
+ * Find the quantity i so that (2**i*5**b5)/(2**s2*5**s5) is 1/2 unit
+ * in the least significant place of the floating point number.
+ */
+
+ if (denorm) {
+ i = be + EXPONENT_BIAS + (FP_PRECISION-1);
+ } else {
+ i = 1 + FP_PRECISION - bbits;
+ }
+ b2 += i;
+ s2 += i;
+
+ /*
+ * Reduce the fractions to lowest terms, since the above calculation
+ * may have left excess powers of 2 in numerator and denominator.
+ */
+
+ CastOutPowersOf2(&b2, &m2minus, &s2);
+
+ /*
+ * In the special case where bw==1, the nearest floating point number
+ * to it on the low side is 1/4 ulp below it. Adjust accordingly.
+ */
+
+ m2plus = m2minus;
+ if (!denorm && bw == 1) {
+ ++b2;
+ ++s2;
+ ++m2plus;
+ }
+
+ if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] <= 64) {
+ /*
+ * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word,
+ * then all our intermediate calculations can be done using exact
+ * 64-bit arithmetic with no need for expensive multiprecision
+ * operations. (This will be true for all numbers in the range
+ * [1.0e-3 .. 1.0e+24]).
+ */
+
+ return ShorteningInt64Conversion(&d, convType, bw, b2, b5, m2plus,
+ m2minus, m5, s2, s5, k, len, ilim, ilim1, decpt, endPtr);
+ } else if (s5 == 0) {
+ /*
+ * The denominator is a power of 2, so we can replace division by
+ * digit shifts. First we round up s2 to a multiple of DIGIT_BIT,
+ * and adjust m2 and b2 accordingly. Then we launch into a version
+ * of the comparison that's specialized for the 'power of mp_digit
+ * in the denominator' case.
+ */
+
+ if (s2 % DIGIT_BIT != 0) {
+ int delta = DIGIT_BIT - (s2 % DIGIT_BIT);
+
+ b2 += delta;
+ m2plus += delta;
+ m2minus += delta;
+ s2 += delta;
+ }
+ return ShorteningBignumConversionPowD(&d, convType, bw, b2, b5,
+ m2plus, m2minus, m5, s2/DIGIT_BIT, k, len, ilim, ilim1,
+ decpt, endPtr);
+ } else {
+ /*
+ * Alas, there's no helpful special case; use full-up bignum
+ * arithmetic for the conversion.
+ */
+
+ return ShorteningBignumConversion(&d, convType, bw, b2, m2plus,
+ m2minus, s2, s5, k, len, ilim, ilim1, decpt, endPtr);
+ }
+ } else {
+ /*
+ * Non-shortening conversion.
+ */
+
+ int len = i;
+
+ /*
+ * Reduce numerator and denominator to lowest terms.
+ */
+
+ if (b2 >= s2 && s2 > 0) {
+ b2 -= s2; s2 = 0;
+ } else if (s2 >= b2 && b2 > 0) {
+ s2 -= b2; b2 = 0;
+ }
+
+ if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] <= 64) {
+ /*
+ * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word,
+ * then all our intermediate calculations can be done using exact
+ * 64-bit arithmetic with no need for expensive multiprecision
+ * operations.
+ */
+
+ return StrictInt64Conversion(&d, convType, bw, b2, b5, s2, s5, k,
+ len, ilim, ilim1, decpt, endPtr);
+ } else if (s5 == 0) {
+ /*
+ * The denominator is a power of 2, so we can replace division by
+ * digit shifts. First we round up s2 to a multiple of DIGIT_BIT,
+ * and adjust m2 and b2 accordingly. Then we launch into a version
+ * of the comparison that's specialized for the 'power of mp_digit
+ * in the denominator' case.
+ */
+
+ if (s2 % DIGIT_BIT != 0) {
+ int delta = DIGIT_BIT - (s2 % DIGIT_BIT);
+
+ b2 += delta;
+ s2 += delta;
+ }
+ return StrictBignumConversionPowD(&d, convType, bw, b2, b5,
+ s2/DIGIT_BIT, k, len, ilim, ilim1, decpt, endPtr);
+ } else {
+ /*
+ * There are no helpful special cases, but at least we know in
+ * advance how many digits we will convert. We can run the
+ * conversion in steps of DIGIT_GROUP digits, so as to have many
+ * fewer mp_int divisions.
+ */
+
+ return StrictBignumConversion(&d, convType, bw, b2, s2, s5, k,
+ len, ilim, ilim1, decpt, endPtr);
+ }
}
- *ePtr = e - DBL_MANT_DIG;
- return (f == 1.0 / FLT_RADIX);
}
/*
@@ -2167,14 +4339,12 @@ TclInitDoubleConversion(void)
int x;
Tcl_WideUInt u;
double d;
-
#ifdef IEEE_FLOATING_POINT
union {
double dv;
Tcl_WideUInt iv;
} bitwhack;
#endif
-
#if defined(__sgi) && defined(_COMPILER_VERSION)
union fpc_csr mipsCR;
@@ -2189,8 +4359,7 @@ TclInitDoubleConversion(void)
maxpow10_wide = (int)
floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.));
- pow10_wide = (Tcl_WideUInt *)
- ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
+ pow10_wide = ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
u = 1;
for (i = 0; i < maxpow10_wide; ++i) {
pow10_wide[i] = u;
@@ -2199,8 +4368,8 @@ TclInitDoubleConversion(void)
pow10_wide[i] = u;
/*
- * Determine how many bits of precision a double has, and how many
- * decimal digits that represents.
+ * Determine how many bits of precision a double has, and how many decimal
+ * digits that represents.
*/
if (frexp((double) FLT_RADIX, &log2FLT_RADIX) != 0.5) {
@@ -2211,8 +4380,8 @@ TclInitDoubleConversion(void)
d = 1.0;
/*
- * Initialize a table of powers of ten that can be exactly represented
- * in a double.
+ * Initialize a table of powers of ten that can be exactly represented in
+ * a double.
*/
x = (int) (DBL_MANT_DIG * log((double) FLT_RADIX) / log(5.0));
@@ -2237,6 +4406,11 @@ TclInitDoubleConversion(void)
for (i=0; i<8; ++i) {
mp_sqr(pow5+i, pow5+i+1);
}
+ mp_init_set_int(pow5_13, 1220703125);
+ for (i = 1; i < 5; ++i) {
+ mp_init(pow5_13 + i);
+ mp_sqr(pow5_13 + i - 1, pow5_13 + i);
+ }
/*
* Determine the number of decimal digits to the left and right of the
@@ -2249,7 +4423,6 @@ TclInitDoubleConversion(void)
+ 0.5 * log(10.)) / log(10.));
minDigits = (int) floor((DBL_MIN_EXP - DBL_MANT_DIG)
* log((double) FLT_RADIX) / log(10.));
- mantDIGIT = (mantBits + DIGIT_BIT-1) / DIGIT_BIT;
log10_DIGIT_MAX = (int) floor(DIGIT_BIT * log(2.) / log(10.));
/*
@@ -2293,10 +4466,13 @@ TclFinalizeDoubleConversion(void)
{
int i;
- Tcl_Free((char *) pow10_wide);
+ ckfree(pow10_wide);
for (i=0; i<9; ++i) {
mp_clear(pow5 + i);
}
+ for (i=0; i < 5; ++i) {
+ mp_clear(pow5_13 + i);
+ }
}
/*
@@ -2319,9 +4495,9 @@ TclFinalizeDoubleConversion(void)
int
Tcl_InitBignumFromDouble(
- Tcl_Interp *interp, /* For error message */
- double d, /* Number to convert */
- mp_int *b) /* Place to store the result */
+ Tcl_Interp *interp, /* For error message. */
+ double d, /* Number to convert. */
+ mp_int *b) /* Place to store the result. */
{
double fract;
int expt;
@@ -2378,12 +4554,13 @@ TclBignumToDouble(
const mp_int *a) /* Integer to convert. */
{
mp_int b;
- int bits, shift, i;
+ int bits, shift, i, lsb;
double r;
+
/*
- * Determine how many bits we need, and extract that many from the input.
- * Round to nearest unit in the last place.
+ * We need a 'mantBits'-bit significand. Determine what shift will
+ * give us that.
*/
bits = mp_count_bits(a);
@@ -2395,17 +4572,54 @@ TclBignumToDouble(
return -HUGE_VAL;
}
}
- shift = mantBits + 1 - bits;
+ shift = mantBits - bits;
+
+ /*
+ * If shift > 0, shift the significand left by the requisite number of
+ * bits. If shift == 0, the significand is already exactly 'mantBits'
+ * in length. If shift < 0, we will need to shift the significand right
+ * by the requisite number of bits, and round it. If the '1-shift'
+ * least significant bits are 0, but the 'shift'th bit is nonzero,
+ * then the significand lies exactly between two values and must be
+ * 'rounded to even'.
+ */
+
mp_init(&b);
- if (shift > 0) {
+ if (shift == 0) {
+ mp_copy(a, &b);
+ } else if (shift > 0) {
mp_mul_2d(a, shift, &b);
} else if (shift < 0) {
- mp_div_2d(a, -shift, &b, NULL);
- } else {
- mp_copy(a, &b);
+ lsb = mp_cnt_lsb(a);
+ if (lsb == -1-shift) {
+
+ /*
+ * Round to even
+ */
+
+ mp_div_2d(a, -shift, &b, NULL);
+ if (mp_isodd(&b)) {
+ if (b.sign == MP_ZPOS) {
+ mp_add_d(&b, 1, &b);
+ } else {
+ mp_sub_d(&b, 1, &b);
+ }
+ }
+ } else {
+
+ /*
+ * Ordinary rounding
+ */
+
+ mp_div_2d(a, -1-shift, &b, NULL);
+ if (b.sign == MP_ZPOS) {
+ mp_add_d(&b, 1, &b);
+ } else {
+ mp_sub_d(&b, 1, &b);
+ }
+ mp_div_2d(&b, 1, &b, NULL);
+ }
}
- mp_add_d(&b, 1, &b);
- mp_div_2d(&b, 1, &b, NULL);
/*
* Accumulate the result, one mp_digit at a time.
@@ -2433,6 +4647,20 @@ TclBignumToDouble(
return -r;
}
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCeil --
+ *
+ * Computes the smallest floating point number that is at least the
+ * mp_int argument.
+ *
+ * Results:
+ * Returns the floating point number.
+ *
+ *----------------------------------------------------------------------
+ */
double
TclCeil(
@@ -2476,6 +4704,20 @@ TclCeil(
mp_clear(&b);
return r;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFloor --
+ *
+ * Computes the largest floating point number less than or equal to the
+ * mp_int argument.
+ *
+ * Results:
+ * Returns the floating point value.
+ *
+ *----------------------------------------------------------------------
+ */
double
TclFloor(
@@ -2535,8 +4777,8 @@ TclFloor(
static double
BignumToBiasedFrExp(
- const mp_int *a, /* Integer to convert */
- int *machexp) /* Power of two */
+ const mp_int *a, /* Integer to convert. */
+ int *machexp) /* Power of two. */
{
mp_int b;
int bits;
@@ -2600,8 +4842,8 @@ BignumToBiasedFrExp(
static double
Pow10TimesFrExp(
- int exponent, /* Power of 10 to multiply by */
- double fraction, /* Significand of multiplicand */
+ int exponent, /* Power of 10 to multiply by. */
+ double fraction, /* Significand of multiplicand. */
int *machexp) /* On input, exponent of multiplicand. On
* output, exponent of result. */
{
@@ -2611,7 +4853,7 @@ Pow10TimesFrExp(
if (exponent > 0) {
/*
- * Multiply by 10**exponent
+ * Multiply by 10**exponent.
*/
retval = frexp(retval * pow10vals[exponent&0xf], &j);
@@ -2624,7 +4866,7 @@ Pow10TimesFrExp(
}
} else if (exponent < 0) {
/*
- * Divide by 10**-exponent
+ * Divide by 10**-exponent.
*/
retval = frexp(retval / pow10vals[(-exponent) & 0xf], &j);
@@ -2733,26 +4975,27 @@ TclFormatNaN(
*
* Nokia770Twiddle --
*
- * Transpose the two words of a number for Nokia 770 floating
- * point handling.
+ * Transpose the two words of a number for Nokia 770 floating point
+ * handling.
*
*----------------------------------------------------------------------
*/
-
+#ifdef IEEE_FLOATING_POINT
static Tcl_WideUInt
Nokia770Twiddle(
- Tcl_WideUInt w) /* Number to transpose */
+ Tcl_WideUInt w) /* Number to transpose. */
{
return (((w >> 32) & 0xffffffff) | (w << 32));
}
+#endif
/*
*----------------------------------------------------------------------
*
* TclNokia770Doubles --
*
- * Transpose the two words of a number for Nokia 770 floating
- * point handling.
+ * Transpose the two words of a number for Nokia 770 floating point
+ * handling.
*
*----------------------------------------------------------------------
*/
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 9e2e3aa..04cf4ee 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -32,8 +32,7 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclStringObj.c,v 1.137 2010/04/30 20:52:51 dgp Exp $ */
+ */
#include "tclInt.h"
#include "tommath.h"
@@ -41,9 +40,10 @@
/*
* Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5.
* This is an escape hatch in case the changes have some unexpected unwelcome
- * impact on performance. If things go well, this mechanism can go away when
+ * impact on performance. If things go well, this mechanism can go away when
* post-8.6 development begins.
*/
+
#define COMPAT 0
/*
@@ -131,18 +131,19 @@ typedef struct String {
Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
STRING_MAXCHARS); \
}
+#define stringAttemptAlloc(numChars) \
+ (String *) attemptckalloc((unsigned) STRING_SIZE(numChars) )
#define stringAlloc(numChars) \
(String *) ckalloc((unsigned) STRING_SIZE(numChars) )
#define stringRealloc(ptr, numChars) \
- (String *) ckrealloc((char *) ptr, (unsigned) STRING_SIZE(numChars) )
+ (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
#define stringAttemptRealloc(ptr, numChars) \
- (String *) attemptckrealloc((char *) ptr, \
- (unsigned) STRING_SIZE(numChars) )
+ (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
#define GET_STRING(objPtr) \
((String *) (objPtr)->internalRep.otherValuePtr)
#define SET_STRING(objPtr, stringPtr) \
((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr))
-
+
/*
* TCL STRING GROWTH ALGORITHM
*
@@ -151,8 +152,7 @@ typedef struct String {
*
* Attempt to allocate 2 * (originalLength + appendLength)
* On failure:
- * attempt to allocate originalLength + 2*appendLength +
- * TCL_GROWTH_MIN_ALLOC
+ * attempt to allocate originalLength + 2*appendLength + TCL_MIN_GROWTH
*
* This algorithm allows very good performance, as it rapidly increases the
* memory allocated for a given string, which minimizes the number of
@@ -165,20 +165,20 @@ typedef struct String {
* cover the request, but which hopefully will be less than the total
* available memory.
*
- * The addition of TCL_GROWTH_MIN_ALLOC allows for efficient handling of very
+ * The addition of TCL_MIN_GROWTH allows for efficient handling of very
* small appends. Without this extra slush factor, a sequence of several small
* appends would cause several memory allocations. As long as
- * TCL_GROWTH_MIN_ALLOC is a reasonable size, we can avoid that behavior.
+ * TCL_MIN_GROWTH is a reasonable size, we can avoid that behavior.
*
* The growth algorithm can be tuned by adjusting the following parameters:
*
- * TCL_GROWTH_MIN_ALLOC Additional space, in bytes, to allocate when
+ * TCL_MIN_GROWTH Additional space, in bytes, to allocate when
* the double allocation has failed. Default is
- * 1024 (1 kilobyte).
+ * 1024 (1 kilobyte). See tclInt.h.
*/
-#ifndef TCL_GROWTH_MIN_ALLOC
-#define TCL_GROWTH_MIN_ALLOC 1024
+#ifndef TCL_MIN_UNICHAR_GROWTH
+#define TCL_MIN_UNICHAR_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#endif
static void
@@ -187,11 +187,13 @@ GrowStringBuffer(
int needed,
int flag)
{
- /* Pre-conditions:
+ /*
+ * Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->allocated
* flag || objPtr->bytes != NULL
*/
+
String *stringPtr = GET_STRING(objPtr);
char *ptr = NULL;
int attempt;
@@ -202,24 +204,29 @@ GrowStringBuffer(
if (flag == 0 || stringPtr->allocated > 0) {
attempt = 2 * needed;
if (attempt >= 0) {
- ptr = attemptckrealloc(objPtr->bytes, (unsigned) attempt + 1);
+ ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
}
if (ptr == NULL) {
/*
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for attempt.
*/
+
unsigned int limit = INT_MAX - needed;
- unsigned int extra = needed - objPtr->length + TCL_GROWTH_MIN_ALLOC;
+ unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH;
int growth = (int) ((extra > limit) ? limit : extra);
+
attempt = needed + growth;
- ptr = attemptckrealloc(objPtr->bytes, (unsigned) attempt + 1);
+ ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
}
}
if (ptr == NULL) {
- /* First allocation - just big enough; or last chance fallback. */
+ /*
+ * First allocation - just big enough; or last chance fallback.
+ */
+
attempt = needed;
- ptr = ckrealloc(objPtr->bytes, (unsigned) attempt + 1);
+ ptr = ckrealloc(objPtr->bytes, attempt + 1);
}
objPtr->bytes = ptr;
stringPtr->allocated = attempt;
@@ -230,16 +237,21 @@ GrowUnicodeBuffer(
Tcl_Obj *objPtr,
int needed)
{
- /* Pre-conditions:
+ /*
+ * Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->maxChars
* needed < STRING_MAXCHARS
*/
+
String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
int attempt;
if (stringPtr->maxChars > 0) {
- /* Subsequent appends - apply the growth algorithm. */
+ /*
+ * Subsequent appends - apply the growth algorithm.
+ */
+
attempt = 2 * needed;
if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
ptr = stringAttemptRealloc(stringPtr, attempt);
@@ -249,16 +261,21 @@ GrowUnicodeBuffer(
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for attempt.
*/
+
unsigned int limit = STRING_MAXCHARS - needed;
unsigned int extra = needed - stringPtr->numChars
- + TCL_GROWTH_MIN_ALLOC/sizeof(Tcl_UniChar);
+ + TCL_MIN_UNICHAR_GROWTH;
int growth = (int) ((extra > limit) ? limit : extra);
+
attempt = needed + growth;
ptr = stringAttemptRealloc(stringPtr, attempt);
}
}
if (ptr == NULL) {
- /* First allocation - just big enough; or last chance fallback. */
+ /*
+ * First allocation - just big enough; or last chance fallback.
+ */
+
attempt = needed;
ptr = stringRealloc(stringPtr, attempt);
}
@@ -474,7 +491,10 @@ Tcl_GetCharLength(
stringPtr = GET_STRING(objPtr);
numChars = stringPtr->numChars;
- /* If numChars is unknown, compute it. */
+ /*
+ * If numChars is unknown, compute it.
+ */
+
if (numChars == -1) {
TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
stringPtr->numChars = numChars;
@@ -482,8 +502,8 @@ Tcl_GetCharLength(
#if COMPAT
if (numChars < objPtr->length) {
/*
- * Since we've just computed the number of chars, and not all
- * UTF chars are 1-byte long, go ahead and populate the unicode
+ * Since we've just computed the number of chars, and not all UTF
+ * chars are 1-byte long, go ahead and populate the unicode
* string.
*/
@@ -539,7 +559,10 @@ Tcl_GetUniChar(
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
- /* If numChars is unknown, compute it. */
+ /*
+ * If numChars is unknown, compute it.
+ */
+
if (stringPtr->numChars == -1) {
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
@@ -670,14 +693,20 @@ Tcl_GetRange(
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
- /* If numChars is unknown, compute it. */
+ /*
+ * If numChars is unknown, compute it.
+ */
+
if (stringPtr->numChars == -1) {
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
- /* Since we know the char length of the result, store it. */
+ /*
+ * Since we know the char length of the result, store it.
+ */
+
SetStringFromAny(NULL, newObjPtr);
stringPtr = GET_STRING(newObjPtr);
stringPtr->numChars = newObjPtr->length;
@@ -729,7 +758,6 @@ Tcl_SetStringObj(
*/
TclFreeIntRep(objPtr);
- objPtr->typePtr = NULL;
/*
* Free any old string rep, then set the string rep to a copy of the
@@ -805,9 +833,9 @@ Tcl_SetObjLength(
* Need to enlarge the buffer.
*/
if (objPtr->bytes == tclEmptyStringRep) {
- objPtr->bytes = ckalloc((unsigned) length+1);
+ objPtr->bytes = ckalloc(length + 1);
} else {
- objPtr->bytes = ckrealloc(objPtr->bytes, (unsigned) length+1);
+ objPtr->bytes = ckrealloc(objPtr->bytes, length + 1);
}
stringPtr->allocated = length;
}
@@ -833,14 +861,17 @@ Tcl_SetObjLength(
stringPtr->maxChars = length;
}
- /* Mark the new end of the unicode string */
+ /*
+ * Mark the new end of the unicode string
+ */
+
stringPtr->numChars = length;
stringPtr->unicode[length] = 0;
stringPtr->hasUnicode = 1;
/*
- * Can only get here when objPtr->bytes == NULL.
- * No need to invalidate the string rep.
+ * Can only get here when objPtr->bytes == NULL. No need to invalidate
+ * the string rep.
*/
}
}
@@ -880,9 +911,10 @@ Tcl_AttemptSetObjLength(
if (length < 0) {
/*
- * Setting to a negative length is nonsense. This is probably the
+ * Setting to a negative length is nonsense. This is probably the
* result of overflowing the signed integer range.
*/
+
return 0;
}
if (Tcl_IsShared(objPtr)) {
@@ -903,12 +935,13 @@ Tcl_AttemptSetObjLength(
/*
* Need to enlarge the buffer.
*/
+
char *newBytes;
if (objPtr->bytes == tclEmptyStringRep) {
- newBytes = attemptckalloc((unsigned) length+1);
+ newBytes = attemptckalloc(length + 1);
} else {
- newBytes = attemptckrealloc(objPtr->bytes, (unsigned) length+1);
+ newBytes = attemptckrealloc(objPtr->bytes, length + 1);
}
if (newBytes == NULL) {
return 0;
@@ -943,14 +976,17 @@ Tcl_AttemptSetObjLength(
stringPtr->maxChars = length;
}
- /* Mark the new end of the unicode string */
+ /*
+ * Mark the new end of the unicode string.
+ */
+
stringPtr->unicode[length] = 0;
stringPtr->numChars = length;
stringPtr->hasUnicode = 1;
/*
- * Can only get here when objPtr->bytes == NULL.
- * No need to invalidate the string rep.
+ * Can only get here when objPtr->bytes == NULL. No need to invalidate
+ * the string rep.
*/
}
return 1;
@@ -1228,13 +1264,23 @@ Tcl_AppendObjToObj(
const char *bytes;
/*
+ * Special case: second object is standard-empty is fast case. We know
+ * that appending nothing to anything leaves that starting anything...
+ */
+
+ if (appendObjPtr->bytes == tclEmptyStringRep) {
+ return;
+ }
+
+ /*
* Handle append of one bytearray object to another as a special case.
* Note that we only do this when the objects don't have string reps; if
* it did, then appending the byte arrays together could well lose
* information; this is a special-case optimization only.
*/
- if (TclIsPureByteArray(objPtr) && TclIsPureByteArray(appendObjPtr)) {
+ if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
+ && TclIsPureByteArray(appendObjPtr)) {
unsigned char *bytesSrc;
int lengthSrc, lengthTotal;
@@ -1361,12 +1407,14 @@ AppendUnicodeToUnicodeRep(
stringCheckLimits(numChars);
if (numChars > stringPtr->maxChars) {
+ int offset = -1;
+
/*
* Protect against case where unicode points into the existing
- * stringPtr->unicode array. Force it to follow any relocations
- * due to the reallocs below.
+ * stringPtr->unicode array. Force it to follow any relocations due to
+ * the reallocs below.
*/
- int offset = -1;
+
if (unicode >= stringPtr->unicode
&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
offset = unicode - stringPtr->unicode;
@@ -1375,7 +1423,10 @@ AppendUnicodeToUnicodeRep(
GrowUnicodeBuffer(objPtr, numChars);
stringPtr = GET_STRING(objPtr);
- /* Relocate unicode if needed; see above. */
+ /*
+ * Relocate unicode if needed; see above.
+ */
+
if (offset >= 0) {
unicode = stringPtr->unicode + offset;
}
@@ -1386,7 +1437,7 @@ AppendUnicodeToUnicodeRep(
* trailing null.
*/
- memcpy(stringPtr->unicode + stringPtr->numChars, unicode,
+ memmove(stringPtr->unicode + stringPtr->numChars, unicode,
appendNumChars * sizeof(Tcl_UniChar));
stringPtr->unicode[numChars] = 0;
stringPtr->numChars = numChars;
@@ -1427,7 +1478,10 @@ AppendUnicodeToUtfRep(
}
#if COMPAT
- /* Invalidate the unicode rep */
+ /*
+ * Invalidate the unicode rep.
+ */
+
stringPtr->hasUnicode = 0;
#endif
}
@@ -1439,7 +1493,7 @@ AppendUnicodeToUtfRep(
*
* This function converts the contents of "bytes" to Unicode and appends
* the Unicode to the Unicode rep of "objPtr". objPtr must already have a
- * valid Unicode rep. numBytes must be non-negative.
+ * valid Unicode rep. numBytes must be non-negative.
*
* Results:
* None.
@@ -1515,22 +1569,30 @@ AppendUtfToUtfRep(
stringPtr = GET_STRING(objPtr);
if (newLength > stringPtr->allocated) {
+ int offset = -1;
+
/*
* Protect against case where unicode points into the existing
- * stringPtr->unicode array. Force it to follow any relocations
- * due to the reallocs below.
+ * stringPtr->unicode array. Force it to follow any relocations due to
+ * the reallocs below.
*/
- int offset = -1;
+
if (bytes >= objPtr->bytes
&& bytes <= objPtr->bytes + objPtr->length) {
offset = bytes - objPtr->bytes;
}
- /* TODO: consider passing flag=1: no overalloc on first append.
- * This would make test stringObj-8.1 fail.*/
+ /*
+ * TODO: consider passing flag=1: no overalloc on first append. This
+ * would make test stringObj-8.1 fail.
+ */
+
GrowStringBuffer(objPtr, newLength, 0);
- /* Relocate bytes if needed; see above. */
+ /*
+ * Relocate bytes if needed; see above.
+ */
+
if (offset >= 0) {
bytes = objPtr->bytes + offset;
}
@@ -1543,11 +1605,10 @@ AppendUtfToUtfRep(
stringPtr->numChars = -1;
stringPtr->hasUnicode = 0;
- memcpy(objPtr->bytes + oldLength, bytes, numBytes);
+ memmove(objPtr->bytes + oldLength, bytes, numBytes);
objPtr->bytes[newLength] = 0;
objPtr->length = newLength;
}
-
/*
*----------------------------------------------------------------------
@@ -1578,6 +1639,7 @@ Tcl_AppendStringsToObjVA(
while (1) {
const char *bytes = va_arg(argList, char *);
+
if (bytes == NULL) {
break;
}
@@ -1643,7 +1705,7 @@ Tcl_AppendFormatToObj(
int objc,
Tcl_Obj *const objv[])
{
- const char *span = format, *msg;
+ const char *span = format, *msg, *errCode;
int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0;
int originalLength, limit;
static const char *mixedXPG =
@@ -1681,6 +1743,7 @@ Tcl_AppendFormatToObj(
if (numBytes) {
if (numBytes > limit) {
msg = overflow;
+ errCode = "OVERFLOW";
goto errorMsg;
}
Tcl_AppendToObj(appendObj, span, numBytes);
@@ -1720,18 +1783,21 @@ Tcl_AppendFormatToObj(
if (newXpg) {
if (gotSequential) {
msg = mixedXPG;
+ errCode = "MIXEDSPECTYPES";
goto errorMsg;
}
gotXpg = 1;
} else {
if (gotXpg) {
msg = mixedXPG;
+ errCode = "MIXEDSPECTYPES";
goto errorMsg;
}
gotSequential = 1;
}
if ((objIndex < 0) || (objIndex >= objc)) {
msg = badIndex[gotXpg];
+ errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
goto errorMsg;
}
@@ -1779,6 +1845,7 @@ Tcl_AppendFormatToObj(
} else if (ch == '*') {
if (objIndex >= objc - 1) {
msg = badIndex[gotXpg];
+ errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
goto errorMsg;
}
if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) {
@@ -1794,6 +1861,7 @@ Tcl_AppendFormatToObj(
}
if (width > limit) {
msg = overflow;
+ errCode = "OVERFLOW";
goto errorMsg;
}
@@ -1814,6 +1882,7 @@ Tcl_AppendFormatToObj(
} else if (ch == '*') {
if (objIndex >= objc - 1) {
msg = badIndex[gotXpg];
+ errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
goto errorMsg;
}
if (TclGetIntFromObj(interp, objv[objIndex], &precision)
@@ -1871,6 +1940,7 @@ Tcl_AppendFormatToObj(
switch (ch) {
case '\0':
msg = "format string ended in middle of field specifier";
+ errCode = "INCOMPLETE";
goto errorMsg;
case 's':
if (gotPrecision) {
@@ -1900,6 +1970,7 @@ Tcl_AppendFormatToObj(
case 'u':
if (useBig) {
msg = "unsigned bignum format is invalid";
+ errCode = "BADUNSIGNED";
goto errorMsg;
}
case 'd':
@@ -2047,6 +2118,7 @@ Tcl_AppendFormatToObj(
}
if (toAppend > segmentLimit) {
msg = overflow;
+ errCode = "OVERFLOW";
goto errorMsg;
}
Tcl_AppendToObj(segment, bytes, toAppend);
@@ -2061,8 +2133,7 @@ Tcl_AppendFormatToObj(
case 'b': {
Tcl_WideUInt bits = (Tcl_WideUInt) 0;
Tcl_WideInt numDigits = (Tcl_WideInt) 0;
- int length, numBits = 4, base = 16;
- int index = 0, shift = 0;
+ int length, numBits = 4, base = 16, index = 0, shift = 0;
Tcl_Obj *pure;
char *bytes;
@@ -2103,6 +2174,7 @@ Tcl_AppendFormatToObj(
}
if (numDigits > INT_MAX) {
msg = overflow;
+ errCode = "OVERFLOW";
goto errorMsg;
}
} else if (!useBig) {
@@ -2170,6 +2242,7 @@ Tcl_AppendFormatToObj(
}
if (toAppend > segmentLimit) {
msg = overflow;
+ errCode = "OVERFLOW";
goto errorMsg;
}
Tcl_AppendObjToObj(segment, pure);
@@ -2223,6 +2296,7 @@ Tcl_AppendFormatToObj(
p += sprintf(p, "%d", precision);
if (precision > INT_MAX - length) {
msg = overflow;
+ errCode = "OVERFLOW";
goto errorMsg;
}
length += precision;
@@ -2239,11 +2313,13 @@ Tcl_AppendFormatToObj(
allocSegment = 1;
if (!Tcl_AttemptSetObjLength(segment, length)) {
msg = overflow;
+ errCode = "OVERFLOW";
goto errorMsg;
}
bytes = TclGetString(segment);
if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) {
msg = overflow;
+ errCode = "OVERFLOW";
goto errorMsg;
}
break;
@@ -2252,6 +2328,7 @@ Tcl_AppendFormatToObj(
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("bad field specifier \"%c\"", ch));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
}
goto error;
}
@@ -2283,6 +2360,7 @@ Tcl_AppendFormatToObj(
Tcl_DecrRefCount(segment);
}
msg = overflow;
+ errCode = "OVERFLOW";
goto errorMsg;
}
Tcl_AppendObjToObj(appendObj, segment);
@@ -2305,6 +2383,7 @@ Tcl_AppendFormatToObj(
if (numBytes) {
if (numBytes > limit) {
msg = overflow;
+ errCode = "OVERFLOW";
goto errorMsg;
}
Tcl_AppendToObj(appendObj, span, numBytes);
@@ -2317,6 +2396,7 @@ Tcl_AppendFormatToObj(
errorMsg:
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, NULL);
}
error:
Tcl_SetObjLength(appendObj, originalLength);
@@ -2346,6 +2426,7 @@ Tcl_Format(
{
int result;
Tcl_Obj *objPtr = Tcl_NewObj();
+
result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
if (result != TCL_OK) {
Tcl_DecrRefCount(objPtr);
@@ -2391,7 +2472,6 @@ AppendPrintfToObjVA(
}
do {
switch (*p) {
-
case '\0':
seekingConversion = 0;
break;
@@ -2444,11 +2524,11 @@ AppendPrintfToObjVA(
case -1:
case 0:
Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
- (long int)va_arg(argList, int)));
+ (long) va_arg(argList, int)));
break;
case 1:
Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
- va_arg(argList, long int)));
+ va_arg(argList, long)));
break;
}
break;
@@ -2462,7 +2542,7 @@ AppendPrintfToObjVA(
seekingConversion = 0;
break;
case '*':
- lastNum = (int)va_arg(argList, int);
+ lastNum = (int) va_arg(argList, int);
Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
p++;
break;
@@ -2564,8 +2644,8 @@ Tcl_ObjPrintf(
*
* Results:
* An unshared Tcl value which is the [string reverse] of the argument
- * supplied. When sharing rules permit, the returned value might be
- * the argument with modifications done in place.
+ * supplied. When sharing rules permit, the returned value might be the
+ * argument with modifications done in place.
*
* Side effects:
* May allocate a new Tcl_Obj.
@@ -2573,84 +2653,124 @@ Tcl_ObjPrintf(
*---------------------------------------------------------------------------
*/
+static void
+ReverseBytes(
+ unsigned char *to, /* Copy bytes into here... */
+ unsigned char *from, /* ...from here... */
+ int count) /* Until this many are copied, */
+ /* reversing as you go. */
+{
+ unsigned char *src = from + count;
+ if (to == from) {
+ /* Reversing in place */
+ while (--src > to) {
+ unsigned char c = *src;
+ *src = *to;
+ *to++ = c;
+ }
+ } else {
+ while (--src >= from) {
+ *to++ = *src;
+ }
+ }
+}
+
Tcl_Obj *
TclStringObjReverse(
Tcl_Obj *objPtr)
{
String *stringPtr;
- char *src = NULL, *dest = NULL;
- Tcl_UniChar *usrc = NULL, *udest = NULL;
- Tcl_Obj *resultPtr = NULL;
+ Tcl_UniChar ch;
+
+ if (TclIsPureByteArray(objPtr)) {
+ int numBytes;
+ unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);
+
+ if (Tcl_IsShared(objPtr)) {
+ objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
+ }
+ ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
+ return objPtr;
+ }
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
- if (stringPtr->hasUnicode == 0) {
- if (stringPtr->numChars == -1) {
- TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
- }
- if (stringPtr->numChars <= 1) {
- return objPtr;
- }
- if (stringPtr->numChars == objPtr->length) {
- /* All one-byte chars. Reverse in objPtr->bytes. */
- if (Tcl_IsShared(objPtr)) {
- resultPtr = Tcl_NewObj();
- Tcl_SetObjLength(resultPtr, objPtr->length);
- dest = TclGetString(resultPtr);
- src = objPtr->bytes + objPtr->length - 1;
- while (src >= objPtr->bytes) {
- *dest++ = *src--;
- }
- return resultPtr;
+ if (stringPtr->hasUnicode) {
+ Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
+ Tcl_UniChar *src = from + stringPtr->numChars;
+
+ if (Tcl_IsShared(objPtr)) {
+ Tcl_UniChar *to;
+
+ /*
+ * Create a non-empty, pure unicode value, so we can coax
+ * Tcl_SetObjLength into growing the unicode rep buffer.
+ */
+
+ ch = 0;
+ objPtr = Tcl_NewUnicodeObj(&ch, 1);
+ Tcl_SetObjLength(objPtr, stringPtr->numChars);
+ to = Tcl_GetUnicode(objPtr);
+ while (--src >= from) {
+ *to++ = *src;
}
- /* Unshared. Reverse objPtr->bytes in place. */
- dest = objPtr->bytes;
- src = dest + objPtr->length - 1;
- while (dest < src) {
- char tmp = *src;
- *src-- = *dest;
- *dest++ = tmp;
+ } else {
+ /* Reversing in place */
+ while (--src > from) {
+ ch = *src;
+ *src = *from;
+ *from++ = ch;
}
- return objPtr;
}
- FillUnicodeRep(objPtr);
- stringPtr = GET_STRING(objPtr);
- }
- if (stringPtr->numChars <= 1) {
- return objPtr;
}
- /* Reverse the Unicode rep. */
- if (Tcl_IsShared(objPtr)) {
- Tcl_UniChar ch = 0;
+ if (objPtr->bytes) {
+ int numChars = stringPtr->numChars;
+ int numBytes = objPtr->length;
+ char *to, *from = objPtr->bytes;
- /*
- * Create a non-empty, pure unicode value, so we can coax
- * Tcl_SetObjLength into growing the unicode rep buffer.
- */
-
- resultPtr = Tcl_NewUnicodeObj(&ch, 1);
- Tcl_SetObjLength(resultPtr, stringPtr->numChars);
- udest = Tcl_GetUnicode(resultPtr);
- usrc = stringPtr->unicode + stringPtr->numChars - 1;
- while (usrc >= stringPtr->unicode) {
- *udest++ = *usrc--;
+ if (Tcl_IsShared(objPtr)) {
+ objPtr = Tcl_NewObj();
+ Tcl_SetObjLength(objPtr, numBytes);
}
- return resultPtr;
- }
+ to = objPtr->bytes;
+
+ if (numChars < numBytes) {
+ /*
+ * Either numChars == -1 and we don't know how many chars are
+ * represented by objPtr->bytes and we need Pass 1 just in case,
+ * or numChars >= 0 and we know we have fewer chars than bytes,
+ * so we know there's a multibyte character needing Pass 1.
+ *
+ * Pass 1. Reverse the bytes of each multi-byte character.
+ */
+ int charCount = 0;
+ int bytesLeft = numBytes;
+
+ while (bytesLeft) {
+ /*
+ * NOTE: We know that the from buffer is NUL-terminated.
+ * It's part of the contract for objPtr->bytes values.
+ * Thus, we can skip calling Tcl_UtfCharComplete() here.
+ */
+ int bytesInChar = Tcl_UtfToUniChar(from, &ch);
+
+ ReverseBytes((unsigned char *)to, (unsigned char *)from,
+ bytesInChar);
+ to += bytesInChar;
+ from += bytesInChar;
+ bytesLeft -= bytesInChar;
+ charCount++;
+ }
- /* Unshared. Reverse objPtr->bytes in place. */
- udest = stringPtr->unicode;
- usrc = udest + stringPtr->numChars - 1;
- while (udest < usrc) {
- Tcl_UniChar tmp = *usrc;
- *usrc-- = *udest;
- *udest++ = tmp;
+ from = to = objPtr->bytes;
+ stringPtr->numChars = charCount;
+ }
+ /* Pass 2. Reverse all the bytes. */
+ ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);
}
- TclInvalidateStringRep(objPtr);
- stringPtr->allocated = 0;
return objPtr;
}
@@ -2677,6 +2797,7 @@ FillUnicodeRep(
* rep. */
{
String *stringPtr = GET_STRING(objPtr);
+
ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length,
stringPtr->numChars);
}
@@ -2745,21 +2866,27 @@ DupStringInternalRep(
#if COMPAT==0
if (srcStringPtr->numChars == -1) {
/*
- * The String struct in the source value holds zero useful data.
- * Don't bother copying it. Don't even bother allocating space in
- * which to copy it. Just let the copy be untyped.
+ * The String struct in the source value holds zero useful data. Don't
+ * bother copying it. Don't even bother allocating space in which to
+ * copy it. Just let the copy be untyped.
*/
+
return;
}
if (srcStringPtr->hasUnicode) {
int copyMaxChars;
+
if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) {
copyMaxChars = 2 * srcStringPtr->numChars;
} else {
copyMaxChars = srcStringPtr->maxChars;
}
- copyStringPtr = stringAlloc(copyMaxChars);
+ copyStringPtr = stringAttemptAlloc(copyMaxChars);
+ if (copyStringPtr == NULL) {
+ copyMaxChars = srcStringPtr->numChars;
+ copyStringPtr = stringAlloc(copyMaxChars);
+ }
copyStringPtr->maxChars = copyMaxChars;
memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
srcStringPtr->numChars * sizeof(Tcl_UniChar));
@@ -2773,12 +2900,13 @@ DupStringInternalRep(
copyStringPtr->numChars = srcStringPtr->numChars;
/*
- * Tricky point: the string value was copied by generic object
- * management code, so it doesn't contain any extra bytes that
- * might exist in the source object.
+ * Tricky point: the string value was copied by generic object management
+ * code, so it doesn't contain any extra bytes that might exist in the
+ * source object.
*/
+
copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
-#else
+#else /* COMPAT!=0 */
/*
* If the src obj is a string of 1-byte Utf chars, then copy the string
* rep of the source object and create an "empty" Unicode internal rep for
@@ -2787,7 +2915,10 @@ DupStringInternalRep(
*/
if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) {
- /* Copy the full allocation for the Unicode buffer. */
+ /*
+ * Copy the full allocation for the Unicode buffer.
+ */
+
copyStringPtr = stringAlloc(srcStringPtr->maxChars);
copyStringPtr->maxChars = srcStringPtr->maxChars;
memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
@@ -2798,16 +2929,18 @@ DupStringInternalRep(
copyStringPtr = stringAlloc(0);
copyStringPtr->unicode[0] = 0;
copyStringPtr->maxChars = 0;
+
/*
* Tricky point: the string value was copied by generic object
- * management code, so it doesn't contain any extra bytes that
- * might exist in the source object.
+ * management code, so it doesn't contain any extra bytes that might
+ * exist in the source object.
*/
+
copyStringPtr->allocated = copyPtr->length;
}
copyStringPtr->numChars = srcStringPtr->numChars;
copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
-#endif
+#endif /* COMPAT==0 */
SET_STRING(copyPtr, copyStringPtr);
copyPtr->typePtr = &tclStringType;
@@ -2839,7 +2972,7 @@ SetStringFromAny(
String *stringPtr = stringAlloc(0);
/*
- * Convert whatever we have into an untyped value. Just A String.
+ * Convert whatever we have into an untyped value. Just A String.
*/
(void) TclGetString(objPtr);
@@ -2883,6 +3016,7 @@ UpdateStringOfString(
Tcl_Obj *objPtr) /* Object with string rep to update. */
{
String *stringPtr = GET_STRING(objPtr);
+
if (stringPtr->numChars == 0) {
TclInitStringRep(objPtr, tclEmptyStringRep, 0);
} else {
@@ -2897,10 +3031,12 @@ ExtendStringRepWithUnicode(
const Tcl_UniChar *unicode,
int numChars)
{
+ /*
+ * Pre-condition: this is the "string" Tcl_ObjType.
+ */
+
int i, origLength, size = 0;
char *dst, buf[TCL_UTF_MAX];
-
- /* Pre-condition: this is the "string" Tcl_ObjType */
String *stringPtr = GET_STRING(objPtr);
if (numChars < 0) {
@@ -2916,7 +3052,10 @@ ExtendStringRepWithUnicode(
}
size = origLength = objPtr->length;
- /* Quick cheap check in case we have more than enough room. */
+ /*
+ * Quick cheap check in case we have more than enough room.
+ */
+
if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
&& stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
goto copyBytes;
@@ -2929,12 +3068,15 @@ ExtendStringRepWithUnicode(
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
- /* Grow space if needed */
+ /*
+ * Grow space if needed.
+ */
+
if (size > stringPtr->allocated) {
GrowStringBuffer(objPtr, size, 1);
}
- copyBytes:
+ copyBytes:
dst = objPtr->bytes + origLength;
for (i = 0; i < numChars; i++) {
dst += Tcl_UniCharToUtf((int) unicode[i], dst);
@@ -2965,7 +3107,7 @@ static void
FreeStringInternalRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
- ckfree((char *) GET_STRING(objPtr));
+ ckfree(GET_STRING(objPtr));
objPtr->typePtr = NULL;
}
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index b804b9a..88ada19 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclStubInit.c,v 1.197 2010/09/16 14:49:37 nijtmans Exp $
*/
#include "tclInt.h"
@@ -41,6 +39,141 @@
#undef Tcl_CreateHashEntry
#undef Tcl_Panic
#undef Tcl_FindExecutable
+#undef TclpGetPid
+#undef TclSockMinimumBuffers
+
+/* See bug 510001: TclSockMinimumBuffers needs plat imp */
+#ifdef _WIN64
+# define TclSockMinimumBuffersOld 0
+#else
+#define TclSockMinimumBuffersOld sockMinimumBuffersOld
+static int TclSockMinimumBuffersOld(int sock, int size)
+{
+ return TclSockMinimumBuffers(INT2PTR(sock), size);
+}
+#endif
+
+
+#if defined(_WIN32) || defined(__CYGWIN__)
+#undef TclWinNToHS
+#define TclWinNToHS winNToHS
+static unsigned short TclWinNToHS(unsigned short ns) {
+ return ntohs(ns);
+}
+#endif
+
+#ifdef __WIN32__
+# define TclUnixWaitForFile 0
+# define TclUnixCopyFile 0
+# define TclUnixOpenTemporaryFile 0
+# define TclpReaddir 0
+# define TclpIsAtty 0
+#elif defined(__CYGWIN__)
+# define TclpIsAtty TclPlatIsAtty
+# define TclWinSetInterfaces (void (*) (int)) doNothing
+# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
+# define TclWinFlushDirtyChannels doNothing
+# define TclWinResetInterfaces doNothing
+
+static Tcl_Encoding winTCharEncoding;
+
+static int
+TclpIsAtty(int fd)
+{
+ return isatty(fd);
+}
+
+int
+TclWinGetPlatformId()
+{
+ /* Don't bother to determine the real platform on cygwin,
+ * because VER_PLATFORM_WIN32_NT is the only supported platform */
+ return 2; /* VER_PLATFORM_WIN32_NT */;
+}
+
+void *TclWinGetTclInstance()
+{
+ void *hInstance = NULL;
+ GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
+ (const char *)&winTCharEncoding, &hInstance);
+ return hInstance;
+}
+
+int
+TclWinSetSockOpt(SOCKET s, int level, int optname,
+ const char *optval, int optlen)
+{
+ return setsockopt((int) s, level, optname, optval, optlen);
+}
+
+int
+TclWinGetSockOpt(SOCKET s, int level, int optname,
+ char *optval, int *optlen)
+{
+ return getsockopt((int) s, level, optname, optval, optlen);
+}
+
+struct servent *
+TclWinGetServByName(const char *name, const char *proto)
+{
+ return getservbyname(name, proto);
+}
+
+char *
+TclWinNoBackslash(char *path)
+{
+ char *p;
+
+ for (p = path; *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ return path;
+}
+
+int
+TclpGetPid(Tcl_Pid pid)
+{
+ return (int) (size_t) pid;
+}
+
+static void
+doNothing(void)
+{
+ /* dummy implementation, no need to do anything */
+}
+
+char *
+Tcl_WinUtfToTChar(
+ const char *string,
+ int len,
+ Tcl_DString *dsPtr)
+{
+ if (!winTCharEncoding) {
+ winTCharEncoding = Tcl_GetEncoding(0, "unicode");
+ }
+ return Tcl_UtfToExternalDString(winTCharEncoding,
+ string, len, dsPtr);
+}
+
+char *
+Tcl_WinTCharToUtf(
+ const char *string,
+ int len,
+ Tcl_DString *dsPtr)
+{
+ if (!winTCharEncoding) {
+ winTCharEncoding = Tcl_GetEncoding(0, "unicode");
+ }
+ return Tcl_ExternalToUtfDString(winTCharEncoding,
+ string, len, dsPtr);
+}
+
+#else /* UNIX and MAC */
+# define TclpLocaltime_unix TclpLocaltime
+# define TclpGmtime_unix TclpGmtime
+#endif
/*
* WARNING: The contents of this file is automatically generated by the
@@ -80,7 +213,7 @@ static const TclIntStubs tclIntStubs = {
0, /* 21 */
TclFindElement, /* 22 */
TclFindProc, /* 23 */
- 0, /* 24 */
+ TclFormatInt, /* 24 */
TclFreePackageInfo, /* 25 */
0, /* 26 */
0, /* 27 */
@@ -134,7 +267,7 @@ static const TclIntStubs tclIntStubs = {
TclpGetClicks, /* 75 */
TclpGetSeconds, /* 76 */
TclpGetTime, /* 77 */
- TclpGetTimeZone, /* 78 */
+ 0, /* 78 */
0, /* 79 */
0, /* 80 */
TclpRealloc, /* 81 */
@@ -160,13 +293,13 @@ static const TclIntStubs tclIntStubs = {
TclSetPreInitScript, /* 101 */
TclSetupEnv, /* 102 */
TclSockGetPort, /* 103 */
- TclSockMinimumBuffers, /* 104 */
+ TclSockMinimumBuffersOld, /* 104 */
0, /* 105 */
0, /* 106 */
0, /* 107 */
TclTeardownNamespace, /* 108 */
TclUpdateReturnInfo, /* 109 */
- 0, /* 110 */
+ TclSockMinimumBuffers, /* 110 */
Tcl_AddInterpResolvers, /* 111 */
Tcl_AppendExportList, /* 112 */
Tcl_CreateNamespace, /* 113 */
@@ -305,12 +438,14 @@ static const TclIntStubs tclIntStubs = {
TclInitRewriteEnsemble, /* 246 */
TclResetRewriteEnsemble, /* 247 */
TclCopyChannel, /* 248 */
+ TclDoubleDigits, /* 249 */
+ TclSetSlaveCancelFlags, /* 250 */
};
static const TclIntPlatStubs tclIntPlatStubs = {
TCL_STUB_MAGIC,
0,
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
TclGetAndDetachPids, /* 0 */
TclpCloseFile, /* 1 */
TclpCreateCommandChannel, /* 2 */
@@ -326,38 +461,55 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclpGmtime_unix, /* 12 */
TclpInetNtoa, /* 13 */
TclUnixCopyFile, /* 14 */
+ 0, /* 15 */
+ 0, /* 16 */
+ 0, /* 17 */
+ 0, /* 18 */
+ 0, /* 19 */
+ 0, /* 20 */
+ 0, /* 21 */
+ 0, /* 22 */
+ 0, /* 23 */
+ 0, /* 24 */
+ 0, /* 25 */
+ 0, /* 26 */
+ 0, /* 27 */
+ 0, /* 28 */
+ TclWinCPUID, /* 29 */
+ TclUnixOpenTemporaryFile, /* 30 */
#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
TclWinConvertError, /* 0 */
TclWinConvertWSAError, /* 1 */
TclWinGetServByName, /* 2 */
TclWinGetSockOpt, /* 3 */
TclWinGetTclInstance, /* 4 */
- 0, /* 5 */
+ TclUnixWaitForFile, /* 5 */
TclWinNToHS, /* 6 */
TclWinSetSockOpt, /* 7 */
TclpGetPid, /* 8 */
TclWinGetPlatformId, /* 9 */
- 0, /* 10 */
+ TclpReaddir, /* 10 */
TclGetAndDetachPids, /* 11 */
TclpCloseFile, /* 12 */
TclpCreateCommandChannel, /* 13 */
TclpCreatePipe, /* 14 */
TclpCreateProcess, /* 15 */
- 0, /* 16 */
- 0, /* 17 */
+ TclpIsAtty, /* 16 */
+ TclUnixCopyFile, /* 17 */
TclpMakeFile, /* 18 */
TclpOpenFile, /* 19 */
TclWinAddProcess, /* 20 */
- 0, /* 21 */
+ TclpInetNtoa, /* 21 */
TclpCreateTempFile, /* 22 */
- TclpGetTZName, /* 23 */
+ 0, /* 23 */
TclWinNoBackslash, /* 24 */
0, /* 25 */
TclWinSetInterfaces, /* 26 */
TclWinFlushDirtyChannels, /* 27 */
TclWinResetInterfaces, /* 28 */
TclWinCPUID, /* 29 */
+ TclUnixOpenTemporaryFile, /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
TclGetAndDetachPids, /* 0 */
@@ -380,13 +532,24 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclMacOSXCopyFileAttributes, /* 17 */
TclMacOSXMatchType, /* 18 */
TclMacOSXNotifierAddRunLoopMode, /* 19 */
+ 0, /* 20 */
+ 0, /* 21 */
+ 0, /* 22 */
+ 0, /* 23 */
+ 0, /* 24 */
+ 0, /* 25 */
+ 0, /* 26 */
+ 0, /* 27 */
+ 0, /* 28 */
+ TclWinCPUID, /* 29 */
+ TclUnixOpenTemporaryFile, /* 30 */
#endif /* MACOSX */
};
static const TclPlatStubs tclPlatStubs = {
TCL_STUB_MAGIC,
0,
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
Tcl_WinUtfToTChar, /* 0 */
Tcl_WinTCharToUtf, /* 1 */
#endif /* WIN */
@@ -460,6 +623,9 @@ const TclTomMathStubs tclTomMathStubs = {
TclBN_s_mp_mul_digs, /* 58 */
TclBN_s_mp_sqr, /* 59 */
TclBN_s_mp_sub, /* 60 */
+ TclBN_mp_init_set_int, /* 61 */
+ TclBN_mp_set_int, /* 62 */
+ TclBN_mp_cnt_lsb, /* 63 */
};
static const TclStubHooks tclStubHooks = {
@@ -483,7 +649,7 @@ const TclStubs tclStubs = {
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_CreateFileHandler, /* 9 */
#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) /* WIN */
0, /* 9 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -492,7 +658,7 @@ const TclStubs tclStubs = {
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_DeleteFileHandler, /* 10 */
#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) /* WIN */
0, /* 10 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -657,7 +823,7 @@ const TclStubs tclStubs = {
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_GetOpenFile, /* 167 */
#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#if defined(__WIN32__) /* WIN */
0, /* 167 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -1125,6 +1291,7 @@ const TclStubs tclStubs = {
Tcl_LoadFile, /* 627 */
Tcl_FindSymbol, /* 628 */
Tcl_FSUnloadFile, /* 629 */
+ Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 0197741..a9d0f02 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -9,19 +9,8 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclStubLib.c,v 1.34 2010/08/31 20:48:17 nijtmans Exp $
- */
-
-/*
- * We need to ensure that we use the stub macros so that this file contains no
- * references to any of the stub functions. This will make it possible to
- * build an extension that references Tcl_InitStubs but doesn't end up
- * including the rest of the stub functions.
*/
-#define USE_TCL_STUBS
-
#include "tclInt.h"
MODULE_SCOPE const TclStubs *tclStubsPtr;
@@ -43,9 +32,7 @@ HasStubSupport(
if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
return iPtr->stubTable;
}
-
- iPtr->result =
- (char *)"This interpreter does not support stubs-enabled extensions.";
+ iPtr->result = (char *) "interpreter uses an incompatible stubs mechanism";
iPtr->freeProc = TCL_STATIC;
return NULL;
}
@@ -76,7 +63,7 @@ static int isDigit(const int c)
*
*----------------------------------------------------------------------
*/
-
+#undef Tcl_InitStubs
MODULE_SCOPE const char *
Tcl_InitStubs(
Tcl_Interp *interp,
@@ -85,6 +72,7 @@ Tcl_InitStubs(
{
const char *actualVersion = NULL;
ClientData pkgData = NULL;
+ const TclStubs *stubsPtr;
/*
* We can't optimize this check by caching tclStubsPtr because that
@@ -92,12 +80,12 @@ Tcl_InitStubs(
* times. [Bug 615304]
*/
- tclStubsPtr = HasStubSupport(interp);
- if (!tclStubsPtr) {
+ stubsPtr = HasStubSupport(interp);
+ if (!stubsPtr) {
return NULL;
}
- actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
+ actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
if (actualVersion == NULL) {
return NULL;
}
@@ -115,19 +103,19 @@ Tcl_InitStubs(
while (*p && (*p == *q)) {
p++; q++;
}
- if (*p) {
+ if (*p || isDigit(*q)) {
/* Construct error message */
- Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
+ stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
return NULL;
}
} else {
- actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
+ actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
if (actualVersion == NULL) {
return NULL;
}
}
}
- tclStubsPtr = (TclStubs *) pkgData;
+ tclStubsPtr = (TclStubs *)pkgData;
if (tclStubsPtr->hooks) {
tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index b845d72..a8b27fb 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -13,8 +13,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclTest.c,v 1.154 2010/09/27 19:42:38 msofer Exp $
*/
#undef STATIC_BUILD
@@ -23,6 +21,8 @@
#endif
#include "tclInt.h"
#include "tclOO.h"
+#include <math.h>
+
/*
* Required for Testregexp*Cmd
*/
@@ -75,6 +75,8 @@ typedef struct TestAsyncHandler {
/* Next is list of handlers. */
} TestAsyncHandler;
+TCL_DECLARE_MUTEX(asyncTestMutex)
+
static TestAsyncHandler *firstHandler = NULL;
/*
@@ -233,6 +235,9 @@ static int TestdelCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestdelassocdataCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
+static int TestdoubledigitsObjCmd(ClientData dummy,
+ Tcl_Interp* interp,
+ int objc, Tcl_Obj* const objv[]);
static int TestdstringCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestencodingObjCmd(ClientData dummy,
@@ -303,9 +308,8 @@ static int TestexitmainloopCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestpanicCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestfinexitObjCmd(ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
+static int TestparseargsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
static int TestparserObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -377,7 +381,8 @@ static Tcl_FSRenameFileProc TestReportRenameFile;
static Tcl_FSCreateDirectoryProc TestReportCreateDirectory;
static Tcl_FSCopyDirectoryProc TestReportCopyDirectory;
static Tcl_FSRemoveDirectoryProc TestReportRemoveDirectory;
-static Tcl_FSLoadFileProc TestReportLoadFile;
+static int TestReportLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr);
static Tcl_FSLinkProc TestReportLink;
static Tcl_FSFileAttrStringsProc TestReportFileAttrStrings;
static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet;
@@ -404,6 +409,14 @@ static int TestHashSystemHashCmd(ClientData clientData,
static int TestNRELevels(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+static int TestInterpResolverCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+#if defined(HAVE_CPUID) || defined(__WIN32__)
+static int TestcpuidCmd(ClientData dummy,
+ Tcl_Interp* interp, int objc,
+ Tcl_Obj *const objv[]);
+#endif
static const Tcl_Filesystem testReportingFilesystem = {
"reporting",
@@ -434,7 +447,7 @@ static const Tcl_Filesystem testReportingFilesystem = {
TestReportRenameFile,
TestReportCopyDirectory,
TestReportLstat,
- TestReportLoadFile,
+ (Tcl_FSLoadFileProc *) TestReportLoadFile,
NULL /* cwd */,
TestReportChdir
};
@@ -569,6 +582,8 @@ Tcltest_Init(
Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd,
+ NULL, NULL);
Tcl_DStringInit(&dstring);
Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL,
NULL);
@@ -616,7 +631,7 @@ Tcltest_Init(
Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL,
NULL);
Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
- Tcl_CreateObjCommand(interp, "testfinexit", TestfinexitObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
@@ -658,6 +673,10 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
NULL, NULL);
+#if defined(HAVE_CPUID) || defined(__WIN32__)
+ Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
+ (ClientData) 0, NULL);
+#endif
t3ArgTypes[0] = TCL_EITHER;
t3ArgTypes[1] = TCL_EITHER;
Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
@@ -665,6 +684,8 @@ Tcltest_Init(
Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
+ NULL, NULL);
if (TclObjTest_Init(interp) != TCL_OK) {
return TCL_ERROR;
@@ -785,25 +806,29 @@ TestasyncCmd(
if (argc != 3) {
goto wrongNumArgs;
}
- asyncPtr = (TestAsyncHandler *) ckalloc(sizeof(TestAsyncHandler));
+ asyncPtr = ckalloc(sizeof(TestAsyncHandler));
+ asyncPtr->command = ckalloc(strlen(argv[2]) + 1);
+ strcpy(asyncPtr->command, argv[2]);
+ Tcl_MutexLock(&asyncTestMutex);
asyncPtr->id = nextId;
nextId++;
asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc,
- (ClientData) asyncPtr);
- asyncPtr->command = (char *) ckalloc((unsigned) (strlen(argv[2]) + 1));
- strcpy(asyncPtr->command, argv[2]);
+ INT2PTR(asyncPtr->id));
asyncPtr->nextPtr = firstHandler;
firstHandler = asyncPtr;
+ Tcl_MutexUnlock(&asyncTestMutex);
Tcl_SetObjResult(interp, Tcl_NewIntObj(asyncPtr->id));
} else if (strcmp(argv[1], "delete") == 0) {
if (argc == 2) {
+ Tcl_MutexLock(&asyncTestMutex);
while (firstHandler != NULL) {
asyncPtr = firstHandler;
firstHandler = asyncPtr->nextPtr;
Tcl_AsyncDelete(asyncPtr->handler);
ckfree(asyncPtr->command);
- ckfree((char *) asyncPtr);
+ ckfree(asyncPtr);
}
+ Tcl_MutexUnlock(&asyncTestMutex);
return TCL_OK;
}
if (argc != 3) {
@@ -812,6 +837,7 @@ TestasyncCmd(
if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
return TCL_ERROR;
}
+ Tcl_MutexLock(&asyncTestMutex);
for (prevPtr = NULL, asyncPtr = firstHandler; asyncPtr != NULL;
prevPtr = asyncPtr, asyncPtr = asyncPtr->nextPtr) {
if (asyncPtr->id != id) {
@@ -824,9 +850,10 @@ TestasyncCmd(
}
Tcl_AsyncDelete(asyncPtr->handler);
ckfree(asyncPtr->command);
- ckfree((char *) asyncPtr);
+ ckfree(asyncPtr);
break;
}
+ Tcl_MutexUnlock(&asyncTestMutex);
} else if (strcmp(argv[1], "mark") == 0) {
if (argc != 5) {
goto wrongNumArgs;
@@ -835,6 +862,7 @@ TestasyncCmd(
|| (Tcl_GetInt(interp, argv[4], &code) != TCL_OK)) {
return TCL_ERROR;
}
+ Tcl_MutexLock(&asyncTestMutex);
for (asyncPtr = firstHandler; asyncPtr != NULL;
asyncPtr = asyncPtr->nextPtr) {
if (asyncPtr->id == id) {
@@ -843,6 +871,7 @@ TestasyncCmd(
}
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
+ Tcl_MutexUnlock(&asyncTestMutex);
return code;
#ifdef TCL_THREADS
} else if (strcmp(argv[1], "marklater") == 0) {
@@ -852,19 +881,22 @@ TestasyncCmd(
if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
return TCL_ERROR;
}
+ Tcl_MutexLock(&asyncTestMutex);
for (asyncPtr = firstHandler; asyncPtr != NULL;
asyncPtr = asyncPtr->nextPtr) {
if (asyncPtr->id == id) {
Tcl_ThreadId threadID;
if (Tcl_CreateThread(&threadID, AsyncThreadProc,
- (ClientData) asyncPtr, TCL_THREAD_STACK_DEFAULT,
+ INT2PTR(id), TCL_THREAD_STACK_DEFAULT,
TCL_THREAD_NOFLAGS) != TCL_OK) {
Tcl_SetResult(interp, "can't create thread", TCL_STATIC);
+ Tcl_MutexUnlock(&asyncTestMutex);
return TCL_ERROR;
}
break;
}
}
+ Tcl_MutexUnlock(&asyncTestMutex);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be create, delete, int, mark, or marklater", NULL);
@@ -881,15 +913,29 @@ TestasyncCmd(
static int
AsyncHandlerProc(
- ClientData clientData, /* Pointer to TestAsyncHandler structure. */
+ ClientData clientData, /* If of TestAsyncHandler structure.
+ * in global list. */
Tcl_Interp *interp, /* Interpreter in which command was
* executed, or NULL. */
int code) /* Current return code from command. */
{
- TestAsyncHandler *asyncPtr = (TestAsyncHandler *) clientData;
+ TestAsyncHandler *asyncPtr;
+ int id = PTR2INT(clientData);
const char *listArgv[4], *cmd;
char string[TCL_INTEGER_SPACE];
+ Tcl_MutexLock(&asyncTestMutex);
+ for (asyncPtr = firstHandler; asyncPtr != NULL;
+ asyncPtr = asyncPtr->nextPtr) {
+ if (asyncPtr->id == id) break;
+ }
+ Tcl_MutexUnlock(&asyncTestMutex);
+
+ if (!asyncPtr) {
+ /* Woops - this one was deleted between the AsyncMark and now */
+ return TCL_OK;
+ }
+
TclFormatInt(string, code);
listArgv[0] = asyncPtr->command;
listArgv[1] = Tcl_GetString(Tcl_GetObjResult(interp));
@@ -904,7 +950,7 @@ AsyncHandlerProc(
* invoked, it's possible. Better error checking is needed here.
*/
}
- ckfree((char *)cmd);
+ ckfree(cmd);
return code;
}
@@ -927,12 +973,22 @@ AsyncHandlerProc(
#ifdef TCL_THREADS
static Tcl_ThreadCreateType
AsyncThreadProc(
- ClientData clientData) /* Parameter is a pointer to a
+ ClientData clientData) /* Parameter is the id of a
* TestAsyncHandler, defined above. */
{
- TestAsyncHandler *asyncPtr = clientData;
+ TestAsyncHandler *asyncPtr;
+ int id = PTR2INT(clientData);
+
Tcl_Sleep(1);
- Tcl_AsyncMark(asyncPtr->handler);
+ Tcl_MutexLock(&asyncTestMutex);
+ for (asyncPtr = firstHandler; asyncPtr != NULL;
+ asyncPtr = asyncPtr->nextPtr) {
+ if (asyncPtr->id == id) {
+ Tcl_AsyncMark(asyncPtr->handler);
+ break;
+ }
+ }
+ Tcl_MutexUnlock(&asyncTestMutex);
Tcl_ExitThread(TCL_OK);
TCL_THREAD_CREATE_RETURN;
}
@@ -1522,9 +1578,9 @@ TestdelCmd(
return TCL_ERROR;
}
- dPtr = (DelCmd *) ckalloc(sizeof(DelCmd));
+ dPtr = ckalloc(sizeof(DelCmd));
dPtr->interp = interp;
- dPtr->deleteCmd = (char *) ckalloc((unsigned) (strlen(argv[3]) + 1));
+ dPtr->deleteCmd = ckalloc(strlen(argv[3]) + 1);
strcpy(dPtr->deleteCmd, argv[3]);
Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr,
@@ -1543,7 +1599,7 @@ DelCmdProc(
Tcl_AppendResult(interp, dPtr->deleteCmd, NULL);
ckfree(dPtr->deleteCmd);
- ckfree((char *) dPtr);
+ ckfree(dPtr);
return TCL_OK;
}
@@ -1551,12 +1607,12 @@ static void
DelDeleteProc(
ClientData clientData) /* String command to evaluate. */
{
- DelCmd *dPtr = (DelCmd *) clientData;
+ DelCmd *dPtr = clientData;
Tcl_Eval(dPtr->interp, dPtr->deleteCmd);
Tcl_ResetResult(dPtr->interp);
ckfree(dPtr->deleteCmd);
- ckfree((char *) dPtr);
+ ckfree(dPtr);
}
/*
@@ -1594,6 +1650,102 @@ TestdelassocdataCmd(
}
/*
+ *-----------------------------------------------------------------------------
+ *
+ * TestdoubledigitsCmd --
+ *
+ * This procedure implements the 'testdoubledigits' command. It is
+ * used to test the low-level floating-point formatting primitives
+ * in Tcl.
+ *
+ * Usage:
+ * testdoubledigits fpval ndigits type ?shorten"
+ *
+ * Parameters:
+ * fpval - Floating-point value to format.
+ * ndigits - Digit count to request from Tcl_DoubleDigits
+ * type - One of 'shortest', 'Steele', 'e', 'f'
+ * shorten - Indicates that the 'shorten' flag should be passed in.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+TestdoubledigitsObjCmd(ClientData unused,
+ /* NULL */
+ Tcl_Interp* interp,
+ /* Tcl interpreter */
+ int objc,
+ /* Parameter count */
+ Tcl_Obj* const objv[])
+ /* Parameter vector */
+{
+ static const char* options[] = {
+ "shortest",
+ "Steele",
+ "e",
+ "f",
+ NULL
+ };
+ static const int types[] = {
+ TCL_DD_SHORTEST,
+ TCL_DD_STEELE,
+ TCL_DD_E_FORMAT,
+ TCL_DD_F_FORMAT
+ };
+
+ const Tcl_ObjType* doubleType;
+ double d;
+ int status;
+ int ndigits;
+ int type;
+ int decpt;
+ int signum;
+ char* str;
+ char* endPtr;
+ Tcl_Obj* strObj;
+ Tcl_Obj* retval;
+
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 1, objv, "fpval ndigits type ?shorten?");
+ return TCL_ERROR;
+ }
+ status = Tcl_GetDoubleFromObj(interp, objv[1], &d);
+ if (status != TCL_OK) {
+ doubleType = Tcl_GetObjType("double");
+ if (objv[1]->typePtr == doubleType
+ || TclIsNaN(objv[1]->internalRep.doubleValue)) {
+ status = TCL_OK;
+ memcpy(&d, &(objv[1]->internalRep.doubleValue), sizeof(double));
+ }
+ }
+ if (status != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK
+ || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type",
+ TCL_EXACT, &type) != TCL_OK) {
+ fprintf(stderr, "bad value? %g\n", d);
+ return TCL_ERROR;
+ }
+ type = types[type];
+ if (objc > 4) {
+ if (strcmp(Tcl_GetString(objv[4]), "shorten")) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
+ return TCL_ERROR;
+ }
+ type |= TCL_DD_SHORTEN_FLAG;
+ }
+ str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
+ strObj = Tcl_NewStringObj(str, endPtr-str);
+ ckfree(str);
+ retval = Tcl_NewListObj(1, &strObj);
+ Tcl_ListObjAppendElement(NULL, retval, Tcl_NewIntObj(decpt));
+ strObj = Tcl_NewStringObj(signum ? "-" : "+", 1);
+ Tcl_ListObjAppendElement(NULL, retval, strObj);
+ Tcl_SetObjResult(interp, retval);
+ return TCL_OK;
+}
+
+/*
*----------------------------------------------------------------------
*
* TestdstringCmd --
@@ -1662,11 +1814,11 @@ TestdstringCmd(
} else if (strcmp(argv[2], "staticlarge") == 0) {
Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC);
} else if (strcmp(argv[2], "free") == 0) {
- char *s = (char *) ckalloc(100);
+ char *s = ckalloc(100);
strcpy(s, "This is a malloc-ed string");
Tcl_SetResult(interp, s, TCL_DYNAMIC);
} else if (strcmp(argv[2], "special") == 0) {
- char *s = (char *) ckalloc(100) + 16;
+ char *s = (char*)ckalloc(100) + 16;
strcpy(s, "This is a specially-allocated string");
Tcl_SetResult(interp, s, SpecialFree);
} else {
@@ -1768,15 +1920,15 @@ TestencodingObjCmd(
if (objc != 5) {
return TCL_ERROR;
}
- encodingPtr = (TclEncoding *) ckalloc(sizeof(TclEncoding));
+ encodingPtr = ckalloc(sizeof(TclEncoding));
encodingPtr->interp = interp;
string = Tcl_GetStringFromObj(objv[3], &length);
- encodingPtr->toUtfCmd = (char *) ckalloc((unsigned) (length + 1));
+ encodingPtr->toUtfCmd = ckalloc(length + 1);
memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);
string = Tcl_GetStringFromObj(objv[4], &length);
- encodingPtr->fromUtfCmd = (char *) ckalloc((unsigned) (length + 1));
+ encodingPtr->fromUtfCmd = ckalloc(length + 1);
memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));
string = Tcl_GetStringFromObj(objv[2], &length);
@@ -1871,12 +2023,11 @@ static void
EncodingFreeProc(
ClientData clientData) /* ClientData associated with type. */
{
- TclEncoding *encodingPtr;
+ TclEncoding *encodingPtr = clientData;
- encodingPtr = (TclEncoding *) clientData;
- ckfree((char *) encodingPtr->toUtfCmd);
- ckfree((char *) encodingPtr->fromUtfCmd);
- ckfree((char *) encodingPtr);
+ ckfree(encodingPtr->toUtfCmd);
+ ckfree(encodingPtr->fromUtfCmd);
+ ckfree(encodingPtr);
}
/*
@@ -2031,7 +2182,7 @@ TesteventObjCmd(
"position specifier", TCL_EXACT, &posIndex) != TCL_OK) {
return TCL_ERROR;
}
- ev = (TestEvent *) ckalloc(sizeof(TestEvent));
+ ev = ckalloc(sizeof(TestEvent));
ev->header.proc = TesteventProc;
ev->header.nextPtr = NULL;
ev->interp = interp;
@@ -2889,7 +3040,7 @@ TestlinkCmd(
if (strcmp(argv[5], "-") == 0) {
stringVar = NULL;
} else {
- stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1));
+ stringVar = ckalloc(strlen(argv[5]) + 1);
strcpy(stringVar, argv[5]);
}
}
@@ -2996,7 +3147,7 @@ TestlinkCmd(
if (strcmp(argv[5], "-") == 0) {
stringVar = NULL;
} else {
- stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1));
+ stringVar = ckalloc(strlen(argv[5]) + 1);
strcpy(stringVar, argv[5]);
}
Tcl_UpdateLinkedVar(interp, "string");
@@ -3117,7 +3268,7 @@ TestlocaleCmd(
"ctype", "numeric", "time", "collate", "monetary",
"all", NULL
};
- static int lcTypes[] = {
+ static const int lcTypes[] = {
LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY,
LC_ALL
};
@@ -3308,7 +3459,7 @@ CleanupTestSetassocdataTests(
ClientData clientData, /* Data to be released. */
Tcl_Interp *interp) /* Interpreter being deleted. */
{
- ckfree((char *) clientData);
+ ckfree(clientData);
}
/*
@@ -3839,10 +3990,8 @@ TestregexpObjCmd(
info.matches[ii].end - 1);
}
}
- valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0);
+ valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG);
if (valuePtr == NULL) {
- Tcl_AppendResult(interp, "couldn't set variable \"",
- Tcl_GetString(varPtr), "\"", NULL);
return TCL_ERROR;
}
}
@@ -4007,7 +4156,7 @@ TestsetassocdataCmd(
return TCL_ERROR;
}
- buf = ckalloc((unsigned) strlen(argv[2]) + 1);
+ buf = ckalloc(strlen(argv[2]) + 1);
strcpy(buf, argv[2]);
/*
@@ -4389,53 +4538,12 @@ TestpanicCmd(
*/
argString = Tcl_Merge(argc-1, argv+1);
- Tcl_Panic(argString);
- ckfree((char *)argString);
+ Tcl_Panic("%s", argString);
+ ckfree(argString);
return TCL_OK;
}
-/*
- *----------------------------------------------------------------------
- *
- * TestfinexitObjCmd --
- *
- * Calls a variant of [exit] including the full finalization path.
- *
- * Results:
- * Error, or doesn't return.
- *
- * Side effects:
- * Exits application.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestfinexitObjCmd(
- ClientData dummy, /* Not used. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument objects. */
-{
- int value;
-
- if ((objc != 1) && (objc != 2)) {
- Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
- return TCL_ERROR;
- }
-
- if (objc == 1) {
- value = 0;
- } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
- return TCL_ERROR;
- }
- Tcl_Finalize();
- TclpExit(value);
- /*NOTREACHED*/
- return TCL_ERROR; /* Better not ever reach this! */
-}
-
static int
TestfileCmd(
ClientData dummy, /* Not used. */
@@ -4615,8 +4723,8 @@ GetTimesCmd(
fprintf(stderr, "alloc & free 100000 6 word items\n");
Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
- objPtr = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
- ckfree((char *) objPtr);
+ objPtr = ckalloc(sizeof(Tcl_Obj));
+ ckfree(objPtr);
}
Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
@@ -4624,10 +4732,10 @@ GetTimesCmd(
/* alloc 5000 times */
fprintf(stderr, "alloc 5000 6 word items\n");
- objv = (Tcl_Obj **) ckalloc(5000 * sizeof(Tcl_Obj *));
+ objv = ckalloc(5000 * sizeof(Tcl_Obj *));
Tcl_GetTime(&start);
for (i = 0; i < 5000; i++) {
- objv[i] = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
+ objv[i] = ckalloc(sizeof(Tcl_Obj));
}
Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
@@ -4637,7 +4745,7 @@ GetTimesCmd(
fprintf(stderr, "free 5000 6 word items\n");
Tcl_GetTime(&start);
for (i = 0; i < 5000; i++) {
- ckfree((char *) objv[i]);
+ ckfree(objv[i]);
}
Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
@@ -4663,7 +4771,7 @@ GetTimesCmd(
Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
fprintf(stderr, " %.3f usec per Tcl_DecrRefCount\n", timePer/5000);
- ckfree((char *) objv);
+ ckfree(objv);
/* TclGetString 100000 times */
fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n");
@@ -5054,7 +5162,7 @@ TestmainthreadCmd(
const char **argv) /* Argument strings. */
{
if (argc == 1) {
- Tcl_Obj *idObj = Tcl_NewLongObj((long) Tcl_GetCurrentThread());
+ Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
@@ -5211,7 +5319,7 @@ TestChannelCmd(
*nextPtrPtr = curPtr->nextPtr;
curPtr->nextPtr = NULL;
chan = curPtr->chan;
- ckfree((char *) curPtr);
+ ckfree(curPtr);
break;
}
}
@@ -5281,7 +5389,7 @@ TestChannelCmd(
/* Remember the channel in the pool of detached channels */
- det = (TestChannel *) ckalloc(sizeof(TestChannel));
+ det = ckalloc(sizeof(TestChannel));
det->chan = chan;
det->nextPtr = firstDetached;
firstDetached = det;
@@ -5451,7 +5559,7 @@ TestChannelCmd(
return TCL_ERROR;
}
- TclFormatInt(buf, (long) Tcl_GetChannelThread(chan));
+ TclFormatInt(buf, (size_t) Tcl_GetChannelThread(chan));
Tcl_AppendResult(interp, buf, NULL);
return TCL_OK;
}
@@ -5679,8 +5787,7 @@ TestChannelEventCmd(
return TCL_ERROR;
}
- esPtr = (EventScriptRecord *) ckalloc((unsigned)
- sizeof(EventScriptRecord));
+ esPtr = ckalloc(sizeof(EventScriptRecord));
esPtr->nextPtr = statePtr->scriptRecordPtr;
statePtr->scriptRecordPtr = esPtr;
@@ -5737,7 +5844,7 @@ TestChannelEventCmd(
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
TclChannelEventScriptInvoker, (ClientData) esPtr);
Tcl_DecrRefCount(esPtr->scriptPtr);
- ckfree((char *) esPtr);
+ ckfree(esPtr);
return TCL_OK;
}
@@ -5778,7 +5885,7 @@ TestChannelEventCmd(
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
TclChannelEventScriptInvoker, (ClientData) esPtr);
Tcl_DecrRefCount(esPtr->scriptPtr);
- ckfree((char *) esPtr);
+ ckfree(esPtr);
}
statePtr->scriptRecordPtr = NULL;
return TCL_OK;
@@ -6506,6 +6613,62 @@ TestNumUtfCharsCmd(
}
return TCL_OK;
}
+
+#if defined(HAVE_CPUID) || defined(__WIN32__)
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestcpuidCmd --
+ *
+ * Retrieves CPU ID information.
+ *
+ * Usage:
+ * testwincpuid <eax>
+ *
+ * Parameters:
+ * eax - The value to pass in the EAX register to a CPUID instruction.
+ *
+ * Results:
+ * Returns a four-element list containing the values from the EAX, EBX,
+ * ECX and EDX registers returned from the CPUID instruction.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestcpuidCmd(
+ ClientData dummy,
+ Tcl_Interp* interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const * objv) /* Parameter vector */
+{
+ int status, index, i;
+ unsigned int regs[4];
+ Tcl_Obj *regsObjs[4];
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "eax");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ status = TclWinCPUID((unsigned) index, regs);
+ if (status != TCL_OK) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("operation not available", -1));
+ return status;
+ }
+ for (i=0 ; i<4 ; ++i) {
+ regsObjs[i] = Tcl_NewIntObj((int) regs[i]);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
+ return TCL_OK;
+}
+#endif
/*
* Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag
@@ -6623,7 +6786,7 @@ TestNRELevels(
ptrdiff_t depth;
Tcl_Obj *levels[6];
int i = 0;
- TEOV_callback *cbPtr = ((Interp *) interp)->execEnvPtr->callbackPtr;
+ NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr;
if (refDepth == NULL) {
refDepth = &depth;
@@ -6632,11 +6795,11 @@ TestNRELevels(
depth = (refDepth - &depth);
levels[0] = Tcl_NewIntObj(depth);
- levels[1] = Tcl_NewIntObj(((Interp *)interp)->numLevels);
+ levels[1] = Tcl_NewIntObj(iPtr->numLevels);
levels[2] = Tcl_NewIntObj(iPtr->cmdFramePtr->level);
levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level);
- levels[4] = Tcl_NewIntObj((iPtr->execEnvPtr->execStackPtr->tosPtr
- - iPtr->execEnvPtr->execStackPtr->stackWords));
+ levels[4] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
+ - iPtr->execEnvPtr->execStackPtr->stackWords);
while (cbPtr) {
i++;
@@ -6953,9 +7116,245 @@ TestconcatobjCmd(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TestparseargsCmd --
+ *
+ * This procedure implements the "testparseargs" command. It is used to
+ * test that Tcl_ParseArgsObjv does indeed return the right number of
+ * arguments. In other words, that [Bug 3413857] was fixed properly.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestparseargsCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Arguments. */
+{
+ static int foo = 0;
+ int count = objc;
+ Tcl_Obj **remObjv, *result[3];
+ Tcl_ArgvInfo argTable[] = {
+ {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
+ TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
+ };
+
+ foo = 0;
+ if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
+ return TCL_ERROR;
+ }
+ result[0] = Tcl_NewIntObj(foo);
+ result[1] = Tcl_NewIntObj(count);
+ result[2] = Tcl_NewListObj(count, remObjv);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
+ ckfree(remObjv);
+ return TCL_OK;
+}
+
+/**
+ * Test harness for command and variable resolvers.
+ */
+
+static int
+InterpCmdResolver(
+ Tcl_Interp *interp,
+ const char *name,
+ Tcl_Namespace *context,
+ int flags,
+ Tcl_Command *rPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ CallFrame *varFramePtr = iPtr->varFramePtr;
+ Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ?
+ varFramePtr->procPtr : NULL;
+ Namespace *ns2NsPtr = (Namespace *)
+ Tcl_FindNamespace(interp, "::ns2", NULL, 0);
+
+ if (procPtr && (procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr
+ || (ns2NsPtr && procPtr->cmdPtr->nsPtr == ns2NsPtr))) {
+ const char *callingCmdName =
+ Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr);
+
+ if ((callingCmdName[0] == 'x') && (callingCmdName[1] == '\0')
+ && (name[0] == 'z') && (name[1] == '\0')) {
+ Tcl_Command sourceCmdPtr = Tcl_FindCommand(interp, "y", NULL,
+ TCL_GLOBAL_ONLY);
+
+ if (sourceCmdPtr != NULL) {
+ *rPtr = sourceCmdPtr;
+ return TCL_OK;
+ }
+ }
+ }
+ return TCL_CONTINUE;
+}
+
+static int
+InterpVarResolver(
+ Tcl_Interp *interp,
+ const char *name,
+ Tcl_Namespace *context,
+ int flags,
+ Tcl_Var *rPtr)
+{
+ /*
+ * Don't resolve the variable; use standard rules.
+ */
+
+ return TCL_CONTINUE;
+}
+
+typedef struct MyResolvedVarInfo {
+ Tcl_ResolvedVarInfo vInfo; /* This must be the first element. */
+ Tcl_Var var;
+ Tcl_Obj *nameObj;
+} MyResolvedVarInfo;
+
+static inline void
+HashVarFree(
+ Tcl_Var var)
+{
+ if (VarHashRefCount(var) < 2) {
+ ckfree(var);
+ } else {
+ VarHashRefCount(var)--;
+ }
+}
+
+static void
+MyCompiledVarFree(
+ Tcl_ResolvedVarInfo *vInfoPtr)
+{
+ MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vInfoPtr;
+
+ Tcl_DecrRefCount(resVarInfo->nameObj);
+ if (resVarInfo->var) {
+ HashVarFree(resVarInfo->var);
+ }
+ ckfree(vInfoPtr);
+}
+
+#define TclVarHashGetValue(hPtr) \
+ ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
+
+static Tcl_Var
+MyCompiledVarFetch(
+ Tcl_Interp *interp,
+ Tcl_ResolvedVarInfo *vinfoPtr)
+{
+ MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vinfoPtr;
+ Tcl_Var var = resVarInfo->var;
+ int isNewVar;
+ Interp *iPtr = (Interp *) interp;
+ Tcl_HashEntry *hPtr;
+
+ if (var != NULL) {
+ if (!(((Var *) var)->flags & VAR_DEAD_HASH)) {
+ /*
+ * The cached variable is valid, return it.
+ */
+
+ return var;
+ }
+
+ /*
+ * The variable is not valid anymore. Clean it up.
+ */
+
+ HashVarFree(var);
+ }
+
+ hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) &iPtr->globalNsPtr->varTable,
+ (char *) resVarInfo->nameObj, &isNewVar);
+ if (hPtr) {
+ var = (Tcl_Var) TclVarHashGetValue(hPtr);
+ } else {
+ var = NULL;
+ }
+ resVarInfo->var = var;
+
+ /*
+ * Increment the reference counter to avoid ckfree() of the variable in
+ * Tcl's FreeVarEntry(); for cleanup, we provide our own HashVarFree();
+ */
+
+ VarHashRefCount(var)++;
+ return var;
+}
+
+static int
+InterpCompiledVarResolver(
+ Tcl_Interp *interp,
+ const char *name,
+ int length,
+ Tcl_Namespace *context,
+ Tcl_ResolvedVarInfo **rPtr)
+{
+ if (*name == 'T') {
+ MyResolvedVarInfo *resVarInfo = ckalloc(sizeof(MyResolvedVarInfo));
+
+ resVarInfo->vInfo.fetchProc = MyCompiledVarFetch;
+ resVarInfo->vInfo.deleteProc = MyCompiledVarFree;
+ resVarInfo->var = NULL;
+ resVarInfo->nameObj = Tcl_NewStringObj(name, -1);
+ Tcl_IncrRefCount(resVarInfo->nameObj);
+ *rPtr = &resVarInfo->vInfo;
+ return TCL_OK;
+ }
+ return TCL_CONTINUE;
+}
+
+static int
+TestInterpResolverCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ static const char *const table[] = {
+ "down", "up", NULL
+ };
+ int idx;
+#define RESOLVER_KEY "testInterpResolver"
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "up|down");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], table, "operation", TCL_EXACT,
+ &idx) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (idx) {
+ case 1: /* up */
+ Tcl_AddInterpResolvers(interp, RESOLVER_KEY, InterpCmdResolver,
+ InterpVarResolver, InterpCompiledVarResolver);
+ break;
+ case 0: /*down*/
+ if (!Tcl_RemoveInterpResolvers(interp, RESOLVER_KEY)) {
+ Tcl_AppendResult(interp, "could not remove the resolver scheme",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 89f42a6..7494beb 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -12,8 +12,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclTestObj.c,v 1.38 2010/03/18 20:34:48 dgp Exp $
*/
#ifndef USE_TCL_STUBS
@@ -22,23 +20,15 @@
#include "tclInt.h"
#include "tommath.h"
-/*
- * An array of Tcl_Obj pointers used in the commands that operate on or get
- * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
- * Tcl_Obj *.
- */
-
-#define NUMBER_OF_OBJECT_VARS 20
-static Tcl_Obj *varPtr[NUMBER_OF_OBJECT_VARS];
/*
* Forward declarations for functions defined later in this file:
*/
-static int CheckIfVarUnset(Tcl_Interp *interp, int varIndex);
+static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex);
static int GetVariableIndex(Tcl_Interp *interp,
const char *string, int *indexPtr);
-static void SetVarToObj(int varIndex, Tcl_Obj *objPtr);
+static void SetVarToObj(Tcl_Obj **varPtr, int varIndex, Tcl_Obj *objPtr);
static int TestbignumobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int TestbooleanobjCmd(ClientData dummy,
@@ -64,6 +54,27 @@ typedef struct TestString {
Tcl_UniChar unicode[2];
} TestString;
+#define VARPTR_KEY "TCLOBJTEST_VARPTR"
+#define NUMBER_OF_OBJECT_VARS 20
+
+static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp)
+{
+ register int i;
+ Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
+ for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
+ if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
+ }
+ Tcl_DeleteAssocData(interp, VARPTR_KEY);
+ ckfree(varPtr);
+}
+
+static Tcl_Obj **GetVarPtr(Tcl_Interp *interp)
+{
+ Tcl_InterpDeleteProc *proc;
+
+ return (Tcl_Obj **) Tcl_GetAssocData(interp, VARPTR_KEY, &proc);
+}
+
/*
*----------------------------------------------------------------------
*
@@ -87,7 +98,18 @@ TclObjTest_Init(
Tcl_Interp *interp)
{
register int i;
+ /*
+ * An array of Tcl_Obj pointers used in the commands that operate on or get
+ * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
+ * Tcl_Obj *.
+ */
+ Tcl_Obj **varPtr;
+ varPtr = (Tcl_Obj **) ckalloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0]));
+ if (!varPtr) {
+ return TCL_ERROR;
+ }
+ Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr);
for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
varPtr[i] = NULL;
}
@@ -144,6 +166,7 @@ TestbignumobjCmd(
int index, varIndex;
const char *string;
mp_int bignumValue, newValue;
+ Tcl_Obj **varPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
@@ -157,6 +180,7 @@ TestbignumobjCmd(
if (GetVariableIndex(interp, string, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
switch (index) {
case BIGNUM_SET:
@@ -188,7 +212,7 @@ TestbignumobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBignumObj(varPtr[varIndex], &bignumValue);
} else {
- SetVarToObj(varIndex, Tcl_NewBignumObj(&bignumValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue));
}
break;
@@ -197,7 +221,7 @@ TestbignumobjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
break;
@@ -207,7 +231,7 @@ TestbignumobjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
@@ -226,7 +250,7 @@ TestbignumobjCmd(
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBignumObj(varPtr[varIndex], &newValue);
} else {
- SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
}
break;
@@ -235,7 +259,7 @@ TestbignumobjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
@@ -254,7 +278,7 @@ TestbignumobjCmd(
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBignumObj(varPtr[varIndex], &newValue);
} else {
- SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
}
}
@@ -289,6 +313,7 @@ TestbooleanobjCmd(
{
int varIndex, boolValue;
const char *index, *subCmd;
+ Tcl_Obj **varPtr;
if (objc < 3) {
wrongNumArgs:
@@ -301,6 +326,8 @@ TestbooleanobjCmd(
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
+
subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "set") == 0) {
if (objc != 4) {
@@ -321,14 +348,14 @@ TestbooleanobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
} else {
- SetVarToObj(varIndex, Tcl_NewBooleanObj(boolValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(boolValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "get") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -336,7 +363,7 @@ TestbooleanobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
@@ -346,7 +373,7 @@ TestbooleanobjCmd(
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
} else {
- SetVarToObj(varIndex, Tcl_NewBooleanObj(!boolValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
@@ -387,6 +414,7 @@ TestdoubleobjCmd(
int varIndex;
double doubleValue;
const char *index, *subCmd, *string;
+ Tcl_Obj **varPtr;
if (objc < 3) {
wrongNumArgs:
@@ -394,6 +422,8 @@ TestdoubleobjCmd(
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
+
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
@@ -420,14 +450,14 @@ TestdoubleobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetDoubleObj(varPtr[varIndex], doubleValue);
} else {
- SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "get") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -435,7 +465,7 @@ TestdoubleobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
@@ -445,14 +475,14 @@ TestdoubleobjCmd(
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetDoubleObj(varPtr[varIndex], doubleValue * 10.0);
} else {
- SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue * 10.0));
+ SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue * 10.0));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "div10") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
@@ -462,7 +492,7 @@ TestdoubleobjCmd(
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetDoubleObj(varPtr[varIndex], doubleValue / 10.0);
} else {
- SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue / 10.0));
+ SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue / 10.0));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
@@ -525,7 +555,7 @@ TestindexobjCmd(
}
Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
- indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr;
+ indexRep = objv[1]->internalRep.otherValuePtr;
indexRep->index = index2;
result = Tcl_GetIndexFromObj(NULL, objv[1],
tablePtr, "token", 0, &index);
@@ -547,7 +577,7 @@ TestindexobjCmd(
return TCL_ERROR;
}
- argv = (const char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
+ argv = ckalloc((objc-3) * sizeof(char *));
for (i = 4; i < objc; i++) {
argv[i-4] = Tcl_GetString(objv[i]);
}
@@ -562,16 +592,15 @@ TestindexobjCmd(
if (objv[3]->typePtr != NULL
&& !strcmp("index", objv[3]->typePtr->name)) {
- indexRep = (struct IndexRep *) objv[3]->internalRep.otherValuePtr;
+ indexRep = objv[3]->internalRep.otherValuePtr;
if (indexRep->tablePtr == (void *) argv) {
- objv[3]->typePtr->freeIntRepProc(objv[3]);
- objv[3]->typePtr = NULL;
+ TclFreeIntRep(objv[3]);
}
}
result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
- ckfree((char *) argv);
+ ckfree(argv);
if (result == TCL_OK) {
Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
}
@@ -606,6 +635,7 @@ TestintobjCmd(
int intValue, varIndex, i;
long longValue;
const char *index, *subCmd, *string;
+ Tcl_Obj **varPtr;
if (objc < 3) {
wrongNumArgs:
@@ -613,6 +643,7 @@ TestintobjCmd(
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
@@ -640,7 +671,7 @@ TestintobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], intValue);
} else {
- SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
@@ -655,7 +686,7 @@ TestintobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], intValue);
} else {
- SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
}
} else if (strcmp(subCmd, "setlong") == 0) {
if (objc != 4) {
@@ -669,7 +700,7 @@ TestintobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], intValue);
} else {
- SetVarToObj(varIndex, Tcl_NewLongObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "setmaxlong") == 0) {
@@ -680,13 +711,13 @@ TestintobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], maxLong);
} else {
- SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
+ SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(maxLong));
}
} else if (strcmp(subCmd, "ismaxlong") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
@@ -698,7 +729,7 @@ TestintobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -706,7 +737,7 @@ TestintobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
string = Tcl_GetString(varPtr[varIndex]);
@@ -728,7 +759,7 @@ TestintobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
} else {
- SetVarToObj(varIndex, Tcl_NewLongObj(LONG_MAX));
+ SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(LONG_MAX));
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
Tcl_ResetResult(interp);
@@ -741,7 +772,7 @@ TestintobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
@@ -751,14 +782,14 @@ TestintobjCmd(
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], intValue * 10);
} else {
- SetVarToObj(varIndex, Tcl_NewIntObj(intValue * 10));
+ SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue * 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "div10") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
@@ -768,7 +799,7 @@ TestintobjCmd(
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], intValue / 10);
} else {
- SetVarToObj(varIndex, Tcl_NewIntObj(intValue / 10));
+ SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue / 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
@@ -822,11 +853,13 @@ TestlistobjCmd(
int cmdIndex; /* Ordinal number of the subcommand */
int first; /* First index in the list */
int count; /* Count of elements in a list */
+ Tcl_Obj **varPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
@@ -840,7 +873,7 @@ TestlistobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
} else {
- SetVarToObj(varIndex, Tcl_NewListObj(objc-3, objv+3));
+ SetVarToObj(varPtr, varIndex, Tcl_NewListObj(objc-3, objv+3));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
@@ -850,7 +883,7 @@ TestlistobjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -867,7 +900,7 @@ TestlistobjCmd(
return TCL_ERROR;
}
if (Tcl_IsShared(varPtr[varIndex])) {
- SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
Tcl_ResetResult(interp);
return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count,
@@ -903,6 +936,7 @@ TestobjCmd(
int varIndex, destIndex, i;
const char *index, *subCmd, *string;
const Tcl_ObjType *targetType;
+ Tcl_Obj **varPtr;
if (objc < 2) {
wrongNumArgs:
@@ -910,6 +944,7 @@ TestobjCmd(
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "assign") == 0) {
if (objc != 4) {
@@ -919,14 +954,14 @@ TestobjCmd(
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
string = Tcl_GetString(objv[3]);
if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
return TCL_ERROR;
}
- SetVarToObj(destIndex, varPtr[varIndex]);
+ SetVarToObj(varPtr, destIndex, varPtr[varIndex]);
Tcl_SetObjResult(interp, varPtr[destIndex]);
} else if (strcmp(subCmd, "convert") == 0) {
const char *typeName;
@@ -938,7 +973,7 @@ TestobjCmd(
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
typeName = Tcl_GetString(objv[3]);
@@ -960,14 +995,14 @@ TestobjCmd(
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
string = Tcl_GetString(objv[3]);
if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
return TCL_ERROR;
}
- SetVarToObj(destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ SetVarToObj(varPtr, destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
Tcl_SetObjResult(interp, varPtr[destIndex]);
} else if (strcmp(subCmd, "freeallvars") == 0) {
if (objc != 2) {
@@ -987,7 +1022,7 @@ TestobjCmd(
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_InvalidateStringRep(varPtr[varIndex]);
@@ -1000,7 +1035,7 @@ TestobjCmd(
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- SetVarToObj(varIndex, Tcl_NewObj());
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "objtype") == 0) {
const char *typeName;
@@ -1027,7 +1062,7 @@ TestobjCmd(
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(varPtr[varIndex]->refCount));
@@ -1039,7 +1074,7 @@ TestobjCmd(
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
@@ -1096,6 +1131,7 @@ TeststringobjCmd(
#define MAX_STRINGS 11
const char *index, *string, *strings[MAX_STRINGS+1];
TestString *strPtr;
+ Tcl_Obj **varPtr;
static const char *const options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
"set", "set2", "setlength", "maxchars", "getunicode",
@@ -1108,6 +1144,7 @@ TeststringobjCmd(
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
@@ -1126,7 +1163,7 @@ TeststringobjCmd(
return TCL_ERROR;
}
if (varPtr[varIndex] == NULL) {
- SetVarToObj(varIndex, Tcl_NewObj());
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
}
/*
@@ -1135,7 +1172,7 @@ TeststringobjCmd(
*/
if (Tcl_IsShared(varPtr[varIndex])) {
- SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
string = Tcl_GetString(objv[3]);
Tcl_AppendToObj(varPtr[varIndex], string, length);
@@ -1146,7 +1183,7 @@ TeststringobjCmd(
goto wrongNumArgs;
}
if (varPtr[varIndex] == NULL) {
- SetVarToObj(varIndex, Tcl_NewObj());
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
}
/*
@@ -1155,7 +1192,7 @@ TeststringobjCmd(
*/
if (Tcl_IsShared(varPtr[varIndex])) {
- SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
for (i = 3; i < objc; i++) {
strings[i-3] = Tcl_GetString(objv[i]);
@@ -1173,7 +1210,7 @@ TeststringobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -1182,7 +1219,7 @@ TeststringobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr, varIndex)) {
return TCL_ERROR;
}
string = Tcl_GetString(varPtr[varIndex]);
@@ -1202,8 +1239,7 @@ TeststringobjCmd(
if (varPtr[varIndex] != NULL) {
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
- strPtr = (TestString *)
- (varPtr[varIndex])->internalRep.otherValuePtr;
+ strPtr = varPtr[varIndex]->internalRep.otherValuePtr;
length = (int) strPtr->allocated;
} else {
length = -1;
@@ -1229,7 +1265,7 @@ TeststringobjCmd(
&& !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetStringObj(varPtr[varIndex], string, length);
} else {
- SetVarToObj(varIndex, Tcl_NewStringObj(string, length));
+ SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, length));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
@@ -1237,7 +1273,7 @@ TeststringobjCmd(
if (objc != 4) {
goto wrongNumArgs;
}
- SetVarToObj(varIndex, objv[3]);
+ SetVarToObj(varPtr, varIndex, objv[3]);
break;
case 8: /* setlength */
if (objc != 4) {
@@ -1257,8 +1293,7 @@ TeststringobjCmd(
if (varPtr[varIndex] != NULL) {
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
- strPtr = (TestString *)
- (varPtr[varIndex])->internalRep.otherValuePtr;
+ strPtr = varPtr[varIndex]->internalRep.otherValuePtr;
length = strPtr->maxChars;
} else {
length = -1;
@@ -1276,7 +1311,7 @@ TeststringobjCmd(
goto wrongNumArgs;
}
if (varPtr[varIndex] == NULL) {
- SetVarToObj(varIndex, Tcl_NewObj());
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
}
/*
@@ -1285,7 +1320,7 @@ TeststringobjCmd(
*/
if (Tcl_IsShared(varPtr[varIndex])) {
- SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
string = Tcl_GetStringFromObj(varPtr[varIndex], &length);
@@ -1307,7 +1342,7 @@ TeststringobjCmd(
goto wrongNumArgs;
}
if (varPtr[varIndex] == NULL) {
- SetVarToObj(varIndex, Tcl_NewObj());
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
}
/*
@@ -1316,7 +1351,7 @@ TeststringobjCmd(
*/
if (Tcl_IsShared(varPtr[varIndex])) {
- SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &length);
@@ -1359,6 +1394,7 @@ TeststringobjCmd(
static void
SetVarToObj(
+ Tcl_Obj **varPtr,
int varIndex, /* Designates the assignment variable. */
Tcl_Obj *objPtr) /* Points to object to assign to var. */
{
@@ -1431,6 +1467,7 @@ GetVariableIndex(
static int
CheckIfVarUnset(
Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tcl_Obj ** varPtr,
int varIndex) /* Index of the test variable to check. */
{
if (varPtr[varIndex] == NULL) {
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index 6e0b670..a3f89f6 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclTestProcBodyObj.c,v 1.12 2010/06/16 14:49:50 nijtmans Exp $
*/
#ifndef USE_TCL_STUBS
diff --git a/generic/tclThread.c b/generic/tclThread.c
index 58cc18d..d1f2691 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclThread.c,v 1.25 2009/03/16 00:43:09 mistachkin Exp $
*/
#include "tclInt.h"
@@ -85,16 +83,17 @@ Tcl_GetThreadData(
/*
* Initialize the key for this thread.
*/
+
result = TclThreadStorageKeyGet(keyPtr);
if (result == NULL) {
- result = ckalloc((size_t)size);
+ result = ckalloc(size);
memset(result, 0, (size_t) size);
TclThreadStorageKeySet(keyPtr, result);
}
#else /* TCL_THREADS */
if (*keyPtr == NULL) {
- result = ckalloc((size_t)size);
+ result = ckalloc(size);
memset(result, 0, (size_t)size);
*keyPtr = result;
RememberSyncObject(keyPtr, &keyRecord);
@@ -180,14 +179,14 @@ RememberSyncObject(
if (recPtr->num >= recPtr->max) {
recPtr->max += 8;
- newList = (void **) ckalloc(recPtr->max * sizeof(void *));
+ newList = ckalloc(recPtr->max * sizeof(void *));
for (i=0,j=0 ; i<recPtr->num ; i++) {
if (recPtr->list[i] != NULL) {
newList[j++] = recPtr->list[i];
}
}
if (recPtr->list != NULL) {
- ckfree((char *) recPtr->list);
+ ckfree(recPtr->list);
}
recPtr->list = newList;
recPtr->num = j;
@@ -399,7 +398,7 @@ TclFinalizeSynchronization(void)
blockPtr = *keyPtr;
ckfree(blockPtr);
}
- ckfree((char *) keyRecord.list);
+ ckfree(keyRecord.list);
keyRecord.list = NULL;
}
keyRecord.max = 0;
@@ -419,7 +418,7 @@ TclFinalizeSynchronization(void)
}
}
if (mutexRecord.list != NULL) {
- ckfree((char *) mutexRecord.list);
+ ckfree(mutexRecord.list);
mutexRecord.list = NULL;
}
mutexRecord.max = 0;
@@ -432,7 +431,7 @@ TclFinalizeSynchronization(void)
}
}
if (condRecord.list != NULL) {
- ckfree((char *) condRecord.list);
+ ckfree(condRecord.list);
condRecord.list = NULL;
}
condRecord.max = 0;
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index 6ea6351..e4261d6 100755
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclThreadAlloc.c,v 1.32 2010/03/05 14:34:04 dkf Exp $
*/
#include "tclInt.h"
@@ -147,6 +145,26 @@ static Tcl_Mutex *objLockPtr;
static Cache sharedCache;
static Cache *sharedPtr = &sharedCache;
static Cache *firstCachePtr = &sharedCache;
+
+#if defined(HAVE_FAST_TSD)
+static __thread Cache *tcachePtr;
+
+# define GETCACHE(cachePtr) \
+ do { \
+ if (!tcachePtr) { \
+ tcachePtr = GetCache(); \
+ } \
+ (cachePtr) = tcachePtr; \
+ } while (0)
+#else
+# define GETCACHE(cachePtr) \
+ do { \
+ (cachePtr) = TclpGetAllocCache(); \
+ if ((cachePtr) == NULL) { \
+ (cachePtr) = GetCache(); \
+ } \
+ } while (0)
+#endif
/*
*----------------------------------------------------------------------
@@ -310,10 +328,7 @@ TclpAlloc(
}
#endif
- cachePtr = TclpGetAllocCache();
- if (cachePtr == NULL) {
- cachePtr = GetCache();
- }
+ GETCACHE(cachePtr);
/*
* Increment the requested size to include room for the Block structure.
@@ -380,10 +395,7 @@ TclpFree(
return;
}
- cachePtr = TclpGetAllocCache();
- if (cachePtr == NULL) {
- cachePtr = GetCache();
- }
+ GETCACHE(cachePtr);
/*
* Get the block back from the user pointer and call system free directly
@@ -455,10 +467,7 @@ TclpRealloc(
}
#endif
- cachePtr = TclpGetAllocCache();
- if (cachePtr == NULL) {
- cachePtr = GetCache();
- }
+ GETCACHE(cachePtr);
/*
* If the block is not a system block and fits in place, simply return the
@@ -532,12 +541,10 @@ TclpRealloc(
Tcl_Obj *
TclThreadAllocObj(void)
{
- register Cache *cachePtr = TclpGetAllocCache();
+ register Cache *cachePtr;
register Tcl_Obj *objPtr;
- if (cachePtr == NULL) {
- cachePtr = GetCache();
- }
+ GETCACHE(cachePtr);
/*
* Get this thread's obj list structure and move or allocate new objs if
@@ -606,11 +613,9 @@ void
TclThreadFreeObj(
Tcl_Obj *objPtr)
{
- Cache *cachePtr = TclpGetAllocCache();
+ Cache *cachePtr;
- if (cachePtr == NULL) {
- cachePtr = GetCache();
- }
+ GETCACHE(cachePtr);
/*
* Get this thread's list and push on the free Tcl_Obj.
@@ -807,15 +812,7 @@ LockBucket(
Cache *cachePtr,
int bucket)
{
-#if 0
- if (Tcl_MutexTryLock(bucketInfo[bucket].lockPtr) != TCL_OK) {
- Tcl_MutexLock(bucketInfo[bucket].lockPtr);
- cachePtr->buckets[bucket].numWaits++;
- sharedPtr->buckets[bucket].numWaits++;
- }
-#else
Tcl_MutexLock(bucketInfo[bucket].lockPtr);
-#endif
cachePtr->buckets[bucket].numLocks++;
sharedPtr->buckets[bucket].numLocks++;
}
diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c
index 6410959..4b09e1c 100644
--- a/generic/tclThreadJoin.c
+++ b/generic/tclThreadJoin.c
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclThreadJoin.c,v 1.8 2010/02/24 10:32:17 dkf Exp $
*/
#include "tclInt.h"
@@ -203,7 +201,7 @@ TclJoinThread(
Tcl_ConditionFinalize(&threadPtr->cond);
Tcl_MutexFinalize(&threadPtr->threadMutex);
- ckfree((char *) threadPtr);
+ ckfree(threadPtr);
return TCL_OK;
}
@@ -232,7 +230,7 @@ TclRememberJoinableThread(
{
JoinableThread *threadPtr;
- threadPtr = (JoinableThread *) ckalloc(sizeof(JoinableThread));
+ threadPtr = ckalloc(sizeof(JoinableThread));
threadPtr->id = id;
threadPtr->done = 0;
threadPtr->waitedUpon = 0;
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
index ea2eeb1..f24e334 100644
--- a/generic/tclThreadStorage.c
+++ b/generic/tclThreadStorage.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclThreadStorage.c,v 1.21 2009/12/21 23:25:40 nijtmans Exp $
*/
#include "tclInt.h"
@@ -119,7 +117,7 @@ TSDTableDelete(
* and must now be deallocated or they will leak.
*/
- ckfree((char *) tsdTablePtr->tablePtr[i]);
+ ckfree(tsdTablePtr->tablePtr[i]);
}
}
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 8607b15..22b5995 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -11,8 +11,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclThreadTest.c,v 1.35 2009/11/23 20:17:36 nijtmans Exp $
*/
#ifndef USE_TCL_STUBS
@@ -48,7 +46,7 @@ static Tcl_ThreadDataKey dataKey;
* protected by threadMutex.
*/
-static ThreadSpecificData *threadList;
+static ThreadSpecificData *threadList = NULL;
/*
* The following bit-values are legal for the "flags" field of the
@@ -168,7 +166,7 @@ TclThread_Init(
*/
Tcl_MutexLock(&threadMutex);
- if ((long) mainThreadId == 0) {
+ if (mainThreadId == 0) {
mainThreadId = Tcl_GetCurrentThread();
}
Tcl_MutexUnlock(&threadMutex);
@@ -275,7 +273,7 @@ ThreadObjCmd(
} else {
result = NULL;
}
- return ThreadCancel(interp, (Tcl_ThreadId) id, result, flags);
+ return ThreadCancel(interp, (Tcl_ThreadId) (size_t) id, result, flags);
}
case THREAD_CREATE: {
const char *script;
@@ -339,11 +337,11 @@ ThreadObjCmd(
*/
if (objc == 2) {
- idObj = Tcl_NewLongObj((long) Tcl_GetCurrentThread());
+ idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
} else if (objc == 3
&& strcmp("-main", Tcl_GetString(objv[2])) == 0) {
Tcl_MutexLock(&threadMutex);
- idObj = Tcl_NewLongObj((long) mainThreadId);
+ idObj = Tcl_NewLongObj((long)(size_t)mainThreadId);
Tcl_MutexUnlock(&threadMutex);
} else {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -368,13 +366,13 @@ ThreadObjCmd(
return TCL_ERROR;
}
- result = Tcl_JoinThread((Tcl_ThreadId) id, &status);
+ result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status);
if (result == TCL_OK) {
Tcl_SetIntObj(Tcl_GetObjResult(interp), status);
} else {
char buf[20];
- sprintf(buf, "%ld", id);
+ TclFormatInt(buf, id);
Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
}
return result;
@@ -410,7 +408,7 @@ ThreadObjCmd(
}
arg++;
script = Tcl_GetString(objv[arg]);
- return ThreadSend(interp, (Tcl_ThreadId) id, script, wait);
+ return ThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait);
}
case THREAD_EVENT: {
if (objc > 2) {
@@ -438,7 +436,7 @@ ThreadObjCmd(
ckfree(errorProcString);
}
proc = Tcl_GetString(objv[2]);
- errorProcString = ckalloc(strlen(proc)+1);
+ errorProcString = ckalloc(strlen(proc) + 1);
strcpy(errorProcString, proc);
Tcl_MutexUnlock(&threadMutex);
return TCL_OK;
@@ -515,7 +513,7 @@ ThreadCreate(
TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
Tcl_MutexUnlock(&threadMutex);
Tcl_AppendResult(interp, "can't create a new thread", NULL);
- ckfree((char *) ctrl.script);
+ ckfree(ctrl.script);
return TCL_ERROR;
}
@@ -526,7 +524,7 @@ ThreadCreate(
Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL);
Tcl_MutexUnlock(&threadMutex);
Tcl_ConditionFinalize(&ctrl.condWait);
- Tcl_SetObjResult(interp, Tcl_NewLongObj((long)id));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj((long)(size_t)id));
return TCL_OK;
}
@@ -599,7 +597,7 @@ NewTestThread(
* eval'ing, for the case that we exit during evaluation
*/
- threadEvalScript = ckalloc(strlen(ctrlPtr->script)+1);
+ threadEvalScript = ckalloc(strlen(ctrlPtr->script) + 1);
strcpy(threadEvalScript, ctrlPtr->script);
Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript);
@@ -625,9 +623,9 @@ NewTestThread(
* Clean up.
*/
- ListRemove(tsdPtr);
- Tcl_Release(tsdPtr->interp);
Tcl_DeleteInterp(tsdPtr->interp);
+ Tcl_Release(tsdPtr->interp);
+ ListRemove(tsdPtr);
Tcl_ExitThread(result);
TCL_THREAD_CREATE_RETURN;
@@ -658,7 +656,7 @@ ThreadErrorProc(
char *script;
char buf[TCL_DOUBLE_SPACE+1];
- sprintf(buf, "%ld", (long) Tcl_GetCurrentThread());
+ TclFormatInt(buf, (size_t) Tcl_GetCurrentThread());
errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
if (errorProcString == NULL) {
@@ -746,6 +744,7 @@ ListRemove(
tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
}
tsdPtr->nextPtr = tsdPtr->prevPtr = 0;
+ tsdPtr->interp = NULL;
Tcl_MutexUnlock(&threadMutex);
}
@@ -775,7 +774,7 @@ ThreadList(
Tcl_MutexLock(&threadMutex);
for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewLongObj((long) tsdPtr->threadId));
+ Tcl_NewLongObj((long)(size_t)tsdPtr->threadId));
}
Tcl_MutexUnlock(&threadMutex);
Tcl_SetObjResult(interp, listPtr);
@@ -843,13 +842,13 @@ ThreadSend(
* Create the event for its event queue.
*/
- threadEventPtr = (ThreadEvent *) ckalloc(sizeof(ThreadEvent));
+ threadEventPtr = ckalloc(sizeof(ThreadEvent));
threadEventPtr->script = ckalloc(strlen(script) + 1);
strcpy(threadEventPtr->script, script);
if (!wait) {
resultPtr = threadEventPtr->resultPtr = NULL;
} else {
- resultPtr = (ThreadEventResult *) ckalloc(sizeof(ThreadEventResult));
+ resultPtr = ckalloc(sizeof(ThreadEventResult));
threadEventPtr->resultPtr = resultPtr;
/*
@@ -932,7 +931,7 @@ ThreadSend(
Tcl_ConditionFinalize(&resultPtr->done);
code = resultPtr->code;
- ckfree((char *) resultPtr);
+ ckfree(resultPtr);
return code;
}
@@ -989,7 +988,8 @@ ThreadCancel(
Tcl_MutexUnlock(&threadMutex);
Tcl_ResetResult(interp);
- return Tcl_CancelEval(tsdPtr->interp, Tcl_NewStringObj(result, -1), 0, flags);
+ return Tcl_CancelEval(tsdPtr->interp,
+ (result != NULL) ? Tcl_NewStringObj(result, -1) : NULL, 0, flags);
}
/*
@@ -1085,7 +1085,7 @@ ThreadFreeProc(
ClientData clientData)
{
if (clientData) {
- ckfree((char *) clientData);
+ ckfree(clientData);
}
}
@@ -1113,7 +1113,7 @@ ThreadDeleteEvent(
ClientData clientData) /* dummy */
{
if (eventPtr->proc == ThreadEventProc) {
- ckfree((char *) ((ThreadEvent *) eventPtr)->script);
+ ckfree(((ThreadEvent *) eventPtr)->script);
return 1;
}
@@ -1150,6 +1150,11 @@ ThreadExitProc(
char *threadEvalScript = clientData;
ThreadEventResult *resultPtr, *nextPtr;
Tcl_ThreadId self = Tcl_GetCurrentThread();
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (tsdPtr->interp != NULL) {
+ ListRemove(tsdPtr);
+ }
Tcl_MutexLock(&threadMutex);
@@ -1177,7 +1182,7 @@ ThreadExitProc(
}
resultPtr->nextPtr = resultPtr->prevPtr = 0;
resultPtr->eventPtr->resultPtr = NULL;
- ckfree((char *) resultPtr);
+ ckfree(resultPtr);
} else if (resultPtr->dstThreadId == self) {
/*
* Dang. The target is going away. Unblock the caller. The result
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index aaa3493..6b17825 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclTimer.c,v 1.42 2010/02/24 10:32:17 dkf Exp $
*/
#include "tclInt.h"
@@ -129,6 +127,17 @@ static Tcl_ThreadDataKey dataKey;
(1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
((long)(t1).usec - (long)(t2).usec)/1000)
+#define TCL_TIME_DIFF_MS_CEILING(t1, t2) \
+ (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
+ ((long)(t1).usec - (long)(t2).usec + 999)/1000)
+
+/*
+ * Sleeps under that number of milliseconds don't get double-checked
+ * and are done in exactly one Tcl_Sleep(). This to limit gettimeofday()s.
+ */
+
+#define SLEEP_OFFLOAD_GETTIMEOFDAY 20
+
/*
* The maximum number of milliseconds for each Tcl_Sleep call in AfterDelay.
* This is used to limit the maximum lag between interp limit and script
@@ -173,8 +182,7 @@ static void TimerSetupProc(ClientData clientData, int flags);
static ThreadSpecificData *
InitTimer(void)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
if (tsdPtr == NULL) {
tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -205,8 +213,7 @@ static void
TimerExitProc(
ClientData clientData) /* Not used. */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
if (tsdPtr != NULL) {
@@ -215,7 +222,7 @@ TimerExitProc(
timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
while (timerHandlerPtr != NULL) {
tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
- ckfree((char *) timerHandlerPtr);
+ ckfree(timerHandlerPtr);
timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
}
}
@@ -288,10 +295,9 @@ TclCreateAbsoluteTimerHandler(
ClientData clientData)
{
register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
- ThreadSpecificData *tsdPtr;
+ ThreadSpecificData *tsdPtr = InitTimer();
- tsdPtr = InitTimer();
- timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));
+ timerHandlerPtr = ckalloc(sizeof(TimerHandler));
/*
* Fill in fields for the event.
@@ -367,7 +373,7 @@ Tcl_DeleteTimerHandler(
} else {
prevPtr->nextPtr = timerHandlerPtr->nextPtr;
}
- ckfree((char *) timerHandlerPtr);
+ ckfree(timerHandlerPtr);
return;
}
}
@@ -482,7 +488,7 @@ TimerCheckProc(
if (blockTime.sec == 0 && blockTime.usec == 0 &&
!tsdPtr->timerPending) {
tsdPtr->timerPending = 1;
- timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
+ timerEvPtr = ckalloc(sizeof(Tcl_Event));
timerEvPtr->proc = TimerHandlerEventProc;
Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
}
@@ -585,7 +591,7 @@ TimerHandlerEventProc(
*nextPtrPtr = timerHandlerPtr->nextPtr;
timerHandlerPtr->proc(timerHandlerPtr->clientData);
- ckfree((char *) timerHandlerPtr);
+ ckfree(timerHandlerPtr);
}
TimerSetupProc(NULL, TCL_TIMER_EVENTS);
return 1;
@@ -619,7 +625,7 @@ Tcl_DoWhenIdle(
Tcl_Time blockTime;
ThreadSpecificData *tsdPtr = InitTimer();
- idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
+ idlePtr = ckalloc(sizeof(IdleHandler));
idlePtr->proc = proc;
idlePtr->clientData = clientData;
idlePtr->generation = tsdPtr->idleGeneration;
@@ -668,7 +674,7 @@ Tcl_CancelIdleCall(
while ((idlePtr->proc == proc)
&& (idlePtr->clientData == clientData)) {
nextPtr = idlePtr->nextPtr;
- ckfree((char *) idlePtr);
+ ckfree(idlePtr);
idlePtr = nextPtr;
if (prevPtr == NULL) {
tsdPtr->idleList = idlePtr;
@@ -743,7 +749,7 @@ TclServiceIdle(void)
tsdPtr->lastIdlePtr = NULL;
}
idlePtr->proc(idlePtr->clientData);
- ckfree((char *) idlePtr);
+ ckfree(idlePtr);
}
if (tsdPtr->idleList) {
blockTime.sec = 0;
@@ -784,7 +790,6 @@ Tcl_AfterObjCmd(
AfterAssocData *assocPtr;
int length;
int index;
- char buf[16 + TCL_INTEGER_SPACE];
static const char *const afterSubCmds[] = {
"cancel", "idle", "info", NULL
};
@@ -803,7 +808,7 @@ Tcl_AfterObjCmd(
assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL);
if (assocPtr == NULL) {
- assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
+ assocPtr = ckalloc(sizeof(AfterAssocData));
assocPtr->interp = interp;
assocPtr->firstAfterPtr = NULL;
Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr);
@@ -822,9 +827,13 @@ Tcl_AfterObjCmd(
&index) != TCL_OK)) {
index = -1;
if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
- Tcl_AppendResult(interp, "bad argument \"",
- Tcl_GetString(objv[1]),
- "\": must be cancel, idle, info, or an integer", NULL);
+ const char *arg = Tcl_GetString(objv[1]);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad argument \"%s\": must be"
+ " cancel, idle, info, or an integer", arg));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
+ arg, NULL);
return TCL_ERROR;
}
}
@@ -842,7 +851,7 @@ Tcl_AfterObjCmd(
if (objc == 2) {
return AfterDelay(interp, ms);
}
- afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
+ afterPtr = ckalloc(sizeof(AfterInfo));
afterPtr->assocPtr = assocPtr;
if (objc == 3) {
afterPtr->commandPtr = objv[2];
@@ -922,7 +931,7 @@ Tcl_AfterObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?");
return TCL_ERROR;
}
- afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
+ afterPtr = ckalloc(sizeof(AfterInfo));
afterPtr->assocPtr = assocPtr;
if (objc == 3) {
afterPtr->commandPtr = objv[2];
@@ -938,17 +947,18 @@ Tcl_AfterObjCmd(
Tcl_DoWhenIdle(AfterProc, afterPtr);
Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
break;
- case AFTER_INFO: {
- Tcl_Obj *resultListPtr;
-
+ case AFTER_INFO:
if (objc == 2) {
+ Tcl_Obj *resultObj = Tcl_NewObj();
+
for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
afterPtr = afterPtr->nextPtr) {
if (assocPtr->interp == interp) {
- sprintf(buf, "after#%d", afterPtr->id);
- Tcl_AppendElement(interp, buf);
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
+ "after#%d", afterPtr->id));
}
}
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
if (objc != 3) {
@@ -957,17 +967,22 @@ Tcl_AfterObjCmd(
}
afterPtr = GetAfterEvent(assocPtr, objv[2]);
if (afterPtr == NULL) {
- Tcl_AppendResult(interp, "event \"", TclGetString(objv[2]),
- "\" doesn't exist", NULL);
+ const char *eventStr = TclGetString(objv[2]);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "event \"%s\" doesn't exist", eventStr));
+ Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL);
return TCL_ERROR;
- }
- resultListPtr = Tcl_NewObj();
- Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
- Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
- (afterPtr->token == NULL) ? "idle" : "timer", -1));
- Tcl_SetObjResult(interp, resultListPtr);
+ } else {
+ Tcl_Obj *resultListPtr = Tcl_NewObj();
+
+ Tcl_ListObjAppendElement(interp, resultListPtr,
+ afterPtr->commandPtr);
+ Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
+ (afterPtr->token == NULL) ? "idle" : "timer", -1));
+ Tcl_SetObjResult(interp, resultListPtr);
+ }
break;
- }
default:
Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
}
@@ -1002,7 +1017,8 @@ AfterDelay(
Tcl_Time endTime, now;
Tcl_WideInt diff;
- Tcl_GetTime(&endTime);
+ Tcl_GetTime(&now);
+ endTime = now;
endTime.sec += (long)(ms/1000);
endTime.usec += ((int)(ms%1000))*1000;
if (endTime.usec >= 1000000) {
@@ -1011,7 +1027,6 @@ AfterDelay(
}
do {
- Tcl_GetTime(&now);
if (Tcl_AsyncReady()) {
if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
return TCL_ERROR;
@@ -1029,7 +1044,7 @@ AfterDelay(
}
if (iPtr->limit.timeEvent == NULL
|| TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
- diff = TCL_TIME_DIFF_MS(endTime, now);
+ diff = TCL_TIME_DIFF_MS_CEILING(endTime, now);
#ifndef TCL_WIDE_INT_IS_LONG
if (diff > LONG_MAX) {
diff = LONG_MAX;
@@ -1038,9 +1053,11 @@ AfterDelay(
if (diff > TCL_TIME_MAXIMUM_SLICE) {
diff = TCL_TIME_MAXIMUM_SLICE;
}
+ if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) diff = 1;
if (diff > 0) {
Tcl_Sleep((long) diff);
- }
+ if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) break;
+ } else break;
} else {
diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
#ifndef TCL_WIDE_INT_IS_LONG
@@ -1066,6 +1083,7 @@ AfterDelay(
return TCL_ERROR;
}
}
+ Tcl_GetTime(&now);
} while (TCL_TIME_BEFORE(now, endTime));
return TCL_OK;
}
@@ -1182,7 +1200,7 @@ AfterProc(
*/
Tcl_DecrRefCount(afterPtr->commandPtr);
- ckfree((char *) afterPtr);
+ ckfree(afterPtr);
}
/*
@@ -1220,7 +1238,7 @@ FreeAfterPtr(
prevPtr->nextPtr = afterPtr->nextPtr;
}
Tcl_DecrRefCount(afterPtr->commandPtr);
- ckfree((char *) afterPtr);
+ ckfree(afterPtr);
}
/*
@@ -1259,9 +1277,9 @@ AfterCleanupProc(
Tcl_CancelIdleCall(AfterProc, afterPtr);
}
Tcl_DecrRefCount(afterPtr->commandPtr);
- ckfree((char *) afterPtr);
+ ckfree(afterPtr);
}
- ckfree((char *) assocPtr);
+ ckfree(assocPtr);
}
/*
@@ -1269,5 +1287,7 @@ AfterCleanupProc(
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls
index 12fa7cd..ea3abb1 100644
--- a/generic/tclTomMath.decls
+++ b/generic/tclTomMath.decls
@@ -12,8 +12,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: tclTomMath.decls,v 1.8 2010/09/15 07:33:54 nijtmans Exp $
library tcl
@@ -214,3 +212,12 @@ declare 59 {
declare 60 {
int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c)
}
+declare 61 {
+ int TclBN_mp_init_set_int(mp_int *a, unsigned long i)
+}
+declare 62 {
+ int TclBN_mp_set_int(mp_int *a, unsigned long i)
+}
+declare 63 {
+ int TclBN_mp_cnt_lsb(const mp_int *a)
+}
diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h
index 0b2df47..dd9edaf 100644
--- a/generic/tclTomMath.h
+++ b/generic/tclTomMath.h
@@ -15,7 +15,6 @@
#ifndef BN_H_
#define BN_H_
-#include "tclInt.h"
#include "tclTomMathDecls.h"
#ifndef MODULE_SCOPE
#define MODULE_SCOPE extern
@@ -831,10 +830,3 @@ MODULE_SCOPE const char *mp_s_rmap;
#endif
#endif
-
-
-/* $Source: /root/tcl/repos-to-convert/tcl/generic/tclTomMath.h,v $ */
-/* Based on Tom's version 1.8 */
-/* $Revision: 1.14 $ */
-/* $Date: 2010/05/03 14:36:41 $ */
-
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
index 61e9c07..ef22153 100644
--- a/generic/tclTomMathDecls.h
+++ b/generic/tclTomMathDecls.h
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclTomMathDecls.h,v 1.13 2010/08/19 04:26:04 nijtmans Exp $
*/
#ifndef _TCLTOMMATHDECLS
@@ -65,6 +63,7 @@
#define mp_cmp TclBN_mp_cmp
#define mp_cmp_d TclBN_mp_cmp_d
#define mp_cmp_mag TclBN_mp_cmp_mag
+#define mp_cnt_lsb TclBN_mp_cnt_lsb
#define mp_copy TclBN_mp_copy
#define mp_count_bits TclBN_mp_count_bits
#define mp_div TclBN_mp_div
@@ -79,6 +78,7 @@
#define mp_init_copy TclBN_mp_init_copy
#define mp_init_multi TclBN_mp_init_multi
#define mp_init_set TclBN_mp_init_set
+#define mp_init_set_int TclBN_mp_init_set_int
#define mp_init_size TclBN_mp_init_size
#define mp_karatsuba_mul TclBN_mp_karatsuba_mul
#define mp_karatsuba_sqr TclBN_mp_karatsuba_sqr
@@ -96,6 +96,7 @@
#define mp_rshd TclBN_mp_rshd
#define mp_s_rmap TclBNMpSRmap
#define mp_set TclBN_mp_set
+#define mp_set_int TclBN_mp_set_int
#define mp_shrink TclBN_mp_shrink
#define mp_sqr TclBN_mp_sqr
#define mp_sqrt TclBN_mp_sqrt
@@ -268,10 +269,16 @@ EXTERN int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c,
EXTERN int TclBN_s_mp_sqr(mp_int *a, mp_int *b);
/* 60 */
EXTERN int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
+/* 61 */
+EXTERN int TclBN_mp_init_set_int(mp_int *a, unsigned long i);
+/* 62 */
+EXTERN int TclBN_mp_set_int(mp_int *a, unsigned long i);
+/* 63 */
+EXTERN int TclBN_mp_cnt_lsb(const mp_int *a);
typedef struct TclTomMathStubs {
int magic;
- const struct TclTomMathStubHooks *hooks;
+ void *hooks;
int (*tclBN_epoch) (void); /* 0 */
int (*tclBN_revision) (void); /* 1 */
@@ -334,6 +341,9 @@ typedef struct TclTomMathStubs {
int (*tclBN_s_mp_mul_digs) (mp_int *a, mp_int *b, mp_int *c, int digs); /* 58 */
int (*tclBN_s_mp_sqr) (mp_int *a, mp_int *b); /* 59 */
int (*tclBN_s_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 60 */
+ int (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */
+ int (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */
+ int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */
} TclTomMathStubs;
#ifdef __cplusplus
@@ -472,6 +482,12 @@ extern const TclTomMathStubs *tclTomMathStubsPtr;
(tclTomMathStubsPtr->tclBN_s_mp_sqr) /* 59 */
#define TclBN_s_mp_sub \
(tclTomMathStubsPtr->tclBN_s_mp_sub) /* 60 */
+#define TclBN_mp_init_set_int \
+ (tclTomMathStubsPtr->tclBN_mp_init_set_int) /* 61 */
+#define TclBN_mp_set_int \
+ (tclTomMathStubsPtr->tclBN_mp_set_int) /* 62 */
+#define TclBN_mp_cnt_lsb \
+ (tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclTomMathInt.h b/generic/tclTomMathInt.h
index 1b9eb64..831f13f 100644
--- a/generic/tclTomMathInt.h
+++ b/generic/tclTomMathInt.h
@@ -1,2 +1,3 @@
+#include "tclInt.h"
#include "tclTomMath.h"
#include "tommath_class.h"
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
index 694b607..775e86b 100644
--- a/generic/tclTomMathInterface.c
+++ b/generic/tclTomMathInterface.c
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclTomMathInterface.c,v 1.16 2010/08/31 20:48:17 nijtmans Exp $
*/
#include "tclInt.h"
diff --git a/generic/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c
index 1f21bee..a3bc4b3 100644
--- a/generic/tclTomMathStubLib.c
+++ b/generic/tclTomMathStubLib.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclTomMathStubLib.c,v 1.3 2010/08/31 20:48:17 nijtmans Exp $
*/
/*
@@ -75,10 +73,10 @@ TclTomMathInitializeStubs(
tclTomMathStubsPtr = stubsPtr;
return actualVersion;
}
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error loading ", packageName,
- " (requested version ", version, ", actual version ",
- actualVersion, "): ", errMsg, NULL);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error loading %s (requested version %s, actual version %s): %s",
+ packageName, version, actualVersion, errMsg));
return NULL;
}
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 2e8759e..519f201 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclTrace.c,v 1.60 2010/08/22 18:53:26 nijtmans Exp $
*/
#include "tclInt.h"
@@ -24,11 +22,11 @@ typedef struct {
int flags; /* Operations for which Tcl command is to be
* invoked. */
size_t length; /* Number of non-NUL chars. in command. */
- char command[4]; /* Space for Tcl command to invoke. Actual
+ char command[1]; /* Space for Tcl command to invoke. Actual
* size will be as large as necessary to hold
* command. This field must be the last in the
- * structure, so that it can be larger than 4
- * bytes. */
+ * structure, so that it can be larger than 1
+ * byte. */
} TraceVarInfo;
typedef struct {
@@ -58,11 +56,11 @@ typedef struct {
* deleted too early. Keeps track of how many
* pieces of code have a pointer to this
* structure. */
- char command[4]; /* Space for Tcl command to invoke. Actual
+ char command[1]; /* Space for Tcl command to invoke. Actual
* size will be as large as necessary to hold
* command. This field must be the last in the
- * structure, so that it can be larger than 4
- * bytes. */
+ * structure, so that it can be larger than 1
+ * byte. */
} TraceCommandInfo;
/*
@@ -115,7 +113,7 @@ static const char *const traceTypeOptions[] = {
static Tcl_TraceTypeObjCmd *const traceSubCmds[] = {
TraceExecutionObjCmd,
TraceCommandObjCmd,
- TraceVariableObjCmd,
+ TraceVariableObjCmd
};
/*
@@ -368,8 +366,10 @@ Tcl_TraceObjCmd(
return TCL_OK;
badVarOps:
- Tcl_AppendResult(interp, "bad operations \"", flagOps,
- "\": should be one or more of rwua", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad operations \"%s\": should be one or more of rwua",
+ flagOps));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL);
return TCL_ERROR;
}
@@ -435,9 +435,11 @@ TraceExecutionObjCmd(
return result;
}
if (listLen == 0) {
- Tcl_SetResult(interp, "bad operation list \"\": must be "
- "one or more of enter, leave, enterstep, or leavestep",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad operation list \"\": must be one or more of"
+ " enter, leave, enterstep, or leavestep", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
+ NULL);
return TCL_ERROR;
}
for (i = 0; i < listLen; i++) {
@@ -463,9 +465,8 @@ TraceExecutionObjCmd(
command = Tcl_GetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
- TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)
- ckalloc((unsigned) (sizeof(TraceCommandInfo)
- - sizeof(tcmdPtr->command) + length + 1));
+ TraceCommandInfo *tcmdPtr = ckalloc(
+ TclOffset(TraceCommandInfo, command) + 1 + length);
tcmdPtr->flags = flags;
tcmdPtr->stepTrace = NULL;
@@ -482,7 +483,7 @@ TraceExecutionObjCmd(
name = Tcl_GetString(objv[3]);
if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
tcmdPtr) != TCL_OK) {
- ckfree((char *) tcmdPtr);
+ ckfree(tcmdPtr);
return TCL_ERROR;
}
} else {
@@ -533,7 +534,7 @@ TraceExecutionObjCmd(
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
if (tcmdPtr->startCmd != NULL) {
- ckfree((char *) tcmdPtr->startCmd);
+ ckfree(tcmdPtr->startCmd);
}
}
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
@@ -544,7 +545,7 @@ TraceExecutionObjCmd(
tcmdPtr->flags = 0;
}
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char *) tcmdPtr);
+ ckfree(tcmdPtr);
}
break;
}
@@ -677,8 +678,11 @@ TraceCommandObjCmd(
return result;
}
if (listLen == 0) {
- Tcl_SetResult(interp, "bad operation list \"\": must be "
- "one or more of delete or rename", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad operation list \"\": must be one or more of"
+ " delete or rename", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
+ NULL);
return TCL_ERROR;
}
@@ -700,9 +704,8 @@ TraceCommandObjCmd(
command = Tcl_GetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
- TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)
- ckalloc((unsigned) (sizeof(TraceCommandInfo)
- - sizeof(tcmdPtr->command) + length + 1));
+ TraceCommandInfo *tcmdPtr = ckalloc(
+ TclOffset(TraceCommandInfo, command) + 1 + length);
tcmdPtr->flags = flags;
tcmdPtr->stepTrace = NULL;
@@ -715,7 +718,7 @@ TraceCommandObjCmd(
name = Tcl_GetString(objv[3]);
if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
tcmdPtr) != TCL_OK) {
- ckfree((char *) tcmdPtr);
+ ckfree(tcmdPtr);
return TCL_ERROR;
}
} else {
@@ -746,7 +749,7 @@ TraceCommandObjCmd(
TraceCommandProc, clientData);
tcmdPtr->flags |= TCL_TRACE_DESTROYED;
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char *) tcmdPtr);
+ ckfree(tcmdPtr);
}
break;
}
@@ -874,8 +877,11 @@ TraceVariableObjCmd(
return result;
}
if (listLen == 0) {
- Tcl_SetResult(interp, "bad operation list \"\": must be "
- "one or more of array, read, unset, or write", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad operation list \"\": must be one or more of"
+ " array, read, unset, or write", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
+ NULL);
return TCL_ERROR;
}
for (i = 0; i < listLen ; i++) {
@@ -901,9 +907,9 @@ TraceVariableObjCmd(
command = Tcl_GetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
- CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)
- ckalloc((unsigned) (sizeof(CombinedTraceVarInfo)
- + length + 1 - sizeof(ctvarPtr->traceCmdInfo.command)));
+ CombinedTraceVarInfo *ctvarPtr = ckalloc(
+ TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
+ + 1 + length);
ctvarPtr->traceCmdInfo.flags = flags;
if (objv[0] == NULL) {
@@ -918,7 +924,7 @@ TraceVariableObjCmd(
name = Tcl_GetString(objv[3]);
if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr)
!= TCL_OK) {
- ckfree((char *) ctvarPtr);
+ ckfree(ctvarPtr);
return TCL_ERROR;
}
} else {
@@ -1112,7 +1118,7 @@ Tcl_TraceCommand(
* Set up trace information.
*/
- tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace));
+ tracePtr = ckalloc(sizeof(CommandTrace));
tracePtr->traceProc = proc;
tracePtr->clientData = clientData;
tracePtr->flags = flags &
@@ -1121,8 +1127,18 @@ Tcl_TraceCommand(
tracePtr->refCount = 1;
cmdPtr->tracePtr = tracePtr;
if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
+ /*
+ * Bug 3484621: up the interp's epoch if this is a BC'ed command
+ */
+
+ if ((cmdPtr->compileProc != NULL) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)){
+ Interp *iPtr = (Interp *) interp;
+ iPtr->compileEpoch++;
+ }
cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
}
+
+
return TCL_OK;
}
@@ -1208,7 +1224,7 @@ Tcl_UntraceCommand(
tracePtr->flags = 0;
if ((--tracePtr->refCount) <= 0) {
- ckfree((char *) tracePtr);
+ ckfree(tracePtr);
}
if (hasExecTraces) {
@@ -1225,6 +1241,15 @@ Tcl_UntraceCommand(
*/
cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;
+
+ /*
+ * Bug 3484621: up the interp's epoch if this is a BC'ed command
+ */
+
+ if (cmdPtr->compileProc != NULL) {
+ Interp *iPtr = (Interp *) interp;
+ iPtr->compileEpoch++;
+ }
}
}
@@ -1276,9 +1301,9 @@ TraceCommandProc(
Tcl_DStringAppendElement(&cmd, oldName);
Tcl_DStringAppendElement(&cmd, (newName ? newName : ""));
if (flags & TCL_TRACE_RENAME) {
- Tcl_DStringAppend(&cmd, " rename", 7);
+ TclDStringAppendLiteral(&cmd, " rename");
} else if (flags & TCL_TRACE_DELETE) {
- Tcl_DStringAppend(&cmd, " delete", 7);
+ TclDStringAppendLiteral(&cmd, " delete");
}
/*
@@ -1315,7 +1340,7 @@ TraceCommandProc(
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
if (tcmdPtr->startCmd != NULL) {
- ckfree((char *) tcmdPtr->startCmd);
+ ckfree(tcmdPtr->startCmd);
}
}
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
@@ -1358,7 +1383,7 @@ TraceCommandProc(
tcmdPtr->refCount--;
}
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char *) tcmdPtr);
+ ckfree(tcmdPtr);
}
}
@@ -1450,7 +1475,7 @@ TclCheckExecutionTraces(
traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel,
command, (Tcl_Command) cmdPtr, objc, objv);
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char *) tcmdPtr);
+ ckfree(tcmdPtr);
}
}
}
@@ -1693,7 +1718,7 @@ CommandObjTraceDeleted(
TraceCommandInfo *tcmdPtr = clientData;
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char *) tcmdPtr);
+ ckfree(tcmdPtr);
}
}
@@ -1776,7 +1801,7 @@ TraceExecutionProc(
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
if (tcmdPtr->startCmd != NULL) {
- ckfree((char *) tcmdPtr->startCmd);
+ ckfree(tcmdPtr->startCmd);
}
}
@@ -1908,7 +1933,7 @@ TraceExecutionProc(
}
if (call) {
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char *) tcmdPtr);
+ ckfree(tcmdPtr);
}
}
return traceCode;
@@ -1972,24 +1997,24 @@ TraceVarProc(
#ifndef TCL_REMOVE_OBSOLETE_TRACES
if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) {
if (flags & TCL_TRACE_ARRAY) {
- Tcl_DStringAppend(&cmd, " a", 2);
+ TclDStringAppendLiteral(&cmd, " a");
} else if (flags & TCL_TRACE_READS) {
- Tcl_DStringAppend(&cmd, " r", 2);
+ TclDStringAppendLiteral(&cmd, " r");
} else if (flags & TCL_TRACE_WRITES) {
- Tcl_DStringAppend(&cmd, " w", 2);
+ TclDStringAppendLiteral(&cmd, " w");
} else if (flags & TCL_TRACE_UNSETS) {
- Tcl_DStringAppend(&cmd, " u", 2);
+ TclDStringAppendLiteral(&cmd, " u");
}
} else {
#endif
if (flags & TCL_TRACE_ARRAY) {
- Tcl_DStringAppend(&cmd, " array", 6);
+ TclDStringAppendLiteral(&cmd, " array");
} else if (flags & TCL_TRACE_READS) {
- Tcl_DStringAppend(&cmd, " read", 5);
+ TclDStringAppendLiteral(&cmd, " read");
} else if (flags & TCL_TRACE_WRITES) {
- Tcl_DStringAppend(&cmd, " write", 6);
+ TclDStringAppendLiteral(&cmd, " write");
} else if (flags & TCL_TRACE_UNSETS) {
- Tcl_DStringAppend(&cmd, " unset", 6);
+ TclDStringAppendLiteral(&cmd, " unset");
}
#ifndef TCL_REMOVE_OBSOLETE_TRACES
}
@@ -2025,6 +2050,7 @@ TraceVarProc(
}
if (code != TCL_OK) { /* copy error msg to result */
Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);
+
Tcl_IncrRefCount(errMsgObj);
result = (char *) errMsgObj;
}
@@ -2134,7 +2160,7 @@ Tcl_CreateObjTrace(
iPtr->tracesForbiddingInline++;
}
- tracePtr = (Trace *) ckalloc(sizeof(Trace));
+ tracePtr = ckalloc(sizeof(Trace));
tracePtr->level = level;
tracePtr->proc = proc;
tracePtr->clientData = clientData;
@@ -2197,8 +2223,7 @@ Tcl_CreateTrace(
* command. */
ClientData clientData) /* Arbitrary value word to pass to proc. */
{
- StringTraceData *data = (StringTraceData *)
- ckalloc(sizeof(StringTraceData));
+ StringTraceData *data = ckalloc(sizeof(StringTraceData));
data->clientData = clientData;
data->proc = proc;
@@ -2555,7 +2580,7 @@ TclCallVarTraces(
char *newPart1;
Tcl_DStringInit(&nameCopy);
- Tcl_DStringAppend(&nameCopy, part1, (p-part1));
+ Tcl_DStringAppend(&nameCopy, part1, p-part1);
newPart1 = Tcl_DStringValue(&nameCopy);
newPart1[offset] = 0;
part1 = newPart1;
@@ -2693,7 +2718,8 @@ TclCallVarTraces(
if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
Tcl_SetObjResult((Tcl_Interp *)iPtr, (Tcl_Obj *) result);
} else {
- Tcl_SetResult((Tcl_Interp *)iPtr, result, TCL_STATIC);
+ Tcl_SetObjResult((Tcl_Interp *)iPtr,
+ Tcl_NewStringObj(result, -1));
}
Tcl_AddErrorInfo((Tcl_Interp *)iPtr, "");
@@ -2880,6 +2906,16 @@ Tcl_UntraceVar2(
* The code below makes it possible to delete traces while traces are
* active: it makes sure that the deleted trace won't be processed by
* TclCallVarTraces.
+ *
+ * Caveat (Bug 3062331): When an unset trace handler on a variable
+ * tries to delete a different unset trace handler on the same variable,
+ * the results may be surprising. When variable unset traces fire, the
+ * traced variable is already gone. So the TclLookupVar() call above
+ * will not find that variable, and not finding it will never reach here
+ * to perform the deletion. This means callers of Tcl_UntraceVar*()
+ * attempting to delete unset traces from within the handler of another
+ * unset trace have to account for the possibility that their call to
+ * Tcl_UntraceVar*() is a no-op.
*/
for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
@@ -3108,7 +3144,7 @@ Tcl_TraceVar2(
register VarTrace *tracePtr;
int result;
- tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
+ tracePtr = ckalloc(sizeof(VarTrace));
tracePtr->traceProc = proc;
tracePtr->clientData = clientData;
tracePtr->flags = flags;
@@ -3116,7 +3152,7 @@ Tcl_TraceVar2(
result = TraceVarEx(interp, part1, part2, tracePtr);
if (result != TCL_OK) {
- ckfree((char *) tracePtr);
+ ckfree(tracePtr);
}
return result;
}
diff --git a/generic/tclUniData.c b/generic/tclUniData.c
index 97b809a..5c88639 100644
--- a/generic/tclUniData.c
+++ b/generic/tclUniData.c
@@ -7,8 +7,6 @@
*
* Copyright (c) 1998 by Scriptics Corporation.
* All rights reserved.
- *
- * RCS: @(#) $Id: tclUniData.c,v 1.5 2010/05/27 08:38:07 nijtmans Exp $
*/
/*
@@ -25,361 +23,521 @@
* to the same alternate page number.
*/
-static unsigned char pageMap[] = {
- 0, 1, 2, 3, 0, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 7, 15, 16, 17,
- 18, 19, 20, 21, 22, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 7, 32,
- 7, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 47,
- 48, 49, 50, 51, 52, 35, 47, 53, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69,
- 58, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 80, 81,
- 84, 85, 80, 86, 87, 88, 89, 90, 91, 92, 35, 93, 94, 95, 35, 96, 97,
- 98, 99, 100, 101, 102, 35, 47, 103, 104, 35, 35, 105, 106, 107, 47,
- 47, 108, 47, 47, 109, 47, 110, 111, 47, 112, 47, 113, 114, 115, 116,
- 114, 47, 117, 118, 35, 47, 47, 119, 90, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 120, 121, 47, 47, 122,
- 35, 35, 35, 35, 47, 123, 124, 125, 126, 47, 127, 128, 47, 129, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 7, 7, 7, 7, 130, 7, 7, 131, 132, 133, 134,
- 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148,
- 149, 150, 151, 152, 153, 154, 155, 156, 156, 156, 156, 156, 156, 156,
- 157, 158, 159, 160, 161, 162, 35, 35, 35, 160, 163, 164, 165, 166,
- 167, 168, 169, 160, 160, 160, 160, 170, 171, 172, 173, 174, 160, 160,
- 175, 35, 35, 35, 35, 176, 177, 178, 179, 180, 181, 35, 35, 160, 160,
- 160, 160, 160, 160, 160, 160, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 182, 160, 160, 155, 160, 160, 160, 160, 160, 160, 170, 183, 184, 185,
- 90, 47, 186, 90, 47, 187, 188, 189, 47, 47, 190, 128, 35, 35, 191,
- 192, 193, 194, 192, 195, 196, 197, 160, 160, 160, 198, 160, 160, 199,
- 197, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 200, 35, 35, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 201, 35, 35, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 202, 203, 204, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 205, 35, 35, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206,
- 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206,
- 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206,
- 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206,
- 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 47, 47, 47, 47, 47, 47, 47, 47, 47, 208, 35, 35, 35, 35,
- 35, 35, 209, 210, 211, 47, 47, 212, 213, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 214, 215, 47, 216, 47, 217, 218, 35, 219, 220, 221, 47,
- 47, 47, 222, 223, 2, 224, 225, 226, 227, 228, 229, 230, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 231, 35, 232, 233,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 208, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 47, 234, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 235, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
- 207, 207, 207, 236, 207, 207, 207, 207, 207, 207, 207, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
- 35, 35, 35, 35, 35
+static const unsigned short pageMap[] = {
+ 0, 32, 64, 96, 0, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416,
+ 448, 224, 480, 512, 544, 576, 608, 640, 672, 704, 704, 736, 768, 800,
+ 832, 864, 896, 928, 960, 992, 224, 1024, 224, 1056, 224, 224, 1088,
+ 1120, 1152, 1184, 1216, 1248, 1280, 1312, 1344, 1376, 1408, 1344, 1344,
+ 1440, 1472, 1504, 1536, 1568, 1344, 1344, 1600, 1632, 1664, 1696, 1728,
+ 1760, 1792, 1792, 1824, 1792, 1856, 1888, 1920, 1952, 1984, 2016, 2048,
+ 2080, 2112, 2144, 2176, 2208, 2240, 2272, 2304, 2336, 2368, 2016, 2400,
+ 2432, 2464, 2496, 2528, 2560, 2592, 2624, 2656, 2688, 2720, 2752, 2784,
+ 2816, 2848, 2752, 2880, 2912, 2944, 2976, 3008, 3040, 3072, 3104, 3136,
+ 3168, 1792, 3200, 3232, 3264, 1792, 3296, 3328, 3360, 3392, 3424, 3456,
+ 3488, 1792, 1344, 3520, 3552, 3584, 3616, 3648, 3680, 3712, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 3744, 1344, 3776, 3808,
+ 3840, 1344, 3872, 1344, 3904, 3936, 3968, 1344, 1344, 4000, 4032, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 4064, 4096, 1344, 1344, 4128, 4160, 4192,
+ 4224, 4256, 1344, 4288, 4320, 4352, 4384, 1344, 4416, 4448, 1344, 4480,
+ 1344, 4512, 4544, 4576, 4608, 4640, 1344, 4672, 4704, 4736, 4768, 1344,
+ 4800, 4832, 4864, 4896, 1792, 1792, 4928, 4960, 4992, 5024, 5056, 5088,
+ 1344, 5120, 1344, 5152, 5184, 5216, 1792, 1792, 5248, 5280, 5312, 5344,
+ 5376, 5408, 5440, 5376, 704, 5472, 224, 224, 224, 224, 5504, 224, 224,
+ 224, 5536, 5568, 5600, 5632, 5664, 5696, 5728, 5760, 5792, 5824, 5856,
+ 5888, 5920, 5952, 5984, 6016, 6048, 6080, 6112, 6144, 6176, 6208, 6240,
+ 6272, 6304, 6304, 6304, 6304, 6304, 6304, 6304, 6304, 6336, 6368, 4736,
+ 6400, 6432, 6464, 6496, 6528, 4736, 6560, 6592, 6624, 6656, 6688, 6720,
+ 6752, 4736, 4736, 4736, 4736, 4736, 6784, 6816, 6848, 4736, 4736, 4736,
+ 6880, 4736, 4736, 4736, 4736, 6912, 4736, 4736, 6944, 6976, 4736, 7008,
+ 7040, 4736, 4736, 4736, 4736, 4736, 4736, 4736, 4736, 6304, 6304, 6304,
+ 6304, 7072, 6304, 7104, 7136, 6304, 6304, 6304, 6304, 6304, 6304, 6304,
+ 6304, 4736, 7168, 7200, 1792, 1792, 1792, 1792, 1792, 7232, 7264, 7296,
+ 7328, 224, 224, 224, 7360, 7392, 7424, 1344, 7456, 7488, 7520, 7520,
+ 704, 7552, 7584, 1792, 1792, 7616, 4736, 4736, 7648, 4736, 4736, 4736,
+ 4736, 4736, 4736, 7680, 7712, 7744, 7776, 3104, 1344, 7808, 4032, 1344,
+ 7840, 7872, 7904, 1344, 1344, 7936, 7968, 4736, 8000, 8032, 8064, 8096,
+ 4736, 8064, 8128, 4736, 8032, 4736, 4736, 4736, 4736, 4736, 4736, 4736,
+ 4736, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 4512, 4736, 4736, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 8160,
+ 1792, 8192, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 8224, 4736, 8256, 5216, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 8288, 8320, 224, 8352, 8384, 1344, 1344, 8416, 8448, 8480, 224,
+ 8512, 8544, 8576, 1792, 8608, 8640, 8672, 1344, 8704, 8736, 8768, 8800,
+ 8832, 1632, 8864, 8896, 4544, 1888, 8928, 8960, 1792, 1344, 8992, 9024,
+ 9056, 1344, 9088, 9120, 9152, 9184, 9216, 1792, 1792, 1792, 1792, 1344,
+ 9248, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 9280, 9312, 9344, 9376, 9376, 9376, 9376, 9376, 9376, 9376,
+ 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376,
+ 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376,
+ 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376,
+ 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376,
+ 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9376, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408, 9408,
+ 9408, 9408, 9408, 9408, 9408, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 9440, 1344, 1344, 9472, 1792, 9504, 9536, 9568,
+ 1344, 1344, 9600, 9632, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 9664, 9696, 1344, 9728, 1344, 9760, 9792, 9824, 9856, 9888,
+ 9920, 1344, 1344, 1344, 9952, 9984, 64, 10016, 10048, 10080, 10112,
+ 10144, 10176
+#if TCL_UTF_MAX > 3
+ ,10208, 10240, 10272, 1792, 1344, 1344, 1344, 7968, 10304, 10336, 10368,
+ 10400, 10432, 1792, 10464, 10496, 1792, 1792, 1792, 1792, 4544, 1344,
+ 10528, 1792, 10112, 10560, 10592, 1792, 10624, 1344, 10656, 1792, 10688,
+ 10720, 10752, 1344, 10784, 10816, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 10848, 10880, 10912,
+ 1792, 1792, 1792, 1792, 1792, 10944, 10976, 1792, 1792, 1344, 11008,
+ 1792, 1792, 11040, 11072, 11104, 11136, 1792, 1792, 1792, 1792, 1344,
+ 11168, 11200, 11232, 1792, 1792, 1792, 1792, 1344, 1344, 11264, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 11296, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 11328, 11360, 11392, 11424, 5056, 11456,
+ 11488, 11520, 11552, 11584, 11616, 1792, 5056, 11648, 11680, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1344, 11712, 10816, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 11744, 1792, 1792,
+ 1792, 1792, 10368, 10368, 10368, 11776, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 11744, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 11808, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1344, 1344, 11840, 11872, 11904, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 11936,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 4736, 4736, 4736, 4736, 4736, 4736, 4736, 7680, 4736,
+ 11968, 4736, 12000, 12032, 12064, 12096, 1792, 4736, 4736, 12128, 1792,
+ 1792, 1792, 1792, 1792, 4736, 4736, 12160, 12192, 1792, 1792, 1792,
+ 1792, 12224, 12256, 12288, 12320, 12352, 12384, 12416, 12448, 12480,
+ 12512, 12544, 12576, 12608, 12224, 12256, 12640, 12320, 12672, 12704,
+ 12736, 12448, 12768, 12800, 12832, 12864, 12896, 12928, 12960, 12992,
+ 13024, 13056, 13088, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 13120, 13152, 13184, 13216, 13248, 13280, 1792, 13312, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 4736, 13344, 4736, 4736, 7648,
+ 13376, 13408, 1792, 13440, 13472, 4736, 13344, 13504, 1792, 1792, 13536,
+ 13568, 13504, 13600, 1792, 1792, 1792, 1792, 1792, 4736, 13632, 4736,
+ 13664, 7648, 4736, 13696, 13728, 4736, 8032, 13760, 4736, 4736, 4736,
+ 4736, 13792, 4736, 12096, 13824, 13856, 1792, 1792, 1792, 13888, 4736,
+ 4736, 13920, 1792, 4736, 4736, 13952, 1792, 4736, 4736, 4736, 7648,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 7488, 1792,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4000, 1344, 1344,
+ 1344, 1344, 1344, 1344, 10784, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792, 1792,
+ 1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
+ 1344, 1344, 1344, 1344, 1344, 10784
+#endif /* TCL_UTF_MAX > 3 */
};
/*
@@ -388,421 +546,795 @@ static unsigned char pageMap[] = {
* set of character attributes.
*/
-static unsigned char groupMap[] = {
+static const unsigned char groupMap[] = {
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8,
3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 7, 7, 7, 3, 3, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 5, 3, 6, 11, 12, 11, 13, 13, 13, 13, 13, 13,
13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
- 13, 13, 13, 5, 7, 6, 7, 1, 2, 3, 4, 4, 4, 4, 14, 14, 11, 14, 15, 16,
- 7, 8, 14, 11, 14, 7, 17, 17, 11, 18, 14, 3, 11, 17, 15, 19, 17, 17,
- 17, 3, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
- 10, 10, 10, 10, 10, 10, 10, 10, 7, 10, 10, 10, 10, 10, 10, 10, 15,
+ 13, 13, 13, 5, 7, 6, 7, 1, 2, 3, 4, 4, 4, 4, 14, 3, 11, 14, 15, 16,
+ 7, 17, 14, 11, 14, 7, 18, 18, 11, 19, 3, 3, 11, 18, 15, 20, 18, 18,
+ 18, 3, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10, 7, 10, 10, 10, 10, 10, 10, 10, 21,
13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
- 13, 13, 13, 13, 13, 13, 7, 13, 13, 13, 13, 13, 13, 13, 20, 21, 22,
- 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21,
- 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22,
- 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 23, 24, 21, 22, 21,
- 22, 21, 22, 15, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21,
- 22, 21, 22, 15, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21,
- 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22,
- 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 25,
- 21, 22, 21, 22, 21, 22, 26, 15, 27, 21, 22, 21, 22, 28, 21, 22, 29,
- 29, 21, 22, 15, 30, 31, 32, 21, 22, 29, 33, 34, 35, 36, 21, 22, 15,
- 15, 35, 37, 15, 38, 21, 22, 21, 22, 21, 22, 39, 21, 22, 39, 15, 15,
- 21, 22, 39, 21, 22, 40, 40, 21, 22, 21, 22, 41, 21, 22, 15, 42, 21,
- 22, 15, 43, 42, 42, 42, 42, 44, 45, 46, 44, 45, 46, 44, 45, 46, 21,
- 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 47, 21,
- 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22,
- 15, 44, 45, 46, 21, 22, 48, 49, 21, 22, 21, 22, 21, 22, 21, 22, 0,
- 0, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22,
- 21, 22, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 50, 51, 15, 52, 52, 15, 53, 15,
- 54, 15, 15, 15, 15, 52, 15, 15, 55, 15, 15, 15, 15, 56, 57, 15, 15,
- 15, 15, 15, 57, 15, 15, 58, 15, 15, 59, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 60, 15, 15, 60, 15, 15, 15, 15, 60, 15, 61, 61, 15, 15,
- 15, 15, 15, 15, 62, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 63,
- 63, 63, 63, 63, 63, 63, 63, 63, 11, 11, 63, 63, 63, 63, 63, 63, 63,
- 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 63, 63, 11,
- 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 63, 63, 63, 63,
- 63, 11, 11, 11, 11, 11, 11, 11, 11, 11, 63, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
- 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
- 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 65, 64, 64, 64, 64, 64, 64,
- 64, 64, 64, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 64,
- 64, 64, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11,
- 0, 0, 0, 0, 63, 0, 0, 0, 3, 0, 0, 0, 0, 0, 11, 11, 66, 3, 67, 67, 67,
- 0, 68, 0, 69, 69, 15, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
- 10, 10, 10, 10, 10, 0, 10, 10, 10, 10, 10, 10, 10, 10, 10, 70, 71,
- 71, 71, 15, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
- 13, 13, 13, 72, 13, 13, 13, 13, 13, 13, 13, 13, 13, 73, 74, 74, 0,
- 75, 76, 77, 77, 77, 78, 79, 15, 0, 0, 21, 22, 21, 22, 21, 22, 21, 22,
- 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 80, 81, 47,
- 15, 82, 83, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 84, 84, 84, 84, 84, 84, 84,
- 84, 84, 84, 84, 84, 84, 84, 84, 84, 10, 10, 10, 10, 10, 10, 10, 10,
+ 13, 13, 13, 13, 13, 13, 7, 13, 13, 13, 13, 13, 13, 13, 22, 23, 24,
+ 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
+ 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 25, 26, 23, 24, 23,
+ 24, 23, 24, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
+ 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 27,
+ 23, 24, 23, 24, 23, 24, 28, 29, 30, 23, 24, 23, 24, 31, 23, 24, 32,
+ 32, 23, 24, 21, 33, 34, 35, 23, 24, 32, 36, 37, 38, 39, 23, 24, 40,
+ 21, 38, 41, 42, 43, 23, 24, 23, 24, 23, 24, 44, 23, 24, 44, 21, 21,
+ 23, 24, 44, 23, 24, 45, 45, 23, 24, 23, 24, 46, 23, 24, 21, 15, 23,
+ 24, 21, 47, 15, 15, 15, 15, 48, 49, 50, 48, 49, 50, 48, 49, 50, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 51, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
+ 21, 48, 49, 50, 23, 24, 52, 53, 23, 24, 23, 24, 23, 24, 23, 24, 54,
+ 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
+ 23, 24, 21, 21, 21, 21, 21, 21, 55, 23, 24, 56, 57, 58, 58, 23, 24,
+ 59, 60, 61, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 62, 63, 64, 65,
+ 66, 21, 67, 67, 21, 68, 21, 69, 21, 21, 21, 21, 67, 21, 21, 70, 21,
+ 71, 72, 21, 73, 74, 21, 75, 21, 21, 21, 74, 21, 76, 77, 21, 21, 78,
+ 21, 21, 21, 21, 21, 21, 21, 79, 21, 21, 80, 21, 21, 80, 21, 21, 21,
+ 21, 80, 81, 82, 82, 83, 21, 21, 21, 21, 21, 84, 21, 15, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
+ 85, 85, 85, 85, 85, 85, 85, 85, 11, 11, 11, 11, 85, 85, 85, 85, 85,
+ 85, 85, 85, 85, 85, 85, 85, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
+ 11, 11, 11, 11, 85, 85, 85, 85, 85, 11, 11, 11, 11, 11, 11, 11, 85,
+ 11, 85, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
+ 11, 11, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 86, 86, 86, 86, 86, 87, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 23, 24, 23,
+ 24, 85, 11, 23, 24, 0, 0, 85, 42, 42, 42, 3, 0, 0, 0, 0, 0, 11, 11,
+ 88, 3, 89, 89, 89, 0, 90, 0, 91, 91, 21, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 0, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 92, 93, 93, 93, 21, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 13, 13, 94, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 95, 96, 96, 97, 98, 99, 100, 100, 100, 101, 102, 103, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
+ 23, 24, 23, 24, 104, 105, 106, 21, 107, 108, 7, 23, 24, 109, 23, 24,
+ 21, 54, 54, 54, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110,
+ 110, 110, 110, 110, 110, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
- 10, 10, 10, 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
- 13, 13, 13, 13, 13, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, 81,
- 81, 81, 81, 81, 21, 22, 14, 64, 64, 64, 64, 0, 85, 85, 0, 0, 21, 22,
- 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21,
- 22, 77, 21, 22, 21, 22, 0, 0, 21, 22, 0, 0, 21, 22, 0, 0, 0, 21, 22,
- 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21,
- 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22,
- 21, 22, 0, 0, 21, 22, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 86,
+ 13, 13, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
+ 105, 105, 105, 105, 23, 24, 14, 86, 86, 86, 86, 86, 111, 111, 23, 24,
+ 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 112, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 113, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 114,
+ 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114,
+ 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114,
+ 114, 114, 114, 114, 114, 114, 114, 114, 114, 0, 0, 85, 3, 3, 3, 3,
+ 3, 3, 0, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115,
+ 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115,
+ 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 21, 0,
+ 3, 8, 0, 0, 0, 0, 4, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 8, 86, 3, 86, 86, 3, 86, 86, 3, 86, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 3, 3, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 0, 7, 7, 7, 3, 3,
+ 4, 3, 3, 14, 14, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 0,
+ 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 85, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 15, 86, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 15, 86, 86, 86,
+ 86, 86, 86, 86, 17, 14, 86, 86, 86, 86, 86, 86, 85, 85, 86, 86, 14,
+ 86, 86, 86, 86, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 14,
+ 14, 15, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 17, 15, 86, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86,
86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
- 0, 0, 63, 3, 3, 3, 3, 3, 3, 0, 87, 87, 87, 87, 87, 87, 87, 87, 87,
- 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87,
- 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 15, 0, 3, 8, 0, 0,
- 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
- 64, 64, 64, 0, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
- 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 0, 64, 64, 64, 3, 64, 3, 64,
- 64, 3, 64, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 0, 0, 0, 0, 0, 42, 42, 42, 3, 3, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 3, 0, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 0, 0, 0, 0, 0, 63, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 0, 0, 64, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 3, 42, 64,
- 64, 64, 64, 64, 64, 64, 85, 85, 64, 64, 64, 64, 64, 64, 63, 63, 64,
- 64, 14, 64, 64, 64, 64, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 42, 42,
- 42, 14, 14, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 88, 42,
- 64, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0, 0, 64, 64, 64, 64,
- 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
- 64, 64, 64, 64, 64, 64, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 42, 42, 42, 42, 42, 42, 64, 64, 64, 64, 64, 64, 64,
- 64, 64, 64, 64, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 64,
- 64, 89, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 0, 0, 64, 42, 89, 89, 89, 64, 64, 64, 64, 64, 64,
- 64, 64, 89, 89, 89, 89, 64, 0, 0, 42, 64, 64, 64, 64, 0, 0, 0, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 64, 64, 3, 3, 9, 9, 9, 9, 9, 9,
- 9, 9, 9, 9, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 64,
- 89, 89, 0, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0, 42, 42, 0, 0, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 0, 42, 42, 42, 42, 42, 42, 42, 0, 42, 0, 0, 0, 42,
- 42, 42, 42, 0, 0, 64, 0, 89, 89, 89, 64, 64, 64, 64, 0, 0, 89, 89,
- 0, 0, 89, 89, 64, 0, 0, 0, 0, 0, 0, 0, 0, 0, 89, 0, 0, 0, 0, 42, 42,
- 0, 42, 42, 42, 64, 64, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 42, 42,
- 4, 4, 17, 17, 17, 17, 17, 17, 14, 0, 0, 0, 0, 0, 0, 0, 64, 0, 0, 42,
- 42, 42, 42, 42, 42, 0, 0, 0, 0, 42, 42, 0, 0, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0,
- 42, 42, 42, 42, 42, 42, 42, 0, 42, 42, 0, 42, 42, 0, 42, 42, 0, 0,
- 64, 0, 89, 89, 89, 64, 64, 0, 0, 0, 0, 64, 64, 0, 0, 64, 64, 64, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42, 42, 42, 42, 0, 42, 0, 0, 0, 0, 0,
- 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 64, 64, 42, 42, 42, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 64, 64, 89, 0, 42, 42, 42, 42, 42, 42, 42,
- 0, 42, 0, 42, 42, 42, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 42, 42, 42, 42, 42,
- 42, 42, 0, 42, 42, 0, 42, 42, 42, 42, 42, 0, 0, 64, 42, 89, 89, 89,
- 64, 64, 64, 64, 64, 0, 64, 64, 89, 0, 89, 89, 64, 0, 0, 42, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42, 0, 0, 0, 0, 0, 9, 9, 9, 9,
- 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 0, 42, 42, 42, 42, 42, 42, 42, 0, 42,
- 42, 0, 0, 42, 42, 42, 42, 0, 0, 64, 42, 89, 64, 89, 64, 64, 64, 0,
- 0, 0, 89, 89, 0, 0, 89, 89, 64, 0, 0, 0, 0, 0, 0, 0, 0, 64, 89, 0,
- 0, 0, 0, 42, 42, 0, 42, 42, 42, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9,
- 9, 9, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 64, 89,
- 0, 42, 42, 42, 42, 42, 42, 0, 0, 0, 42, 42, 42, 0, 42, 42, 42, 42,
- 0, 0, 0, 42, 42, 0, 42, 0, 42, 42, 0, 0, 0, 42, 42, 0, 0, 0, 42, 42,
- 42, 0, 0, 0, 42, 42, 42, 42, 42, 42, 42, 42, 0, 42, 42, 42, 0, 0, 0,
- 0, 89, 89, 64, 89, 89, 0, 0, 0, 89, 89, 89, 0, 89, 89, 89, 64, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 89, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 17, 17, 17, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 89, 89, 89, 0, 42, 42, 42, 42, 42, 42, 42, 42, 0, 42,
- 42, 42, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 0, 42, 42, 42, 42, 42, 0, 0, 0, 0, 64, 64, 64, 89, 89,
- 89, 89, 0, 64, 64, 64, 0, 64, 64, 64, 64, 0, 0, 0, 0, 0, 0, 0, 64,
- 64, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42, 42, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9,
- 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 89,
- 89, 0, 42, 42, 42, 42, 42, 42, 42, 42, 0, 42, 42, 42, 0, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 42, 42, 42,
- 42, 42, 0, 0, 0, 0, 89, 64, 89, 89, 89, 89, 89, 0, 64, 89, 89, 0, 89,
- 89, 64, 64, 0, 0, 0, 0, 0, 0, 0, 89, 89, 0, 0, 0, 0, 0, 0, 0, 42, 0,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0, 0, 0, 89, 89, 89, 64, 64,
- 64, 0, 0, 89, 89, 89, 0, 89, 89, 89, 64, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 89, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 89, 89, 0, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0, 0, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 42, 0, 0,
- 42, 42, 42, 42, 42, 42, 42, 0, 0, 0, 64, 0, 0, 0, 0, 89, 89, 89, 64,
- 64, 64, 0, 64, 0, 89, 89, 89, 89, 89, 89, 89, 89, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 89, 89, 3, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 64, 42, 42, 64, 64, 64, 64, 64, 64, 64, 0, 0, 0, 0, 4, 42, 42,
- 42, 42, 42, 42, 63, 64, 64, 64, 64, 64, 64, 64, 64, 3, 9, 9, 9, 9,
- 9, 9, 9, 9, 9, 9, 3, 3, 0, 0, 0, 0, 0, 42, 42, 0, 42, 0, 0, 42, 42,
- 0, 42, 0, 0, 42, 0, 0, 0, 0, 0, 0, 42, 42, 42, 42, 0, 42, 42, 42, 42,
- 42, 42, 42, 0, 42, 42, 42, 0, 42, 0, 42, 0, 0, 42, 42, 0, 42, 42, 42,
- 42, 64, 42, 42, 64, 64, 64, 64, 64, 64, 0, 64, 64, 42, 0, 0, 42, 42,
- 42, 42, 42, 0, 63, 0, 64, 64, 64, 64, 64, 64, 0, 0, 9, 9, 9, 9, 9,
- 9, 9, 9, 9, 9, 0, 0, 42, 42, 0, 0, 42, 14, 14, 14, 3, 3, 3, 3, 3, 3,
- 3, 3, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 64, 64, 14, 14, 14,
- 14, 14, 14, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 17, 17, 17, 17, 17, 17, 17,
- 17, 17, 17, 14, 64, 14, 64, 14, 64, 5, 6, 5, 6, 89, 89, 42, 42, 42,
- 42, 42, 42, 42, 42, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 0, 0, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64,
- 64, 64, 64, 64, 64, 64, 64, 89, 64, 64, 64, 64, 64, 3, 64, 64, 42,
- 42, 42, 42, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 64, 0, 64, 64,
- 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
- 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
- 0, 14, 14, 14, 14, 14, 14, 14, 14, 64, 14, 14, 14, 14, 14, 14, 0, 0,
- 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42, 42, 0, 42,
- 42, 42, 42, 42, 0, 42, 42, 0, 89, 64, 64, 64, 64, 89, 64, 0, 0, 0,
- 64, 64, 89, 64, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3,
- 3, 3, 3, 3, 3, 42, 42, 42, 42, 42, 42, 89, 89, 64, 64, 0, 0, 0, 0,
- 0, 0, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77,
- 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77,
- 77, 77, 77, 77, 77, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 0, 0, 0, 0, 3, 0, 0, 0, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0,
- 0, 0, 0, 0, 42, 42, 42, 42, 0, 0, 0, 0, 0, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0, 0, 0, 0, 0, 42, 42, 42,
- 42, 42, 42, 42, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 0, 42, 0, 42, 42, 42, 42, 0, 0, 42, 42, 42, 42, 42, 42, 42,
- 0, 42, 0, 42, 42, 42, 42, 0, 0, 42, 42, 42, 42, 42, 42, 42, 0, 42,
- 0, 42, 42, 42, 42, 0, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 0, 42, 0, 42, 42, 42, 42, 0, 0, 42, 42, 42, 42, 42, 42,
- 42, 0, 42, 0, 42, 42, 42, 42, 0, 0, 42, 42, 42, 42, 42, 42, 42, 0,
- 42, 42, 42, 42, 42, 42, 42, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3,
- 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
- 17, 0, 0, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 3, 3, 42, 42, 42, 42, 42,
- 42, 42, 42, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 5, 6, 0, 0, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 3, 3, 3, 90, 90, 90, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 89, 89, 89, 64, 64, 64, 64, 64, 64, 64, 89, 89, 89, 89, 89,
- 89, 89, 89, 64, 89, 89, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
- 3, 3, 3, 3, 3, 3, 3, 4, 3, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3,
- 3, 3, 3, 3, 8, 3, 3, 3, 3, 88, 88, 88, 88, 0, 9, 9, 9, 9, 9, 9, 9,
- 9, 9, 9, 0, 0, 0, 0, 0, 0, 42, 42, 42, 63, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0, 0, 0, 0, 0, 0,
- 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 64, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 21, 22, 21, 22, 21, 22, 21,
- 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 15, 15,
- 15, 15, 15, 91, 0, 0, 0, 0, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22,
- 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 21, 22, 0,
- 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 93, 93, 93, 93, 93,
- 93, 93, 93, 92, 92, 92, 92, 92, 92, 0, 0, 93, 93, 93, 93, 93, 93, 0,
- 0, 92, 92, 92, 92, 92, 92, 92, 92, 93, 93, 93, 93, 93, 93, 93, 93,
- 92, 92, 92, 92, 92, 92, 92, 92, 93, 93, 93, 93, 93, 93, 93, 93, 92,
- 92, 92, 92, 92, 92, 0, 0, 93, 93, 93, 93, 93, 93, 0, 0, 15, 92, 15,
- 92, 15, 92, 15, 92, 0, 93, 0, 93, 0, 93, 0, 93, 92, 92, 92, 92, 92,
- 92, 92, 92, 93, 93, 93, 93, 93, 93, 93, 93, 94, 94, 95, 95, 95, 95,
- 96, 96, 97, 97, 98, 98, 99, 99, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92,
- 100, 100, 100, 100, 100, 100, 100, 100, 92, 92, 92, 92, 92, 92, 92,
- 92, 100, 100, 100, 100, 100, 100, 100, 100, 92, 92, 92, 92, 92, 92,
- 92, 92, 100, 100, 100, 100, 100, 100, 100, 100, 92, 92, 15, 101, 15,
- 0, 15, 15, 93, 93, 102, 102, 103, 11, 104, 11, 11, 11, 15, 101, 15,
- 0, 15, 15, 105, 105, 105, 105, 103, 11, 11, 11, 92, 92, 15, 15, 0,
- 0, 15, 15, 93, 93, 106, 106, 0, 11, 11, 11, 92, 92, 15, 15, 15, 107,
- 15, 15, 93, 93, 108, 108, 109, 11, 11, 11, 0, 0, 15, 101, 15, 0, 15,
- 15, 110, 110, 111, 111, 103, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2,
- 2, 2, 2, 88, 88, 88, 88, 8, 8, 8, 8, 8, 8, 3, 3, 16, 19, 5, 16, 16,
- 19, 5, 16, 3, 3, 3, 3, 3, 3, 3, 3, 112, 113, 88, 88, 88, 88, 88, 2,
- 3, 3, 3, 3, 3, 3, 3, 3, 3, 16, 19, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7,
- 5, 6, 0, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 88, 88, 88, 88, 88, 88, 17,
- 0, 0, 0, 17, 17, 17, 17, 17, 17, 7, 7, 7, 5, 6, 15, 17, 17, 17, 17,
- 17, 17, 17, 17, 17, 17, 7, 7, 7, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
+ 86, 86, 86, 86, 86, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, 86, 86, 86,
+ 86, 85, 85, 14, 3, 3, 3, 85, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86,
+ 86, 86, 86, 85, 86, 86, 86, 86, 86, 86, 86, 86, 86, 85, 86, 86, 86,
+ 85, 86, 86, 86, 86, 86, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 0, 0, 3, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
- 64, 64, 64, 85, 85, 85, 85, 64, 85, 85, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 77,
- 14, 14, 14, 14, 77, 14, 14, 15, 77, 77, 77, 15, 15, 77, 77, 77, 15,
- 14, 77, 14, 14, 14, 77, 77, 77, 77, 77, 14, 14, 14, 14, 14, 14, 77,
- 14, 114, 14, 77, 14, 115, 116, 77, 77, 14, 15, 77, 77, 14, 77, 15,
- 42, 42, 42, 42, 15, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
- 17, 17, 17, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117,
- 117, 117, 117, 117, 117, 118, 118, 118, 118, 118, 118, 118, 118, 118,
- 118, 118, 118, 118, 118, 118, 118, 90, 90, 90, 90, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, 86, 86, 86, 116,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 86, 116, 86, 15, 116, 116, 116, 86, 86, 86, 86, 86, 86,
+ 86, 86, 116, 116, 116, 116, 86, 116, 116, 15, 86, 86, 86, 86, 86, 86,
+ 86, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 3, 3, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 3, 85, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
+ 15, 15, 15, 15, 0, 86, 116, 116, 0, 15, 15, 15, 15, 15, 15, 15, 15,
+ 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
+ 15, 0, 15, 0, 0, 0, 15, 15, 15, 15, 0, 0, 86, 15, 116, 116, 116, 86,
+ 86, 86, 86, 0, 0, 116, 116, 0, 0, 116, 116, 86, 15, 0, 0, 0, 0, 0,
+ 0, 0, 0, 116, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 86, 86, 0, 0, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 4, 4, 18, 18, 18, 18, 18, 18, 14, 4,
+ 0, 0, 0, 0, 0, 86, 86, 116, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
+ 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15,
+ 15, 0, 15, 15, 0, 15, 15, 0, 0, 86, 0, 116, 116, 116, 86, 86, 0, 0,
+ 0, 0, 86, 86, 0, 0, 86, 86, 86, 0, 0, 0, 86, 0, 0, 0, 0, 0, 0, 0, 15,
+ 15, 15, 15, 0, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9,
+ 9, 86, 86, 15, 15, 15, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86,
+ 116, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15,
+ 15, 15, 0, 0, 86, 15, 116, 116, 116, 86, 86, 86, 86, 86, 0, 86, 86,
+ 116, 0, 116, 116, 86, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 15, 15, 86, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 4,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15,
+ 15, 0, 0, 86, 15, 116, 86, 116, 86, 86, 86, 86, 0, 0, 116, 116, 0,
+ 0, 116, 116, 86, 0, 0, 0, 0, 0, 0, 0, 0, 86, 116, 0, 0, 0, 0, 15, 15,
+ 0, 15, 15, 15, 86, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14, 15,
+ 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 15, 0, 15,
+ 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 0,
+ 15, 15, 0, 15, 0, 15, 15, 0, 0, 0, 15, 15, 0, 0, 0, 15, 15, 15, 0,
+ 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 116,
+ 116, 86, 116, 116, 0, 0, 0, 116, 116, 116, 0, 116, 116, 116, 86, 0,
+ 0, 15, 0, 0, 0, 0, 0, 0, 116, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 14, 14, 14, 14, 14, 14,
+ 4, 14, 0, 0, 0, 0, 0, 0, 116, 116, 116, 0, 15, 15, 15, 15, 15, 15,
+ 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 0, 15, 86, 86,
+ 86, 116, 116, 116, 116, 0, 86, 86, 86, 0, 86, 86, 86, 86, 0, 0, 0,
+ 0, 0, 0, 0, 86, 86, 0, 15, 15, 0, 0, 0, 0, 0, 0, 15, 15, 86, 86, 0,
+ 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18,
+ 18, 18, 18, 18, 14, 0, 0, 116, 116, 0, 15, 15, 15, 15, 15, 15, 15,
+ 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 86, 15, 116, 86, 116,
+ 116, 116, 116, 116, 0, 86, 116, 116, 0, 116, 116, 86, 86, 0, 0, 0,
+ 0, 0, 0, 0, 116, 116, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 15, 86, 86, 0,
+ 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 116,
+ 116, 116, 86, 86, 86, 86, 0, 116, 116, 116, 0, 116, 116, 116, 86, 15,
+ 0, 0, 0, 0, 0, 0, 0, 0, 116, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 86, 86,
+ 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 0, 0, 0,
+ 14, 15, 15, 15, 15, 15, 15, 0, 0, 116, 116, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0,
+ 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 86, 0, 0, 0, 0, 116, 116, 116,
+ 86, 86, 86, 0, 86, 0, 116, 116, 116, 116, 116, 116, 116, 116, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 116, 116, 3, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 86, 15, 15, 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0,
+ 4, 15, 15, 15, 15, 15, 15, 85, 86, 86, 86, 86, 86, 86, 86, 86, 3, 9,
+ 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 0, 0, 0, 0, 15, 15, 0, 15, 0, 0,
+ 15, 15, 0, 15, 0, 0, 15, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 15, 15,
+ 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 0, 15, 0, 0, 15, 15, 0, 15,
+ 15, 15, 15, 86, 15, 15, 86, 86, 86, 86, 86, 86, 0, 86, 86, 15, 0, 0,
+ 15, 15, 15, 15, 15, 0, 85, 0, 86, 86, 86, 86, 86, 86, 0, 0, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 0, 0, 15, 15, 15, 15, 15, 14, 14, 14, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 14, 3, 14, 14, 14, 86, 86, 14,
+ 14, 14, 14, 14, 14, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 14, 86, 14, 86, 14, 86, 5, 6, 5, 6, 116, 116, 15,
+ 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 86, 86, 86, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, 3,
+ 86, 86, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 86, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 86, 86, 86, 86, 0, 14, 14, 14, 14, 14, 14, 14, 14, 86, 14, 14, 14,
+ 14, 14, 14, 0, 14, 14, 3, 3, 3, 3, 3, 14, 14, 14, 14, 3, 3, 0, 0, 0,
+ 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 116, 116, 86, 86,
+ 86, 86, 116, 86, 86, 86, 86, 86, 86, 116, 86, 86, 116, 116, 86, 86,
+ 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15,
+ 15, 15, 116, 116, 86, 86, 15, 15, 15, 15, 86, 86, 86, 15, 116, 116,
+ 116, 15, 15, 116, 116, 116, 116, 116, 116, 116, 15, 15, 15, 86, 86,
+ 86, 86, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 116,
+ 116, 86, 86, 116, 116, 116, 116, 116, 116, 86, 15, 116, 9, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 116, 116, 116, 86, 14, 14, 117, 117, 117, 117, 117,
+ 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117,
+ 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117, 117,
+ 117, 117, 117, 117, 117, 0, 117, 0, 0, 0, 0, 0, 117, 0, 0, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 3, 85, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15,
+ 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15,
+ 15, 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
+ 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 0, 0, 86, 86, 86, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0,
+ 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 2, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 5, 6, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3,
+ 3, 118, 118, 118, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
+ 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 3, 3, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
+ 0, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86,
+ 116, 86, 86, 86, 86, 86, 86, 86, 116, 116, 116, 116, 116, 116, 116,
+ 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 3,
+ 3, 85, 3, 3, 3, 4, 15, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
+ 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0,
+ 0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3, 3, 86, 86, 86, 2, 0, 9, 9, 9, 9, 9,
+ 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 85, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
+ 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 15, 0, 0, 0, 0, 0,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 0, 0, 0, 86, 86, 86, 116, 116, 116, 116, 86,
+ 86, 116, 116, 116, 0, 0, 0, 0, 116, 116, 86, 116, 116, 116, 116, 116,
+ 116, 86, 86, 86, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9,
+ 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15,
+ 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 116, 116, 116, 116, 116, 116,
+ 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 15, 15, 15,
+ 15, 15, 15, 15, 116, 116, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9,
+ 9, 9, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 116, 116, 116,
+ 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 116, 86, 116, 86, 86, 86, 86, 86, 86, 86,
+ 0, 86, 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116,
+ 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, 0, 86,
+ 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9,
+ 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 85, 3, 3, 3, 3, 3,
+ 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86,
+ 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 116,
+ 86, 86, 86, 86, 86, 116, 86, 116, 116, 116, 116, 116, 86, 116, 116,
+ 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9,
+ 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 0, 0, 0, 86, 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 116, 86, 86, 86, 86, 116, 116, 86, 86, 116, 86, 116, 116, 15, 15,
+ 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 86, 116, 86, 86, 116, 116, 116, 86, 116, 86, 86, 86, 116, 116,
+ 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 116, 116, 116,
+ 116, 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116,
+ 86, 86, 0, 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
+ 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 85, 85, 85, 85, 85, 85, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 3, 86, 86, 86, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, 86, 86,
+ 15, 15, 15, 15, 86, 15, 15, 15, 15, 116, 116, 86, 15, 15, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 85, 85, 85,
+ 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
+ 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
+ 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
+ 85, 85, 85, 85, 85, 85, 85, 85, 85, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 85, 119, 21, 21, 21, 120, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 85, 85, 85, 85, 85, 86, 86, 86, 86, 86, 86,
+ 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 86, 86, 86, 86, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 121, 21, 21,
+ 122, 21, 123, 123, 123, 123, 123, 123, 123, 123, 124, 124, 124, 124,
+ 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 0, 0, 124, 124, 124,
+ 124, 124, 124, 0, 0, 123, 123, 123, 123, 123, 123, 123, 123, 124, 124,
+ 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 123, 123,
+ 124, 124, 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123,
+ 0, 0, 124, 124, 124, 124, 124, 124, 0, 0, 21, 123, 21, 123, 21, 123,
+ 21, 123, 0, 124, 0, 124, 0, 124, 0, 124, 123, 123, 123, 123, 123, 123,
+ 123, 123, 124, 124, 124, 124, 124, 124, 124, 124, 125, 125, 126, 126,
+ 126, 126, 127, 127, 128, 128, 129, 129, 130, 130, 0, 0, 123, 123, 123,
+ 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, 131, 131, 123,
+ 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, 131,
+ 131, 123, 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131,
+ 131, 131, 131, 123, 123, 21, 132, 21, 0, 21, 21, 124, 124, 133, 133,
+ 134, 11, 135, 11, 11, 11, 21, 132, 21, 0, 21, 21, 136, 136, 136, 136,
+ 134, 11, 11, 11, 123, 123, 21, 21, 0, 0, 21, 21, 124, 124, 137, 137,
+ 0, 11, 11, 11, 123, 123, 21, 21, 21, 106, 21, 21, 124, 124, 138, 138,
+ 109, 11, 11, 11, 0, 0, 21, 132, 21, 0, 21, 21, 139, 139, 140, 140,
+ 134, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17,
+ 8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, 3, 3,
+ 3, 3, 3, 141, 142, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, 17,
+ 17, 17, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 17, 18, 85, 0, 0, 18, 18,
+ 18, 18, 18, 18, 7, 7, 7, 5, 6, 85, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 7, 7, 7, 5, 6, 0, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85,
+ 85, 85, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
+ 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 86, 86, 111, 111, 111, 111, 86, 111, 111, 111, 86, 86, 86, 86, 86,
+ 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 14, 14, 100, 14, 14, 14, 14, 100, 14, 14, 21, 100, 100, 100,
+ 21, 21, 100, 100, 100, 21, 14, 100, 14, 14, 7, 100, 100, 100, 100,
+ 100, 14, 14, 14, 14, 14, 14, 100, 14, 143, 14, 100, 14, 144, 145, 100,
+ 100, 14, 21, 100, 100, 146, 100, 21, 15, 15, 15, 15, 21, 14, 14, 21,
+ 21, 100, 100, 7, 7, 7, 7, 7, 100, 21, 21, 21, 21, 14, 7, 14, 14, 147,
+ 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148,
+ 148, 148, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149,
+ 149, 149, 149, 149, 118, 118, 118, 23, 24, 118, 118, 118, 118, 18,
0, 0, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14,
14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 7,
14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
- 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 14, 14,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14,
+ 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14,
+ 14, 14, 14, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 7, 7, 14, 14, 14, 14, 14, 14, 14, 5, 6, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 150, 150, 150, 150, 150, 150, 150, 150,
+ 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, 150,
+ 150, 150, 150, 150, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151,
+ 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151, 151,
+ 151, 151, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 17, 17, 17,
- 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
- 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
- 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
- 17, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 119, 119, 119, 119, 119, 119,
- 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119, 119,
- 119, 119, 119, 119, 119, 119, 120, 120, 120, 120, 120, 120, 120, 120,
- 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, 120,
- 120, 120, 120, 120, 17, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 7, 7, 7, 7, 7, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6,
+ 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5,
+ 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 5, 6, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 14, 14, 7, 7, 7, 7, 7, 7, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 0, 0, 0, 0, 0, 0, 114, 114, 114, 114, 114, 114, 114, 114,
+ 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114,
+ 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114,
+ 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, 0, 115, 115,
+ 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115,
+ 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115,
+ 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115, 115,
+ 115, 115, 115, 0, 23, 24, 152, 153, 154, 155, 156, 23, 24, 23, 24,
+ 23, 24, 157, 158, 159, 160, 21, 23, 24, 21, 23, 24, 21, 21, 21, 21,
+ 21, 85, 85, 161, 161, 23, 24, 23, 24, 21, 14, 14, 14, 14, 14, 14, 23,
+ 24, 23, 24, 86, 86, 86, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3, 18, 3, 3,
+ 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162,
+ 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 162,
+ 162, 162, 162, 162, 162, 162, 162, 162, 162, 162, 0, 162, 0, 0, 0,
+ 0, 0, 162, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 85,
+ 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15,
+ 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
+ 15, 15, 15, 0, 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20, 3, 16, 20, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3, 16, 20, 5, 6,
+ 5, 6, 5, 6, 5, 6, 3, 3, 3, 3, 3, 85, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 8, 8, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 14, 14, 14,
+ 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
+ 0, 0, 0, 2, 3, 3, 3, 14, 85, 15, 118, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6,
+ 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 8, 5, 6, 6, 14, 118, 118, 118, 118,
+ 118, 118, 118, 118, 118, 86, 86, 86, 86, 116, 116, 8, 85, 85, 85, 85,
+ 85, 14, 14, 118, 118, 118, 85, 15, 3, 14, 14, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 0, 0, 86, 86, 11, 11, 85, 85, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 3, 85, 85, 85, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
+ 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 14, 14,
+ 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
- 14, 14, 14, 0, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18,
+ 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 0, 14, 0, 14, 14, 14, 14, 0, 0, 0, 14, 0, 14, 14,
- 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
- 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
- 17, 17, 17, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 3, 3, 3, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9,
+ 9, 9, 9, 9, 9, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 15, 86, 111, 111, 111, 3, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 3, 85, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 86, 15, 15,
+ 15, 15, 15, 15, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 86,
+ 86, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11, 11, 11, 11, 11,
+ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
+ 85, 85, 85, 85, 85, 85, 85, 85, 85, 11, 11, 23, 24, 23, 24, 23, 24,
+ 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 23, 24, 23, 24, 23, 24, 23,
+ 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
+ 23, 24, 23, 24, 23, 24, 85, 21, 21, 21, 21, 21, 21, 21, 21, 23, 24,
+ 23, 24, 163, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 85, 11, 11, 23,
+ 24, 164, 21, 0, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 165, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 85, 21, 15, 15, 15, 15,
+ 15, 15, 15, 86, 15, 15, 15, 86, 15, 15, 15, 15, 86, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 116, 116, 86, 86, 116, 14, 14, 14, 14, 0, 0, 0, 0, 18, 18,
+ 18, 18, 18, 18, 14, 14, 4, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3,
+ 3, 0, 0, 0, 0, 0, 0, 0, 0, 116, 116, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 116, 116, 116, 116, 116, 116, 116,
+ 116, 116, 116, 116, 116, 116, 116, 116, 116, 86, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86,
+ 15, 15, 15, 15, 15, 15, 3, 3, 3, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15,
+ 15, 86, 86, 86, 86, 86, 86, 86, 86, 3, 3, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 86, 116, 116, 86, 86, 86, 86, 116, 116, 86,
+ 116, 116, 116, 116, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 85, 9,
+ 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 86, 86, 86, 86, 86, 86, 116, 116, 86, 86, 116, 116, 86,
+ 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 86, 15, 15, 15, 15, 15,
+ 15, 15, 15, 86, 116, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 3, 3,
+ 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 85, 15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 116, 0, 0, 0, 0, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 15, 86,
+ 86, 86, 15, 15, 86, 86, 15, 15, 15, 15, 15, 86, 86, 15, 86, 15, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 15, 15, 85, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 116,
+ 86, 86, 116, 116, 3, 3, 15, 85, 85, 116, 86, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15,
+ 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
+ 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 116, 116, 86, 116, 116, 86, 116, 116,
+ 3, 116, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15,
+ 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 0, 0, 0, 0, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166,
+ 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166,
+ 166, 166, 166, 166, 166, 166, 166, 166, 167, 167, 167, 167, 167, 167,
+ 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167,
+ 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 15,
+ 86, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 0, 15,
+ 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 11, 11, 11,
+ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 4, 14, 0, 0, 86, 86, 86, 86, 86,
+ 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 3, 3, 3, 3, 3, 3, 5,
+ 6, 3, 0, 0, 0, 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 3, 8, 8, 12, 12, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5,
+ 6, 5, 6, 3, 3, 5, 6, 3, 3, 3, 3, 12, 12, 12, 3, 3, 3, 0, 3, 3, 3, 3,
+ 8, 5, 6, 5, 6, 5, 6, 3, 3, 3, 7, 8, 7, 7, 7, 0, 3, 4, 3, 3, 0, 0, 0,
+ 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 17, 0, 3, 3, 3, 4,
+ 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3,
+ 7, 7, 7, 3, 11, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 5, 7, 6, 7, 5,
+ 6, 3, 5, 6, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 85, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0,
+ 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15,
+ 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14, 7, 7, 7, 7, 14, 14,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14, 0, 0
+#if TCL_UTF_MAX > 3
+ ,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 0, 0, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118,
+ 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118,
+ 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118,
+ 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 118, 18,
+ 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 18, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
- 0, 0, 0, 2, 3, 3, 3, 14, 63, 42, 90, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6,
- 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 8, 5, 6, 6, 14, 90, 90, 90, 90, 90,
- 90, 90, 90, 90, 64, 64, 64, 64, 64, 64, 8, 63, 63, 63, 63, 63, 14,
- 14, 90, 90, 90, 0, 0, 0, 14, 14, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0, 0, 0, 64, 64,
- 11, 11, 63, 63, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 12, 63,
- 63, 63, 0, 0, 0, 0, 0, 0, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0, 0, 0, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 14, 14, 17, 17, 17,
- 17, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 86, 0, 0, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 118, 15, 15, 15, 15, 15, 15, 15, 15, 118, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 15, 15, 15, 15, 0, 0, 0,
+ 0, 15, 15, 15, 15, 15, 15, 15, 15, 3, 118, 118, 118, 118, 118, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 168, 168, 168, 168, 168, 168, 168, 168, 168,
+ 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168,
+ 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168,
+ 168, 168, 168, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169,
+ 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169,
+ 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169,
+ 169, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 0, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, 15, 0, 0, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 0, 3, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 18, 18, 18, 18, 18, 18, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 15,
+ 15, 15, 86, 86, 86, 0, 86, 86, 0, 0, 0, 0, 0, 86, 86, 86, 86, 15, 15,
+ 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
+ 0, 0, 0, 86, 86, 86, 0, 0, 0, 0, 86, 18, 18, 18, 18, 18, 18, 18, 18,
+ 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0,
+ 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, 18, 3, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
+ 0, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 18, 18,
+ 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 116, 86, 116, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3,
+ 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9, 9, 9,
+ 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 116, 116, 116, 86,
+ 86, 86, 86, 116, 116, 86, 86, 3, 3, 17, 3, 3, 3, 3, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0,
+ 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 86, 86,
+ 86, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, 86, 86, 86,
+ 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116, 15, 15,
+ 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9,
+ 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86,
+ 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 116, 86, 0, 0, 0, 0, 0,
+ 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 118, 118, 118, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
+ 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 116, 116,
+ 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116,
+ 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116,
+ 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116,
+ 116, 116, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86,
+ 86, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 15, 15, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 0, 0, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17,
- 17, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 116, 116, 86, 86, 86, 14, 14, 14, 116,
+ 116, 116, 116, 116, 116, 17, 17, 17, 17, 17, 17, 17, 17, 86, 86, 86,
+ 86, 86, 86, 86, 86, 14, 14, 86, 86, 86, 86, 86, 86, 86, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 86, 86, 86, 86, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 86, 86, 86,
+ 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14,
+ 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 21,
+ 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 100, 0,
+ 100, 100, 0, 0, 100, 0, 0, 100, 100, 0, 0, 100, 100, 100, 100, 0, 100,
+ 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, 21, 0, 21, 0, 21, 21,
+ 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 100, 100, 0, 100, 100, 100, 100, 0, 0,
+ 100, 100, 100, 100, 100, 100, 100, 100, 0, 100, 100, 100, 100, 100,
+ 100, 100, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 100, 100, 0, 100, 100,
+ 100, 100, 0, 100, 100, 100, 100, 100, 0, 100, 0, 0, 0, 100, 100, 100,
+ 100, 100, 100, 100, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 100, 100, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 21, 21, 21, 21, 21, 21, 0, 0, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 7, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7,
+ 21, 21, 21, 21, 21, 21, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21,
+ 21, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 7, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100,
+ 100, 100, 100, 100, 100, 100, 100, 100, 7, 21, 21, 21, 21, 21, 21,
+ 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
+ 21, 21, 7, 21, 21, 21, 21, 21, 21, 100, 21, 0, 0, 9, 9, 9, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15,
+ 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15,
+ 0, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15,
+ 15, 15, 15, 0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 15, 0,
+ 15, 0, 15, 0, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 0, 15,
+ 0, 15, 0, 15, 0, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15,
+ 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15,
+ 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
+ 18, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
+ 0, 0, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 0,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 0, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 42, 42, 42, 42, 42, 42, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0, 0, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 0, 14, 0, 0,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14,
+ 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 42, 42, 42, 42, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 121, 121, 121, 121, 121, 121, 121,
- 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121,
- 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, 122, 122, 122,
- 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
- 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
- 122, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
- 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 0,
- 0, 0, 0, 0, 42, 64, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 7, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 42, 42, 42, 42,
- 42, 0, 42, 0, 42, 42, 0, 42, 42, 0, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0, 0, 0, 64, 64, 64, 64,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 8, 8, 12, 12, 5, 6, 5, 6, 5,
- 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 0, 0, 0, 0, 3, 3, 3, 3, 12, 12, 12,
- 3, 3, 3, 0, 3, 3, 3, 3, 8, 5, 6, 5, 6, 5, 6, 3, 3, 3, 7, 8, 7, 7, 7,
- 0, 3, 4, 3, 3, 0, 0, 0, 0, 42, 42, 42, 0, 42, 0, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 0, 0, 88, 0, 3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9,
- 9, 9, 9, 9, 9, 9, 9, 3, 3, 7, 7, 7, 3, 11, 13, 13, 13, 13, 13, 13,
- 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
- 13, 13, 13, 5, 7, 6, 7, 0, 0, 3, 5, 6, 3, 12, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 63, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 63,
- 63, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42,
- 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 42, 0, 0, 0,
- 42, 42, 42, 42, 42, 42, 0, 0, 42, 42, 42, 42, 42, 42, 0, 0, 42, 42,
- 42, 42, 42, 42, 0, 0, 42, 42, 42, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0,
- 14, 7, 7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 88, 88, 88, 14,
- 14, 42, 17, 42, 42, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 123, 123, 123,
- 126, 126, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 89, 64, 14, 14, 14,
- 14, 14, 0, 0, 77, 77, 15, 15, 77, 15, 15, 77, 77, 15, 77, 77, 15, 77,
- 77, 15, 15, 77, 15, 15, 77, 77, 15, 77, 77, 15, 77, 77, 15, 15, 77,
- 15, 15, 77, 77, 15, 77, 77, 15, 77, 77, 15, 15, 77, 77, 15, 15, 77,
- 15, 15, 77, 77, 15, 15, 77, 15, 15, 77, 77, 15, 15, 9, 9, 9, 42, 42,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14,
+ 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 88, 0, 88, 88, 88, 88, 88, 88, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 122, 122,
- 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
- 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
- 122
+ 0
+#endif /* TCL_UTF_MAX > 3 */
};
/*
@@ -818,40 +1350,43 @@ static unsigned char groupMap[] = {
* 101 = sub delta for upper, sub 1 for title
* 110 = sub delta for upper, add delta for lower
*
- * Bits 8-21 Reserved for future use.
- *
- * Bits 22-31 Case delta: delta for case conversions. This should be the
+ * Bits 8-31 Case delta: delta for case conversions. This should be the
* highest field so we can easily sign extend.
*/
-static int groups[] = {
- 0, 15, 12, 25, 27, 21, 22, 26, 20, 9, 134217793, 28, 19, 134217858,
- 29, 2, 23, 11, 1178599554, 24, -507510654, 4194369, 4194434, -834666431,
- 973078658, -507510719, 1258291330, 880803905, 864026689, 859832385,
- 331350081, 847249473, 851443777, 868220993, -406847358, 884998209,
- 876609601, 893386817, 897581121, 914358337, 910164033, 918552641,
- 5, -234880894, 8388705, 4194499, 8388770, 331350146, -406847423,
- -234880959, 880803970, 864026754, 859832450, 847249538, 851443842,
- 868221058, 876609666, 884998274, 893386882, 897581186, 914358402,
- 910164098, 918552706, 4, 6, -352321402, 159383617, 155189313,
- 268435521, 264241217, 159383682, 155189378, 130023554, 268435586,
- 264241282, 260046978, 239075458, 1, 197132418, 226492546, 360710274,
- 335544450, -251658175, 402653314, 335544385, 7, 201326657, 201326722,
- 16, 8, 10, 247464066, -33554302, -33554367, -310378366, -360710014,
- -419430270, -536870782, -469761918, -528482174, -33554365, -37748606,
- -310378431, -37748669, 155189378, -360710079, -419430335, -29359998,
- -469761983, -29360063, -536870847, -528482239, 13, 14, -1463812031,
- -801111999, -293601215, 67108938, 67109002, 109051997, 109052061,
- 18, 17, 8388673, 12582977, 8388738, 12583042
+static const int groups[] = {
+ 0, 15, 12, 25, 27, 21, 22, 26, 20, 9, 8257, 28, 19, 8322, 29,
+ 5, 23, 16, 11, -190078, 24, 2, -30846, 321, 386, -50879, 59522,
+ -30911, 76930, -49790, 53825, 52801, 52545, 20289, 51777, 52033,
+ 53057, -24702, 54081, 53569, -41598, 54593, -33150, 54849, 55873,
+ 55617, 56129, -14206, 609, 451, 674, 20354, -24767, -14271, -33215,
+ 2763585, -41663, 2762817, -2768510, -49855, 17729, 18241, -2760318,
+ -2759550, -2760062, 53890, 52866, 52610, 51842, 52098, 53122,
+ -10823550, -10830718, 53634, 54146, -2750078, -2751614, 54658,
+ 54914, -2745982, 55938, 17794, 55682, 18306, 56194, 4, 6, -21370,
+ 9793, 9537, 16449, 16193, 9858, 9602, 8066, 16514, 16258, 2113,
+ 16002, 14722, 1, 12162, 13954, 2178, 22146, 20610, -1662, -15295,
+ 24706, -1727, 20545, 7, 3905, 3970, 12353, 12418, 8, 1859649,
+ 10, -9044862, -976254, 15234, -1949375, -1918, -1983, -18814,
+ -21886, -25470, -32638, -28542, -32126, -1981, -2174, -18879,
+ -2237, 1844610, -21951, -25535, -28607, -32703, -32191, 13, 14,
+ -1924287, -2145983, -2115007, 7233, 7298, 4170, 4234, 6749, 6813,
+ -2750143, -976319, -2746047, 2763650, 2762882, -2759615, -2751679,
+ -2760383, -2760127, -2768575, 1859714, -9044927, -10823615, -10830783,
+ 18, 17, 10305, 10370
};
+#if TCL_UTF_MAX > 3
+# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1fffff) >= 0x2fa20)
+#else
+# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1f0000) != 0)
+#endif
+
/*
* The following constants are used to determine the category of a
* Unicode character.
*/
-#define UNICODE_CATEGORY_MASK 0X1F
-
enum {
UNASSIGNED,
UPPERCASE_LETTER,
@@ -891,14 +1426,13 @@ enum {
* to do sign extension on right shifts.
*/
-#define GetCaseType(info) (((info) & 0xE0) >> 5)
-#define GetCategory(info) ((info) & 0x1F)
-#define GetDelta(info) (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22)))
+#define GetCaseType(info) (((info) & 0xe0) >> 5)
+#define GetCategory(ch) (GetUniCharInfo(ch) & 0x1f)
+#define GetDelta(info) ((info) >> 8)
/*
* This macro extracts the information about a character from the
* Unicode character tables.
*/
-#define GetUniCharInfo(ch) (groups[groupMap[(pageMap[(((int)(ch)) & 0xffff) >> OFFSET_BITS] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))]])
-
+#define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xffff) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 31e52ba..4b5b37b 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUtf.c,v 1.40 2009/09/07 07:28:38 das Exp $
*/
#include "tclInt.h"
@@ -28,28 +26,27 @@
#define ALPHA_BITS ((1 << UPPERCASE_LETTER) | (1 << LOWERCASE_LETTER) \
| (1 << TITLECASE_LETTER) | (1 << MODIFIER_LETTER) | (1<<OTHER_LETTER))
+#define CONTROL_BITS ((1 << CONTROL) | (1 << FORMAT) | (1 << PRIVATE_USE))
+
#define DIGIT_BITS (1 << DECIMAL_DIGIT_NUMBER)
#define SPACE_BITS ((1 << SPACE_SEPARATOR) | (1 << LINE_SEPARATOR) \
| (1 << PARAGRAPH_SEPARATOR))
-#define CONNECTOR_BITS (1 << CONNECTOR_PUNCTUATION)
-
-#define PRINT_BITS (ALPHA_BITS | DIGIT_BITS | SPACE_BITS | \
- (1 << NON_SPACING_MARK) | (1 << ENCLOSING_MARK) | \
- (1 << COMBINING_SPACING_MARK) | (1 << LETTER_NUMBER) | \
- (1 << OTHER_NUMBER) | (1 << CONNECTOR_PUNCTUATION) | \
- (1 << DASH_PUNCTUATION) | (1 << OPEN_PUNCTUATION) | \
- (1 << CLOSE_PUNCTUATION) | (1 << INITIAL_QUOTE_PUNCTUATION) | \
- (1 << FINAL_QUOTE_PUNCTUATION) | (1 << OTHER_PUNCTUATION) | \
- (1 << MATH_SYMBOL) | (1 << CURRENCY_SYMBOL) | \
- (1 << MODIFIER_SYMBOL) | (1 << OTHER_SYMBOL))
+#define WORD_BITS (ALPHA_BITS | DIGIT_BITS | (1 << CONNECTOR_PUNCTUATION))
#define PUNCT_BITS ((1 << CONNECTOR_PUNCTUATION) | \
(1 << DASH_PUNCTUATION) | (1 << OPEN_PUNCTUATION) | \
(1 << CLOSE_PUNCTUATION) | (1 << INITIAL_QUOTE_PUNCTUATION) | \
(1 << FINAL_QUOTE_PUNCTUATION) | (1 << OTHER_PUNCTUATION))
+#define GRAPH_BITS (WORD_BITS | PUNCT_BITS | \
+ (1 << NON_SPACING_MARK) | (1 << ENCLOSING_MARK) | \
+ (1 << COMBINING_SPACING_MARK) | (1 << LETTER_NUMBER) | \
+ (1 << OTHER_NUMBER) | \
+ (1 << MATH_SYMBOL) | (1 << CURRENCY_SYMBOL) | \
+ (1 << MODIFIER_SYMBOL) | (1 << OTHER_SYMBOL))
+
/*
* Unicode characters less than this value are represented by themselves in
* UTF-8 strings.
@@ -1129,10 +1126,9 @@ Tcl_UniCharToUpper(
int info = GetUniCharInfo(ch);
if (GetCaseType(info) & 0x04) {
- return (Tcl_UniChar) (ch - GetDelta(info));
- } else {
- return ch;
+ ch -= GetDelta(info);
}
+ return (Tcl_UniChar) ch;
}
/*
@@ -1158,10 +1154,9 @@ Tcl_UniCharToLower(
int info = GetUniCharInfo(ch);
if (GetCaseType(info) & 0x02) {
- return (Tcl_UniChar) (ch + GetDelta(info));
- } else {
- return ch;
+ ch += GetDelta(info);
}
+ return (Tcl_UniChar) ch;
}
/*
@@ -1192,12 +1187,11 @@ Tcl_UniCharToTitle(
* Subtract or add one depending on the original case.
*/
- return (Tcl_UniChar) (ch + ((mode & 0x4) ? -1 : 1));
+ ch += ((mode & 0x4) ? -1 : 1);
} else if (mode == 0x4) {
- return (Tcl_UniChar) (ch - GetDelta(info));
- } else {
- return ch;
+ ch -= GetDelta(info);
}
+ return (Tcl_UniChar) ch;
}
/*
@@ -1331,9 +1325,7 @@ int
Tcl_UniCharIsAlnum(
int ch) /* Unicode character to test. */
{
- register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
-
- return (((ALPHA_BITS | DIGIT_BITS) >> category) & 1);
+ return (((ALPHA_BITS | DIGIT_BITS) >> GetCategory(ch)) & 1);
}
/*
@@ -1356,8 +1348,7 @@ int
Tcl_UniCharIsAlpha(
int ch) /* Unicode character to test. */
{
- register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
- return ((ALPHA_BITS >> category) & 1);
+ return ((ALPHA_BITS >> GetCategory(ch)) & 1);
}
/*
@@ -1380,7 +1371,7 @@ int
Tcl_UniCharIsControl(
int ch) /* Unicode character to test. */
{
- return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == CONTROL);
+ return ((CONTROL_BITS >> GetCategory(ch)) & 1);
}
/*
@@ -1403,7 +1394,7 @@ int
Tcl_UniCharIsDigit(
int ch) /* Unicode character to test. */
{
- return (GetUniCharInfo(ch)&UNICODE_CATEGORY_MASK) == DECIMAL_DIGIT_NUMBER;
+ return (GetCategory(ch) == DECIMAL_DIGIT_NUMBER);
}
/*
@@ -1426,8 +1417,7 @@ int
Tcl_UniCharIsGraph(
int ch) /* Unicode character to test. */
{
- register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
- return (((PRINT_BITS >> category) & 1) && ((unsigned char) ch != ' '));
+ return ((GRAPH_BITS >> GetCategory(ch)) & 1);
}
/*
@@ -1450,7 +1440,7 @@ int
Tcl_UniCharIsLower(
int ch) /* Unicode character to test. */
{
- return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == LOWERCASE_LETTER);
+ return (GetCategory(ch) == LOWERCASE_LETTER);
}
/*
@@ -1473,8 +1463,7 @@ int
Tcl_UniCharIsPrint(
int ch) /* Unicode character to test. */
{
- register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
- return ((PRINT_BITS >> category) & 1);
+ return (((GRAPH_BITS|SPACE_BITS) >> GetCategory(ch)) & 1);
}
/*
@@ -1497,8 +1486,7 @@ int
Tcl_UniCharIsPunct(
int ch) /* Unicode character to test. */
{
- register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
- return ((PUNCT_BITS >> category) & 1);
+ return ((PUNCT_BITS >> GetCategory(ch)) & 1);
}
/*
@@ -1521,18 +1509,18 @@ int
Tcl_UniCharIsSpace(
int ch) /* Unicode character to test. */
{
- register int category;
-
/*
* If the character is within the first 127 characters, just use the
* standard C function, otherwise consult the Unicode table.
*/
- if (ch < 0x80) {
+ if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) {
return isspace(UCHAR(ch)); /* INTL: ISO space */
+ } else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x200b
+ || (Tcl_UniChar) ch == 0x2060 || (Tcl_UniChar) ch == 0xfeff) {
+ return 1;
} else {
- category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
- return ((SPACE_BITS >> category) & 1);
+ return ((SPACE_BITS >> GetCategory(ch)) & 1);
}
}
@@ -1556,7 +1544,7 @@ int
Tcl_UniCharIsUpper(
int ch) /* Unicode character to test. */
{
- return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == UPPERCASE_LETTER);
+ return (GetCategory(ch) == UPPERCASE_LETTER);
}
/*
@@ -1579,9 +1567,7 @@ int
Tcl_UniCharIsWordChar(
int ch) /* Unicode character to test. */
{
- register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
-
- return (((ALPHA_BITS | DIGIT_BITS | CONNECTOR_BITS) >> category) & 1);
+ return ((WORD_BITS >> GetCategory(ch)) & 1);
}
/*
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index fb4e20b..13e54ec 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -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.
- *
- * RCS: @(#) $Id: tclUtil.c,v 1.117 2010/08/22 18:53:26 nijtmans Exp $
*/
#include "tclInt.h"
+#include "tclParse.h"
#include <math.h>
/*
@@ -27,31 +26,71 @@ static ProcessGlobalValue executableName = {
};
/*
- * The following values are used in the flags returned by Tcl_ScanElement and
- * used by Tcl_ConvertElement. The values TCL_DONT_USE_BRACES and
- * TCL_DONT_QUOTE_HASH are defined in tcl.h; make sure neither value overlaps
- * with any of the values below.
- *
- * TCL_DONT_USE_BRACES - 1 means the string mustn't be enclosed in
- * braces (e.g. it contains unmatched braces, or
- * ends in a backslash character, or user just
- * doesn't want braces); handle all special
- * characters by adding backslashes.
- * USE_BRACES - 1 means the string contains a special
- * character that can be handled simply by
- * enclosing the entire argument in braces.
- * BRACES_UNMATCHED - 1 means that braces aren't properly matched in
- * the argument.
+ * The following values are used in the flags arguments of Tcl*Scan*Element
+ * and Tcl*Convert*Element. The values TCL_DONT_USE_BRACES and
+ * TCL_DONT_QUOTE_HASH are defined in tcl.h, like so:
+ *
+#define TCL_DONT_USE_BRACES 1
+#define TCL_DONT_QUOTE_HASH 8
+ *
+ * Those are public flag bits which callers of the public routines
+ * Tcl_Convert*Element() can use to indicate:
+ *
+ * TCL_DONT_USE_BRACES - 1 means the caller is insisting that brace
+ * quoting not be used when converting the list
+ * element.
* TCL_DONT_QUOTE_HASH - 1 means the caller insists that a leading hash
* character ('#') should *not* be quoted. This
* is appropriate when the caller can guarantee
* the element is not the first element of a
* list, so [eval] cannot mis-parse the element
* as a comment.
+ *
+ * The remaining values which can be carried by the flags of these routines
+ * are for internal use only. Make sure they do not overlap with the public
+ * values above.
+ *
+ * The Tcl*Scan*Element() routines make a determination which of 4 modes of
+ * conversion is most appropriate for Tcl*Convert*Element() to perform, and
+ * sets two bits of the flags value to indicate the mode selected.
+ *
+ * CONVERT_NONE The element needs no quoting. Its literal string is
+ * suitable as is.
+ * CONVERT_BRACE The conversion should be enclosing the literal string
+ * in braces.
+ * CONVERT_ESCAPE The conversion should be using backslashes to escape
+ * any characters in the string that require it.
+ * CONVERT_MASK A mask value used to extract the conversion mode from
+ * the flags argument.
+ * Also indicates a strange conversion mode where all
+ * special characters are escaped with backslashes
+ * *except for braces*. This is a strange and unnecessary
+ * case, but it's part of the historical way in which
+ * lists have been formatted in Tcl. To experiment with
+ * removing this case, set the value of COMPAT to 0.
+ *
+ * One last flag value is used only by callers of TclScanElement(). The flag
+ * value produced by a call to Tcl*Scan*Element() will never leave this bit
+ * set.
+ *
+ * CONVERT_ANY The caller of TclScanElement() declares it can make no
+ * promise about what public flags will be passed to the
+ * matching call of TclConvertElement(). As such,
+ * TclScanElement() has to determine the worst case
+ * destination buffer length over all possibilities, and
+ * in other cases this means an overestimate of the
+ * required size.
+ *
+ * For more details, see the comments on the Tcl*Scan*Element and
+ * Tcl*Convert*Element routines.
*/
-#define USE_BRACES 2
-#define BRACES_UNMATCHED 4
+#define COMPAT 1
+#define CONVERT_NONE 0
+#define CONVERT_BRACE 2
+#define CONVERT_ESCAPE 4
+#define CONVERT_MASK (CONVERT_BRACE | CONVERT_ESCAPE)
+#define CONVERT_ANY 16
/*
* The following key is used by Tcl_PrintDouble and TclPrecTraceProc to
@@ -88,6 +127,322 @@ const Tcl_ObjType tclEndOffsetType = {
};
/*
+ * * STRING REPRESENTATION OF LISTS * * *
+ *
+ * The next several routines implement the conversions of strings to and from
+ * Tcl lists. To understand their operation, the rules of parsing and
+ * generating the string representation of lists must be known. Here we
+ * describe them in one place.
+ *
+ * A list is made up of zero or more elements. Any string is a list if it is
+ * made up of alternating substrings of element-separating ASCII whitespace
+ * and properly formatted elements.
+ *
+ * The ASCII characters which can make up the whitespace between list elements
+ * are:
+ *
+ * \u0009 \t TAB
+ * \u000A \n NEWLINE
+ * \u000B \v VERTICAL TAB
+ * \u000C \f FORM FEED
+ * \u000D \r CARRIAGE RETURN
+ * \u0020 SPACE
+ *
+ * NOTE: differences between this and other places where Tcl defines a role
+ * for "whitespace".
+ *
+ * * Unlike command parsing, here NEWLINE is just another whitespace
+ * character; its role as a command terminator in a script has no
+ * importance here.
+ *
+ * * Unlike command parsing, the BACKSLASH NEWLINE sequence is not
+ * considered to be a whitespace character.
+ *
+ * * Other Unicode whitespace characters (recognized by [string is space]
+ * or Tcl_UniCharIsSpace()) do not play any role as element separators
+ * in Tcl lists.
+ *
+ * * The NUL byte ought not appear, as it is not in strings properly
+ * encoded for Tcl, but if it is present, it is not treated as
+ * separating whitespace, or a string terminator. It is just another
+ * character in a list element.
+ *
+ * The interpretaton of a formatted substring as a list element follows rules
+ * similar to the parsing of the words of a command in a Tcl script. Backslash
+ * substitution plays a key role, and is defined exactly as it is in command
+ * parsing. The same routine, TclParseBackslash() is used in both command
+ * parsing and list parsing.
+ *
+ * NOTE: This means that if and when backslash substitution rules ever change
+ * for command parsing, the interpretation of strings as lists also changes.
+ *
+ * Backslash substitution replaces an "escape sequence" of one or more
+ * characters starting with
+ * \u005c \ BACKSLASH
+ * with a single character. The one character escape sequent case happens only
+ * when BACKSLASH is the last character in the string. In all other cases, the
+ * escape sequence is at least two characters long.
+ *
+ * The formatted substrings are interpreted as element values according to the
+ * following cases:
+ *
+ * * If the first character of a formatted substring is
+ * \u007b { OPEN BRACE
+ * then the end of the substring is the matching
+ * \u007d } CLOSE BRACE
+ * character, where matching is determined by counting nesting levels, and
+ * not including any brace characters that are contained within a backslash
+ * escape sequence in the nesting count. Having found the matching brace,
+ * all characters between the braces are the string value of the element.
+ * If no matching close brace is found before the end of the string, the
+ * string is not a Tcl list. If the character following the close brace is
+ * not an element separating whitespace character, or the end of the string,
+ * then the string is not a Tcl list.
+ *
+ * NOTE: this differs from a brace-quoted word in the parsing of a Tcl
+ * command only in its treatment of the backslash-newline sequence. In a
+ * list element, the literal characters in the backslash-newline sequence
+ * become part of the element value. In a script word, conversion to a
+ * single SPACE character is done.
+ *
+ * NOTE: Most list element values can be represented by a formatted
+ * substring using brace quoting. The exceptions are any element value that
+ * includes an unbalanced brace not in a backslash escape sequence, and any
+ * value that ends with a backslash not itself in a backslash escape
+ * sequence.
+ *
+ * * If the first character of a formatted substring is
+ * \u0022 " QUOTE
+ * then the end of the substring is the next QUOTE character, not counting
+ * any QUOTE characters that are contained within a backslash escape
+ * sequence. If no next QUOTE is found before the end of the string, the
+ * string is not a Tcl list. If the character following the closing QUOTE is
+ * not an element separating whitespace character, or the end of the string,
+ * then the string is not a Tcl list. Having found the limits of the
+ * substring, the element value is produced by performing backslash
+ * substitution on the character sequence between the open and close QUOTEs.
+ *
+ * NOTE: Any element value can be represented by this style of formatting,
+ * given suitable choice of backslash escape sequences.
+ *
+ * * All other formatted substrings are terminated by the next element
+ * separating whitespace character in the string. Having found the limits
+ * of the substring, the element value is produced by performing backslash
+ * substitution on it.
+ *
+ * NOTE: Any element value can be represented by this style of formatting,
+ * given suitable choice of backslash escape sequences, with one exception.
+ * The empty string cannot be represented as a list element without the use
+ * of either braces or quotes to delimit it.
+ *
+ * This collection of parsing rules is implemented in the routine
+ * TclFindElement().
+ *
+ * In order to produce lists that can be parsed by these rules, we need the
+ * ability to distinguish between characters that are part of a list element
+ * value from characters providing syntax that define the structure of the
+ * list. This means that our code that generates lists must at a minimum be
+ * able to produce escape sequences for the 10 characters identified above
+ * that have significance to a list parser.
+ *
+ * * * CANONICAL LISTS * * * * *
+ *
+ * In addition to the basic rules for parsing strings into Tcl lists, there
+ * are additional properties to be met by the set of list values that are
+ * generated by Tcl. Such list values are often said to be in "canonical
+ * form":
+ *
+ * * When any canonical list is evaluated as a Tcl script, it is a script of
+ * either zero commands (an empty list) or exactly one command. The command
+ * word is exactly the first element of the list, and each argument word is
+ * exactly one of the following elements of the list. This means that any
+ * characters that have special meaning during script evaluation need
+ * special treatment when canonical lists are produced:
+ *
+ * * Whitespace between elements may not include NEWLINE.
+ * * The command terminating character,
+ * \u003b ; SEMICOLON
+ * must be BRACEd, QUOTEd, or escaped so that it does not terminate the
+ * command prematurely.
+ * * Any of the characters that begin substitutions in scripts,
+ * \u0024 $ DOLLAR
+ * \u005b [ OPEN BRACKET
+ * \u005c \ BACKSLASH
+ * need to be BRACEd or escaped.
+ * * In any list where the first character of the first element is
+ * \u0023 # HASH
+ * that HASH character must be BRACEd, QUOTEd, or escaped so that it
+ * does not convert the command into a comment.
+ * * Any list element that contains the character sequence BACKSLASH
+ * NEWLINE cannot be formatted with BRACEs. The BACKSLASH character
+ * must be represented by an escape sequence, and unless QUOTEs are
+ * used, the NEWLINE must be as well.
+ *
+ * * It is also guaranteed that one can use a canonical list as a building
+ * block of a larger script within command substitution, as in this example:
+ * set script "puts \[[list $cmd $arg]]"; eval $script
+ * To support this usage, any appearance of the character
+ * \u005d ] CLOSE BRACKET
+ * in a list element must be BRACEd, QUOTEd, or escaped.
+ *
+ * * Finally it is guaranteed that enclosing a canonical list in braces
+ * produces a new value that is also a canonical list. This new list has
+ * length 1, and its only element is the original canonical list. This same
+ * guarantee also makes it possible to construct scripts where an argument
+ * word is given a list value by enclosing the canonical form of that list
+ * in braces:
+ * set script "puts {[list $one $two $three]}"; eval $script
+ * This sort of coding was once fairly common, though it's become more
+ * idiomatic to see the following instead:
+ * set script [list puts [list $one $two $three]]; eval $script
+ * In order to support this guarantee, every canonical list must have
+ * balance when counting those braces that are not in escape sequences.
+ *
+ * Within these constraints, the canonical list generation routines
+ * TclScanElement() and TclConvertElement() attempt to generate the string for
+ * any list that is easiest to read. When an element value is itself
+ * acceptable as the formatted substring, it is usually used (CONVERT_NONE).
+ * When some quoting or escaping is required, use of BRACEs (CONVERT_BRACE) is
+ * usually preferred over the use of escape sequences (CONVERT_ESCAPE). There
+ * are some exceptions to both of these preferences for reasons of code
+ * simplicity, efficiency, and continuation of historical habits. Canonical
+ * lists never use the QUOTE formatting to delimit their elements because that
+ * form of quoting does not nest, which makes construction of nested lists far
+ * too much trouble. Canonical lists always use only a single SPACE character
+ * for element-separating whitespace.
+ *
+ * * * FUTURE CONSIDERATIONS * * *
+ *
+ * When a list element requires quoting or escaping due to a CLOSE BRACKET
+ * character or an internal QUOTE character, a strange formatting mode is
+ * recommended. For example, if the value "a{b]c}d" is converted by the usual
+ * modes:
+ *
+ * CONVERT_BRACE: a{b]c}d => {a{b]c}d}
+ * CONVERT_ESCAPE: a{b]c}d => a\{b\]c\}d
+ *
+ * we get perfectly usable formatted list elements. However, this is not what
+ * Tcl releases have been producing. Instead, we have:
+ *
+ * CONVERT_MASK: a{b]c}d => a{b\]c}d
+ *
+ * where the CLOSE BRACKET is escaped, but the BRACEs are not. The same effect
+ * can be seen replacing ] with " in this example. There does not appear to be
+ * any functional or aesthetic purpose for this strange additional mode. The
+ * sole purpose I can see for preserving it is to keep generating the same
+ * formatted lists programmers have become accustomed to, and perhaps written
+ * tests to expect. That is, compatibility only. The additional code
+ * complexity required to support this mode is significant. The lines of code
+ * supporting it are delimited in the routines below with #if COMPAT
+ * directives. This makes it easy to experiment with eliminating this
+ * formatting mode simply with "#define COMPAT 0" above. I believe this is
+ * worth considering.
+ *
+ * Another consideration is the treatment of QUOTE characters in list
+ * elements. TclConvertElement() must have the ability to produce the escape
+ * sequence \" so that when a list element begins with a QUOTE we do not
+ * confuse that first character with a QUOTE used as list syntax to define
+ * list structure. However, that is the only place where QUOTE characters need
+ * quoting. In this way, handling QUOTE could really be much more like the way
+ * we handle HASH which also needs quoting and escaping only in particular
+ * situations. Following up this could increase the set of list elements that
+ * can use the CONVERT_NONE formatting mode.
+ *
+ * More speculative is that the demands of canonical list form require brace
+ * balance for the list as a whole, while the current implementation achieves
+ * this by establishing brace balance for every element.
+ *
+ * Finally, a reminder that the rules for parsing and formatting lists are
+ * closely tied together with the rules for parsing and evaluating scripts,
+ * and will need to evolve in sync.
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMaxListLength --
+ *
+ * Given 'bytes' pointing to 'numBytes' bytes, scan through them and
+ * count the number of whitespace runs that could be list element
+ * separators. If 'numBytes' is -1, scan to the terminating '\0'. Not a
+ * full list parser. Typically used to get a quick and dirty overestimate
+ * of length size in order to allocate space for an actual list parser to
+ * operate with.
+ *
+ * Results:
+ * Returns the largest number of list elements that could possibly be in
+ * this string, interpreted as a Tcl list. If 'endPtr' is not NULL,
+ * writes a pointer to the end of the string scanned there.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMaxListLength(
+ const char *bytes,
+ int numBytes,
+ const char **endPtr)
+{
+ int count = 0;
+
+ if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
+ /* Empty string case - quick exit */
+ goto done;
+ }
+
+ /*
+ * No list element before leading white space.
+ */
+
+ count += 1 - TclIsSpaceProc(*bytes);
+
+ /*
+ * Count white space runs as potential element separators.
+ */
+
+ while (numBytes) {
+ if ((numBytes == -1) && (*bytes == '\0')) {
+ break;
+ }
+ if (TclIsSpaceProc(*bytes)) {
+ /*
+ * Space run started; bump count.
+ */
+
+ count++;
+ do {
+ bytes++;
+ numBytes -= (numBytes != -1);
+ } while (numBytes && TclIsSpaceProc(*bytes));
+ if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
+ break;
+ }
+
+ /*
+ * (*bytes) is non-space; return to counting state.
+ */
+ }
+ bytes++;
+ numBytes -= (numBytes != -1);
+ }
+
+ /*
+ * No list element following trailing white space.
+ */
+
+ count -= TclIsSpaceProc(bytes[-1]);
+
+ done:
+ if (endPtr) {
+ *endPtr = bytes;
+ }
+ return count;
+}
+
+/*
*----------------------------------------------------------------------
*
* TclFindElement --
@@ -107,13 +462,18 @@ const Tcl_ObjType tclEndOffsetType = {
* that's part of the element. If this is the last argument in the list,
* then *nextPtr will point just after the last character in the list
* (i.e., at the character at list+listLength). If sizePtr is non-NULL,
- * *sizePtr is filled in with the number of characters in the element. If
- * the element is in braces, then *elementPtr will point to the character
+ * *sizePtr is filled in with the number of bytes in the element. If the
+ * element is in braces, then *elementPtr will point to the character
* after the opening brace and *sizePtr will not include either of the
* braces. If there isn't an element in the list, *sizePtr will be zero,
- * and both *elementPtr and *termPtr will point just after the last
- * character in the list. Note: this function does NOT collapse backslash
- * sequences.
+ * and both *elementPtr and *nextPtr will point just after the last
+ * character in the list. If literalPtr is non-NULL, *literalPtr is set
+ * to a boolean value indicating whether the substring returned as the
+ * values of **elementPtr and *sizePtr is the literal value of a list
+ * element. If not, a call to TclCopyAndCollapse() is needed to produce
+ * the actual value of the list element. Note: this function does NOT
+ * collapse backslash sequences, but uses *literalPtr to tell callers
+ * when it is required for them to do so.
*
* Side effects:
* None.
@@ -137,8 +497,12 @@ TclFindElement(
* argument (next arg or end of list). */
int *sizePtr, /* If non-zero, fill in with size of
* element. */
- int *bracePtr) /* If non-zero, fill in with non-zero/zero to
- * indicate that arg was/wasn't in braces. */
+ int *literalPtr) /* If non-zero, fill in with non-zero/zero to
+ * indicate that the substring of *sizePtr
+ * bytes starting at **elementPtr is/is not
+ * the literal list element and therefore
+ * does not/does require a call to
+ * TclCopyAndCollapse() by the caller. */
{
const char *p = list;
const char *elemStart; /* Points to first byte of first element. */
@@ -147,6 +511,7 @@ TclFindElement(
int inQuotes = 0;
int size = 0; /* lint. */
int numChars;
+ int literal = 1;
const char *p2;
/*
@@ -156,7 +521,7 @@ TclFindElement(
*/
limit = (list + listLength);
- while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
+ while ((p < limit) && (TclIsSpaceProc(*p))) {
p++;
}
if (p == limit) { /* no element found */
@@ -172,9 +537,6 @@ TclFindElement(
p++;
}
elemStart = p;
- if (bracePtr != 0) {
- *bracePtr = openBraces;
- }
/*
* Find element's end (a space, close brace, or the end of the string).
@@ -204,8 +566,7 @@ TclFindElement(
} else if (openBraces == 1) {
size = (p - elemStart);
p++;
- if ((p >= limit)
- || isspace(UCHAR(*p))) { /* INTL: ISO space. */
+ if ((p >= limit) || TclIsSpaceProc(*p)) {
goto done;
}
@@ -215,14 +576,15 @@ TclFindElement(
if (interp != NULL) {
p2 = p;
- while ((p2 < limit)
- && (!isspace(UCHAR(*p2))) /* INTL: ISO space. */
+ while ((p2 < limit) && (!TclIsSpaceProc(*p2))
&& (p2 < p+20)) {
p2++;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"list element in braces followed by \"%.*s\" "
"instead of space", (int) (p2-p), p));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
+ NULL);
}
return TCL_ERROR;
}
@@ -234,7 +596,17 @@ TclFindElement(
*/
case '\\':
- Tcl_UtfBackslash(p, &numChars, NULL);
+ if (openBraces == 0) {
+ /*
+ * A backslash sequence not within a brace quoted element
+ * means the value of the element is different from the
+ * substring we are parsing. A call to TclCopyAndCollapse() is
+ * needed to produce the element value. Inform the caller.
+ */
+
+ literal = 0;
+ }
+ TclParseBackslash(p, limit - p, &numChars, NULL);
p += (numChars - 1);
break;
@@ -263,8 +635,7 @@ TclFindElement(
if (inQuotes) {
size = (p - elemStart);
p++;
- if ((p >= limit)
- || isspace(UCHAR(*p))) { /* INTL: ISO space */
+ if ((p >= limit) || TclIsSpaceProc(*p)) {
goto done;
}
@@ -274,14 +645,15 @@ TclFindElement(
if (interp != NULL) {
p2 = p;
- while ((p2 < limit)
- && (!isspace(UCHAR(*p2))) /* INTL: ISO space */
+ while ((p2 < limit) && (!TclIsSpaceProc(*p2))
&& (p2 < p+20)) {
p2++;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"list element in quotes followed by \"%.*s\" "
"instead of space", (int) (p2-p), p));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
+ NULL);
}
return TCL_ERROR;
}
@@ -297,14 +669,18 @@ TclFindElement(
if (p == limit) {
if (openBraces != 0) {
if (interp != NULL) {
- Tcl_SetResult(interp, "unmatched open brace in list",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unmatched open brace in list", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "BRACE",
+ NULL);
}
return TCL_ERROR;
} else if (inQuotes) {
if (interp != NULL) {
- Tcl_SetResult(interp, "unmatched open quote in list",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unmatched open quote in list", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "QUOTE",
+ NULL);
}
return TCL_ERROR;
}
@@ -312,7 +688,7 @@ TclFindElement(
}
done:
- while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
+ while ((p < limit) && (TclIsSpaceProc(*p))) {
p++;
}
*elementPtr = elemStart;
@@ -320,6 +696,9 @@ TclFindElement(
if (sizePtr != 0) {
*sizePtr = size;
}
+ if (literalPtr != 0) {
+ *literalPtr = literal;
+ }
return TCL_OK;
}
@@ -328,14 +707,13 @@ TclFindElement(
*
* TclCopyAndCollapse --
*
- * Copy a string and eliminate any backslashes that aren't in braces.
+ * Copy a string and substitute all backslash escape sequences
*
* Results:
- * Count characters get copied from src to dst. Along the way, if
- * backslash sequences are found outside braces, the backslashes are
- * eliminated in the copy. After scanning count chars from source, a null
- * character is placed at the end of dst. Returns the number of
- * characters that got copied.
+ * Count bytes get copied from src to dst. Along the way, backslash
+ * sequences are substituted in the copy. After scanning count bytes from
+ * src, a null character is placed at the end of dst. Returns the number
+ * of bytes that got written to dst.
*
* Side effects:
* None.
@@ -345,26 +723,29 @@ TclFindElement(
int
TclCopyAndCollapse(
- int count, /* Number of characters to copy from src. */
+ int count, /* Number of byte to copy from src. */
const char *src, /* Copy from here... */
char *dst) /* ... to here. */
{
- register char c;
- int numRead;
int newCount = 0;
- int backslashCount;
- for (c = *src; count > 0; src++, c = *src, count--) {
+ while (count > 0) {
+ char c = *src;
+
if (c == '\\') {
- backslashCount = Tcl_UtfBackslash(src, &numRead, dst);
+ int numRead;
+ int backslashCount = TclParseBackslash(src, count, &numRead, dst);
+
dst += backslashCount;
newCount += backslashCount;
- src += numRead-1;
- count -= numRead-1;
+ src += numRead;
+ count -= numRead;
} else {
*dst = c;
dst++;
newCount++;
+ src++;
+ count--;
}
}
*dst = 0;
@@ -409,76 +790,55 @@ Tcl_SplitList(
const char ***argvPtr) /* Pointer to place to store pointer to array
* of pointers to list elements. */
{
- const char **argv, *l, *element;
+ const char **argv, *end, *element;
char *p;
- int length, size, i, result, elSize, brace;
+ int length, size, i, result, elSize;
/*
- * Figure out how much space to allocate. There must be enough space for
- * both the array of pointers and also for a copy of the list. To estimate
- * the number of pointers needed, count the number of space characters in
- * the list.
+ * Allocate enough space to work in. A (const char *) for each (possible)
+ * list element plus one more for terminating NULL, plus as many bytes as
+ * in the original string value, plus one more for a terminating '\0'.
+ * Space used to hold element separating white space in the original
+ * string gets re-purposed to hold '\0' characters in the argv array.
*/
- for (size = 2, l = list; *l != 0; l++) {
- if (isspace(UCHAR(*l))) { /* INTL: ISO space. */
- size++;
-
- /*
- * Consecutive space can only count as a single list delimiter.
- */
-
- while (1) {
- char next = *(l + 1);
+ size = TclMaxListLength(list, -1, &end) + 1;
+ length = end - list;
+ argv = ckalloc((size * sizeof(char *)) + length + 1);
- if (next == '\0') {
- break;
- }
- l++;
- if (isspace(UCHAR(next))) { /* INTL: ISO space. */
- continue;
- }
- break;
- }
- }
- }
- length = l - list;
- argv = (const char **) ckalloc((unsigned)
- ((size * sizeof(char *)) + length + 1));
for (i = 0, p = ((char *) argv) + size*sizeof(char *);
*list != 0; i++) {
const char *prevList = list;
+ int literal;
result = TclFindElement(interp, list, length, &element, &list,
- &elSize, &brace);
+ &elSize, &literal);
length -= (list - prevList);
if (result != TCL_OK) {
- if (interp != NULL) {
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", NULL);
- }
- ckfree((char *) argv);
+ ckfree(argv);
return result;
}
if (*element == 0) {
break;
}
if (i >= size) {
- ckfree((char *) argv);
+ ckfree(argv);
if (interp != NULL) {
- Tcl_SetResult(interp, "internal error in Tcl_SplitList",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "internal error in Tcl_SplitList", -1));
+ Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
+ NULL);
}
return TCL_ERROR;
}
argv[i] = p;
- if (brace) {
+ if (literal) {
memcpy(p, element, (size_t) elSize);
p += elSize;
*p = 0;
p++;
} else {
- TclCopyAndCollapse(elSize, element, p);
- p += elSize+1;
+ p += 1 + TclCopyAndCollapse(elSize, element, p);
}
}
@@ -491,128 +851,49 @@ Tcl_SplitList(
/*
*----------------------------------------------------------------------
*
- * TclMarkList --
- *
- * Marks the locations within a string where list elements start and
- * computes where they end.
+ * Tcl_ScanElement --
*
- * Results
- * The return value is normally TCL_OK, which means that the list was
- * successfully split up. If TCL_ERROR is returned, it means that "list"
- * didn't have proper list structure; the interp's result will contain a
- * more detailed error message.
+ * This function is a companion function to Tcl_ConvertElement. It scans
+ * a string to see what needs to be done to it (e.g. add backslashes or
+ * enclosing braces) to make the string into a valid Tcl list element.
*
- * *argvPtr will be filled in with the address of an array whose elements
- * point to the places where the elements of list start, in order.
- * *argcPtr will get filled in with the number of valid elements in the
- * array. *argszPtr will get filled in with the address of an array whose
- * elements are the lengths of the elements of the list, in order.
- * Note: *argvPtr, *argcPtr and *argszPtr are only modified if the
- * function returns normally.
+ * Results:
+ * The return value is an overestimate of the number of bytes that will
+ * be needed by Tcl_ConvertElement to produce a valid list element from
+ * src. The word at *flagPtr is filled in with a value needed by
+ * Tcl_ConvertElement when doing the actual conversion.
*
* Side effects:
- * Memory is allocated.
+ * None.
*
*----------------------------------------------------------------------
*/
int
-TclMarkList(
- Tcl_Interp *interp, /* Interpreter to use for error reporting. If
- * NULL, no error message is left. */
- const char *list, /* Pointer to string with list structure. */
- const char *end, /* Pointer to first char after the list. */
- int *argcPtr, /* Pointer to location to fill in with the
- * number of elements in the list. */
- const int **argszPtr, /* Pointer to place to store length of list
- * elements. */
- const char ***argvPtr) /* Pointer to place to store pointer to array
- * of pointers to list elements. */
+Tcl_ScanElement(
+ register const char *src, /* String to convert to list element. */
+ register int *flagPtr) /* Where to store information to guide
+ * Tcl_ConvertCountedElement. */
{
- const char **argv, *l, *element;
- int *argn, length, size, i, result, elSize, brace;
-
- /*
- * Figure out how much space to allocate. There must be enough space for
- * the array of pointers and lengths. To estimate the number of pointers
- * needed, count the number of whitespace characters in the list.
- */
-
- for (size=2, l=list ; l!=end ; l++) {
- if (isspace(UCHAR(*l))) { /* INTL: ISO space. */
- size++;
-
- /*
- * Consecutive space can only count as a single list delimiter.
- */
-
- while (1) {
- char next = *(l + 1);
-
- if ((l+1) == end) {
- break;
- }
- l++;
- if (isspace(UCHAR(next))) { /* INTL: ISO space. */
- continue;
- }
- break;
- }
- }
- }
- length = l - list;
- argv = (const char **) ckalloc((unsigned) size * sizeof(char *));
- argn = (int *) ckalloc((unsigned) size * sizeof(int *));
-
- for (i = 0; list != end; i++) {
- const char *prevList = list;
-
- result = TclFindElement(interp, list, length, &element, &list,
- &elSize, &brace);
- length -= (list - prevList);
- if (result != TCL_OK) {
- ckfree((char *) argv);
- ckfree((char *) argn);
- return result;
- }
- if (*element == 0) {
- break;
- }
- if (i >= size) {
- ckfree((char *) argv);
- ckfree((char *) argn);
- if (interp != NULL) {
- Tcl_SetResult(interp, "internal error in TclMarkList",
- TCL_STATIC);
- }
- return TCL_ERROR;
- }
- argv[i] = element;
- argn[i] = elSize;
- }
-
- argv[i] = NULL;
- argn[i] = 0;
- *argvPtr = argv;
- *argszPtr = argn;
- *argcPtr = i;
- return TCL_OK;
+ return Tcl_ScanCountedElement(src, -1, flagPtr);
}
/*
*----------------------------------------------------------------------
*
- * Tcl_ScanElement --
+ * Tcl_ScanCountedElement --
*
- * This function is a companion function to Tcl_ConvertElement. It scans
- * a string to see what needs to be done to it (e.g. add backslashes or
- * enclosing braces) to make the string into a valid Tcl list element.
+ * This function is a companion function to Tcl_ConvertCountedElement. It
+ * scans a string to see what needs to be done to it (e.g. add
+ * backslashes or enclosing braces) to make the string into a valid Tcl
+ * list element. If length is -1, then the string is scanned from src up
+ * to the first null byte.
*
* Results:
- * The return value is an overestimate of the number of characters that
- * will be needed by Tcl_ConvertElement to produce a valid list element
- * from string. The word at *flagPtr is filled in with a value needed by
- * Tcl_ConvertElement when doing the actual conversion.
+ * The return value is an overestimate of the number of bytes that will
+ * be needed by Tcl_ConvertCountedElement to produce a valid list element
+ * from src. The word at *flagPtr is filled in with a value needed by
+ * Tcl_ConvertCountedElement when doing the actual conversion.
*
* Side effects:
* None.
@@ -621,30 +902,42 @@ TclMarkList(
*/
int
-Tcl_ScanElement(
- register const char *string,/* String to convert to list element. */
- register int *flagPtr) /* Where to store information to guide
- * Tcl_ConvertCountedElement. */
+Tcl_ScanCountedElement(
+ const char *src, /* String to convert to Tcl list element. */
+ int length, /* Number of bytes in src, or -1. */
+ int *flagPtr) /* Where to store information to guide
+ * Tcl_ConvertElement. */
{
- return Tcl_ScanCountedElement(string, -1, flagPtr);
+ int flags = CONVERT_ANY;
+ int numBytes = TclScanElement(src, length, &flags);
+
+ *flagPtr = flags;
+ return numBytes;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_ScanCountedElement --
+ * TclScanElement --
*
- * This function is a companion function to Tcl_ConvertCountedElement. It
- * scans a string to see what needs to be done to it (e.g. add
- * backslashes or enclosing braces) to make the string into a valid Tcl
- * list element. If length is -1, then the string is scanned up to the
- * first null byte.
+ * This function is a companion function to TclConvertElement. It scans a
+ * string to see what needs to be done to it (e.g. add backslashes or
+ * enclosing braces) to make the string into a valid Tcl list element. If
+ * length is -1, then the string is scanned from src up to the first null
+ * byte. A NULL value for src is treated as an empty string. The incoming
+ * value of *flagPtr is a report from the caller what additional flags it
+ * will pass to TclConvertElement().
*
* Results:
- * The return value is an overestimate of the number of characters that
- * will be needed by Tcl_ConvertCountedElement to produce a valid list
- * element from string. The word at *flagPtr is filled in with a value
- * needed by Tcl_ConvertCountedElement when doing the actual conversion.
+ * The recommended formatting mode for the element is determined and a
+ * value is written to *flagPtr indicating that recommendation. This
+ * recommendation is combined with the incoming flag values in *flagPtr
+ * set by the caller to determine how many bytes will be needed by
+ * TclConvertElement() in which to write the formatted element following
+ * the recommendation modified by the flag values. This number of bytes
+ * is the return value of the routine. In some situations it may be an
+ * overestimate, but so long as the caller passes the same flags to
+ * TclConvertElement(), it will be large enough.
*
* Side effects:
* None.
@@ -653,115 +946,269 @@ Tcl_ScanElement(
*/
int
-Tcl_ScanCountedElement(
- const char *string, /* String to convert to Tcl list element. */
- int length, /* Number of bytes in string, or -1. */
+TclScanElement(
+ const char *src, /* String to convert to Tcl list element. */
+ int length, /* Number of bytes in src, or -1. */
int *flagPtr) /* Where to store information to guide
* Tcl_ConvertElement. */
{
- int flags, nestingLevel;
- register const char *p, *lastChar;
-
- /*
- * This function and Tcl_ConvertElement together do two things:
- *
- * 1. They produce a proper list, one that will yield back the argument
- * strings when evaluated or when disassembled with Tcl_SplitList. This
- * is the most important thing.
- *
- * 2. They try to produce legible output, which means minimizing the use
- * of backslashes (using braces instead). However, there are some
- * situations where backslashes must be used (e.g. an element like
- * "{abc": the leading brace will have to be backslashed. For each
- * element, one of three things must be done:
- *
- * (a) Use the element as-is (it doesn't contain any special
- * characters). This is the most desirable option.
- *
- * (b) Enclose the element in braces, but leave the contents alone.
- * This happens if the element contains embedded space, or if it
- * contains characters with special interpretation ($, [, ;, or \),
- * or if it starts with a brace or double-quote, or if there are no
- * characters in the element.
- *
- * (c) Don't enclose the element in braces, but add backslashes to
- * prevent special interpretation of special characters. This is a
- * last resort used when the argument would normally fall under
- * case (b) but contains unmatched braces. It also occurs if the
- * last character of the argument is a backslash or if the element
- * contains a backslash followed by newline.
- *
- * The function figures out how many bytes will be needed to store the
- * result (actually, it overestimates). It also collects information about
- * the element in the form of a flags word.
- *
- * Note: list elements produced by this function and
- * Tcl_ConvertCountedElement must have the property that they can be
- * enclosing in curly braces to make sub-lists. This means, for example,
- * that we must not leave unmatched curly braces in the resulting list
- * element. This property is necessary in order for functions like
- * Tcl_DStringStartSublist to work.
- */
+ const char *p = src;
+ int nestingLevel = 0; /* Brace nesting count */
+ int forbidNone = 0; /* Do not permit CONVERT_NONE mode. Something
+ * needs protection or escape. */
+ int requireEscape = 0; /* Force use of CONVERT_ESCAPE mode. For some
+ * reason bare or brace-quoted form fails. */
+ int extra = 0; /* Count of number of extra bytes needed for
+ * formatted element, assuming we use escape
+ * sequences in formatting. */
+ int bytesNeeded; /* Buffer length computed to complete the
+ * element formatting in the selected mode. */
+#if COMPAT
+ int preferEscape = 0; /* Use preferences to track whether to use */
+ int preferBrace = 0; /* CONVERT_MASK mode. */
+ int braceCount = 0; /* Count of all braces '{' '}' seen. */
+#endif /* COMPAT */
+
+ if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) {
+ /*
+ * Empty string element must be brace quoted.
+ */
- nestingLevel = 0;
- flags = 0;
- if (string == NULL) {
- string = "";
- }
- if (length == -1) {
- length = strlen(string);
+ *flagPtr = CONVERT_BRACE;
+ return 2;
}
- lastChar = string + length;
- p = string;
- if ((p == lastChar) || (*p == '{') || (*p == '"')) {
- flags |= USE_BRACES;
+
+ if ((*p == '{') || (*p == '"')) {
+ /*
+ * Must escape or protect so leading character of value is not
+ * misinterpreted as list element delimiting syntax.
+ */
+
+ forbidNone = 1;
+#if COMPAT
+ preferBrace = 1;
+#endif /* COMPAT */
}
- for (; p < lastChar; p++) {
+
+ while (length) {
+ if (CHAR_TYPE(*p) != TYPE_NORMAL) {
switch (*p) {
- case '{':
+ case '{': /* TYPE_BRACE */
+#if COMPAT
+ braceCount++;
+#endif /* COMPAT */
+ extra++; /* Escape '{' => '\{' */
nestingLevel++;
break;
- case '}':
+ case '}': /* TYPE_BRACE */
+#if COMPAT
+ braceCount++;
+#endif /* COMPAT */
+ extra++; /* Escape '}' => '\}' */
nestingLevel--;
if (nestingLevel < 0) {
- flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;
+ /*
+ * Unbalanced braces! Cannot format with brace quoting.
+ */
+
+ requireEscape = 1;
}
break;
- case '[':
- case '$':
- case ';':
- case ' ':
- case '\f':
- case '\n':
- case '\r':
- case '\t':
- case '\v':
- flags |= USE_BRACES;
+ case ']': /* TYPE_CLOSE_BRACK */
+ case '"': /* TYPE_SPACE */
+#if COMPAT
+ forbidNone = 1;
+ extra++; /* Escapes all just prepend a backslash */
+ preferEscape = 1;
break;
- case '\\':
- if ((p+1 == lastChar) || (p[1] == '\n')) {
- flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
- } else {
- int size;
+#else
+ /* FLOW THROUGH */
+#endif /* COMPAT */
+ case '[': /* TYPE_SUBS */
+ case '$': /* TYPE_SUBS */
+ case ';': /* TYPE_COMMAND_END */
+ case ' ': /* TYPE_SPACE */
+ case '\f': /* TYPE_SPACE */
+ case '\n': /* TYPE_COMMAND_END */
+ case '\r': /* TYPE_SPACE */
+ case '\t': /* TYPE_SPACE */
+ case '\v': /* TYPE_SPACE */
+ forbidNone = 1;
+ extra++; /* Escape sequences all one byte longer. */
+#if COMPAT
+ preferBrace = 1;
+#endif /* COMPAT */
+ break;
+ case '\\': /* TYPE_SUBS */
+ extra++; /* Escape '\' => '\\' */
+ if ((length == 1) || ((length == -1) && (p[1] == '\0'))) {
+ /*
+ * Final backslash. Cannot format with brace quoting.
+ */
+
+ requireEscape = 1;
+ break;
+ }
+ if (p[1] == '\n') {
+ extra++; /* Escape newline => '\n', one byte longer */
+
+ /*
+ * Backslash newline sequence. Brace quoting not permitted.
+ */
- Tcl_UtfBackslash(p, &size, NULL);
- p += size-1;
- flags |= USE_BRACES;
+ requireEscape = 1;
+ length -= (length > 0);
+ p++;
+ break;
}
+ if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) {
+ extra++; /* Escape sequences all one byte longer. */
+ length -= (length > 0);
+ p++;
+ }
+ forbidNone = 1;
+#if COMPAT
+ preferBrace = 1;
+#endif /* COMPAT */
+ break;
+ case '\0': /* TYPE_SUBS */
+ if (length == -1) {
+ goto endOfString;
+ }
+ /* TODO: Panic on improper encoding? */
break;
}
+ }
+ length -= (length > 0);
+ p++;
}
+
+ endOfString:
if (nestingLevel != 0) {
- flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
+ /*
+ * Unbalanced braces! Cannot format with brace quoting.
+ */
+
+ requireEscape = 1;
}
- *flagPtr = flags;
/*
- * Allow enough space to backslash every character plus leave two spaces
- * for braces.
+ * We need at least as many bytes as are in the element value...
*/
- return 2*(p-string) + 2;
+ bytesNeeded = p - src;
+
+ if (requireEscape) {
+ /*
+ * We must use escape sequences. Add all the extra bytes needed to
+ * have room to create them.
+ */
+
+ bytesNeeded += extra;
+
+ /*
+ * Make room to escape leading #, if needed.
+ */
+
+ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
+ bytesNeeded++;
+ }
+ *flagPtr = CONVERT_ESCAPE;
+ goto overflowCheck;
+ }
+ if (*flagPtr & CONVERT_ANY) {
+ /*
+ * The caller has not let us know what flags it will pass to
+ * TclConvertElement() so compute the max size we might need for any
+ * possible choice. Normally the formatting using escape sequences is
+ * the longer one, and a minimum "extra" value of 2 makes sure we
+ * don't request too small a buffer in those edge cases where that's
+ * not true.
+ */
+
+ if (extra < 2) {
+ extra = 2;
+ }
+ *flagPtr &= ~CONVERT_ANY;
+ *flagPtr |= TCL_DONT_USE_BRACES;
+ }
+ if (forbidNone) {
+ /*
+ * We must request some form of quoting of escaping...
+ */
+
+#if COMPAT
+ if (preferEscape && !preferBrace) {
+ /*
+ * If we are quoting solely due to ] or internal " characters use
+ * the CONVERT_MASK mode where we escape all special characters
+ * except for braces. "extra" counted space needed to escape
+ * braces too, so substract "braceCount" to get our actual needs.
+ */
+
+ bytesNeeded += (extra - braceCount);
+ /* Make room to escape leading #, if needed. */
+ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
+ bytesNeeded++;
+ }
+
+ /*
+ * If the caller reports it will direct TclConvertElement() to
+ * use full escapes on the element, add back the bytes needed to
+ * escape the braces.
+ */
+
+ if (*flagPtr & TCL_DONT_USE_BRACES) {
+ bytesNeeded += braceCount;
+ }
+ *flagPtr = CONVERT_MASK;
+ goto overflowCheck;
+ }
+#endif /* COMPAT */
+ if (*flagPtr & TCL_DONT_USE_BRACES) {
+ /*
+ * If the caller reports it will direct TclConvertElement() to
+ * use escapes, add the extra bytes needed to have room for them.
+ */
+
+ bytesNeeded += extra;
+
+ /*
+ * Make room to escape leading #, if needed.
+ */
+
+ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
+ bytesNeeded++;
+ }
+ } else {
+ /*
+ * Add 2 bytes for room for the enclosing braces.
+ */
+
+ bytesNeeded += 2;
+ }
+ *flagPtr = CONVERT_BRACE;
+ goto overflowCheck;
+ }
+
+ /*
+ * So far, no need to quote or escape anything.
+ */
+
+ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
+ /*
+ * If we need to quote a leading #, make room to enclose in braces.
+ */
+
+ bytesNeeded += 2;
+ }
+ *flagPtr = CONVERT_NONE;
+
+ overflowCheck:
+ if (bytesNeeded < 0) {
+ Tcl_Panic("TclScanElement: string length overflow");
+ }
+ return bytesNeeded;
}
/*
@@ -822,125 +1269,191 @@ Tcl_ConvertCountedElement(
char *dst, /* Place to put list-ified element. */
int flags) /* Flags produced by Tcl_ScanElement. */
{
- register char *p = dst;
- register const char *lastChar;
+ int numBytes = TclConvertElement(src, length, dst, flags);
+ dst[numBytes] = '\0';
+ return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclConvertElement --
+ *
+ * This is a companion function to TclScanElement. Given the information
+ * produced by TclScanElement, this function converts a string to a list
+ * element equal to that string.
+ *
+ * Results:
+ * Information is copied to *dst in the form of a list element identical
+ * to src (i.e. if Tcl_SplitList is applied to dst it will produce a
+ * string identical to src). The return value is a count of the number of
+ * characters copied (not including the terminating NULL character).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclConvertElement(
+ register const char *src, /* Source information for list element. */
+ int length, /* Number of bytes in src, or -1. */
+ char *dst, /* Place to put list-ified element. */
+ int flags) /* Flags produced by Tcl_ScanElement. */
+{
+ int conversion = flags & CONVERT_MASK;
+ char *p = dst;
/*
- * See the comment block at the beginning of the Tcl_ScanElement code for
- * details of how this works.
+ * Let the caller demand we use escape sequences rather than braces.
*/
- if (src && length == -1) {
- length = strlen(src);
+ if ((flags & TCL_DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) {
+ conversion = CONVERT_ESCAPE;
}
- if ((src == NULL) || (length == 0)) {
- p[0] = '{';
- p[1] = '}';
- p[2] = 0;
- return 2;
+
+ /*
+ * No matter what the caller demands, empty string must be braced!
+ */
+
+ if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) {
+ src = tclEmptyStringRep;
+ length = 0;
+ conversion = CONVERT_BRACE;
}
- lastChar = src + length;
+
+ /*
+ * Escape leading hash as needed and requested.
+ */
+
if ((*src == '#') && !(flags & TCL_DONT_QUOTE_HASH)) {
- flags |= USE_BRACES;
+ if (conversion == CONVERT_ESCAPE) {
+ p[0] = '\\';
+ p[1] = '#';
+ p += 2;
+ src++;
+ length -= (length > 0);
+ } else {
+ conversion = CONVERT_BRACE;
+ }
+ }
+
+ /*
+ * No escape or quoting needed. Copy the literal string value.
+ */
+
+ if (conversion == CONVERT_NONE) {
+ if (length == -1) {
+ /* TODO: INT_MAX overflow? */
+ while (*src) {
+ *p++ = *src++;
+ }
+ return p - dst;
+ } else {
+ memcpy(dst, src, length);
+ return length;
+ }
}
- if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {
+
+ /*
+ * Formatted string is original string enclosed in braces.
+ */
+
+ if (conversion == CONVERT_BRACE) {
*p = '{';
p++;
- for (; src != lastChar; src++, p++) {
- *p = *src;
+ if (length == -1) {
+ /* TODO: INT_MAX overflow? */
+ while (*src) {
+ *p++ = *src++;
+ }
+ } else {
+ memcpy(p, src, length);
+ p += length;
}
*p = '}';
p++;
- } else {
- if (*src == '{') {
- /*
- * Can't have a leading brace unless the whole element is enclosed
- * in braces. Add a backslash before the brace. Furthermore, this
- * may destroy the balance between open and close braces, so set
- * BRACES_UNMATCHED.
- */
+ return p - dst;
+ }
- p[0] = '\\';
- p[1] = '{';
- p += 2;
- src++;
- flags |= BRACES_UNMATCHED;
- } else if ((*src == '#') && !(flags & TCL_DONT_QUOTE_HASH)) {
- /*
- * Leading '#' could be seen by [eval] as the start of a comment,
- * if on the first element of a list, so quote it.
- */
+ /* conversion == CONVERT_ESCAPE or CONVERT_MASK */
- p[0] = '\\';
- p[1] = '#';
- p += 2;
- src++;
- }
- for (; src != lastChar; src++) {
- switch (*src) {
- case ']':
- case '[':
- case '$':
- case ';':
- case ' ':
- case '\\':
- case '"':
- *p = '\\';
- p++;
- break;
- case '{':
- case '}':
- /*
- * It may not seem necessary to backslash braces, but it is.
- * The reason for this is that the resulting list element may
- * actually be an element of a sub-list enclosed in braces
- * (e.g. if Tcl_DStringStartSublist has been invoked), so
- * there may be a brace mismatch if the braces aren't
- * backslashed.
- */
+ /*
+ * Formatted string is original string converted to escape sequences.
+ */
- if (flags & BRACES_UNMATCHED) {
- *p = '\\';
- p++;
- }
- break;
- case '\f':
- *p = '\\';
- p++;
- *p = 'f';
- p++;
- continue;
- case '\n':
- *p = '\\';
- p++;
- *p = 'n';
- p++;
- continue;
- case '\r':
- *p = '\\';
- p++;
- *p = 'r';
- p++;
- continue;
- case '\t':
- *p = '\\';
- p++;
- *p = 't';
- p++;
- continue;
- case '\v':
+ for ( ; length; src++, length -= (length > 0)) {
+ switch (*src) {
+ case ']':
+ case '[':
+ case '$':
+ case ';':
+ case ' ':
+ case '\\':
+ case '"':
+ *p = '\\';
+ p++;
+ break;
+ case '{':
+ case '}':
+#if COMPAT
+ if (conversion == CONVERT_ESCAPE)
+#endif /* COMPAT */
+ {
*p = '\\';
p++;
- *p = 'v';
- p++;
- continue;
}
- *p = *src;
+ break;
+ case '\f':
+ *p = '\\';
+ p++;
+ *p = 'f';
+ p++;
+ continue;
+ case '\n':
+ *p = '\\';
+ p++;
+ *p = 'n';
+ p++;
+ continue;
+ case '\r':
+ *p = '\\';
+ p++;
+ *p = 'r';
+ p++;
+ continue;
+ case '\t':
+ *p = '\\';
p++;
+ *p = 't';
+ p++;
+ continue;
+ case '\v':
+ *p = '\\';
+ p++;
+ *p = 'v';
+ p++;
+ continue;
+ case '\0':
+ if (length == -1) {
+ return p - dst;
+ }
+
+ /*
+ * If we reach this point, there's an embedded NULL in the string
+ * range being processed, which should not happen when the
+ * encoding rules for Tcl strings are properly followed. If the
+ * day ever comes when we stop tolerating such things, this is
+ * where to put the Tcl_Panic().
+ */
+
+ break;
}
+ *p = *src;
+ p++;
}
- *p = '\0';
- return p-dst;
+ return p - dst;
}
/*
@@ -968,12 +1481,22 @@ Tcl_Merge(
int argc, /* How many strings to merge. */
const char *const *argv) /* Array of string values. */
{
-# define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr;
- int numChars;
- char *result;
- char *dst;
- int i;
+#define LOCAL_SIZE 20
+ int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+ int i, bytesNeeded = 0;
+ char *result, *dst;
+ const int maxFlags = UINT_MAX / sizeof(int);
+
+ /*
+ * Handle empty list case first, so logic of the general case can be
+ * simpler.
+ */
+
+ if (argc == 0) {
+ result = ckalloc(1);
+ result[0] = '\0';
+ return result;
+ }
/*
* Pass 1: estimate space, gather flags.
@@ -981,35 +1504,51 @@ Tcl_Merge(
if (argc <= LOCAL_SIZE) {
flagPtr = localFlags;
+ } else if (argc > maxFlags) {
+ /*
+ * We cannot allocate a large enough flag array to format this list in
+ * one pass. We could imagine converting this routine to a multi-pass
+ * implementation, but for sizeof(int) == 4, the limit is a max of
+ * 2^30 list elements and since each element is at least one byte
+ * formatted, and requires one byte space between it and the next one,
+ * that a minimum space requirement of 2^31 bytes, which is already
+ * INT_MAX. If we tried to format a list of > maxFlags elements, we're
+ * just going to overflow the size limits on the formatted string
+ * anyway, so just issue that same panic early.
+ */
+
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
} else {
- flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
+ flagPtr = ckalloc(argc * sizeof(int));
}
- numChars = 1;
for (i = 0; i < argc; i++) {
- numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;
+ flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
+ bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]);
+ if (bytesNeeded < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
}
+ if (bytesNeeded > INT_MAX - argc + 1) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+ bytesNeeded += argc;
/*
* Pass two: copy into the result area.
*/
- result = (char *) ckalloc((unsigned) numChars);
+ result = ckalloc(bytesNeeded);
dst = result;
for (i = 0; i < argc; i++) {
- numChars = Tcl_ConvertElement(argv[i], dst,
- flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
- dst += numChars;
+ flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
+ dst += TclConvertElement(argv[i], -1, dst, flagPtr[i]);
*dst = ' ';
dst++;
}
- if (dst == result) {
- *dst = 0;
- } else {
- dst[-1] = 0;
- }
+ dst[-1] = 0;
if (flagPtr != localFlags) {
- ckfree((char *) flagPtr);
+ ckfree(flagPtr);
}
return result;
}
@@ -1051,6 +1590,167 @@ Tcl_Backslash(
/*
*----------------------------------------------------------------------
*
+ * TclTrimRight --
+ *
+ * Takes two counted strings in the Tcl encoding which must both be null
+ * terminated. Conceptually trims from the right side of the first string
+ * all characters found in the second string.
+ *
+ * Results:
+ * The number of bytes to be removed from the end of the string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclTrimRight(
+ const char *bytes, /* String to be trimmed... */
+ int numBytes, /* ...and its length in bytes */
+ const char *trim, /* String of trim characters... */
+ int numTrim) /* ...and its length in bytes */
+{
+ const char *p = bytes + numBytes;
+ int pInc;
+
+ if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
+ Tcl_Panic("TclTrimRight works only on null-terminated strings");
+ }
+
+ /*
+ * Empty strings -> nothing to do.
+ */
+
+ if ((numBytes == 0) || (numTrim == 0)) {
+ return 0;
+ }
+
+ /*
+ * Outer loop: iterate over string to be trimmed.
+ */
+
+ do {
+ Tcl_UniChar ch1;
+ const char *q = trim;
+ int bytesLeft = numTrim;
+
+ p = Tcl_UtfPrev(p, bytes);
+ pInc = TclUtfToUniChar(p, &ch1);
+
+ /*
+ * Inner loop: scan trim string for match to current character.
+ */
+
+ do {
+ Tcl_UniChar ch2;
+ int qInc = TclUtfToUniChar(q, &ch2);
+
+ if (ch1 == ch2) {
+ break;
+ }
+
+ q += qInc;
+ bytesLeft -= qInc;
+ } while (bytesLeft);
+
+ if (bytesLeft == 0) {
+ /*
+ * No match; trim task done; *p is last non-trimmed char.
+ */
+
+ p += pInc;
+ break;
+ }
+ } while (p > bytes);
+
+ return numBytes - (p - bytes);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTrimLeft --
+ *
+ * Takes two counted strings in the Tcl encoding which must both be null
+ * terminated. Conceptually trims from the left side of the first string
+ * all characters found in the second string.
+ *
+ * Results:
+ * The number of bytes to be removed from the start of the string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclTrimLeft(
+ const char *bytes, /* String to be trimmed... */
+ int numBytes, /* ...and its length in bytes */
+ const char *trim, /* String of trim characters... */
+ int numTrim) /* ...and its length in bytes */
+{
+ const char *p = bytes;
+
+ if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
+ Tcl_Panic("TclTrimLeft works only on null-terminated strings");
+ }
+
+ /*
+ * Empty strings -> nothing to do.
+ */
+
+ if ((numBytes == 0) || (numTrim == 0)) {
+ return 0;
+ }
+
+ /*
+ * Outer loop: iterate over string to be trimmed.
+ */
+
+ do {
+ Tcl_UniChar ch1;
+ int pInc = TclUtfToUniChar(p, &ch1);
+ const char *q = trim;
+ int bytesLeft = numTrim;
+
+ /*
+ * Inner loop: scan trim string for match to current character.
+ */
+
+ do {
+ Tcl_UniChar ch2;
+ int qInc = TclUtfToUniChar(q, &ch2);
+
+ if (ch1 == ch2) {
+ break;
+ }
+
+ q += qInc;
+ bytesLeft -= qInc;
+ } while (bytesLeft);
+
+ if (bytesLeft == 0) {
+ /*
+ * No match; trim task done; *p is first non-trimmed char.
+ */
+
+ break;
+ }
+
+ p += pInc;
+ numBytes -= pInc;
+ } while (numBytes);
+
+ return p - bytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_Concat --
*
* Concatenate a set of strings into a single large string.
@@ -1067,56 +1767,97 @@ Tcl_Backslash(
*----------------------------------------------------------------------
*/
+/* The whitespace characters trimmed during [concat] operations */
+#define CONCAT_WS " \f\v\r\t\n"
+#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_WS "") - 1)
+
char *
Tcl_Concat(
int argc, /* Number of strings to concatenate. */
const char *const *argv) /* Array of strings to concatenate. */
{
- int totalSize, i;
- char *p;
- char *result;
+ int i, needSpace = 0, bytesNeeded = 0;
+ char *result, *p;
+
+ /*
+ * Dispose of the empty result corner case first to simplify later code.
+ */
- for (totalSize = 1, i = 0; i < argc; i++) {
- totalSize += strlen(argv[i]) + 1;
- }
- result = (char *) ckalloc((unsigned) totalSize);
if (argc == 0) {
- *result = '\0';
+ result = (char *) ckalloc(1);
+ result[0] = '\0';
return result;
}
- for (p = result, i = 0; i < argc; i++) {
- const char *element;
- int length;
+ /*
+ * First allocate the result buffer at the size required.
+ */
+
+ for (i = 0; i < argc; i++) {
+ bytesNeeded += strlen(argv[i]);
+ if (bytesNeeded < 0) {
+ Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
+ }
+ }
+ if (bytesNeeded + argc - 1 < 0) {
/*
- * Clip white space off the front and back of the string to generate a
- * neater result, and ignore any empty elements.
+ * Panic test could be tighter, but not going to bother for this
+ * legacy routine.
*/
+ Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
+ }
+
+ /*
+ * All element bytes + (argc - 1) spaces + 1 terminating NULL.
+ */
+
+ result = ckalloc((unsigned) (bytesNeeded + argc));
+
+ for (p = result, i = 0; i < argc; i++) {
+ int trim, elemLength;
+ const char *element;
+
element = argv[i];
- while (isspace(UCHAR(*element))) { /* INTL: ISO space. */
- element++;
- }
- for (length = strlen(element);
- (length > 0)
- && (isspace(UCHAR(element[length-1]))) /* INTL: ISO space. */
- && ((length < 2) || (element[length-2] != '\\'));
- length--) {
- /* Null loop body. */
- }
- if (length == 0) {
+ elemLength = strlen(argv[i]);
+
+ /*
+ * Trim away the leading whitespace.
+ */
+
+ trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+ element += trim;
+ elemLength -= trim;
+
+ /*
+ * Trim away the trailing whitespace. Do not permit trimming to expose
+ * a final backslash character.
+ */
+
+ trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+ trim -= trim && (element[elemLength - trim - 1] == '\\');
+ elemLength -= trim;
+
+ /*
+ * If we're left with empty element after trimming, do nothing.
+ */
+
+ if (elemLength == 0) {
continue;
}
- memcpy(p, element, (size_t) length);
- p += length;
- *p = ' ';
- p++;
- }
- if (p != result) {
- p[-1] = 0;
- } else {
- *p = 0;
+
+ /*
+ * Append to the result with space if needed.
+ */
+
+ if (needSpace) {
+ *p++ = ' ';
+ }
+ memcpy(p, element, (size_t) elemLength);
+ p += elemLength;
+ needSpace = 1;
}
+ *p = '\0';
return result;
}
@@ -1143,64 +1884,39 @@ Tcl_ConcatObj(
int objc, /* Number of objects to concatenate. */
Tcl_Obj *const objv[]) /* Array of objects to concatenate. */
{
- int allocSize, finalSize, length, elemLength, i;
- char *p;
+ int i, elemLength, needSpace = 0, bytesNeeded = 0;
const char *element;
- char *concatStr;
Tcl_Obj *objPtr, *resPtr;
/*
* Check first to see if all the items are of list type or empty. If so,
* we will concat them together as lists, and return a list object. This
- * is only valid when the lists have no current string representation,
- * since we don't know what the original type was. An original string rep
- * may have lost some whitespace info when converted which could be
- * important.
+ * is only valid when the lists are in canonical form.
*/
for (i = 0; i < objc; i++) {
- List *listRepPtr;
+ int length;
objPtr = objv[i];
- if (objPtr->typePtr != &tclListType) {
- TclGetString(objPtr);
- if (objPtr->length) {
- break;
- } else {
- continue;
- }
+ if (TclListObjIsCanonical(objPtr)) {
+ continue;
}
- listRepPtr = (List *) objPtr->internalRep.twoPtrValue.ptr1;
- if (objPtr->bytes != NULL && !listRepPtr->canonicalFlag) {
+ Tcl_GetStringFromObj(objPtr, &length);
+ if (length > 0) {
break;
}
}
if (i == objc) {
- Tcl_Obj **listv;
- int listc;
-
resPtr = NULL;
for (i = 0; i < objc; i++) {
- /*
- * Tcl_ListObjAppendList could be used here, but this saves us a
- * bit of type checking (since we've already done it). Use of
- * INT_MAX tells us to always put the new stuff on the end. It
- * will be set right in Tcl_ListObjReplace.
- * Note that all objs at this point are either lists or have an
- * empty string rep.
- */
-
objPtr = objv[i];
- if (objPtr->bytes && !objPtr->length) {
+ if (objPtr->bytes && objPtr->length == 0) {
continue;
}
- TclListObjGetElements(NULL, objPtr, &listc, &listv);
- if (listc) {
- if (resPtr) {
- Tcl_ListObjReplace(NULL, resPtr, INT_MAX, 0, listc, listv);
- } else {
- resPtr = TclListObjCopy(NULL, objPtr);
- }
+ if (resPtr) {
+ Tcl_ListObjAppendList(NULL, resPtr, objPtr);
+ } else {
+ resPtr = TclListObjCopy(NULL, objPtr);
}
}
if (!resPtr) {
@@ -1212,81 +1928,69 @@ Tcl_ConcatObj(
/*
* Something cannot be determined to be safe, so build the concatenation
* the slow way, using the string representations.
+ *
+ * First try to pre-allocate the size required.
*/
- allocSize = 0;
for (i = 0; i < objc; i++) {
- objPtr = objv[i];
- element = TclGetStringFromObj(objPtr, &length);
- if ((element != NULL) && (length > 0)) {
- allocSize += (length + 1);
+ element = TclGetStringFromObj(objv[i], &elemLength);
+ bytesNeeded += elemLength;
+ if (bytesNeeded < 0) {
+ break;
}
}
- if (allocSize == 0) {
- allocSize = 1; /* enough for the NULL byte at end */
- }
/*
- * Allocate storage for the concatenated result. Note that allocSize is
- * one more than the total number of characters, and so includes room for
- * the terminating NULL byte.
+ * Does not matter if this fails, will simply try later to build up the
+ * string with each Append reallocating as needed with the usual string
+ * append algorithm. When that fails it will report the error.
*/
- concatStr = ckalloc((unsigned) allocSize);
+ TclNewObj(resPtr);
+ Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
+ Tcl_SetObjLength(resPtr, 0);
- /*
- * Now concatenate the elements. Clip white space off the front and back
- * to generate a neater result, and ignore any empty elements. Also put a
- * null byte at the end.
- */
+ for (i = 0; i < objc; i++) {
+ int trim;
+
+ element = TclGetStringFromObj(objv[i], &elemLength);
- finalSize = 0;
- if (objc == 0) {
- *concatStr = '\0';
- } else {
- p = concatStr;
- for (i = 0; i < objc; i++) {
- objPtr = objv[i];
- element = TclGetStringFromObj(objPtr, &elemLength);
- while ((elemLength > 0) && (UCHAR(*element) < 127)
- && isspace(UCHAR(*element))) { /* INTL: ISO C space. */
- element++;
- elemLength--;
- }
+ /*
+ * Trim away the leading whitespace.
+ */
- /*
- * Trim trailing white space. But, be careful not to trim a space
- * character if it is preceded by a backslash: in this case it
- * could be significant.
- */
+ trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+ element += trim;
+ elemLength -= trim;
- while ((elemLength > 0) && (UCHAR(element[elemLength-1]) < 127)
- && isspace(UCHAR(element[elemLength-1]))
- /* INTL: ISO C space. */
- && ((elemLength < 2) || (element[elemLength-2] != '\\'))) {
- elemLength--;
- }
- if (elemLength == 0) {
- continue; /* nothing left of this element */
- }
- memcpy(p, element, (size_t) elemLength);
- p += elemLength;
- *p = ' ';
- p++;
- finalSize += (elemLength + 1);
+ /*
+ * Trim away the trailing whitespace. Do not permit trimming to expose
+ * a final backslash character.
+ */
+
+ trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+ trim -= trim && (element[elemLength - trim - 1] == '\\');
+ elemLength -= trim;
+
+ /*
+ * If we're left with empty element after trimming, do nothing.
+ */
+
+ if (elemLength == 0) {
+ continue;
}
- if (p != concatStr) {
- p[-1] = 0;
- finalSize -= 1; /* we overwrote the final ' ' */
- } else {
- *p = 0;
+
+ /*
+ * Append to the result with space if needed.
+ */
+
+ if (needSpace) {
+ Tcl_AppendToObj(resPtr, " ", 1);
}
+ Tcl_AppendToObj(resPtr, element, elemLength);
+ needSpace = 1;
}
-
- TclNewObj(objPtr);
- objPtr->bytes = concatStr;
- objPtr->length = finalSize;
- return objPtr;
+ return resPtr;
}
/*
@@ -1683,6 +2387,7 @@ TclByteArrayMatch(
/*
* Matches ranges of form [a-z] or [z-a].
*/
+
break;
}
} else if (startChar == ch1) {
@@ -1729,9 +2434,9 @@ TclByteArrayMatch(
*
* TclStringMatchObj --
*
- * See if a particular string matches a particular pattern.
- * Allows case insensitivity. This is the generic multi-type handler
- * for the various matching algorithms.
+ * See if a particular string matches a particular pattern. Allows case
+ * insensitivity. This is the generic multi-type handler for the various
+ * matching algorithms.
*
* Results:
* The return value is 1 if string matches pattern, and 0 otherwise. The
@@ -1835,8 +2540,6 @@ Tcl_DStringAppend(
* at end. */
{
int newSize;
- char *dst;
- const char *end;
if (length < 0) {
length = strlen(bytes);
@@ -1852,13 +2555,12 @@ Tcl_DStringAppend(
if (newSize >= dsPtr->spaceAvl) {
dsPtr->spaceAvl = newSize * 2;
if (dsPtr->string == dsPtr->staticSpace) {
- char *newString = ckalloc((unsigned) dsPtr->spaceAvl);
+ char *newString = ckalloc(dsPtr->spaceAvl);
memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
dsPtr->string = newString;
} else {
- dsPtr->string = ckrealloc((void *) dsPtr->string,
- (size_t) dsPtr->spaceAvl);
+ dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
}
}
@@ -1866,18 +2568,46 @@ Tcl_DStringAppend(
* Copy the new string into the buffer at the end of the old one.
*/
- for (dst = dsPtr->string + dsPtr->length, end = bytes+length;
- bytes < end; bytes++, dst++) {
- *dst = *bytes;
- }
- *dst = '\0';
+ memcpy(dsPtr->string + dsPtr->length, bytes, length);
dsPtr->length += length;
+ dsPtr->string[dsPtr->length] = '\0';
return dsPtr->string;
}
/*
*----------------------------------------------------------------------
*
+ * TclDStringAppendObj, TclDStringAppendDString --
+ *
+ * Simple wrappers round Tcl_DStringAppend that make it easier to append
+ * from particular sources of strings.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclDStringAppendObj(
+ Tcl_DString *dsPtr,
+ Tcl_Obj *objPtr)
+{
+ int length;
+ char *bytes = Tcl_GetStringFromObj(objPtr, &length);
+
+ return Tcl_DStringAppend(dsPtr, bytes, length);
+}
+
+char *
+TclDStringAppendDString(
+ Tcl_DString *dsPtr,
+ Tcl_DString *toAppendPtr)
+{
+ return Tcl_DStringAppend(dsPtr, Tcl_DStringValue(toAppendPtr),
+ Tcl_DStringLength(toAppendPtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_DStringAppendElement --
*
* Append a list element to the current value of a dynamic string.
@@ -1899,12 +2629,11 @@ Tcl_DStringAppendElement(
const char *element) /* String to append. Must be
* null-terminated. */
{
- int newSize, flags, strSize;
- char *dst;
-
- strSize = ((element== NULL) ? 0 : strlen(element));
- newSize = Tcl_ScanCountedElement(element, strSize, &flags)
- + dsPtr->length + 1;
+ char *dst = dsPtr->string + dsPtr->length;
+ int needSpace = TclNeedSpace(dsPtr->string, dst);
+ int flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
+ int newSize = dsPtr->length + needSpace
+ + TclScanElement(element, -1, &flags);
/*
* Allocate a larger buffer for the string if the current one isn't large
@@ -1917,14 +2646,14 @@ Tcl_DStringAppendElement(
if (newSize >= dsPtr->spaceAvl) {
dsPtr->spaceAvl = newSize * 2;
if (dsPtr->string == dsPtr->staticSpace) {
- char *newString = ckalloc((unsigned) dsPtr->spaceAvl);
+ char *newString = ckalloc(dsPtr->spaceAvl);
memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
dsPtr->string = newString;
} else {
- dsPtr->string = (char *) ckrealloc((void *) dsPtr->string,
- (size_t) dsPtr->spaceAvl);
+ dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
}
+ dst = dsPtr->string + dsPtr->length;
}
/*
@@ -1932,8 +2661,7 @@ Tcl_DStringAppendElement(
* the end, with a space, if needed.
*/
- dst = dsPtr->string + dsPtr->length;
- if (TclNeedSpace(dsPtr->string, dst)) {
+ if (needSpace) {
*dst = ' ';
dst++;
dsPtr->length++;
@@ -1946,7 +2674,8 @@ Tcl_DStringAppendElement(
flags |= TCL_DONT_QUOTE_HASH;
}
- dsPtr->length += Tcl_ConvertCountedElement(element, strSize, dst, flags);
+ dsPtr->length += TclConvertElement(element, -1, dst, flags);
+ dsPtr->string[dsPtr->length] = '\0';
return dsPtr->string;
}
@@ -1999,13 +2728,12 @@ Tcl_DStringSetLength(
dsPtr->spaceAvl = length + 1;
}
if (dsPtr->string == dsPtr->staticSpace) {
- char *newString = ckalloc((unsigned) dsPtr->spaceAvl);
+ char *newString = ckalloc(dsPtr->spaceAvl);
memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
dsPtr->string = newString;
} else {
- dsPtr->string = (char *) ckrealloc((void *) dsPtr->string,
- (size_t) dsPtr->spaceAvl);
+ dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
}
}
dsPtr->length = length;
@@ -2068,23 +2796,8 @@ Tcl_DStringResult(
Tcl_DString *dsPtr) /* Dynamic string that is to become the
* result of interp. */
{
- Interp *iPtr = (Interp *) interp;
Tcl_ResetResult(interp);
-
- if (dsPtr->string != dsPtr->staticSpace) {
- iPtr->result = dsPtr->string;
- iPtr->freeProc = TCL_DYNAMIC;
- } else if (dsPtr->length < TCL_RESULT_SIZE) {
- iPtr->result = iPtr->resultSpace;
- strcpy(iPtr->result, dsPtr->string);
- } else {
- Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
- }
-
- dsPtr->string = dsPtr->staticSpace;
- dsPtr->length = 0;
- dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
- dsPtr->staticSpace[0] = '\0';
+ Tcl_SetObjResult(interp, TclDStringToObj(dsPtr));
}
/*
@@ -2120,6 +2833,39 @@ Tcl_DStringGetResult(
}
/*
+ * Do more efficient transfer when we know the result is a Tcl_Obj. When
+ * there's no st`ring result, we only have to deal with two cases:
+ *
+ * 1. When the string rep is the empty string, when we don't copy but
+ * instead use the staticSpace in the DString to hold an empty string.
+
+ * 2. When the string rep is not there or there's a real string rep, when
+ * we use Tcl_GetString to fetch (or generate) the string rep - which
+ * we know to have been allocated with ckalloc() - and use it to
+ * populate the DString space. Then, we free the internal rep. and set
+ * the object's string representation back to the canonical empty
+ * string.
+ */
+
+ if (!iPtr->result[0] && iPtr->objResultPtr
+ && !Tcl_IsShared(iPtr->objResultPtr)) {
+ if (iPtr->objResultPtr->bytes == tclEmptyStringRep) {
+ dsPtr->string = dsPtr->staticSpace;
+ dsPtr->string[0] = 0;
+ dsPtr->length = 0;
+ dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+ } else {
+ dsPtr->string = Tcl_GetString(iPtr->objResultPtr);
+ dsPtr->length = iPtr->objResultPtr->length;
+ dsPtr->spaceAvl = dsPtr->length + 1;
+ TclFreeIntRep(iPtr->objResultPtr);
+ iPtr->objResultPtr->bytes = tclEmptyStringRep;
+ iPtr->objResultPtr->length = 0;
+ }
+ return;
+ }
+
+ /*
* If the string result is empty, move the object result to the string
* result, then reset the object result.
*/
@@ -2132,7 +2878,7 @@ Tcl_DStringGetResult(
dsPtr->string = iPtr->result;
dsPtr->spaceAvl = dsPtr->length+1;
} else {
- dsPtr->string = (char *) ckalloc((unsigned) dsPtr->length+1);
+ dsPtr->string = ckalloc(dsPtr->length+1);
memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
iPtr->freeProc(iPtr->result);
}
@@ -2143,7 +2889,7 @@ Tcl_DStringGetResult(
dsPtr->string = dsPtr->staticSpace;
dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
} else {
- dsPtr->string = (char *) ckalloc((unsigned) dsPtr->length+1);
+ dsPtr->string = ckalloc(dsPtr->length+1);
dsPtr->spaceAvl = dsPtr->length + 1;
}
memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
@@ -2156,6 +2902,64 @@ Tcl_DStringGetResult(
/*
*----------------------------------------------------------------------
*
+ * TclDStringToObj --
+ *
+ * This function moves a dynamic string's contents to a new Tcl_Obj. Be
+ * aware that this function does *not* check that the encoding of the
+ * contents of the dynamic string is correct; this is the caller's
+ * responsibility to enforce.
+ *
+ * Results:
+ * The newly-allocated untyped (i.e., typePtr==NULL) Tcl_Obj with a
+ * reference count of zero.
+ *
+ * Side effects:
+ * The string is "moved" to the object. dsPtr is reinitialized to an
+ * empty string; it does not need to be Tcl_DStringFree'd after this if
+ * not used further.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclDStringToObj(
+ Tcl_DString *dsPtr)
+{
+ Tcl_Obj *result;
+
+ if (dsPtr->length == 0) {
+ TclNewObj(result);
+ } else if (dsPtr->string == dsPtr->staticSpace) {
+ /*
+ * Static buffer, so must copy.
+ */
+
+ TclNewStringObj(result, dsPtr->string, dsPtr->length);
+ } else {
+ /*
+ * Dynamic buffer, so transfer ownership and reset.
+ */
+
+ TclNewObj(result);
+ result->bytes = dsPtr->string;
+ result->length = dsPtr->length;
+ }
+
+ /*
+ * Re-establish the DString as empty with no buffer allocated.
+ */
+
+ dsPtr->string = dsPtr->staticSpace;
+ dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+ dsPtr->length = 0;
+ dsPtr->staticSpace[0] = '\0';
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_DStringStartSublist --
*
* This function adds the necessary information to a dynamic string
@@ -2176,9 +2980,9 @@ Tcl_DStringStartSublist(
Tcl_DString *dsPtr) /* Dynamic string. */
{
if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
- Tcl_DStringAppend(dsPtr, " {", -1);
+ TclDStringAppendLiteral(dsPtr, " {");
} else {
- Tcl_DStringAppend(dsPtr, "{", -1);
+ TclDStringAppendLiteral(dsPtr, "{");
}
}
@@ -2204,7 +3008,7 @@ void
Tcl_DStringEndSublist(
Tcl_DString *dsPtr) /* Dynamic string. */
{
- Tcl_DStringAppend(dsPtr, "}", -1);
+ TclDStringAppendLiteral(dsPtr, "}");
}
/*
@@ -2239,125 +3043,148 @@ Tcl_PrintDouble(
char *p, c;
int exponent;
int signum;
- char buffer[TCL_DOUBLE_SPACE];
- Tcl_UniChar ch;
-
- int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int)sizeof(int));
+ char *digits;
+ char *end;
+ int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int));
/*
- * If *precisionPtr == 0, then use TclDoubleDigits to develop a decimal
- * significand and exponent, then format it in E or F format as
- * appropriate. If *precisionPtr != 0, use the native sprintf and then add
- * a trailing ".0" if there is no decimal point in the rep.
+ * Handle NaN.
*/
+
+ if (TclIsNaN(value)) {
+ TclFormatNaN(value, dst);
+ return;
+ }
- if (*precisionPtr == 0) {
+ /*
+ * Handle infinities.
+ */
+
+ if (TclIsInfinite(value)) {
/*
- * Handle NaN.
+ * Remember to copy the terminating NUL too.
*/
-
- if (TclIsNaN(value)) {
- TclFormatNaN(value, dst);
- return;
+
+ if (value < 0) {
+ memcpy(dst, "-Inf", 5);
+ } else {
+ memcpy(dst, "Inf", 4);
}
+ return;
+ }
+ /*
+ * Ordinary (normal and denormal) values.
+ */
+
+ if (*precisionPtr == 0) {
+ digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST,
+ &exponent, &signum, &end);
+ } else {
/*
- * Handle infinities.
+ * There are at least two possible interpretations for tcl_precision.
+ *
+ * The first is, "choose the decimal representation having
+ * $tcl_precision digits of significance that is nearest to the given
+ * number, breaking ties by rounding to even, and then trimming
+ * trailing zeros." This gives the greatest possible precision in the
+ * decimal string, but offers the anomaly that [expr 0.1] will be
+ * "0.10000000000000001".
+ *
+ * The second is "choose the decimal representation having at most
+ * $tcl_precision digits of significance that is nearest to the given
+ * number. If no such representation converts exactly to the given
+ * number, choose the one that is closest, breaking ties by rounding
+ * to even. If more than one such representation converts exactly to
+ * the given number, choose the shortest, breaking ties in favour of
+ * the nearest, breaking remaining ties in favour of the one ending in
+ * an even digit."
+ *
+ * Tcl 8.4 implements the first of these, which gives rise to
+ * anomalies in formatting:
+ *
+ * % expr 0.1
+ * 0.10000000000000001
+ * % expr 0.01
+ * 0.01
+ * % expr 1e-7
+ * 9.9999999999999995e-08
+ *
+ * For human readability, it appears better to choose the second rule,
+ * and let [expr 0.1] return 0.1. But for 8.4 compatibility, we prefer
+ * the first (the recommended zero value for tcl_precision avoids the
+ * problem entirely).
+ *
+ * Uncomment TCL_DD_SHORTEN_FLAG in the next call to prefer the method
+ * that allows floating point values to be shortened if it can be done
+ * without loss of precision.
*/
- if (TclIsInfinite(value)) {
- if (value < 0) {
- strcpy(dst, "-Inf");
- } else {
- strcpy(dst, "Inf");
+ digits = TclDoubleDigits(value, *precisionPtr,
+ TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */,
+ &exponent, &signum, &end);
+ }
+ if (signum) {
+ *dst++ = '-';
+ }
+ p = digits;
+ if (exponent < -4 || exponent > 16) {
+ /*
+ * E format for numbers < 1e-3 or >= 1e17.
+ */
+
+ *dst++ = *p++;
+ c = *p;
+ if (c != '\0') {
+ *dst++ = '.';
+ while (c != '\0') {
+ *dst++ = c;
+ c = *++p;
}
- return;
}
/*
- * Ordinary (normal and denormal) values.
+ * Tcl 8.4 appears to format with at least a two-digit exponent;
+ * preserve that behaviour when tcl_precision != 0
*/
- exponent = TclDoubleDigits(buffer, value, &signum);
- if (signum) {
- *dst++ = '-';
- }
- p = buffer;
- if (exponent < -3 || exponent > 17) {
- /*
- * E format for numbers < 1e-3 or >= 1e17.
- */
-
- *dst++ = *p++;
- c = *p;
- if (c != '\0') {
- *dst++ = '.';
- while (c != '\0') {
- *dst++ = c;
- c = *++p;
- }
- }
- sprintf(dst, "e%+d", exponent-1);
+ if (*precisionPtr == 0) {
+ sprintf(dst, "e%+d", exponent);
} else {
- /*
- * F format for others.
- */
-
- if (exponent <= 0) {
- *dst++ = '0';
- }
- c = *p;
- while (exponent-- > 0) {
- if (c != '\0') {
- *dst++ = c;
- c = *++p;
- } else {
- *dst++ = '0';
- }
- }
- *dst++ = '.';
- if (c == '\0') {
- *dst++ = '0';
- } else {
- while (++exponent < 0) {
- *dst++ = '0';
- }
- while (c != '\0') {
- *dst++ = c;
- c = *++p;
- }
- }
- *dst++ = '\0';
+ sprintf(dst, "e%+03d", exponent);
}
} else {
/*
- * tcl_precision is supplied, pass it to the native sprintf.
+ * F format for others.
*/
-
- sprintf(dst, "%.*g", *precisionPtr, value);
-
- /*
- * If the ASCII result looks like an integer, add ".0" so that it
- * doesn't look like an integer anymore. This prevents floating-point
- * values from being converted to integers unintentionally. Check for
- * ASCII specifically to speed up the function.
- */
-
- for (p = dst; *p != 0;) {
- if (UCHAR(*p) < 0x80) {
- c = *p++;
+
+ if (exponent < 0) {
+ *dst++ = '0';
+ }
+ c = *p;
+ while (exponent-- >= 0) {
+ if (c != '\0') {
+ *dst++ = c;
+ c = *++p;
} else {
- p += Tcl_UtfToUniChar(p, &ch);
- c = UCHAR(ch);
+ *dst++ = '0';
+ }
+ }
+ *dst++ = '.';
+ if (c == '\0') {
+ *dst++ = '0';
+ } else {
+ while (++exponent < -1) {
+ *dst++ = '0';
}
- if ((c == '.') || isalpha(UCHAR(c))) { /* INTL: ISO only. */
- return;
+ while (c != '\0') {
+ *dst++ = c;
+ c = *++p;
}
}
- p[0] = '.';
- p[1] = '0';
- p[2] = 0;
+ *dst++ = '\0';
}
+ ckfree(digits);
}
/*
@@ -2508,6 +3335,7 @@ TclNeedSpace(
* NOTE: Remove this if other Unicode spaces ever get accepted as
* list-element separators.
*/
+
return 1;
}
switch (*end) {
@@ -2527,6 +3355,94 @@ TclNeedSpace(
/*
*----------------------------------------------------------------------
*
+ * TclFormatInt --
+ *
+ * This procedure formats an integer into a sequence of decimal digit
+ * characters in a buffer. If the integer is negative, a minus sign is
+ * inserted at the start of the buffer. A null character is inserted at
+ * the end of the formatted characters. It is the caller's responsibility
+ * to ensure that enough storage is available. This procedure has the
+ * effect of sprintf(buffer, "%ld", n) but is faster as proven in
+ * benchmarks. This is key to UpdateStringOfInt, which is a common path
+ * for a lot of code (e.g. int-indexed arrays).
+ *
+ * Results:
+ * An integer representing the number of characters formatted, not
+ * including the terminating \0.
+ *
+ * Side effects:
+ * The formatted characters are written into the storage pointer to by
+ * the "buffer" argument.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFormatInt(
+ char *buffer, /* Points to the storage into which the
+ * formatted characters are written. */
+ long n) /* The integer to format. */
+{
+ long intVal;
+ int i;
+ int numFormatted, j;
+ const char *digits = "0123456789";
+
+ /*
+ * Check first whether "n" is zero.
+ */
+
+ if (n == 0) {
+ buffer[0] = '0';
+ buffer[1] = 0;
+ return 1;
+ }
+
+ /*
+ * Check whether "n" is the maximum negative value. This is -2^(m-1) for
+ * an m-bit word, and has no positive equivalent; negating it produces the
+ * same value.
+ */
+
+ intVal = -n; /* [Bug 3390638] Workaround for*/
+ if (n == -n || intVal == n) { /* broken compiler optimizers. */
+ return sprintf(buffer, "%ld", n);
+ }
+
+ /*
+ * Generate the characters of the result backwards in the buffer.
+ */
+
+ intVal = (n < 0? -n : n);
+ i = 0;
+ buffer[0] = '\0';
+ do {
+ i++;
+ buffer[i] = digits[intVal % 10];
+ intVal = intVal/10;
+ } while (intVal > 0);
+ if (n < 0) {
+ i++;
+ buffer[i] = '-';
+ }
+ numFormatted = i;
+
+ /*
+ * Now reverse the characters.
+ */
+
+ for (j = 0; j < i; j++, i--) {
+ char tmp = buffer[i];
+
+ buffer[i] = buffer[j];
+ buffer[j] = tmp;
+ }
+ return numFormatted;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGetIntForIndex --
*
* This function returns an integer corresponding to the list index held
@@ -2584,7 +3500,7 @@ TclGetIntForIndex(
* Leading whitespace is acceptable in an index.
*/
- while (length && isspace(UCHAR(*bytes))) { /* INTL: ISO space. */
+ while (length && TclIsSpaceProc(*bytes)) {
bytes++;
length--;
}
@@ -2597,7 +3513,7 @@ TclGetIntForIndex(
if ((savedOp != '+') && (savedOp != '-')) {
goto parseError;
}
- if (isspace(UCHAR(opPtr[1]))) {
+ if (TclIsSpaceProc(opPtr[1])) {
goto parseError;
}
*opPtr = '\0';
@@ -2623,16 +3539,10 @@ TclGetIntForIndex(
parseError:
if (interp != NULL) {
- /*
- * The result might not be empty; this resets it which should be both
- * a cheap operation, and of little problem because this is an
- * error-generation path anyway.
- */
-
bytes = Tcl_GetString(objPtr);
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad index \"", bytes,
- "\": must be integer?[+-]integer? or end?[+-]integer?", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\": must be integer?[+-]integer? or"
+ " end?[+-]integer?", bytes));
if (!strncmp(bytes, "end-", 4)) {
bytes += 4;
}
@@ -2667,10 +3577,10 @@ static void
UpdateStringOfEndOffset(
register Tcl_Obj *objPtr)
{
- char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1];
+ char buffer[TCL_INTEGER_SPACE + 5];
register int len;
- strcpy(buffer, "end");
+ memcpy(buffer, "end", 4);
len = sizeof("end") - 1;
if (objPtr->internalRep.longValue != 0) {
buffer[len++] = '-';
@@ -2724,9 +3634,8 @@ SetEndOffsetFromAny(
if ((*bytes != 'e') || (strncmp(bytes, "end",
(size_t)((length > 3) ? 3 : length)) != 0)) {
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad index \"", bytes,
- "\": must be end?[+-]integer?", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\": must be end?[+-]integer?", bytes));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
return TCL_ERROR;
@@ -2744,8 +3653,8 @@ SetEndOffsetFromAny(
* after "end-" to Tcl_GetInt, then reverse for offset.
*/
- if (isspace(UCHAR(bytes[4]))) {
- return TCL_ERROR;
+ if (TclIsSpaceProc(bytes[4])) {
+ goto badIndexFormat;
}
if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {
return TCL_ERROR;
@@ -2758,10 +3667,10 @@ SetEndOffsetFromAny(
* Conversion failed. Report the error.
*/
+ badIndexFormat:
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad index \"", bytes,
- "\": must be end?[+-]integer?", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\": must be end?[+-]integer?", bytes));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
return TCL_ERROR;
@@ -2810,7 +3719,7 @@ TclCheckBadOctal(
* zero. Try to generate a meaningful error message.
*/
- while (isspace(UCHAR(*p))) { /* INTL: ISO space. */
+ while (TclIsSpaceProc(*p)) {
p++;
}
if (*p == '+' || *p == '-') {
@@ -2823,7 +3732,7 @@ TclCheckBadOctal(
while (isdigit(UCHAR(*p))) { /* INTL: digit. */
p++;
}
- while (isspace(UCHAR(*p))) { /* INTL: ISO space. */
+ while (TclIsSpaceProc(*p)) {
p++;
}
if (*p == '\0') {
@@ -2837,8 +3746,8 @@ TclCheckBadOctal(
* be added to an existing error message as extra info.
*/
- Tcl_AppendResult(interp, " (looks like invalid octal number)",
- NULL);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ " (looks like invalid octal number)", -1);
}
return 1;
}
@@ -2865,7 +3774,8 @@ ClearHash(
for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
hPtr = Tcl_NextHashEntry(&search)) {
- Tcl_Obj *objPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ Tcl_Obj *objPtr = Tcl_GetHashValue(hPtr);
+
Tcl_DecrRefCount(objPtr);
Tcl_DeleteHashEntry(hPtr);
}
@@ -2893,12 +3803,12 @@ static Tcl_HashTable *
GetThreadHash(
Tcl_ThreadDataKey *keyPtr)
{
- Tcl_HashTable **tablePtrPtr = (Tcl_HashTable **)
- Tcl_GetThreadData(keyPtr, (int) sizeof(Tcl_HashTable *));
+ Tcl_HashTable **tablePtrPtr =
+ Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));
if (NULL == *tablePtrPtr) {
- *tablePtrPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
- Tcl_CreateThreadExitHandler(FreeThreadHash, (ClientData)*tablePtrPtr);
+ *tablePtrPtr = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr);
Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS);
}
return *tablePtrPtr;
@@ -2922,11 +3832,11 @@ static void
FreeThreadHash(
ClientData clientData)
{
- Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData;
+ Tcl_HashTable *tablePtr = clientData;
ClearHash(tablePtr);
Tcl_DeleteHashTable(tablePtr);
- ckfree((char *) tablePtr);
+ ckfree(tablePtr);
}
/*
@@ -2944,7 +3854,7 @@ static void
FreeProcessGlobalValue(
ClientData clientData)
{
- ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *) clientData;
+ ProcessGlobalValue *pgvPtr = clientData;
pgvPtr->epoch++;
pgvPtr->numBytes = 0;
@@ -2989,10 +3899,10 @@ TclSetProcessGlobalValue(
if (NULL != pgvPtr->value) {
ckfree(pgvPtr->value);
} else {
- Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData) pgvPtr);
+ Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
}
bytes = Tcl_GetStringFromObj(newValue, &pgvPtr->numBytes);
- pgvPtr->value = ckalloc((unsigned) pgvPtr->numBytes + 1);
+ pgvPtr->value = ckalloc(pgvPtr->numBytes + 1);
memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1);
if (pgvPtr->encoding) {
Tcl_FreeEncoding(pgvPtr->encoding);
@@ -3008,8 +3918,7 @@ TclSetProcessGlobalValue(
Tcl_IncrRefCount(newValue);
cacheMap = GetThreadHash(&pgvPtr->key);
ClearHash(cacheMap);
- hPtr = Tcl_CreateHashEntry(cacheMap,
- INT2PTR(pgvPtr->epoch), &dummy);
+ hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy);
Tcl_SetHashValue(hPtr, newValue);
Tcl_MutexUnlock(&pgvPtr->mutex);
}
@@ -3058,8 +3967,7 @@ TclGetProcessGlobalValue(
Tcl_DStringLength(&native), &newValue);
Tcl_DStringFree(&native);
ckfree(pgvPtr->value);
- pgvPtr->value = ckalloc((unsigned)
- Tcl_DStringLength(&newValue) + 1);
+ pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1);
memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
(size_t) Tcl_DStringLength(&newValue) + 1);
Tcl_DStringFree(&newValue);
@@ -3273,9 +4181,9 @@ TclReToGlob(
Tcl_DString *dsPtr,
int *exactPtr)
{
- int anchorLeft, anchorRight, lastIsStar;
+ int anchorLeft, anchorRight, lastIsStar, numStars;
char *dsStr, *dsStrStart;
- const char *msg, *p, *strEnd;
+ const char *msg, *p, *strEnd, *code;
strEnd = reStr + reStrLen;
Tcl_DStringInit(dsPtr);
@@ -3286,9 +4194,10 @@ TclReToGlob(
if ((reStrLen >= 4) && (memcmp("***=", reStr, 4) == 0)) {
/*
- * At most, the glob pattern has length 2*reStrLen + 2 to
- * backslash escape every character and have * at each end.
+ * At most, the glob pattern has length 2*reStrLen + 2 to backslash
+ * escape every character and have * at each end.
*/
+
Tcl_DStringSetLength(dsPtr, reStrLen + 2);
dsStr = dsStrStart = Tcl_DStringValue(dsPtr);
*dsStr++ = '*';
@@ -3312,8 +4221,8 @@ TclReToGlob(
}
/*
- * At most, the glob pattern has length reStrLen + 2 to account
- * for possible * at each end.
+ * At most, the glob pattern has length reStrLen + 2 to account for
+ * possible * at each end.
*/
Tcl_DStringSetLength(dsPtr, reStrLen + 2);
@@ -3323,15 +4232,16 @@ TclReToGlob(
* Check for anchored REs (ie ^foo$), so we can use string equal if
* possible. Do not alter the start of str so we can free it correctly.
*
- * Keep track of the last char being an unescaped star to prevent
- * multiple instances. Simpler than checking that the last star
- * may be escaped.
+ * Keep track of the last char being an unescaped star to prevent multiple
+ * instances. Simpler than checking that the last star may be escaped.
*/
msg = NULL;
+ code = NULL;
p = reStr;
anchorRight = 0;
lastIsStar = 0;
+ numStars = 0;
if (*p == '^') {
anchorLeft = 1;
@@ -3384,6 +4294,7 @@ TclReToGlob(
break;
default:
msg = "invalid escape sequence";
+ code = "BADESCAPE";
goto invalidGlob;
}
break;
@@ -3395,6 +4306,7 @@ TclReToGlob(
if (!lastIsStar) {
*dsStr++ = '*';
lastIsStar = 1;
+ numStars++;
}
continue;
} else if (p[1] == '+') {
@@ -3402,6 +4314,7 @@ TclReToGlob(
*dsStr++ = '?';
*dsStr++ = '*';
lastIsStar = 1;
+ numStars++;
continue;
}
}
@@ -3410,6 +4323,7 @@ TclReToGlob(
case '$':
if (p+1 != strEnd) {
msg = "$ not anchor";
+ code = "NONANCHOR";
goto invalidGlob;
}
anchorRight = 1;
@@ -3417,14 +4331,25 @@ TclReToGlob(
case '*': case '+': case '?': case '|': case '^':
case '{': case '}': case '(': case ')': case '[': case ']':
msg = "unhandled RE special char";
+ code = "UNHANDLED";
goto invalidGlob;
- break;
default:
*dsStr++ = *p;
break;
}
lastIsStar = 0;
}
+ if (numStars > 1) {
+ /*
+ * Heuristic: if >1 non-anchoring *, the risk is large that glob
+ * matching is slower than the RE engine, so report invalid.
+ */
+
+ msg = "excessive recursive glob backtrack potential";
+ code = "OVERCOMPLEX";
+ goto invalidGlob;
+ }
+
if (!anchorRight && !lastIsStar) {
*dsStr++ = '*';
}
@@ -3434,22 +4359,12 @@ TclReToGlob(
*exactPtr = (anchorLeft && anchorRight);
}
-#if 0
- fprintf(stderr, "INPUT RE '%.*s' OUTPUT GLOB '%s' anchor %d:%d \n",
- reStrLen, reStr,
- Tcl_DStringValue(dsPtr), anchorLeft, anchorRight);
- fflush(stderr);
-#endif
return TCL_OK;
invalidGlob:
-#if 0
- fprintf(stderr, "INPUT RE '%.*s' NO OUTPUT GLOB %s (%c)\n",
- reStrLen, reStr, msg, *p);
- fflush(stderr);
-#endif
if (interp != NULL) {
- Tcl_AppendResult(interp, msg, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+ Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
}
Tcl_DStringFree(dsPtr);
return TCL_ERROR;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 3370f9d..1c01e41 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -15,11 +15,10 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclVar.c,v 1.205 2010/09/27 17:36:48 msofer Exp $
*/
#include "tclInt.h"
+#include "tclOOInt.h"
/*
* Prototypes for the variable hash key methods.
@@ -296,7 +295,7 @@ CleanupVar(
&& !TclIsVarTraced(varPtr)
&& (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) {
if (VarHashRefCount(varPtr) == 0) {
- ckfree((char *) varPtr);
+ ckfree(varPtr);
} else {
VarHashDeleteEntry(varPtr);
}
@@ -305,7 +304,7 @@ CleanupVar(
TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
(VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) {
if (VarHashRefCount(arrayPtr) == 0) {
- ckfree((char *) arrayPtr);
+ ckfree(arrayPtr);
} else {
VarHashDeleteEntry(arrayPtr);
}
@@ -662,7 +661,7 @@ TclObjLookupVarEx(
len2 = len1 - i - 2;
len1 = i;
- newPart2 = ckalloc((unsigned) (len2+1));
+ newPart2 = ckalloc(len2 + 1);
memcpy(newPart2, part2, (unsigned) len2);
*(newPart2+len2) = '\0';
part2 = newPart2;
@@ -705,7 +704,6 @@ TclObjLookupVarEx(
*/
TclFreeIntRep(part1Ptr);
- part1Ptr->typePtr = NULL;
varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1,
&errMsg, &index);
@@ -765,7 +763,7 @@ TclObjLookupVarEx(
}
donePart1:
-#if 0
+#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
if (varPtr == NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
part1 = TclGetString(part1Ptr);
@@ -1026,8 +1024,7 @@ TclLookupSimpleVar(
tablePtr = varFramePtr->varTablePtr;
if (create) {
if (tablePtr == NULL) {
- tablePtr = (TclVarHashTable *)
- ckalloc(sizeof(TclVarHashTable));
+ tablePtr = ckalloc(sizeof(TclVarHashTable));
TclInitVarHashTable(tablePtr, NULL);
varFramePtr->varTablePtr = tablePtr;
}
@@ -1139,7 +1136,7 @@ TclLookupArrayElement(
}
TclSetVarArray(arrayPtr);
- tablePtr = (TclVarHashTable *) ckalloc(sizeof(TclVarHashTable));
+ tablePtr = ckalloc(sizeof(TclVarHashTable));
arrayPtr->value.tablePtr = tablePtr;
if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
@@ -1830,6 +1827,7 @@ TclPtrSetVar(
Tcl_Obj *oldValuePtr;
Tcl_Obj *resultPtr = NULL;
int result;
+ int cleanupOnEarlyError = (newValuePtr->refCount == 0);
/*
* If the variable is in a hashtable and its hPtr field is NULL, then we
@@ -1895,7 +1893,7 @@ TclPtrSetVar(
varPtr->value.objPtr = NULL;
}
if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
-#if 0
+#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
/*
* Can't happen now!
*/
@@ -2001,7 +1999,7 @@ TclPtrSetVar(
return resultPtr;
earlyError:
- if (newValuePtr->refCount == 0) {
+ if (cleanupOnEarlyError) {
Tcl_DecrRefCount(newValuePtr);
}
goto cleanup;
@@ -2364,7 +2362,6 @@ TclPtrUnsetVar(
if (part1Ptr->typePtr == &tclNsVarNameType) {
TclFreeIntRep(part1Ptr);
- part1Ptr->typePtr = NULL;
}
#endif
@@ -2673,13 +2670,14 @@ Tcl_AppendObjCmd(
/*
* Note that we do not need to increase the refCount of the Var
* pointers: should a trace delete the variable, the return value
- * of TclPtrSetVar will be NULL, and we will not access the
- * variable again.
+ * of TclPtrSetVar will be NULL or emptyObjPtr, and we will not
+ * access the variable again.
*/
varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1],
NULL, objv[i], TCL_APPEND_VALUE|TCL_LEAVE_ERR_MSG, -1);
- if (varValuePtr == NULL) {
+ if ((varValuePtr == NULL) ||
+ (varValuePtr == ((Interp *) interp)->emptyObjPtr)) {
return TCL_ERROR;
}
}
@@ -2992,8 +2990,7 @@ TclArraySet(
}
}
TclSetVarArray(varPtr);
- varPtr->value.tablePtr = (TclVarHashTable *)
- ckalloc(sizeof(TclVarHashTable));
+ varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
return TCL_OK;
}
@@ -3068,7 +3065,8 @@ ArrayStartSearchCmd(
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
- Tcl_AppendResult(interp, "\"", varName, "\" isn't an array", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", varName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
return TCL_ERROR;
}
@@ -3077,25 +3075,22 @@ ArrayStartSearchCmd(
* Make a new array search with a free name.
*/
- searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
+ searchPtr = ckalloc(sizeof(ArraySearch));
hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
if (isNew) {
searchPtr->id = 1;
- Tcl_AppendResult(interp, "s-1-", varName, NULL);
varPtr->flags |= VAR_SEARCH_ACTIVE;
searchPtr->nextPtr = NULL;
} else {
- char string[TCL_INTEGER_SPACE];
-
searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
- TclFormatInt(string, searchPtr->id);
- Tcl_AppendResult(interp, "s-", string, "-", varName, NULL);
searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
}
searchPtr->varPtr = varPtr;
searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
&searchPtr->search);
Tcl_SetHashValue(hPtr, searchPtr);
+ Tcl_SetObjResult(interp,
+ Tcl_ObjPrintf("s-%d-%s", searchPtr->id, varName));
return TCL_OK;
}
@@ -3166,8 +3161,8 @@ ArrayAnyMoreCmd(
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
- Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
- "\" isn't an array", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", TclGetString(varNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
TclGetString(varNameObj), NULL);
return TCL_ERROR;
@@ -3272,8 +3267,8 @@ ArrayNextElementCmd(
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
- Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
- "\" isn't an array", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", TclGetString(varNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
TclGetString(varNameObj), NULL);
return TCL_ERROR;
@@ -3382,8 +3377,8 @@ ArrayDoneSearchCmd(
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
- Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
- "\" isn't an array", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", TclGetString(varNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
TclGetString(varNameObj), NULL);
return TCL_ERROR;
@@ -3419,7 +3414,7 @@ ArrayDoneSearchCmd(
}
}
}
- ckfree((char *) searchPtr);
+ ckfree(searchPtr);
return TCL_OK;
}
@@ -4025,8 +4020,8 @@ ArrayStatsCmd(
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
- Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
- "\" isn't an array", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", TclGetString(varNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
TclGetString(varNameObj), NULL);
return TCL_ERROR;
@@ -4034,7 +4029,8 @@ ArrayStatsCmd(
stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
if (stats == NULL) {
- Tcl_SetResult(interp, "error reading array statistics", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error reading array statistics", -1));
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
@@ -4226,18 +4222,18 @@ TclInitArrayCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
static const EnsembleImplMap arrayImplMap[] = {
- {"anymore", ArrayAnyMoreCmd, NULL, NULL, NULL},
- {"donesearch", ArrayDoneSearchCmd, NULL, NULL, NULL},
- {"exists", ArrayExistsCmd, NULL, NULL, NULL},
- {"get", ArrayGetCmd, NULL, NULL, NULL},
- {"names", ArrayNamesCmd, NULL, NULL, NULL},
- {"nextelement", ArrayNextElementCmd, NULL, NULL, NULL},
- {"set", ArraySetCmd, NULL, NULL, NULL},
- {"size", ArraySizeCmd, NULL, NULL, NULL},
- {"startsearch", ArrayStartSearchCmd, NULL, NULL, NULL},
- {"statistics", ArrayStatsCmd, NULL, NULL, NULL},
- {"unset", ArrayUnsetCmd, NULL, NULL, NULL},
- {NULL, NULL, NULL, NULL, NULL}
+ {"anymore", ArrayAnyMoreCmd, NULL, NULL, NULL, 0},
+ {"donesearch", ArrayDoneSearchCmd, NULL, NULL, NULL, 0},
+ {"exists", ArrayExistsCmd, TclCompileArrayExistsCmd, NULL, NULL, 0},
+ {"get", ArrayGetCmd, NULL, NULL, NULL, 0},
+ {"names", ArrayNamesCmd, NULL, NULL, NULL, 0},
+ {"nextelement", ArrayNextElementCmd, NULL, NULL, NULL, 0},
+ {"set", ArraySetCmd, TclCompileArraySetCmd, NULL, NULL, 0},
+ {"size", ArraySizeCmd, NULL, NULL, NULL, 0},
+ {"startsearch", ArrayStartSearchCmd, NULL, NULL, NULL, 0},
+ {"statistics", ArrayStatsCmd, NULL, NULL, NULL, 0},
+ {"unset", ArrayUnsetCmd, TclCompileArrayUnsetCmd, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
};
return TclMakeEnsemble(interp, "array", arrayImplMap);
@@ -4323,10 +4319,10 @@ ObjMakeUpvar(
|| (varFramePtr == NULL)
|| !HasLocalVars(varFramePtr)
|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
- Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
- TclGetString(myNamePtr), "\": upvar won't create "
+ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+ "bad variable name \"%s\": upvar won't create "
"namespace variable that refers to procedure variable",
- NULL);
+ TclGetString(myNamePtr)));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
return TCL_ERROR;
}
@@ -4424,9 +4420,10 @@ TclPtrObjMakeUpvar(
* myName looks like an array reference.
*/
- Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
- myName, "\": upvar won't create a scalar variable "
- "that looks like an array element", NULL);
+ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+ "bad variable name \"%s\": upvar won't create a"
+ " scalar variable that looks like an array element",
+ myName));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT",
NULL);
return TCL_ERROR;
@@ -4453,15 +4450,15 @@ TclPtrObjMakeUpvar(
}
if (varPtr == otherPtr) {
- Tcl_SetResult((Tcl_Interp *) iPtr,
- "can't upvar from variable to itself", TCL_STATIC);
+ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_NewStringObj(
+ "can't upvar from variable to itself", -1));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", NULL);
return TCL_ERROR;
}
if (TclIsVarTraced(varPtr)) {
- Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
- "\" has traces: can't use for upvar", NULL);
+ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+ "variable \"%s\" has traces: can't use for upvar", myName));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "TRACED", NULL);
return TCL_ERROR;
} else if (!TclIsVarUndefined(varPtr)) {
@@ -4475,8 +4472,8 @@ TclPtrObjMakeUpvar(
*/
if (!TclIsVarLink(varPtr)) {
- Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
- "\" already exists", NULL);
+ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+ "variable \"%s\" already exists", myName));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "EXISTS", NULL);
return TCL_ERROR;
}
@@ -4974,8 +4971,8 @@ Tcl_UpvarObjCmd(
* for this particular case.
*/
- Tcl_AppendResult(interp, "bad level \"", TclGetString(levelObj), "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad level \"%s\"", TclGetString(levelObj)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "LEVEL", NULL);
return TCL_ERROR;
}
@@ -4984,8 +4981,8 @@ Tcl_UpvarObjCmd(
* We've now finished with parsing levels; skip to the variable names.
*/
- objc -= hasLevel+1;
- objv += hasLevel+1;
+ objc -= hasLevel + 1;
+ objv += hasLevel + 1;
/*
* Iterate over each (other variable, local variable) pair. Divide the
@@ -5066,8 +5063,8 @@ SetArraySearchObj(
return TCL_OK;
syntax:
- Tcl_AppendResult(interp, "illegal search identifier \"", string, "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "illegal search identifier \"%s\"", string));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
return TCL_ERROR;
}
@@ -5132,10 +5129,9 @@ ParseSearchId(
*/
if (strcmp(string+offset, varName) != 0) {
- Tcl_AppendResult(interp, "search identifier \"", string,
- "\" isn't for variable \"", varName, "\"", NULL);
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string,
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "search identifier \"%s\" isn't for variable \"%s\"",
+ string, varName));
goto badLookup;
}
@@ -5159,7 +5155,8 @@ ParseSearchId(
}
}
}
- Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't find search \"%s\"", string));
badLookup:
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
return NULL;
@@ -5196,7 +5193,7 @@ DeleteSearches(
for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
searchPtr = nextPtr) {
nextPtr = searchPtr->nextPtr;
- ckfree((char *) searchPtr);
+ ckfree(searchPtr);
}
arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
Tcl_DeleteHashEntry(sPtr);
@@ -5479,13 +5476,13 @@ DeleteArray(
TclClearVarNamespaceVar(elPtr);
}
VarHashDeleteTable(varPtr->value.tablePtr);
- ckfree((char *) varPtr->value.tablePtr);
+ ckfree(varPtr->value.tablePtr);
}
/*
*----------------------------------------------------------------------
*
- * TclTclObjVarErrMsg --
+ * TclObjVarErrMsg --
*
* Generate a reasonable error message describing why a variable
* operation failed.
@@ -5699,7 +5696,7 @@ DupParsedVarName(
if (arrayPtr != NULL) {
Tcl_IncrRefCount(arrayPtr);
elemLen = strlen(elem);
- elemCopy = ckalloc(elemLen+1);
+ elemCopy = ckalloc(elemLen + 1);
memcpy(elemCopy, elem, elemLen);
*(elemCopy + elemLen) = '\0';
elem = elemCopy;
@@ -5732,7 +5729,7 @@ UpdateParsedVarName(
len2 = strlen(part2);
totalLen = len1 + len2 + 2;
- p = ckalloc((unsigned) totalLen + 1);
+ p = ckalloc(totalLen + 1);
objPtr->bytes = p;
objPtr->length = totalLen;
@@ -5900,8 +5897,8 @@ ObjFindNamespaceVar(
Tcl_DecrRefCount(simpleNamePtr);
}
if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown variable \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL);
}
return (Tcl_Var) varPtr;
@@ -6090,7 +6087,7 @@ TclInfoVarsCmd(
}
}
}
- } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
+ } else if (iPtr->varFramePtr->procPtr != NULL) {
AppendLocals(interp, listPtr, simplePatternPtr, 1);
}
@@ -6276,17 +6273,21 @@ AppendLocals(
{
Interp *iPtr = (Interp *) interp;
Var *varPtr;
- int i, localVarCt;
+ int i, localVarCt, added;
Tcl_Obj **varNamePtr, *objNamePtr;
const char *varName;
TclVarHashTable *localVarTablePtr;
Tcl_HashSearch search;
+ Tcl_HashTable addedTable;
const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;
localVarCt = iPtr->varFramePtr->numCompiledLocals;
varPtr = iPtr->varFramePtr->compiledLocals;
localVarTablePtr = iPtr->varFramePtr->varTablePtr;
varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
+ if (includeLinks) {
+ Tcl_InitObjHashTable(&addedTable);
+ }
for (i = 0; i < localVarCt; i++, varNamePtr++) {
/*
@@ -6298,6 +6299,9 @@ AppendLocals(
varName = TclGetString(*varNamePtr);
if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
+ if (includeLinks) {
+ Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
+ }
}
}
varPtr++;
@@ -6308,7 +6312,7 @@ AppendLocals(
*/
if (localVarTablePtr == NULL) {
- return;
+ goto objectVars;
}
/*
@@ -6322,9 +6326,13 @@ AppendLocals(
&& (includeLinks || !TclIsVarLink(varPtr))) {
Tcl_ListObjAppendElement(interp, listPtr,
VarHashGetKey(varPtr));
+ if (includeLinks) {
+ Tcl_CreateHashEntry(&addedTable, VarHashGetKey(varPtr),
+ &added);
+ }
}
}
- return;
+ goto objectVars;
}
/*
@@ -6340,9 +6348,41 @@ AppendLocals(
varName = TclGetString(objNamePtr);
if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
+ if (includeLinks) {
+ Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
+ }
+ }
+ }
+ }
+
+ objectVars:
+ if (!includeLinks) {
+ return;
+ }
+
+ if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) {
+ CallContext *contextPtr = iPtr->varFramePtr->clientData;
+ Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+
+ if (mPtr->declaringObjectPtr) {
+ FOREACH(objNamePtr, mPtr->declaringObjectPtr->variables) {
+ Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
+ if (added && (!pattern ||
+ Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
+ Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
+ }
+ }
+ } else {
+ FOREACH(objNamePtr, mPtr->declaringClassPtr->variables) {
+ Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
+ if (added && (!pattern ||
+ Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
+ Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
+ }
}
}
}
+ Tcl_DeleteHashTable(&addedTable);
}
/*
@@ -6368,7 +6408,7 @@ AllocVarEntry(
Tcl_HashEntry *hPtr;
Var *varPtr;
- varPtr = (Var *) ckalloc(sizeof(VarInHash));
+ varPtr = ckalloc(sizeof(VarInHash));
varPtr->flags = VAR_IN_HASHTABLE;
varPtr->value.objPtr = NULL;
VarHashRefCount(varPtr) = 1;
@@ -6390,7 +6430,7 @@ FreeVarEntry(
if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr)
&& (VarHashRefCount(varPtr) == 1)) {
- ckfree((char *) varPtr);
+ ckfree(varPtr);
} else {
VarHashInvalidateEntry(varPtr);
TclSetVarUndefined(varPtr);
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 8937648..9c1176e 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -5,20 +5,28 @@
*
* Copyright (C) 2004-2005 Pascal Scheffers <pascal@scheffers.net>
* Copyright (C) 2005 Unitas Software B.V.
- * Copyright (c) 2008-2009 Donal K. Fellows
+ * Copyright (c) 2008-2012 Donal K. Fellows
*
* Parts written by Jean-Claude Wippler, as part of Tclkit, placed in the
* public domain March 2003.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclZlib.c,v 1.38 2010/06/21 11:25:26 nijtmans Exp $
*/
#include "tclInt.h"
#ifdef HAVE_ZLIB
#include <zlib.h>
+#include "tclIO.h"
+
+/*
+ * The version of the zlib "package" that this implements. Note that this
+ * thoroughly supersedes the versions included with tclkit, which are "1.1",
+ * so this is at least "2.0" (there's no general *commitment* to have the same
+ * interface, even if that is mostly true).
+ */
+
+#define TCL_ZLIB_VERSION "2.0"
/*
* Magic flags used with wbits fields to indicate that we're handling the gzip
@@ -66,8 +74,27 @@ typedef struct {
int wbits; /* The encoded compression mode, so we can
* restart the stream if necessary. */
Tcl_Command cmd; /* Token for the associated Tcl command. */
+ Tcl_Obj *compDictObj; /* Byte-array object containing compression
+ * dictionary (not dictObj!) to use if
+ * necessary. */
+ int flags; /* Miscellaneous flag bits. */
+ GzipHeader *gzHeaderPtr; /* If we've allocated a gzip header
+ * structure. */
} ZlibStreamHandle;
+#define DICT_TO_SET 0x1 /* If we need to set a compression dictionary
+ * in the low-level engine at the next
+ * opportunity. */
+
+/*
+ * Macros to make it clearer in some of the twiddlier accesses what is
+ * happening.
+ */
+
+#define IsRawStream(zshPtr) ((zshPtr)->format == TCL_ZLIB_FORMAT_RAW)
+#define HaveDictToSet(zshPtr) ((zshPtr)->flags & DICT_TO_SET)
+#define DictWasSet(zshPtr) ((zshPtr)->flags |= ~DICT_TO_SET)
+
/*
* Structure used for stacked channel compression and decompression.
*/
@@ -80,6 +107,11 @@ typedef struct {
* for compression on output, or
* TCL_ZLIB_STREAM_INFLATE for decompression
* on input. */
+ 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
+ * the underlying stream in one go. */
z_stream inStream; /* Structure used by zlib for decompression of
* input. */
z_stream outStream; /* Structure used by zlib for compression of
@@ -92,6 +124,10 @@ 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. */
} ZlibChannelData;
/*
@@ -108,46 +144,57 @@ typedef struct {
#define OUT_HEADER 0x4
/*
- * Size of buffers allocated by default. Should be enough...
+ * Size of buffers allocated by default, and the range it can be set to. The
+ * same sorts of values apply to streams, except with different limits (they
+ * permit byte-level activity). Channels always use bytes unless told to use
+ * larger buffers.
*/
#define DEFAULT_BUFFER_SIZE 4096
-
-/*
- * Time to wait (in milliseconds) before flushing the channel when reading
- * data through the transform.
- */
-
-#define TRANSFORM_FLUSH_DELAY 5
+#define MIN_NONSTREAM_BUFFER_SIZE 16
+#define MAX_BUFFER_SIZE 65536
/*
* Prototypes for private procedures defined later in this file:
*/
-static Tcl_CmdDeleteProc ZlibStreamCmdDelete;
-static Tcl_DriverBlockModeProc ZlibTransformBlockMode;
-static Tcl_DriverCloseProc ZlibTransformClose;
-static Tcl_DriverGetHandleProc ZlibTransformGetHandle;
-static Tcl_DriverGetOptionProc ZlibTransformGetOption;
-static Tcl_DriverHandlerProc ZlibTransformHandler;
-static Tcl_DriverInputProc ZlibTransformInput;
-static Tcl_DriverOutputProc ZlibTransformOutput;
-static Tcl_DriverSetOptionProc ZlibTransformSetOption;
-static Tcl_DriverWatchProc ZlibTransformWatch;
-static Tcl_ObjCmdProc ZlibCmd;
-static Tcl_ObjCmdProc ZlibStreamCmd;
-
-static void ConvertError(Tcl_Interp *interp, int code);
-static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
-static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
- GzipHeader *headerPtr, int *extraSizePtr);
-static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp,
- int mode, int format, int level,
- Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr);
-static void ZlibStreamCleanup(ZlibStreamHandle *zshPtr);
-static void ZlibTransformTimerKill(ZlibChannelData *cd);
-static void ZlibTransformTimerRun(ClientData clientData);
-static void ZlibTransformTimerSetup(ZlibChannelData *cd);
+static Tcl_CmdDeleteProc ZlibStreamCmdDelete;
+static Tcl_DriverBlockModeProc ZlibTransformBlockMode;
+static Tcl_DriverCloseProc ZlibTransformClose;
+static Tcl_DriverGetHandleProc ZlibTransformGetHandle;
+static Tcl_DriverGetOptionProc ZlibTransformGetOption;
+static Tcl_DriverHandlerProc ZlibTransformEventHandler;
+static Tcl_DriverInputProc ZlibTransformInput;
+static Tcl_DriverOutputProc ZlibTransformOutput;
+static Tcl_DriverSetOptionProc ZlibTransformSetOption;
+static Tcl_DriverWatchProc ZlibTransformWatch;
+static Tcl_ObjCmdProc ZlibCmd;
+static Tcl_ObjCmdProc ZlibStreamCmd;
+static Tcl_ObjCmdProc ZlibStreamAddCmd;
+static Tcl_ObjCmdProc ZlibStreamHeaderCmd;
+static Tcl_ObjCmdProc ZlibStreamPutCmd;
+
+static void ConvertError(Tcl_Interp *interp, int code,
+ uLong adler);
+static Tcl_Obj * ConvertErrorToList(int code, uLong adler);
+static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
+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 Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp,
+ int mode, int format, int level, int limit,
+ Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr,
+ Tcl_Obj *compDictObj);
+static void ZlibStreamCleanup(ZlibStreamHandle *zshPtr);
+static int ZlibStreamSubcmd(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static inline void ZlibTransformEventTimerKill(ZlibChannelData *cd);
+static void ZlibTransformTimerRun(ClientData clientData);
/*
* Type of zlib-based compressing and decompressing channels.
@@ -167,7 +214,7 @@ static const Tcl_ChannelType zlibChannelType = {
NULL, /* close2Proc */
ZlibTransformBlockMode,
NULL, /* flushProc */
- ZlibTransformHandler,
+ ZlibTransformEventHandler,
NULL, /* wideSeekProc */
NULL,
NULL
@@ -193,38 +240,139 @@ static void
ConvertError(
Tcl_Interp *interp, /* Interpreter to store the error in. May be
* NULL, in which case nothing happens. */
- int code) /* The zlib error code. */
+ int code, /* The zlib error code. */
+ uLong adler) /* The checksum expected (for Z_NEED_DICT) */
{
+ const char *codeStr, *codeStr2 = NULL;
+ char codeStrBuf[TCL_INTEGER_SPACE];
+
if (interp == NULL) {
return;
}
- if (code == Z_ERRNO) {
+ switch (code) {
+ /*
+ * Firstly, the case that is *different* because it's really coming
+ * from the OS and is just being reported via zlib. It should be
+ * really uncommon because Tcl handles all I/O rather than delegating
+ * it to zlib, but proving it can't happen is hard.
+ */
+
+ case Z_ERRNO:
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp),-1));
- } else {
- const char *codeStr, *codeStr2 = NULL;
- char codeStrBuf[TCL_INTEGER_SPACE];
-
- switch (code) {
- case Z_STREAM_ERROR: codeStr = "STREAM"; break;
- case Z_DATA_ERROR: codeStr = "DATA"; break;
- case Z_MEM_ERROR: codeStr = "MEM"; break;
- case Z_BUF_ERROR: codeStr = "BUF"; break;
- case Z_VERSION_ERROR: codeStr = "VERSION"; break;
- default:
- codeStr = "unknown";
- codeStr2 = codeStrBuf;
- sprintf(codeStrBuf, "%d", code);
- break;
- }
- Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1));
+ return;
/*
- * Tricky point! We might pass NULL twice here (and will when the
- * error type is known).
+ * Normal errors/conditions, some of which have additional detail and
+ * some which don't. (This is not defined by array lookup because zlib
+ * error codes are sometimes negative.)
*/
- Tcl_SetErrorCode(interp, "TCL", "ZLIB", codeStr, codeStr2, NULL);
+ case Z_STREAM_ERROR:
+ codeStr = "STREAM";
+ break;
+ case Z_DATA_ERROR:
+ codeStr = "DATA";
+ break;
+ case Z_MEM_ERROR:
+ codeStr = "MEM";
+ break;
+ case Z_BUF_ERROR:
+ codeStr = "BUF";
+ break;
+ case Z_VERSION_ERROR:
+ codeStr = "VERSION";
+ break;
+ case Z_NEED_DICT:
+ codeStr = "NEED_DICT";
+ codeStr2 = codeStrBuf;
+ sprintf(codeStrBuf, "%lu", adler);
+ break;
+
+ /*
+ * These should _not_ happen! This function is for dealing with error
+ * cases, not non-errors!
+ */
+
+ case Z_OK:
+ Tcl_Panic("unexpected zlib result in error handler: Z_OK");
+ case Z_STREAM_END:
+ Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END");
+
+ /*
+ * Anything else is bad news; it's unexpected. Convert to generic
+ * error.
+ */
+
+ default:
+ codeStr = "UNKNOWN";
+ codeStr2 = codeStrBuf;
+ sprintf(codeStrBuf, "%d", code);
+ break;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1));
+
+ /*
+ * Tricky point! We might pass NULL twice here (and will when the error
+ * type is known).
+ */
+
+ Tcl_SetErrorCode(interp, "TCL", "ZLIB", codeStr, codeStr2, NULL);
+}
+
+static Tcl_Obj *
+ConvertErrorToList(
+ int code, /* The zlib error code. */
+ uLong adler) /* The checksum expected (for Z_NEED_DICT) */
+{
+ Tcl_Obj *objv[4];
+
+ TclNewLiteralStringObj(objv[0], "TCL");
+ TclNewLiteralStringObj(objv[1], "ZLIB");
+ switch (code) {
+ case Z_STREAM_ERROR:
+ TclNewLiteralStringObj(objv[2], "STREAM");
+ return Tcl_NewListObj(3, objv);
+ case Z_DATA_ERROR:
+ TclNewLiteralStringObj(objv[2], "DATA");
+ return Tcl_NewListObj(3, objv);
+ case Z_MEM_ERROR:
+ TclNewLiteralStringObj(objv[2], "MEM");
+ return Tcl_NewListObj(3, objv);
+ case Z_BUF_ERROR:
+ TclNewLiteralStringObj(objv[2], "BUF");
+ return Tcl_NewListObj(3, objv);
+ case Z_VERSION_ERROR:
+ TclNewLiteralStringObj(objv[2], "VERSION");
+ return Tcl_NewListObj(3, objv);
+ case Z_ERRNO:
+ TclNewLiteralStringObj(objv[2], "POSIX");
+ objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), -1);
+ return Tcl_NewListObj(4, objv);
+ case Z_NEED_DICT:
+ TclNewLiteralStringObj(objv[2], "NEED_DICT");
+ objv[3] = Tcl_NewWideIntObj((Tcl_WideInt) adler);
+ return Tcl_NewListObj(4, objv);
+
+ /*
+ * These should _not_ happen! This function is for dealing with error
+ * cases, not non-errors!
+ */
+
+ case Z_OK:
+ Tcl_Panic("unexpected zlib result in error handler: Z_OK");
+ case Z_STREAM_END:
+ Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END");
+
+ /*
+ * Catch-all. Should be unreachable because all cases are already
+ * listed above.
+ */
+
+ default:
+ TclNewLiteralStringObj(objv[2], "UNKNOWN");
+ TclNewIntObj(objv[3], code);
+ return Tcl_NewListObj(4, objv);
}
}
@@ -296,7 +444,9 @@ GenerateHeader(
NULL);
headerPtr->nativeCommentBuf[len] = '\0';
headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf;
- *extraSizePtr += len;
+ if (extraSizePtr != NULL) {
+ *extraSizePtr += len;
+ }
}
if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) {
@@ -314,7 +464,9 @@ GenerateHeader(
headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL);
headerPtr->nativeFilenameBuf[len] = '\0';
headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf;
- *extraSizePtr += len;
+ if (extraSizePtr != NULL) {
+ *extraSizePtr += len;
+ }
}
if (GetValue(interp, dictObj, "os", &value) != TCL_OK) {
@@ -355,7 +507,7 @@ GenerateHeader(
* ExtractHeader --
*
* Take the values out of a gzip header and store them in a dictionary.
- * SetValue is a helper function.
+ * SetValue is a helper macro.
*
* Results:
* None.
@@ -366,18 +518,8 @@ GenerateHeader(
*----------------------------------------------------------------------
*/
-static inline void
-SetValue(
- Tcl_Obj *dictObj,
- const char *key,
- Tcl_Obj *value)
-{
- Tcl_Obj *keyObj = Tcl_NewStringObj(key, -1);
-
- Tcl_IncrRefCount(keyObj);
- Tcl_DictObjPut(NULL, dictObj, keyObj, value);
- TclDecrRefCount(keyObj);
-}
+#define SetValue(dictObj, key, value) \
+ Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value))
static void
ExtractHeader(
@@ -401,9 +543,7 @@ ExtractHeader(
Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1,
&tmp);
- SetValue(dictObj, "comment", Tcl_NewStringObj(Tcl_DStringValue(&tmp),
- Tcl_DStringLength(&tmp)));
- Tcl_DStringFree(&tmp);
+ SetValue(dictObj, "comment", TclDStringToObj(&tmp));
}
SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
if (headerPtr->name != Z_NULL) {
@@ -420,9 +560,7 @@ ExtractHeader(
Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1,
&tmp);
- SetValue(dictObj, "filename", Tcl_NewStringObj(Tcl_DStringValue(&tmp),
- Tcl_DStringLength(&tmp)));
- Tcl_DStringFree(&tmp);
+ SetValue(dictObj, "filename", TclDStringToObj(&tmp));
}
if (headerPtr->os != 255) {
SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os));
@@ -440,6 +578,34 @@ ExtractHeader(
}
}
+static int
+SetInflateDictionary(
+ z_streamp strm,
+ Tcl_Obj *compDictObj)
+{
+ if (compDictObj != NULL) {
+ int length;
+ unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);
+
+ return inflateSetDictionary(strm, bytes, (unsigned) length);
+ }
+ return Z_OK;
+}
+
+static int
+SetDeflateDictionary(
+ z_streamp strm,
+ Tcl_Obj *compDictObj)
+{
+ if (compDictObj != NULL) {
+ int length;
+ unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);
+
+ return deflateSetDictionary(strm, bytes, (unsigned) length);
+ }
+ return Z_OK;
+}
+
/*
*----------------------------------------------------------------------
*
@@ -478,6 +644,7 @@ Tcl_ZlibStreamInit(
ZlibStreamHandle *zshPtr = NULL;
Tcl_DString cmdname;
Tcl_CmdInfo cmdinfo;
+ GzipHeader *gzHeaderPtr = NULL;
switch (mode) {
case TCL_ZLIB_STREAM_DEFLATE:
@@ -492,6 +659,15 @@ Tcl_ZlibStreamInit(
break;
case TCL_ZLIB_FORMAT_GZIP:
wbits = WBITS_GZIP;
+ if (dictObj) {
+ gzHeaderPtr = ckalloc(sizeof(GzipHeader));
+ memset(gzHeaderPtr, 0, sizeof(GzipHeader));
+ if (GenerateHeader(interp, dictObj, gzHeaderPtr,
+ NULL) != TCL_OK) {
+ ckfree(gzHeaderPtr);
+ return TCL_ERROR;
+ }
+ }
break;
case TCL_ZLIB_FORMAT_ZLIB:
wbits = WBITS_ZLIB;
@@ -518,6 +694,14 @@ Tcl_ZlibStreamInit(
break;
case TCL_ZLIB_FORMAT_GZIP:
wbits = WBITS_GZIP;
+ gzHeaderPtr = ckalloc(sizeof(GzipHeader));
+ memset(gzHeaderPtr, 0, sizeof(GzipHeader));
+ gzHeaderPtr->header.name = (Bytef *)
+ gzHeaderPtr->nativeFilenameBuf;
+ gzHeaderPtr->header.name_max = MAXPATHLEN - 1;
+ gzHeaderPtr->header.comment = (Bytef *)
+ gzHeaderPtr->nativeCommentBuf;
+ gzHeaderPtr->header.name_max = MAX_COMMENT_LEN - 1;
break;
case TCL_ZLIB_FORMAT_ZLIB:
wbits = WBITS_ZLIB;
@@ -536,7 +720,7 @@ Tcl_ZlibStreamInit(
" TCL_ZLIB_STREAM_INFLATE");
}
- zshPtr = (ZlibStreamHandle *) ckalloc(sizeof(ZlibStreamHandle));
+ zshPtr = ckalloc(sizeof(ZlibStreamHandle));
zshPtr->interp = interp;
zshPtr->mode = mode;
zshPtr->format = format;
@@ -544,7 +728,11 @@ Tcl_ZlibStreamInit(
zshPtr->wbits = wbits;
zshPtr->currentInput = NULL;
zshPtr->streamEnd = 0;
+ zshPtr->compDictObj = NULL;
+ zshPtr->flags = 0;
+ zshPtr->gzHeaderPtr = gzHeaderPtr;
memset(&zshPtr->stream, 0, sizeof(z_stream));
+ zshPtr->stream.adler = 1;
/*
* No output buffer available yet
@@ -553,12 +741,20 @@ Tcl_ZlibStreamInit(
if (mode == TCL_ZLIB_STREAM_DEFLATE) {
e = deflateInit2(&zshPtr->stream, level, Z_DEFLATED, wbits,
MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
+ if (e == Z_OK && zshPtr->gzHeaderPtr) {
+ e = deflateSetHeader(&zshPtr->stream,
+ &zshPtr->gzHeaderPtr->header);
+ }
} else {
e = inflateInit2(&zshPtr->stream, wbits);
+ if (e == Z_OK && zshPtr->gzHeaderPtr) {
+ e = inflateGetHeader(&zshPtr->stream,
+ &zshPtr->gzHeaderPtr->header);
+ }
}
if (e != Z_OK) {
- ConvertError(interp, e);
+ ConvertError(interp, e, zshPtr->stream.adler);
goto error;
}
@@ -567,17 +763,17 @@ Tcl_ZlibStreamInit(
*/
if (interp != NULL) {
- if (Tcl_Eval(interp, "incr ::tcl::zlib::cmdcounter") != TCL_OK) {
+ if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) {
goto error;
}
Tcl_DStringInit(&cmdname);
- Tcl_DStringAppend(&cmdname, "::tcl::zlib::streamcmd_", -1);
- Tcl_DStringAppend(&cmdname, Tcl_GetString(Tcl_GetObjResult(interp)),
- -1);
+ TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_");
+ TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp));
if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname),
&cmdinfo) == 1) {
- Tcl_SetResult(interp,
- "BUG: Stream command name already exists", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "BUG: Stream command name already exists", -1));
+ Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", NULL);
Tcl_DStringFree(&cmdname);
goto error;
}
@@ -618,8 +814,15 @@ Tcl_ZlibStreamInit(
}
return TCL_OK;
- error:
- ckfree((char *) zshPtr);
+
+ error:
+ if (zshPtr->compDictObj) {
+ Tcl_DecrRefCount(zshPtr->compDictObj);
+ }
+ if (zshPtr->gzHeaderPtr) {
+ ckfree(zshPtr->gzHeaderPtr);
+ }
+ ckfree(zshPtr);
return TCL_ERROR;
}
@@ -726,8 +929,14 @@ ZlibStreamCleanup(
if (zshPtr->currentInput) {
Tcl_DecrRefCount(zshPtr->currentInput);
}
+ if (zshPtr->compDictObj) {
+ Tcl_DecrRefCount(zshPtr->compDictObj);
+ }
+ if (zshPtr->gzHeaderPtr) {
+ ckfree(zshPtr->gzHeaderPtr);
+ }
- ckfree((char *) zshPtr);
+ ckfree(zshPtr);
}
/*
@@ -778,12 +987,24 @@ Tcl_ZlibStreamReset(
if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
e = deflateInit2(&zshPtr->stream, zshPtr->level, Z_DEFLATED,
zshPtr->wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
+ if (e == Z_OK && HaveDictToSet(zshPtr)) {
+ e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
+ if (e == Z_OK) {
+ DictWasSet(zshPtr);
+ }
+ }
} else {
e = inflateInit2(&zshPtr->stream, zshPtr->wbits);
+ if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr) && e == Z_OK) {
+ e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
+ if (e == Z_OK) {
+ DictWasSet(zshPtr);
+ }
+ }
}
if (e != Z_OK) {
- ConvertError(zshPtr->interp, e);
+ ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
/* TODO:cleanup */
return TCL_ERROR;
}
@@ -876,6 +1097,41 @@ Tcl_ZlibStreamChecksum(
/*
*----------------------------------------------------------------------
*
+ * Tcl_ZlibStreamSetCompressionDictionary --
+ *
+ * Sets the compression dictionary for a stream. This will be used as
+ * appropriate for the next compression or decompression action performed
+ * on the stream.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ZlibStreamSetCompressionDictionary(
+ Tcl_ZlibStream zshandle,
+ Tcl_Obj *compressionDictionaryObj)
+{
+ ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
+
+ if (compressionDictionaryObj != NULL) {
+ if (Tcl_IsShared(compressionDictionaryObj)) {
+ compressionDictionaryObj =
+ Tcl_DuplicateObj(compressionDictionaryObj);
+ }
+ Tcl_IncrRefCount(compressionDictionaryObj);
+ zshPtr->flags |= DICT_TO_SET;
+ } else {
+ zshPtr->flags &= ~DICT_TO_SET;
+ }
+ if (zshPtr->compDictObj != NULL) {
+ Tcl_DecrRefCount(zshPtr->compDictObj);
+ }
+ zshPtr->compDictObj = compressionDictionaryObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_ZlibStreamPut --
*
* Add data to the stream for compression or decompression from a
@@ -898,8 +1154,9 @@ Tcl_ZlibStreamPut(
if (zshPtr->streamEnd) {
if (zshPtr->interp) {
- Tcl_SetResult(zshPtr->interp,
- "already past compressed stream end", TCL_STATIC);
+ Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
+ "already past compressed stream end", -1));
+ Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL);
}
return TCL_ERROR;
}
@@ -908,6 +1165,17 @@ Tcl_ZlibStreamPut(
zshPtr->stream.next_in = Tcl_GetByteArrayFromObj(data, &size);
zshPtr->stream.avail_in = size;
+ if (HaveDictToSet(zshPtr)) {
+ e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
+ if (e != Z_OK) {
+ if (zshPtr->interp) {
+ ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
+ }
+ return TCL_ERROR;
+ }
+ DictWasSet(zshPtr);
+ }
+
/*
* Deflatebound doesn't seem to take various header sizes into
* account, so we add 100 extra bytes.
@@ -945,6 +1213,12 @@ Tcl_ZlibStreamPut(
e = deflate(&zshPtr->stream, flush);
}
+ if (e != Z_OK && !(flush==Z_FINISH && e==Z_STREAM_END)) {
+ if (zshPtr->interp) {
+ ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
+ }
+ return TCL_ERROR;
+ }
/*
* And append the final data block.
@@ -1022,7 +1296,7 @@ Tcl_ZlibStreamGet(
* panic for out of memory if we just kept growing the buffer.
*/
- count = 65536;
+ count = MAX_BUFFER_SIZE;
}
/*
@@ -1047,10 +1321,15 @@ Tcl_ZlibStreamGet(
if (listLen > 0) {
/*
* There is more input available, get it from the list and
- * give it to zlib.
+ * give it to zlib. At this point, the data must not be shared
+ * since we require the bytearray representation to not vanish
+ * under our feet. [Bug 3081008]
*/
Tcl_ListObjIndex(NULL, zshPtr->inData, 0, &itemObj);
+ if (Tcl_IsShared(itemObj)) {
+ itemObj = Tcl_DuplicateObj(itemObj);
+ }
itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
Tcl_IncrRefCount(itemObj);
zshPtr->currentInput = itemObj;
@@ -1062,11 +1341,33 @@ Tcl_ZlibStreamGet(
*/
Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL);
- listLen--;
}
}
+ /*
+ * When dealing with a raw stream, we set the dictionary here, once.
+ * (You can't do it in response to getting Z_NEED_DATA as raw streams
+ * don't ever issue that.)
+ */
+
+ if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr)) {
+ e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
+ if (e != Z_OK) {
+ if (zshPtr->interp) {
+ ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
+ }
+ return TCL_ERROR;
+ }
+ DictWasSet(zshPtr);
+ }
e = inflate(&zshPtr->stream, zshPtr->flush);
+ if (e == Z_NEED_DICT && HaveDictToSet(zshPtr)) {
+ e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
+ if (e == Z_OK) {
+ DictWasSet(zshPtr);
+ e = inflate(&zshPtr->stream, zshPtr->flush);
+ }
+ };
Tcl_ListObjLength(NULL, zshPtr->inData, &listLen);
while ((zshPtr->stream.avail_out > 0)
@@ -1078,9 +1379,11 @@ Tcl_ZlibStreamGet(
if (zshPtr->stream.avail_in > 0) {
if (zshPtr->interp) {
- Tcl_SetResult(zshPtr->interp,
- "Unexpected zlib internal state during decompression",
- TCL_STATIC);
+ Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
+ "unexpected zlib internal state during"
+ " decompression", -1));
+ Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "STATE",
+ NULL);
}
Tcl_SetByteArrayLength(data, existing);
return TCL_ERROR;
@@ -1092,10 +1395,15 @@ Tcl_ZlibStreamGet(
}
/*
- * Get the next block of data to go to inflate.
+ * Get the next block of data to go to inflate. At this point, the
+ * data must not be shared since we require the bytearray
+ * representation to not vanish under our feet. [Bug 3081008]
*/
Tcl_ListObjIndex(zshPtr->interp, zshPtr->inData, 0, &itemObj);
+ if (Tcl_IsShared(itemObj)) {
+ itemObj = Tcl_DuplicateObj(itemObj);
+ }
itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
Tcl_IncrRefCount(itemObj);
zshPtr->currentInput = itemObj;
@@ -1113,7 +1421,14 @@ Tcl_ZlibStreamGet(
* And call inflate again.
*/
- e = inflate(&zshPtr->stream, zshPtr->flush);
+ do {
+ e = inflate(&zshPtr->stream, zshPtr->flush);
+ if (e != Z_NEED_DICT || !HaveDictToSet(zshPtr)) {
+ break;
+ }
+ e = SetInflateDictionary(&zshPtr->stream,zshPtr->compDictObj);
+ DictWasSet(zshPtr);
+ } while (e == Z_OK);
}
if (zshPtr->stream.avail_out > 0) {
Tcl_SetByteArrayLength(data,
@@ -1121,7 +1436,7 @@ Tcl_ZlibStreamGet(
}
if (!(e==Z_OK || e==Z_STREAM_END || e==Z_BUF_ERROR)) {
Tcl_SetByteArrayLength(data, existing);
- ConvertError(zshPtr->interp, e);
+ ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
return TCL_ERROR;
}
if (e == Z_STREAM_END) {
@@ -1217,24 +1532,10 @@ Tcl_ZlibDeflate(
gz_header *headerPtr = NULL;
Tcl_Obj *obj;
- /*
- * We pass the data back in the interp result obj...
- */
-
if (!interp) {
return TCL_ERROR;
}
- obj = Tcl_GetObjResult(interp);
-
- /*
- * Make sure that the result is an unshared object. [Bug 2947783]
- */
-
- if (Tcl_IsShared(obj)) {
- obj = Tcl_DuplicateObj(obj);
- Tcl_SetObjResult(interp, obj);
- }
-
+
/*
* Compressed format is specified by the wbits parameter. See zlib.h for
* details.
@@ -1274,6 +1575,12 @@ Tcl_ZlibDeflate(
}
/*
+ * Allocate some space to store the output.
+ */
+
+ TclNewObj(obj);
+
+ /*
* Obtain the pointer to the byte array, we'll pass this pointer straight
* to the deflate command.
*/
@@ -1341,10 +1648,12 @@ Tcl_ZlibDeflate(
*/
Tcl_SetByteArrayLength(obj, stream.total_out);
+ Tcl_SetObjResult(interp, obj);
return TCL_OK;
error:
- ConvertError(interp, e);
+ ConvertError(interp, e, stream.adler);
+ TclDecrRefCount(obj);
return TCL_ERROR;
}
@@ -1373,23 +1682,9 @@ Tcl_ZlibInflate(
Tcl_Obj *obj;
char *nameBuf = NULL, *commentBuf = NULL;
- /*
- * We pass the data back in the interp result obj...
- */
-
if (!interp) {
return TCL_ERROR;
}
- obj = Tcl_GetObjResult(interp);
-
- /*
- * Make sure that the result is an unshared object. [Bug 2947783]
- */
-
- if (Tcl_IsShared(obj)) {
- obj = Tcl_DuplicateObj(obj);
- Tcl_SetObjResult(interp, obj);
- }
/*
* Compressed format is specified by the wbits parameter. See zlib.h for
@@ -1443,6 +1738,7 @@ Tcl_ZlibInflate(
}
}
+ TclNewObj(obj);
outData = Tcl_SetByteArrayLength(obj, bufferSize);
memset(&stream, 0, sizeof(z_stream));
stream.avail_in = (uInt) inLen+1; /* +1 because zlib can "over-request"
@@ -1530,10 +1826,12 @@ Tcl_ZlibInflate(
ckfree(nameBuf);
ckfree(commentBuf);
}
+ Tcl_SetObjResult(interp, obj);
return TCL_OK;
error:
- ConvertError(interp, e);
+ TclDecrRefCount(obj);
+ ConvertError(interp, e, stream.adler);
if (nameBuf) {
ckfree(nameBuf);
}
@@ -1589,12 +1887,10 @@ ZlibCmd(
int objc,
Tcl_Obj *const objv[])
{
- int command, dlen, mode, format, i, option, level = -1;
+ int command, dlen, i, option, level = -1;
unsigned start, buffersize = 0;
- Tcl_ZlibStream zh;
Byte *data;
- Tcl_Obj *obj = Tcl_GetObjResult(interp);
- Tcl_Obj *headerDictObj, *headerVarObj;
+ Tcl_Obj *headerDictObj;
const char *extraInfoStr = NULL;
static const char *const commands[] = {
"adler32", "compress", "crc32", "decompress", "deflate", "gunzip",
@@ -1605,14 +1901,6 @@ ZlibCmd(
CMD_ADLER, CMD_COMPRESS, CMD_CRC, CMD_DECOMPRESS, CMD_DEFLATE,
CMD_GUNZIP, CMD_GZIP, CMD_INFLATE, CMD_PUSH, CMD_STREAM
};
- static const char *const stream_formats[] = {
- "compress", "decompress", "deflate", "gunzip", "gzip", "inflate",
- NULL
- };
- enum zlibFormats {
- FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP,
- FMT_INFLATE
- };
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "command arg ?...?");
@@ -1638,8 +1926,8 @@ ZlibCmd(
start = Tcl_ZlibAdler32(0, NULL, 0);
}
data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
- Tcl_SetWideIntObj(obj,
- (Tcl_WideInt) Tcl_ZlibAdler32(start, data, dlen));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+ (uLong) Tcl_ZlibAdler32(start, data, dlen)));
return TCL_OK;
case CMD_CRC: /* crc32 str ?startvalue?
* -> checksum */
@@ -1655,8 +1943,8 @@ ZlibCmd(
start = Tcl_ZlibCRC32(0, NULL, 0);
}
data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
- Tcl_SetWideIntObj(obj,
- (Tcl_WideInt) Tcl_ZlibCRC32(start, data, dlen));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+ (uLong) Tcl_ZlibCRC32(start, data, dlen)));
return TCL_OK;
case CMD_DEFLATE: /* deflate data ?level?
* -> rawCompressedData */
@@ -1692,12 +1980,27 @@ ZlibCmd(
NULL);
case CMD_GZIP: /* gzip data ?level?
* -> gzippedCompressedData */
+ headerDictObj = NULL;
+
+ /*
+ * Legacy argument format support.
+ */
+
+ if (objc == 4
+ && Tcl_GetIntFromObj(interp, objv[3], &level) == TCL_OK) {
+ if (level < 0 || level > 9) {
+ extraInfoStr = "\n (in -level option)";
+ goto badLevel;
+ }
+ return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2],
+ level, NULL);
+ }
+
if (objc < 3 || objc > 7 || ((objc & 1) == 0)) {
Tcl_WrongNumArgs(interp, 2, objv,
"data ?-level level? ?-header header?");
return TCL_ERROR;
}
- headerDictObj = NULL;
for (i=3 ; i<objc ; i+=2) {
static const char *const gzipopts[] = {
"-header", "-level", NULL
@@ -1736,7 +2039,8 @@ ZlibCmd(
(int *) &buffersize) != TCL_OK) {
return TCL_ERROR;
}
- if (buffersize < 16 || buffersize > 65536) {
+ if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
+ || buffersize > MAX_BUFFER_SIZE) {
goto badBuffer;
}
}
@@ -1754,14 +2058,17 @@ ZlibCmd(
(int *) &buffersize) != TCL_OK) {
return TCL_ERROR;
}
- if (buffersize < 16 || buffersize > 65536) {
+ if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
+ || buffersize > MAX_BUFFER_SIZE) {
goto badBuffer;
}
}
return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2],
buffersize, NULL);
- case CMD_GUNZIP: /* gunzip gzippeddata ?bufferSize?
+ case CMD_GUNZIP: { /* gunzip gzippeddata ?bufferSize?
* -> decompressedData */
+ Tcl_Obj *headerVarObj;
+
if (objc < 3 || objc > 5 || ((objc & 1) == 0)) {
Tcl_WrongNumArgs(interp, 2, objv, "data ?-headerVar varName?");
return TCL_ERROR;
@@ -1782,7 +2089,8 @@ ZlibCmd(
(int *) &buffersize) != TCL_OK) {
return TCL_ERROR;
}
- if (buffersize < 16 || buffersize > 65536) {
+ if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
+ || buffersize > MAX_BUFFER_SIZE) {
goto badBuffer;
}
break;
@@ -1801,207 +2109,360 @@ ZlibCmd(
}
if (headerVarObj != NULL && Tcl_ObjSetVar2(interp, headerVarObj, NULL,
headerDictObj, TCL_LEAVE_ERR_MSG) == NULL) {
- if (headerDictObj) {
- TclDecrRefCount(headerDictObj);
- }
return TCL_ERROR;
}
return TCL_OK;
+ }
case CMD_STREAM: /* stream deflate/inflate/...gunzip \
- * ?level?
+ * ?options...?
* -> handleCmd */
- if (objc < 3 || objc > 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "mode ?level?");
- return TCL_ERROR;
- }
- if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
- &format) != TCL_OK) {
- return TCL_ERROR;
- }
- mode = TCL_ZLIB_STREAM_INFLATE;
- switch ((enum zlibFormats) format) {
- case FMT_DEFLATE:
- mode = TCL_ZLIB_STREAM_DEFLATE;
- case FMT_INFLATE:
- format = TCL_ZLIB_FORMAT_RAW;
- break;
- case FMT_COMPRESS:
- mode = TCL_ZLIB_STREAM_DEFLATE;
- case FMT_DECOMPRESS:
- format = TCL_ZLIB_FORMAT_ZLIB;
- break;
- case FMT_GZIP:
- mode = TCL_ZLIB_STREAM_DEFLATE;
- case FMT_GUNZIP:
- format = TCL_ZLIB_FORMAT_GZIP;
- break;
- }
- if (objc == 4) {
- if (Tcl_GetIntFromObj(interp, objv[3],
- (int *) &level) != TCL_OK) {
- return TCL_ERROR;
- }
- if (level < 0 || level > 9) {
- goto badLevel;
- }
- } else {
- level = Z_DEFAULT_COMPRESSION;
- }
- if (Tcl_ZlibStreamInit(interp, mode, format, level, NULL,
- &zh) != TCL_OK) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh));
- return TCL_OK;
- case CMD_PUSH: { /* push mode channel options...
+ return ZlibStreamSubcmd(interp, objc, objv);
+ case CMD_PUSH: /* push mode channel options...
* -> channel */
- Tcl_Channel chan;
- int chanMode;
- static const char *const pushOptions[] = {
- "-header", "-level", "-limit",
- NULL
- };
- enum pushOptions {poHeader, poLevel, poLimit};
- Tcl_Obj *headerObj = NULL;
- int limit = 1, dummy;
+ return ZlibPushSubcmd(interp, objc, objv);
+ };
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?");
- return TCL_ERROR;
- }
+ return TCL_ERROR;
- if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
- &format) != TCL_OK) {
- return TCL_ERROR;
- }
- switch ((enum zlibFormats) format) {
- case FMT_DEFLATE:
- mode = TCL_ZLIB_STREAM_DEFLATE;
- format = TCL_ZLIB_FORMAT_RAW;
- break;
- case FMT_INFLATE:
- mode = TCL_ZLIB_STREAM_INFLATE;
- format = TCL_ZLIB_FORMAT_RAW;
- break;
- case FMT_COMPRESS:
- mode = TCL_ZLIB_STREAM_DEFLATE;
- format = TCL_ZLIB_FORMAT_ZLIB;
- break;
- case FMT_DECOMPRESS:
- mode = TCL_ZLIB_STREAM_INFLATE;
- format = TCL_ZLIB_FORMAT_ZLIB;
- break;
- case FMT_GZIP:
- mode = TCL_ZLIB_STREAM_DEFLATE;
- format = TCL_ZLIB_FORMAT_GZIP;
- break;
- case FMT_GUNZIP:
- mode = TCL_ZLIB_STREAM_INFLATE;
- format = TCL_ZLIB_FORMAT_GZIP;
- break;
- default:
- Tcl_AppendResult(interp, "IMPOSSIBLE", NULL);
- return TCL_ERROR;
- }
+ badLevel:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
+ if (extraInfoStr) {
+ Tcl_AddErrorInfo(interp, extraInfoStr);
+ }
+ return TCL_ERROR;
+ badBuffer:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "buffer size must be %d to %d",
+ MIN_NONSTREAM_BUFFER_SIZE, MAX_BUFFER_SIZE));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibStreamSubcmd --
+ *
+ * Implementation of the [zlib stream] subcommand.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibStreamSubcmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ static const char *const stream_formats[] = {
+ "compress", "decompress", "deflate", "gunzip", "gzip", "inflate",
+ NULL
+ };
+ enum zlibFormats {
+ FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP,
+ FMT_INFLATE
+ };
+ int i, format, mode = 0, option, level;
+ enum objIndices {
+ OPT_COMPRESSION_DICTIONARY = 0,
+ OPT_GZIP_HEADER = 1,
+ OPT_COMPRESSION_LEVEL = 2,
+ OPT_END = -1
+ };
+ Tcl_Obj *obj[3] = { NULL, NULL, NULL };
+#define compDictObj obj[OPT_COMPRESSION_DICTIONARY]
+#define gzipHeaderObj obj[OPT_GZIP_HEADER]
+#define levelObj obj[OPT_COMPRESSION_LEVEL]
+ typedef struct {
+ const char *name;
+ enum objIndices offset;
+ } OptDescriptor;
+ static const OptDescriptor compressionOpts[] = {
+ { "-dictionary", OPT_COMPRESSION_DICTIONARY },
+ { "-level", OPT_COMPRESSION_LEVEL },
+ { NULL, OPT_END }
+ };
+ static const OptDescriptor gzipOpts[] = {
+ { "-header", OPT_GZIP_HEADER },
+ { "-level", OPT_COMPRESSION_LEVEL },
+ { NULL, OPT_END }
+ };
+ static const OptDescriptor expansionOpts[] = {
+ { "-dictionary", OPT_COMPRESSION_DICTIONARY },
+ { NULL, OPT_END }
+ };
+ static const OptDescriptor gunzipOpts[] = {
+ { NULL, OPT_END }
+ };
+ const OptDescriptor *desc = NULL;
+ Tcl_ZlibStream zh;
+
+ if (objc < 3 || !(objc & 1)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mode ?-option value...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
+ &format) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * The format determines the compression mode and the options that may be
+ * specified.
+ */
- if (TclGetChannelFromObj(interp, objv[3], &chan, &chanMode,
- 0) != TCL_OK) {
+ switch ((enum zlibFormats) format) {
+ case FMT_DEFLATE:
+ desc = compressionOpts;
+ mode = TCL_ZLIB_STREAM_DEFLATE;
+ format = TCL_ZLIB_FORMAT_RAW;
+ break;
+ case FMT_INFLATE:
+ desc = expansionOpts;
+ mode = TCL_ZLIB_STREAM_INFLATE;
+ format = TCL_ZLIB_FORMAT_RAW;
+ break;
+ case FMT_COMPRESS:
+ desc = compressionOpts;
+ mode = TCL_ZLIB_STREAM_DEFLATE;
+ format = TCL_ZLIB_FORMAT_ZLIB;
+ break;
+ case FMT_DECOMPRESS:
+ desc = expansionOpts;
+ mode = TCL_ZLIB_STREAM_INFLATE;
+ format = TCL_ZLIB_FORMAT_ZLIB;
+ break;
+ case FMT_GZIP:
+ desc = gzipOpts;
+ mode = TCL_ZLIB_STREAM_DEFLATE;
+ format = TCL_ZLIB_FORMAT_GZIP;
+ break;
+ case FMT_GUNZIP:
+ desc = gunzipOpts;
+ mode = TCL_ZLIB_STREAM_INFLATE;
+ format = TCL_ZLIB_FORMAT_GZIP;
+ break;
+ default:
+ Tcl_Panic("should be unreachable");
+ }
+
+ /*
+ * Parse the options.
+ */
+
+ for (i=3 ; i<objc ; i+=2) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], desc,
+ sizeof(OptDescriptor), "option", 0, &option) != TCL_OK) {
return TCL_ERROR;
}
+ obj[desc[option].offset] = objv[i+1];
+ }
- /*
- * Sanity checks.
- */
+ /*
+ * If a compression level was given, parse it (integral: 0..9). Otherwise
+ * use the default.
+ */
+
+ if (levelObj == NULL) {
+ level = Z_DEFAULT_COMPRESSION;
+ } else if (Tcl_GetIntFromObj(interp, levelObj, &level) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (level < 0 || level > 9) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
+ Tcl_AddErrorInfo(interp, "\n (in -level option)");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Construct the stream now we know its configuration.
+ */
+
+ if (Tcl_ZlibStreamInit(interp, mode, format, level, gzipHeaderObj,
+ &zh) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (compDictObj != NULL) {
+ Tcl_ZlibStreamSetCompressionDictionary(zh, compDictObj);
+ }
+ Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh));
+ return TCL_OK;
+#undef compDictObj
+#undef gzipHeaderObj
+#undef levelObj
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibPushSubcmd --
+ *
+ * Implementation of the [zlib push] subcommand.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibPushSubcmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ static const char *const stream_formats[] = {
+ "compress", "decompress", "deflate", "gunzip", "gzip", "inflate",
+ NULL
+ };
+ enum zlibFormats {
+ FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP,
+ FMT_INFLATE
+ };
+ Tcl_Channel chan;
+ int chanMode, format, mode = 0, level, i, option;
+ static const char *const pushCompressOptions[] = {
+ "-dictionary", "-header", "-level", NULL
+ };
+ static const char *const pushDecompressOptions[] = {
+ "-dictionary", "-header", "-level", "-limit", NULL
+ };
+ const char *const *pushOptions = pushDecompressOptions;
+ enum pushOptions {poDictionary, poHeader, poLevel, poLimit};
+ Tcl_Obj *headerObj = NULL, *compDictObj = NULL;
+ int limit = 1, dummy;
- if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) {
- Tcl_AppendResult(interp,
- "compression may only be applied to writable channels",
- NULL);
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
+ &format) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum zlibFormats) format) {
+ case FMT_DEFLATE:
+ mode = TCL_ZLIB_STREAM_DEFLATE;
+ format = TCL_ZLIB_FORMAT_RAW;
+ pushOptions = pushCompressOptions;
+ break;
+ case FMT_INFLATE:
+ mode = TCL_ZLIB_STREAM_INFLATE;
+ format = TCL_ZLIB_FORMAT_RAW;
+ break;
+ case FMT_COMPRESS:
+ mode = TCL_ZLIB_STREAM_DEFLATE;
+ format = TCL_ZLIB_FORMAT_ZLIB;
+ pushOptions = pushCompressOptions;
+ break;
+ case FMT_DECOMPRESS:
+ mode = TCL_ZLIB_STREAM_INFLATE;
+ format = TCL_ZLIB_FORMAT_ZLIB;
+ break;
+ case FMT_GZIP:
+ mode = TCL_ZLIB_STREAM_DEFLATE;
+ format = TCL_ZLIB_FORMAT_GZIP;
+ pushOptions = pushCompressOptions;
+ break;
+ case FMT_GUNZIP:
+ mode = TCL_ZLIB_STREAM_INFLATE;
+ format = TCL_ZLIB_FORMAT_GZIP;
+ break;
+ default:
+ Tcl_Panic("should be unreachable");
+ }
+
+ if (TclGetChannelFromObj(interp, objv[3], &chan, &chanMode, 0) != TCL_OK){
+ return TCL_ERROR;
+ }
+
+ /*
+ * Sanity checks.
+ */
+
+ if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "compression may only be applied to writable channels", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", NULL);
+ return TCL_ERROR;
+ }
+ if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "decompression may only be applied to readable channels",-1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse options.
+ */
+
+ level = Z_DEFAULT_COMPRESSION;
+ for (i=4 ; i<objc ; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], pushOptions, "option", 0,
+ &option) != TCL_OK) {
return TCL_ERROR;
}
- if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) {
- Tcl_AppendResult(interp,
- "decompression may only be applied to readable channels",
- NULL);
+ if (++i > objc-1) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value missing for %s option", pushOptions[option]));
+ Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
return TCL_ERROR;
}
-
- /*
- * Parse options.
- */
-
- level = Z_DEFAULT_COMPRESSION;
- for (i=4 ; i<objc ; i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], pushOptions, "option", 0,
- &option) != TCL_OK) {
- return TCL_ERROR;
+ switch ((enum pushOptions) option) {
+ case poHeader:
+ headerObj = objv[i];
+ if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) {
+ goto genericOptionError;
}
- switch ((enum pushOptions) option) {
- case poHeader:
- if (++i > objc-1) {
- Tcl_AppendResult(interp,
- "value missing for -header option", NULL);
- return TCL_ERROR;
- }
- headerObj = objv[i];
- if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) {
- Tcl_AddErrorInfo(interp, "\n (in -header option)");
- return TCL_ERROR;
- }
- break;
- case poLevel:
- if (++i > objc-1) {
- Tcl_AppendResult(interp,
- "value missing for -level option", NULL);
- return TCL_ERROR;
- }
- if (Tcl_GetIntFromObj(interp, objv[i],
- (int *) &level) != TCL_OK) {
- Tcl_AddErrorInfo(interp, "\n (in -level option)");
- return TCL_ERROR;
- }
- if (level < 0 || level > 9) {
- extraInfoStr = "\n (in -level option)";
- goto badLevel;
- }
- break;
- case poLimit:
- if (++i > objc-1) {
- Tcl_AppendResult(interp,
- "value missing for -limit option", NULL);
- return TCL_ERROR;
- }
- if (Tcl_GetIntFromObj(interp, objv[i],
- (int *) &limit) != TCL_OK) {
- Tcl_AddErrorInfo(interp, "\n (in -limit option)");
- return TCL_ERROR;
- }
- if (limit < 1) {
- limit = 1;
- }
- break;
+ break;
+ case poLevel:
+ if (Tcl_GetIntFromObj(interp, objv[i], (int*) &level) != TCL_OK) {
+ goto genericOptionError;
}
+ if (level < 0 || level > 9) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "level must be 0 to 9", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL",
+ NULL);
+ goto genericOptionError;
+ }
+ break;
+ case poLimit:
+ if (Tcl_GetIntFromObj(interp, objv[i], (int*) &limit) != TCL_OK) {
+ goto genericOptionError;
+ }
+ if (limit < 1 || limit > MAX_BUFFER_SIZE) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "read ahead limit must be 1 to %d",
+ MAX_BUFFER_SIZE));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
+ goto genericOptionError;
+ }
+ break;
+ case poDictionary:
+ if (format == TCL_ZLIB_FORMAT_GZIP) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "a compression dictionary may not be set in the "
+ "gzip format", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOPT", NULL);
+ goto genericOptionError;
+ }
+ compDictObj = objv[i];
+ break;
}
-
- if (ZlibStackChannelTransform(interp, mode, format, level, chan,
- headerObj) == NULL) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, objv[3]);
- return TCL_OK;
}
- };
-
- return TCL_ERROR;
- badLevel:
- Tcl_AppendResult(interp, "level must be 0 to 9", NULL);
- if (extraInfoStr) {
- Tcl_AddErrorInfo(interp, extraInfoStr);
+ if (ZlibStackChannelTransform(interp, mode, format, level, limit, chan,
+ headerObj, compDictObj) == NULL) {
+ return TCL_ERROR;
}
- return TCL_ERROR;
- badBuffer:
- Tcl_AppendResult(interp, "buffer size must be 32 to 65536", NULL);
+ Tcl_SetObjResult(interp, objv[3]);
+ return TCL_OK;
+
+ genericOptionError:
+ Tcl_AddErrorInfo(interp, "\n (in ");
+ Tcl_AddErrorInfo(interp, pushOptions[option]);
+ Tcl_AddErrorInfo(interp, " option)");
return TCL_ERROR;
}
@@ -2023,24 +2484,16 @@ ZlibStreamCmd(
Tcl_Obj *const objv[])
{
Tcl_ZlibStream zstream = cd;
- int command, index, count;
- Tcl_Obj *obj = Tcl_GetObjResult(interp);
- int buffersize;
- int flush = -1, i;
+ int command, count, code;
+ Tcl_Obj *obj;
static const char *const cmds[] = {
"add", "checksum", "close", "eof", "finalize", "flush",
- "fullflush", "get", "put", "reset",
+ "fullflush", "get", "header", "put", "reset",
NULL
};
enum zlibStreamCommands {
zs_add, zs_checksum, zs_close, zs_eof, zs_finalize, zs_flush,
- zs_fullflush, zs_get, zs_put, zs_reset
- };
- static const char *const add_options[] = {
- "-buffer", "-finalize", "-flush", "-fullflush", NULL
- };
- enum addOptions {
- ao_buffer, ao_finalize, ao_flush, ao_fullflush
+ zs_fullflush, zs_get, zs_header, zs_put, zs_reset
};
if (objc < 2) {
@@ -2055,107 +2508,11 @@ ZlibStreamCmd(
switch ((enum zlibStreamCommands) command) {
case zs_add: /* $strm add ?$flushopt? $data */
- for (i=2; i<objc-1; i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], add_options, "option", 0,
- &index) != TCL_OK) {
- return TCL_ERROR;
- }
-
- switch ((enum addOptions) index) {
- case ao_flush: /* -flush */
- if (flush > -1) {
- flush = -2;
- } else {
- flush = Z_SYNC_FLUSH;
- }
- break;
- case ao_fullflush: /* -fullflush */
- if (flush > -1) {
- flush = -2;
- } else {
- flush = Z_FULL_FLUSH;
- }
- break;
- case ao_finalize: /* -finalize */
- if (flush > -1) {
- flush = -2;
- } else {
- flush = Z_FINISH;
- }
- break;
- case ao_buffer: /* -buffer */
- if (i == objc-2) {
- Tcl_AppendResult(interp, "\"-buffer\" option must be "
- "followed by integer decompression buffersize",
- NULL);
- return TCL_ERROR;
- }
- if (Tcl_GetIntFromObj(interp, objv[i+1],
- &buffersize) != TCL_OK) {
- return TCL_ERROR;
- }
- }
-
- if (flush == -2) {
- Tcl_AppendResult(interp, "\"-flush\", \"-fullflush\" and "
- "\"-finalize\" options are mutually exclusive", NULL);
- return TCL_ERROR;
- }
- }
- if (flush == -1) {
- flush = 0;
- }
-
- if (Tcl_ZlibStreamPut(zstream, objv[objc-1],
- flush) != TCL_OK) {
- return TCL_ERROR;
- }
- return Tcl_ZlibStreamGet(zstream, obj, -1);
-
+ return ZlibStreamAddCmd(zstream, interp, objc, objv);
+ case zs_header: /* $strm header */
+ return ZlibStreamHeaderCmd(zstream, interp, objc, objv);
case zs_put: /* $strm put ?$flushopt? $data */
- for (i=2; i<objc-1; i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], add_options, "option", 0,
- &index) != TCL_OK) {
- return TCL_ERROR;
- }
-
- switch ((enum addOptions) index) {
- case ao_flush: /* -flush */
- if (flush > -1) {
- flush = -2;
- } else {
- flush = Z_SYNC_FLUSH;
- }
- break;
- case ao_fullflush: /* -fullflush */
- if (flush > -1) {
- flush = -2;
- } else {
- flush = Z_FULL_FLUSH;
- }
- break;
- case ao_finalize: /* -finalize */
- if (flush > -1) {
- flush = -2;
- } else {
- flush = Z_FINISH;
- }
- break;
- case ao_buffer:
- Tcl_AppendResult(interp,
- "\"-buffer\" option not supported here", NULL);
- return TCL_ERROR;
- }
- if (flush == -2) {
- Tcl_AppendResult(interp, "\"-flush\", \"-fullflush\" and "
- "\"-finalize\" options are mutually exclusive", NULL);
- return TCL_ERROR;
- }
- }
- if (flush == -1) {
- flush = 0;
- }
- return Tcl_ZlibStreamPut(zstream, objv[objc-1], flush);
+ return ZlibStreamPutCmd(zstream, interp, objc, objv);
case zs_get: /* $strm get ?count? */
if (objc > 3) {
@@ -2169,33 +2526,50 @@ ZlibStreamCmd(
return TCL_ERROR;
}
}
- return Tcl_ZlibStreamGet(zstream, obj, count);
+ TclNewObj(obj);
+ code = Tcl_ZlibStreamGet(zstream, obj, count);
+ if (code == TCL_OK) {
+ Tcl_SetObjResult(interp, obj);
+ } else {
+ TclDecrRefCount(obj);
+ }
+ return code;
case zs_flush: /* $strm flush */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- Tcl_SetObjLength(obj, 0);
- return Tcl_ZlibStreamPut(zstream, obj, Z_SYNC_FLUSH);
+ TclNewObj(obj);
+ Tcl_IncrRefCount(obj);
+ code = Tcl_ZlibStreamPut(zstream, obj, Z_SYNC_FLUSH);
+ TclDecrRefCount(obj);
+ return code;
case zs_fullflush: /* $strm fullflush */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- Tcl_SetObjLength(obj, 0);
- return Tcl_ZlibStreamPut(zstream, obj, Z_FULL_FLUSH);
+ TclNewObj(obj);
+ Tcl_IncrRefCount(obj);
+ code = Tcl_ZlibStreamPut(zstream, obj, Z_FULL_FLUSH);
+ TclDecrRefCount(obj);
+ return code;
case zs_finalize: /* $strm finalize */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
+
/*
* The flush commands slightly abuse the empty result obj as input
* data.
*/
- Tcl_SetObjLength(obj, 0);
- return Tcl_ZlibStreamPut(zstream, obj, Z_FINISH);
+ TclNewObj(obj);
+ Tcl_IncrRefCount(obj);
+ code = Tcl_ZlibStreamPut(zstream, obj, Z_FINISH);
+ TclDecrRefCount(obj);
+ return code;
case zs_close: /* $strm close */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -2207,14 +2581,15 @@ ZlibStreamCmd(
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- Tcl_SetIntObj(obj, Tcl_ZlibStreamEof(zstream));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_ZlibStreamEof(zstream)));
return TCL_OK;
case zs_checksum: /* $strm checksum */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- Tcl_SetWideIntObj(obj, (Tcl_WideInt) Tcl_ZlibStreamChecksum(zstream));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+ (uLong) Tcl_ZlibStreamChecksum(zstream)));
return TCL_OK;
case zs_reset: /* $strm reset */
if (objc != 2) {
@@ -2226,11 +2601,257 @@ ZlibStreamCmd(
return TCL_OK;
}
+
+static int
+ZlibStreamAddCmd(
+ ClientData cd,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_ZlibStream zstream = cd;
+ int index, code, buffersize = -1, flush = -1, i;
+ Tcl_Obj *obj, *compDictObj = NULL;
+ static const char *const add_options[] = {
+ "-buffer", "-dictionary", "-finalize", "-flush", "-fullflush", NULL
+ };
+ enum addOptions {
+ ao_buffer, ao_dictionary, ao_finalize, ao_flush, ao_fullflush
+ };
+
+ for (i=2; i<objc-1; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], add_options, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum addOptions) index) {
+ case ao_flush: /* -flush */
+ if (flush > -1) {
+ flush = -2;
+ } else {
+ flush = Z_SYNC_FLUSH;
+ }
+ break;
+ case ao_fullflush: /* -fullflush */
+ if (flush > -1) {
+ flush = -2;
+ } else {
+ flush = Z_FULL_FLUSH;
+ }
+ break;
+ case ao_finalize: /* -finalize */
+ if (flush > -1) {
+ flush = -2;
+ } else {
+ flush = Z_FINISH;
+ }
+ break;
+ case ao_buffer: /* -buffer */
+ if (i == objc-2) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-buffer\" option must be followed by integer "
+ "decompression buffersize", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[++i], &buffersize) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (buffersize < 1 || buffersize > MAX_BUFFER_SIZE) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "buffer size must be 1 to %d",
+ MAX_BUFFER_SIZE));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
+ return TCL_ERROR;
+ }
+ break;
+ case ao_dictionary:
+ if (i == objc-2) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-dictionary\" option must be followed by"
+ " compression dictionary bytes", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
+ return TCL_ERROR;
+ }
+ compDictObj = objv[++i];
+ break;
+ }
+
+ if (flush == -2) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-flush\", \"-fullflush\" and \"-finalize\" options"
+ " are mutually exclusive", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (flush == -1) {
+ flush = 0;
+ }
+
+ /*
+ * Set the compression dictionary if requested.
+ */
+
+ if (compDictObj != NULL) {
+ int len;
+
+ (void) Tcl_GetByteArrayFromObj(compDictObj, &len);
+ if (len == 0) {
+ compDictObj = NULL;
+ }
+ Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj);
+ }
+
+ /*
+ * Send the data to the stream core, along with any flushing directive.
+ */
+
+ if (Tcl_ZlibStreamPut(zstream, objv[objc-1], flush) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get such data out as we can (up to the requested length).
+ */
+
+ TclNewObj(obj);
+ code = Tcl_ZlibStreamGet(zstream, obj, buffersize);
+ if (code == TCL_OK) {
+ Tcl_SetObjResult(interp, obj);
+ } else {
+ TclDecrRefCount(obj);
+ }
+ return code;
+}
+
+static int
+ZlibStreamPutCmd(
+ ClientData cd,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_ZlibStream zstream = cd;
+ int index, flush = -1, i;
+ Tcl_Obj *compDictObj = NULL;
+ static const char *const put_options[] = {
+ "-dictionary", "-finalize", "-flush", "-fullflush", NULL
+ };
+ enum putOptions {
+ po_dictionary, po_finalize, po_flush, po_fullflush
+ };
+
+ for (i=2; i<objc-1; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], put_options, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum putOptions) index) {
+ case po_flush: /* -flush */
+ if (flush > -1) {
+ flush = -2;
+ } else {
+ flush = Z_SYNC_FLUSH;
+ }
+ break;
+ case po_fullflush: /* -fullflush */
+ if (flush > -1) {
+ flush = -2;
+ } else {
+ flush = Z_FULL_FLUSH;
+ }
+ break;
+ case po_finalize: /* -finalize */
+ if (flush > -1) {
+ flush = -2;
+ } else {
+ flush = Z_FINISH;
+ }
+ break;
+ case po_dictionary:
+ if (i == objc-2) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-dictionary\" option must be followed by"
+ " compression dictionary bytes", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
+ return TCL_ERROR;
+ }
+ compDictObj = objv[++i];
+ break;
+ }
+ if (flush == -2) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-flush\", \"-fullflush\" and \"-finalize\" options"
+ " are mutually exclusive", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (flush == -1) {
+ flush = 0;
+ }
+
+ /*
+ * Set the compression dictionary if requested.
+ */
+
+ if (compDictObj != NULL) {
+ int len;
+
+ (void) Tcl_GetByteArrayFromObj(compDictObj, &len);
+ if (len == 0) {
+ compDictObj = NULL;
+ }
+ Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj);
+ }
+
+ /*
+ * Send the data to the stream core, along with any flushing directive.
+ */
+
+ return Tcl_ZlibStreamPut(zstream, objv[objc-1], flush);
+}
+
+static int
+ZlibStreamHeaderCmd(
+ ClientData cd,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ ZlibStreamHandle *zshPtr = cd;
+ Tcl_Obj *resultObj;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ } else if (zshPtr->mode != TCL_ZLIB_STREAM_INFLATE
+ || zshPtr->format != TCL_ZLIB_FORMAT_GZIP) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "only gunzip streams can produce header information", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOP", NULL);
+ return TCL_ERROR;
+ }
+
+ TclNewObj(resultObj);
+ ExtractHeader(&zshPtr->gzHeaderPtr->header, resultObj);
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
/*
*----------------------------------------------------------------------
* Set of functions to support channel stacking.
*----------------------------------------------------------------------
+ *
+ * ZlibTransformClose --
+ *
+ * How to shut down a stacked compressing/decompressing transform.
+ *
+ *----------------------------------------------------------------------
*/
static int
@@ -2241,7 +2862,16 @@ ZlibTransformClose(
ZlibChannelData *cd = instanceData;
int e, result = TCL_OK;
- ZlibTransformTimerKill(cd);
+ /*
+ * Delete the support timer.
+ */
+
+ ZlibTransformEventTimerKill(cd);
+
+ /*
+ * Flush any data waiting to be compressed.
+ */
+
if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
cd->outStream.avail_in = 0;
do {
@@ -2251,7 +2881,7 @@ ZlibTransformClose(
if (e != Z_OK && e != Z_STREAM_END) {
/* TODO: is this the right way to do errors on close? */
if (!TclInThreadExit()) {
- ConvertError(interp, e);
+ ConvertError(interp, e, cd->outStream.adler);
}
result = TCL_ERROR;
break;
@@ -2262,23 +2892,27 @@ ZlibTransformClose(
/* TODO: is this the right way to do errors on close?
* Note: when close is called from FinalizeIOSubsystem
* then interp may be NULL */
- if (!TclInThreadExit()) {
- if (interp) {
- Tcl_AppendResult(interp,
- "error while finalizing file: ",
- Tcl_PosixError(interp), NULL);
- }
+ if (!TclInThreadExit() && interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error while finalizing file: %s",
+ Tcl_PosixError(interp)));
}
result = TCL_ERROR;
break;
}
}
} while (e != Z_STREAM_END);
- e = deflateEnd(&cd->inStream);
+ e = deflateEnd(&cd->outStream);
} else {
- e = inflateEnd(&cd->outStream);
+ e = inflateEnd(&cd->inStream);
}
+ /*
+ * Release all memory.
+ */
+
+ Tcl_DStringFree(&cd->decompressed);
+
if (cd->inBuffer) {
ckfree(cd->inBuffer);
cd->inBuffer = NULL;
@@ -2287,8 +2921,19 @@ ZlibTransformClose(
ckfree(cd->outBuffer);
cd->outBuffer = NULL;
}
+ ckfree(cd);
return result;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformInput --
+ *
+ * Reader filter that does decompression.
+ *
+ *----------------------------------------------------------------------
+ */
static int
ZlibTransformInput(
@@ -2300,78 +2945,144 @@ ZlibTransformInput(
ZlibChannelData *cd = instanceData;
Tcl_DriverInputProc *inProc =
Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent));
- int e, readBytes, flush = Z_NO_FLUSH;
+ int readBytes, gotBytes, copied;
if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead,
errorCodePtr);
}
- cd->inStream.next_out = (Bytef *) buf;
- cd->inStream.avail_out = toRead;
- if (cd->inStream.next_in == NULL) {
- goto doReadFirst;
- }
- while (1) {
- e = inflate(&cd->inStream, flush);
- if ((e == Z_STREAM_END) || (e==Z_OK && cd->inStream.avail_out==0)) {
- return toRead - cd->inStream.avail_out;
- }
-
+ gotBytes = 0;
+ while (toRead > 0) {
/*
- * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html
- *
- * Just indicates that the zlib couldn't consume input/produce output,
- * and is fixed by supplying more input.
+ * Loop until the request is satisfied (or no data available from
+ * below, possibly EOF).
*/
- if ((e != Z_OK) && (e != Z_BUF_ERROR)) {
- Tcl_Obj *errObj = Tcl_NewListObj(0, NULL);
+ copied = ResultCopy(cd, buf, toRead);
+ toRead -= copied;
+ buf += copied;
+ gotBytes += copied;
- Tcl_ListObjAppendElement(NULL, errObj,
- Tcl_NewStringObj(cd->inStream.msg, -1));
- Tcl_SetChannelError(cd->parent, errObj);
- *errorCodePtr = EINVAL;
- return -1;
+ if (toRead == 0) {
+ return gotBytes;
}
/*
- * Check if the inflate stopped early.
+ * 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.
*/
- if (cd->inStream.avail_in > 0) {
- continue;
- }
+ readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, cd->readAheadLimit);
/*
- * Emptied the buffer of data from the underlying channel. Get some
- * more.
+ * Three cases here:
+ * 1. Got some data from the underlying channel (readBytes > 0) so
+ * it should be fed through the decompression engine.
+ * 2. Got an error (readBytes < 0) which we should report up except
+ * for the case where we can convert it to a short read.
+ * 3. Got an end-of-data from EOF or blocking (readBytes == 0). If
+ * it is EOF, try flushing the data out of the decompressor.
*/
- doReadFirst:
- /*
- * Hack for Bug 2762041. Disable pre-reading of lots of input, read
- * only one character. This way the Z_END_OF_STREAM can be read
- * without triggering an EOF in the base channel. The higher input
- * loops in DoReadChars() would react to that by stopping, despite the
- * transform still having data which could be read.
- *
- * This is only a hack because other transforms may not be able to
- * work around the general problem in this way.
- */
-
- readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, 1);
if (readBytes < 0) {
+ /*
+ * Report errors to caller. The state of the seek system is
+ * unchanged!
+ */
+
+ if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
+ /*
+ * EAGAIN is a special situation. If we had some data before
+ * we report that instead of the request to re-try.
+ */
+
+ return gotBytes;
+ }
+
*errorCodePtr = Tcl_GetErrno();
return -1;
} else if (readBytes == 0) {
- flush = Z_SYNC_FLUSH;
- }
+ /*
+ * Check wether we hit on EOF in 'parent' or not. If not,
+ * differentiate between blocking and non-blocking modes. In
+ * non-blocking mode we ran temporarily out of data. Signal this
+ * to the caller via EWOULDBLOCK and error return (-1). In the
+ * other cases we simply return what we got and let the caller
+ * wait for more. On the other hand, if we got an EOF we have to
+ * convert and flush all waiting partial data.
+ */
- cd->inStream.next_in = (Bytef *) cd->inBuffer;
- cd->inStream.avail_in = readBytes;
+ if (!Tcl_Eof(cd->parent)) {
+ /*
+ * The state of the seek system is unchanged!
+ */
+
+ if ((gotBytes == 0) && (cd->flags & ASYNC)) {
+ *errorCodePtr = EWOULDBLOCK;
+ return -1;
+ }
+ return gotBytes;
+ }
+
+ /*
+ * (Semi-)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;
+ }
+
+ if (Tcl_DStringLength(&cd->decompressed) == 0) {
+ /*
+ * The drain delivered nothing. Time to deliver what we've
+ * got.
+ */
+
+ return gotBytes;
+ }
+
+ /*
+ * Reset eof, force caller to drain result buffer.
+ */
+
+ ((Channel *) cd->parent)->state->flags &= ~CHANNEL_EOF;
+ } else /* readBytes > 0 */ {
+ /*
+ * 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.
+ */
+
+ if (ResultGenerate(cd, readBytes, Z_NO_FLUSH,
+ errorCodePtr) != TCL_OK) {
+ return -1;
+ }
+ }
}
+ return gotBytes;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformOutput --
+ *
+ * Writer filter that does compression.
+ *
+ *----------------------------------------------------------------------
+ */
static int
ZlibTransformOutput(
@@ -2384,6 +3095,7 @@ ZlibTransformOutput(
Tcl_DriverOutputProc *outProc =
Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent));
int e, produced;
+ Tcl_Obj *errObj;
if (cd->mode == TCL_ZLIB_STREAM_INFLATE) {
return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite,
@@ -2407,15 +3119,30 @@ ZlibTransformOutput(
}
} while (e == Z_OK && produced > 0 && cd->outStream.avail_in > 0);
- if (e != Z_OK) {
- Tcl_SetChannelError(cd->parent,
- Tcl_NewStringObj(cd->outStream.msg, -1));
- *errorCodePtr = EINVAL;
- return -1;
+ if (e == Z_OK) {
+ return toWrite - cd->outStream.avail_in;
}
- return toWrite - cd->outStream.avail_out;
+ errObj = Tcl_NewListObj(0, NULL);
+ Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1));
+ Tcl_ListObjAppendElement(NULL, errObj,
+ ConvertErrorToList(e, cd->outStream.adler));
+ Tcl_ListObjAppendElement(NULL, errObj,
+ Tcl_NewStringObj(cd->outStream.msg, -1));
+ Tcl_SetChannelError(cd->parent, errObj);
+ *errorCodePtr = EINVAL;
+ return -1;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformSetOption --
+ *
+ * Writing side of [fconfigure] on our channel.
+ *
+ *----------------------------------------------------------------------
+ */
static int
ZlibTransformSetOption( /* not used */
@@ -2427,57 +3154,133 @@ ZlibTransformSetOption( /* not used */
ZlibChannelData *cd = instanceData;
Tcl_DriverSetOptionProc *setOptionProc =
Tcl_ChannelSetOptionProc(Tcl_GetChannelType(cd->parent));
- static const char *chanOptions = "flush";
+ static const char *compressChanOptions = "dictionary flush";
+ static const char *gzipChanOptions = "flush";
+ static const char *decompressChanOptions = "dictionary limit";
+ static const char *gunzipChanOptions = "flush limit";
int haveFlushOpt = (cd->mode == TCL_ZLIB_STREAM_DEFLATE);
- if (haveFlushOpt && optionName && strcmp(optionName, "-flush") == 0) {
- int flushType;
+ if (optionName && (strcmp(optionName, "-dictionary") == 0)
+ && (cd->format != TCL_ZLIB_FORMAT_GZIP)) {
+ Tcl_Obj *compDictObj;
+ int code;
- if (value[0] == 'f' && strcmp(value, "full") == 0) {
- flushType = Z_FULL_FLUSH;
- goto doFlush;
+ TclNewStringObj(compDictObj, value, strlen(value));
+ Tcl_IncrRefCount(compDictObj);
+ (void) Tcl_GetByteArrayFromObj(compDictObj, NULL);
+ if (cd->compDictObj) {
+ TclDecrRefCount(cd->compDictObj);
}
- if (value[0] == 's' && strcmp(value, "sync") == 0) {
- flushType = Z_SYNC_FLUSH;
- goto doFlush;
+ cd->compDictObj = compDictObj;
+ code = Z_OK;
+ if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
+ code = SetDeflateDictionary(&cd->outStream, compDictObj);
+ if (code != Z_OK) {
+ ConvertError(interp, code, cd->outStream.adler);
+ return TCL_ERROR;
+ }
+ } else if (cd->format == TCL_ZLIB_FORMAT_RAW) {
+ code = SetInflateDictionary(&cd->inStream, compDictObj);
+ if (code != Z_OK) {
+ ConvertError(interp, code, cd->inStream.adler);
+ return TCL_ERROR;
+ }
}
- Tcl_AppendResult(interp, "unknown -flush type \"", value,
- "\": must be full or sync", NULL);
- return TCL_ERROR;
-
- doFlush:
- cd->outStream.avail_in = 0;
- do {
- int e;
+ return TCL_OK;
+ }
- cd->outStream.next_out = (Bytef *) cd->outBuffer;
- cd->outStream.avail_out = cd->outAllocated;
+ if (haveFlushOpt) {
+ if (optionName && strcmp(optionName, "-flush") == 0) {
+ int flushType;
- e = deflate(&cd->outStream, flushType);
- if (e != Z_OK) {
- ConvertError(interp, e);
+ if (value[0] == 'f' && strcmp(value, "full") == 0) {
+ flushType = Z_FULL_FLUSH;
+ } else if (value[0] == 's' && strcmp(value, "sync") == 0) {
+ flushType = Z_SYNC_FLUSH;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown -flush type \"%s\": must be full or sync",
+ value));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "FLUSH", NULL);
return TCL_ERROR;
}
- if (cd->outStream.avail_out > 0) {
+ /*
+ * Try to actually do the flush now.
+ */
+
+ cd->outStream.avail_in = 0;
+ while (1) {
+ int e;
+
+ cd->outStream.next_out = (Bytef *) cd->outBuffer;
+ cd->outStream.avail_out = cd->outAllocated;
+
+ e = deflate(&cd->outStream, flushType);
+ if (e == Z_BUF_ERROR) {
+ break;
+ } else if (e != Z_OK) {
+ ConvertError(interp, e, cd->outStream.adler);
+ return TCL_ERROR;
+ } else if (cd->outStream.avail_out == 0) {
+ break;
+ }
+
if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
- PTR2INT(cd->outStream.next_out)) < 0) {
- Tcl_AppendResult(interp, "problem flushing channel: ",
- Tcl_PosixError(interp), NULL);
+ cd->outStream.next_out - (Bytef *) cd->outBuffer)<0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "problem flushing channel: %s",
+ Tcl_PosixError(interp)));
return TCL_ERROR;
}
}
- } while (cd->outStream.avail_out > 0);
- return TCL_OK;
+ return TCL_OK;
+ }
+ } else {
+ if (optionName && strcmp(optionName, "-limit") == 0) {
+ int newLimit;
+
+ if (Tcl_GetInt(interp, value, &newLimit) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (newLimit < 1 || newLimit > MAX_BUFFER_SIZE) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "-limit must be between 1 and 65536", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", NULL);
+ return TCL_ERROR;
+ }
+ }
}
if (setOptionProc == NULL) {
- return Tcl_BadChannelOption(interp, optionName, chanOptions);
+ if (cd->format == TCL_ZLIB_FORMAT_GZIP) {
+ return Tcl_BadChannelOption(interp, optionName,
+ (cd->mode == TCL_ZLIB_STREAM_DEFLATE)
+ ? gzipChanOptions : gunzipChanOptions);
+ } else {
+ return Tcl_BadChannelOption(interp, optionName,
+ (cd->mode == TCL_ZLIB_STREAM_DEFLATE)
+ ? compressChanOptions : decompressChanOptions);
+ }
}
+ /*
+ * Pass all unknown options down, to deeper transforms and/or the base
+ * channel.
+ */
+
return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp,
optionName, value);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformGetOption --
+ *
+ * Reading side of [fconfigure] on our channel.
+ *
+ *----------------------------------------------------------------------
+ */
static int
ZlibTransformGetOption(
@@ -2489,7 +3292,10 @@ ZlibTransformGetOption(
ZlibChannelData *cd = instanceData;
Tcl_DriverGetOptionProc *getOptionProc =
Tcl_ChannelGetOptionProc(Tcl_GetChannelType(cd->parent));
- static const char *chanOptions = "checksum header";
+ static const char *compressChanOptions = "checksum dictionary";
+ static const char *gzipChanOptions = "checksum";
+ static const char *decompressChanOptions = "checksum dictionary limit";
+ static const char *gunzipChanOptions = "checksum header limit";
/*
* The "crc" option reports the current CRC (calculated with the Adler32
@@ -2517,6 +3323,28 @@ ZlibTransformGetOption(
}
}
+ if ((cd->format != TCL_ZLIB_FORMAT_GZIP) &&
+ (optionName == NULL || strcmp(optionName, "-dictionary") == 0)) {
+ /*
+ * Embedded NUL bytes are ok; they'll be C080-encoded.
+ */
+
+ if (optionName == NULL) {
+ Tcl_DStringAppendElement(dsPtr, "-dictionary");
+ if (cd->compDictObj) {
+ Tcl_DStringAppendElement(dsPtr,
+ Tcl_GetString(cd->compDictObj));
+ } else {
+ Tcl_DStringAppendElement(dsPtr, "");
+ }
+ } else {
+ int len;
+ const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len);
+
+ Tcl_DStringAppend(dsPtr, str, len);
+ }
+ }
+
/*
* The "header" option, which is only valid on inflating gzip channels,
* reports the header that has been read from the start of the stream.
@@ -2532,10 +3360,7 @@ ZlibTransformGetOption(
Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj));
Tcl_DecrRefCount(tmpObj);
} else {
- int len;
- const char *str = Tcl_GetStringFromObj(tmpObj, &len);
-
- Tcl_DStringAppend(dsPtr, str, len);
+ TclDStringAppendObj(dsPtr, tmpObj);
Tcl_DecrRefCount(tmpObj);
return TCL_OK;
}
@@ -2552,8 +3377,27 @@ ZlibTransformGetOption(
if (optionName == NULL) {
return TCL_OK;
}
- return Tcl_BadChannelOption(interp, optionName, chanOptions);
+ if (cd->format == TCL_ZLIB_FORMAT_GZIP) {
+ return Tcl_BadChannelOption(interp, optionName,
+ (cd->mode == TCL_ZLIB_STREAM_DEFLATE)
+ ? gzipChanOptions : gunzipChanOptions);
+ } else {
+ return Tcl_BadChannelOption(interp, optionName,
+ (cd->mode == TCL_ZLIB_STREAM_DEFLATE)
+ ? compressChanOptions : decompressChanOptions);
+ }
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformWatch, ZlibTransformEventHandler --
+ *
+ * If we have data pending, trigger a readable event after a short time
+ * (in order to allow a real event to catch up).
+ *
+ *----------------------------------------------------------------------
+ */
static void
ZlibTransformWatch(
@@ -2569,63 +3413,28 @@ ZlibTransformWatch(
watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent));
watchProc(Tcl_GetChannelInstanceData(cd->parent), mask);
- if (!(mask & TCL_READABLE)
- || (cd->inStream.avail_in == (uInt) cd->inAllocated)) {
- ZlibTransformTimerKill(cd);
- } else {
- ZlibTransformTimerSetup(cd);
- }
-}
-
-static int
-ZlibTransformGetHandle(
- ClientData instanceData,
- int direction,
- ClientData *handlePtr)
-{
- ZlibChannelData *cd = instanceData;
-
- return Tcl_GetChannelHandle(cd->parent, direction, handlePtr);
-}
-
-static int
-ZlibTransformBlockMode(
- ClientData instanceData,
- int mode)
-{
- ZlibChannelData *cd = instanceData;
- if (mode == TCL_MODE_NONBLOCKING) {
- cd->flags |= ASYNC;
- } else {
- cd->flags &= ~ASYNC;
+ if (!(mask & TCL_READABLE) || Tcl_DStringLength(&cd->decompressed) == 0) {
+ ZlibTransformEventTimerKill(cd);
+ } else if (cd->timer == NULL) {
+ cd->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+ ZlibTransformTimerRun, cd);
}
- return TCL_OK;
}
static int
-ZlibTransformHandler(
+ZlibTransformEventHandler(
ClientData instanceData,
int interestMask)
{
ZlibChannelData *cd = instanceData;
- ZlibTransformTimerKill(cd);
+ ZlibTransformEventTimerKill(cd);
return interestMask;
}
-static void
-ZlibTransformTimerSetup(
- ZlibChannelData *cd)
-{
- if (cd->timer == NULL) {
- cd->timer = Tcl_CreateTimerHandler(TRANSFORM_FLUSH_DELAY,
- ZlibTransformTimerRun, cd);
- }
-}
-
-static void
-ZlibTransformTimerKill(
+static inline void
+ZlibTransformEventTimerKill(
ZlibChannelData *cd)
{
if (cd->timer != NULL) {
@@ -2647,6 +3456,53 @@ ZlibTransformTimerRun(
/*
*----------------------------------------------------------------------
*
+ * ZlibTransformGetHandle --
+ *
+ * Anything that needs the OS handle is told to get it from what we are
+ * stacked on top of.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformGetHandle(
+ ClientData instanceData,
+ int direction,
+ ClientData *handlePtr)
+{
+ ZlibChannelData *cd = instanceData;
+
+ return Tcl_GetChannelHandle(cd->parent, direction, handlePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformBlockMode --
+ *
+ * We need to keep track of the blocking mode; it changes our behavior.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformBlockMode(
+ ClientData instanceData,
+ int mode)
+{
+ ZlibChannelData *cd = instanceData;
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ cd->flags |= ASYNC;
+ } else {
+ cd->flags &= ~ASYNC;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ZlibStackChannelTransform --
*
* Stacks either compression or decompression onto a channel.
@@ -2674,13 +3530,17 @@ ZlibStackChannelTransform(
* decompressing transforms. */
int level, /* What compression level to use. Ignored for
* decompressing transforms. */
+ int limit, /* The limit on the number of bytes to read
+ * ahead; always at least 1. */
Tcl_Channel channel, /* The channel to attach to. */
- Tcl_Obj *gzipHeaderDictPtr) /* A description of header to use, or NULL to
+ Tcl_Obj *gzipHeaderDictPtr, /* A description of header to use, or NULL to
* use a default. Ignored if not compressing
* to produce gzip-format data. */
+ Tcl_Obj *compDictObj) /* Byte-array object containing compression
+ * dictionary (not dictObj!) to use if
+ * necessary. */
{
- ZlibChannelData *cd = (ZlibChannelData *)
- ckalloc(sizeof(ZlibChannelData));
+ ZlibChannelData *cd = ckalloc(sizeof(ZlibChannelData));
Tcl_Channel chan;
int wbits = 0;
int e;
@@ -2691,15 +3551,15 @@ ZlibStackChannelTransform(
memset(cd, 0, sizeof(ZlibChannelData));
cd->mode = mode;
+ cd->format = format;
+ cd->readAheadLimit = limit;
if (format == TCL_ZLIB_FORMAT_GZIP || format == TCL_ZLIB_FORMAT_AUTO) {
if (mode == TCL_ZLIB_STREAM_DEFLATE) {
if (gzipHeaderDictPtr) {
- int dummy = 0;
-
cd->flags |= OUT_HEADER;
if (GenerateHeader(interp, gzipHeaderDictPtr, &cd->outHeader,
- &dummy) != TCL_OK) {
+ NULL) != TCL_OK) {
goto error;
}
}
@@ -2714,6 +3574,12 @@ ZlibStackChannelTransform(
}
}
+ if (compDictObj != NULL) {
+ cd->compDictObj = Tcl_DuplicateObj(compDictObj);
+ Tcl_IncrRefCount(cd->compDictObj);
+ Tcl_GetByteArrayFromObj(cd->compDictObj, NULL);
+ }
+
if (format == TCL_ZLIB_FORMAT_RAW) {
wbits = WBITS_RAW;
} else if (format == TCL_ZLIB_FORMAT_ZLIB) {
@@ -2743,6 +3609,14 @@ ZlibStackChannelTransform(
goto error;
}
}
+ if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) {
+ e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
+ if (e != Z_OK) {
+ goto error;
+ }
+ TclDecrRefCount(cd->compDictObj);
+ cd->compDictObj = NULL;
+ }
} else {
e = deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
@@ -2757,8 +3631,16 @@ ZlibStackChannelTransform(
goto error;
}
}
+ if (cd->compDictObj) {
+ e = SetDeflateDictionary(&cd->outStream, cd->compDictObj);
+ if (e != Z_OK) {
+ goto error;
+ }
+ }
}
+ Tcl_DStringInit(&cd->decompressed);
+
chan = Tcl_StackChannel(interp, &zlibChannelType, cd,
Tcl_GetChannelMode(channel), channel);
if (chan == NULL) {
@@ -2778,12 +3660,177 @@ ZlibStackChannelTransform(
ckfree(cd->outBuffer);
deflateEnd(&cd->outStream);
}
- ckfree((char *) cd);
+ if (cd->compDictObj) {
+ Tcl_DecrRefCount(cd->compDictObj);
+ }
+ ckfree(cd);
return NULL;
}
/*
*----------------------------------------------------------------------
+ *
+ * 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 --
+ *
+ * Extract uncompressed bytes from the compression engine and store them
+ * in our working buffer.
+ *
+ * Result:
+ * TCL_OK/TCL_ERROR (with *errorCodePtr updated with reason).
+ *
+ * Side effects:
+ * See above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ResultGenerate(
+ ZlibChannelData *cd,
+ int n,
+ int flush,
+ int *errorCodePtr)
+{
+#define MAXBUF 1024
+ unsigned char buf[MAXBUF];
+ int e, written;
+ 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;
+
+ e = inflate(&cd->inStream, flush);
+ if (e == Z_NEED_DICT && cd->compDictObj) {
+ e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
+ if (e == Z_OK) {
+ /*
+ * 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.
+ */
+
+ written = MAXBUF - cd->inStream.avail_out;
+ if (written) {
+ Tcl_DStringAppend(&cd->decompressed, (char *) buf, written);
+ }
+
+ /*
+ * The cases where we're definitely done.
+ */
+
+ if (((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR))
+ || (e == Z_STREAM_END)
+ || (e == Z_OK && cd->inStream.avail_out == 0)) {
+ return TCL_OK;
+ }
+
+ /*
+ * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html
+ *
+ * Just indicates that the zlib couldn't consume input/produce output,
+ * and is fixed by supplying more input.
+ *
+ * Otherwise, we've got errors and need to report to higher-up.
+ */
+
+ if ((e != Z_OK) && (e != Z_BUF_ERROR)) {
+ goto handleError;
+ }
+
+ /*
+ * Check if the inflate stopped early.
+ */
+
+ if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) {
+ return TCL_OK;
+ }
+ }
+
+ handleError:
+ errObj = Tcl_NewListObj(0, NULL);
+ Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1));
+ Tcl_ListObjAppendElement(NULL, errObj,
+ ConvertErrorToList(e, cd->inStream.adler));
+ Tcl_ListObjAppendElement(NULL, errObj,
+ Tcl_NewStringObj(cd->inStream.msg, -1));
+ Tcl_SetChannelError(cd->parent, errObj);
+ *errorCodePtr = EINVAL;
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
* Finally, the TclZlibInit function. Used to install the zlib API.
*----------------------------------------------------------------------
*/
@@ -2792,6 +3839,8 @@ int
TclZlibInit(
Tcl_Interp *interp)
{
+ Tcl_Config cfg[2];
+
/*
* This does two things. It creates a counter used in the creation of
* stream commands, and it creates the namespace that will contain those
@@ -2805,7 +3854,24 @@ TclZlibInit(
*/
Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0);
- return TCL_OK;
+
+ /*
+ * Store the underlying configuration information.
+ *
+ * TODO: Describe whether we're using the system version of the library or
+ * a compatibility version built into Tcl?
+ */
+
+ cfg[0].key = "zlibVersion";
+ cfg[0].value = zlibVersion();
+ cfg[1].key = NULL;
+ Tcl_RegisterConfig(interp, "zlib", cfg, "ascii");
+
+ /*
+ * Formally provide the package as a Tcl built-in.
+ */
+
+ return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
}
/*
@@ -2825,7 +3891,8 @@ Tcl_ZlibStreamInit(
Tcl_Obj *dictObj,
Tcl_ZlibStream *zshandle)
{
- Tcl_SetResult(interp, "unimplemented", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
return TCL_ERROR;
}
@@ -2890,7 +3957,8 @@ Tcl_ZlibDeflate(
int level,
Tcl_Obj *gzipHeaderDictObj)
{
- Tcl_SetResult(interp, "unimplemented", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
return TCL_ERROR;
}
@@ -2902,7 +3970,8 @@ Tcl_ZlibInflate(
int bufferSize,
Tcl_Obj *gzipHeaderDictObj)
{
- Tcl_SetResult(interp, "unimplemented", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
return TCL_ERROR;
}
@@ -2923,6 +3992,14 @@ Tcl_ZlibAdler32(
{
return 0;
}
+
+void
+Tcl_ZlibStreamSetCompressionDictionary(
+ Tcl_ZlibStream zshandle,
+ Tcl_Obj *compressionDictionaryObj)
+{
+ /* Do nothing. */
+}
#endif /* HAVE_ZLIB */
/*
diff --git a/library/auto.tcl b/library/auto.tcl
index 7b96840..4bd860d 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -3,8 +3,6 @@
# utility procs formerly in init.tcl dealing with auto execution of commands
# and can be auto loaded themselves.
#
-# RCS: @(#) $Id: auto.tcl,v 1.33 2010/06/14 13:48:25 nijtmans Exp $
-#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
@@ -306,7 +304,14 @@ namespace eval auto_mkindex_parser {
$parser hide namespace
$parser hide eval
$parser hide puts
- $parser invokehidden namespace delete ::
+ foreach ns [$parser invokehidden namespace children ::] {
+ # MUST NOT DELETE "::tcl" OR BAD THINGS HAPPEN!
+ if {$ns eq "::tcl"} continue
+ $parser invokehidden namespace delete $ns
+ }
+ foreach cmd [$parser invokehidden info commands ::*] {
+ $parser invokehidden rename $cmd {}
+ }
$parser invokehidden proc unknown {args} {}
# We'll need access to the "namespace" command within the
diff --git a/library/clock.tcl b/library/clock.tcl
index 2cf4ada..0696c47 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -13,8 +13,6 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: clock.tcl,v 1.60 2010/02/09 22:27:46 dkf Exp $
-#
#----------------------------------------------------------------------
# We must have message catalogs that support the root locale, and we need
@@ -3014,18 +3012,23 @@ proc ::tcl::clock::GetSystemTimeZone {} {
set timezone $result
} elseif {[set result [getenv TZ]] ne {}} {
set timezone $result
- } elseif { [info exists CachedSystemTimeZone] } {
- set timezone $CachedSystemTimeZone
- } elseif { $::tcl_platform(platform) eq {windows} } {
- set timezone [GuessWindowsTimeZone]
- } elseif { [file exists /etc/localtime]
- && ![catch {ReadZoneinfoFile \
- Tcl/Localtime /etc/localtime}] } {
- set timezone :Tcl/Localtime
- } else {
- set timezone :localtime
}
- set CachedSystemTimeZone $timezone
+ if {![info exists timezone]} {
+ # Cache the time zone only if it was detected by one of the
+ # expensive methods.
+ if { [info exists CachedSystemTimeZone] } {
+ set timezone $CachedSystemTimeZone
+ } elseif { $::tcl_platform(platform) eq {windows} } {
+ set timezone [GuessWindowsTimeZone]
+ } elseif { [file exists /etc/localtime]
+ && ![catch {ReadZoneinfoFile \
+ Tcl/Localtime /etc/localtime}] } {
+ set timezone :Tcl/Localtime
+ } else {
+ set timezone :localtime
+ }
+ set CachedSystemTimeZone $timezone
+ }
if { ![dict exists $TimeZoneBad $timezone] } {
dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}]
}
@@ -3408,7 +3411,7 @@ proc ::tcl::clock::LoadZoneinfoFile { fileName } {
proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
variable MINWIDE
variable TZData
- if { ![info exists fname] } {
+ if { ![file exists $fname] } {
return -code error "$fileName not found"
}
@@ -3499,8 +3502,10 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
set i 0
set abbrevs {}
foreach a $abbrList {
- dict set abbrevs $i $a
- incr i [expr { [string length $a] + 1 }]
+ for {set j 0} {$j <= [string length $a]} {incr j} {
+ dict set abbrevs $i [string range $a $j end]
+ incr i
+ }
}
# Package up a list of tuples, each of which contains transition time,
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index 3125ada..4cf73d0 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,7 +1,7 @@
-if {![package vsatisfies [package provide Tcl] 8]} {return}
-if {[string compare $::tcl_platform(platform) windows]} {return}
-if {[info exists ::tcl_platform(debug)]} {
- package ifneeded dde 1.3.2 [list load [file join $dir tcldde13g.dll] dde]
+if {([info commands ::tcl::pkgconfig] eq "")
+ || ([info sharedlibextension] ne ".dll")} return
+if {[::tcl::pkgconfig get debug]} {
+ package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
} else {
- package ifneeded dde 1.3.2 [list load [file join $dir tcldde13.dll] dde]
+ package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde]
}
diff --git a/library/history.tcl b/library/history.tcl
index 125c766..51d2404 100644
--- a/library/history.tcl
+++ b/library/history.tcl
@@ -2,8 +2,6 @@
#
# Implementation of the history command.
#
-# RCS: @(#) $Id: history.tcl,v 1.11 2010/06/14 13:48:25 nijtmans Exp $
-#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution of
@@ -55,7 +53,7 @@ proc ::history {args} {
}
# Tricky stuff needed to make stack and errors come out right!
- tailcall apply {args {tailcall history {*}$args} ::tcl} {*}$args
+ tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
}
# tcl::HistAdd --
diff --git a/library/http/http.tcl b/library/http/http.tcl
index e02ec3f..d57e3ce 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -7,13 +7,11 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: http.tcl,v 1.79 2009/11/18 21:45:38 nijtmans Exp $
package require Tcl 8.6
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
-package provide http 2.8.2
+package provide http 2.8.5
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -45,11 +43,11 @@ namespace eval http {
for {set i 0} {$i <= 256} {incr i} {
set c [format %c $i]
if {![string match {[-._~a-zA-Z0-9]} $c]} {
- set map($c) %[format %.2x $i]
+ set map($c) %[format %.2X $i]
}
}
# These are handled specially
- set map(\n) %0d%0a
+ set map(\n) %0D%0A
variable formMap [array get map]
# Create a map for HTTP/1.1 open sockets
@@ -207,15 +205,13 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
if {[info exists state(after)]} {
after cancel $state(after)
}
- if {[info exists state(-command)] && !$skipCB} {
- if {[catch {eval $state(-command) {$token}} err]} {
- if {$errormsg eq ""} {
- set state(error) [list $err $errorInfo $errorCode]
- set state(status) error
- }
+ if {[info exists state(-command)] && !$skipCB
+ && ![info exists state(done-command-cb)]} {
+ set state(done-command-cb) yes
+ if {[catch {eval $state(-command) {$token}} err] && $errormsg eq ""} {
+ set state(error) [list $err $errorInfo $errorCode]
+ set state(status) error
}
- # Command callback may already have unset our state
- unset -nocomplain state(-command)
}
}
@@ -421,7 +417,6 @@ proc http::geturl {url args} {
# Note that the RE actually combines the user and password parts, as
# recommended in RFC 3986. Indeed, that RFC states that putting passwords
# in URLs is a Really Bad Idea, something with which I would agree utterly.
- # Also note that we do not currently support IPv6 addresses.
#
# From a validation perspective, we need to ensure that the parts of the
# URL that are going to the server are correctly encoded. This is only
@@ -436,7 +431,10 @@ proc http::geturl {url args} {
[^@/\#?]+ # <userinfo part of authority>
) @
)?
- ( [^/:\#?]+ ) # <host part of authority>
+ ( # <host part of authority>
+ [^/:\#?]+ | # host name or IPv4 address
+ \[ [^/\#?]+ \] # IPv6 address in square brackets
+ )
(?: : (\d+) )? # <port part of authority>
)?
( / [^\#]*)? # <path> (including query)
@@ -450,6 +448,7 @@ proc http::geturl {url args} {
return -code error "Unsupported URL: $url"
}
# Phase two: validate
+ set host [string trim $host {[]}]; # strip square brackets from IPv6 address
if {$host eq ""} {
# Caller has to provide a host name; we do not have a "default host"
# that would enable us to handle relative URLs.
@@ -686,6 +685,7 @@ proc http::geturl {url args} {
puts $sock "Proxy-Connection: Keep-Alive"
}
set accept_encoding_seen 0
+ set content_type_seen 0
foreach {key value} $state(-headers) {
if {[string equal -nocase $key "host"]} {
continue
@@ -693,6 +693,9 @@ proc http::geturl {url args} {
if {[string equal -nocase $key "accept-encoding"]} {
set accept_encoding_seen 1
}
+ if {[string equal -nocase $key "content-type"]} {
+ set content_type_seen 1
+ }
set value [string map [list \n "" \r ""] $value]
set key [string trim $key]
if {[string equal -nocase $key "content-length"]} {
@@ -735,7 +738,9 @@ proc http::geturl {url args} {
# response.
if {$isQuery || $isQueryChannel} {
- puts $sock "Content-Type: $state(-type)"
+ if {!$content_type_seen} {
+ puts $sock "Content-Type: $state(-type)"
+ }
if {!$contDone} {
puts $sock "Content-Length: $state(querylength)"
}
@@ -863,12 +868,12 @@ proc http::cleanup {token} {
proc http::Connect {token} {
variable $token
upvar 0 $token state
- global errorInfo errorCode
+ set err "due to unexpected EOF"
if {
[eof $state(sock)] ||
- [string length [fconfigure $state(sock) -error]]
+ [set err [fconfigure $state(sock) -error]] ne ""
} {
- Finish $token "connect failed [fconfigure $state(sock) -error]" 1
+ Finish $token "connect failed $err" 1
} else {
set state(status) connect
fileevent $state(sock) writable {}
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 82b2e0b..303d3bd 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.8.2 [list tclPkgSetup $dir http 2.8.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.8.5 [list tclPkgSetup $dir http 2.8.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/library/http1.0/http.tcl b/library/http1.0/http.tcl
index 99efe6b..8329de4 100644
--- a/library/http1.0/http.tcl
+++ b/library/http1.0/http.tcl
@@ -5,8 +5,6 @@
# These procedures use a callback interface to avoid using vwait,
# which is not defined in the safe base.
#
-# RCS: @(#) $Id: http.tcl,v 1.5 2009/11/18 21:45:38 nijtmans Exp $
-#
# See the http.n man page for documentation
package provide http 1.0
diff --git a/library/init.tcl b/library/init.tcl
index cfcc62f..e836df9 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,8 +3,6 @@
# Default system startup file for Tcl-based applications. Defines
# "unknown" procedure and auto-load facilities.
#
-# RCS: @(#) $Id: init.tcl,v 1.126 2010/06/18 12:41:42 dkf Exp $
-#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
@@ -17,7 +15,7 @@
if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
-package require -exact Tcl 8.6b1.2
+package require -exact Tcl 8.6.0
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
@@ -653,7 +651,7 @@ proc auto_execok name {
set execExtensions [list {} .com .exe .bat .cmd]
}
- if {$name in $shellBuiltins} {
+ if {[string tolower $name] in $shellBuiltins} {
# When this is command.com for some reason on Win2K, Tcl won't
# exec it unless the case is right, which this corrects. COMSPEC
# may not point to a real file, so do the check.
@@ -691,13 +689,14 @@ proc auto_execok name {
}
}
- foreach dir [split $path {;}] {
- # Skip already checked directories
- if {[info exists checked($dir)] || ($dir eq "")} {
- continue
- }
- set checked($dir) {}
- foreach ext $execExtensions {
+ foreach ext $execExtensions {
+ unset -nocomplain checked
+ foreach dir [split $path {;}] {
+ # Skip already checked directories
+ if {[info exists checked($dir)] || ($dir eq "")} {
+ continue
+ }
+ set checked($dir) {}
set file [file join $dir ${name}${ext}]
if {[file exists $file] && ![file isdirectory $file]} {
return [set auto_execs($name) [list $file]]
@@ -823,3 +822,31 @@ proc tcl::CopyDirectory {action src dest} {
}
return
}
+
+# TIP 131
+if 0 {
+proc tcl::rmmadwiw {} {
+ set magic {
+ 42 83 fe f6 ff f8 f1 e5 c6 f9 eb fd ff fb f1 e5 cc f5 ec f5 e3 fd fe
+ ff f5 fa f3 e1 c7 f9 f2 fd ff f9 fe f9 ed f4 fa f6 e6 f9 f2 e6 fd f9
+ ff f9 f6 e6 fa fd ff fc fb fc f9 f1 ed
+ }
+ foreach mystic [lassign $magic tragic] {
+ set comic [expr (0x$mystic ^ 0x$tragic) - 255 + 0x$tragic]
+ append logic [format %x $comic]
+ set tragic $mystic
+ }
+ binary format H* $logic
+}
+
+proc tcl::mathfunc::rmmadwiw {} {
+ set age [expr {9*6}]
+ set mind ""
+ while {$age} {
+ lappend mind [expr {$age%13}]
+ set age [expr {$age/13}]
+ }
+ set matter [lreverse $mind]
+ return [join $matter ""]
+}
+}
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 56b7c12..112507a 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -9,17 +9,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: msgcat.tcl,v 1.29 2009/12/17 16:28:21 dgp Exp $
package require Tcl 8.5
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
-package provide msgcat 1.4.3
+package provide msgcat 1.5.0
namespace eval msgcat {
namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
- mcunknown
+ mcunknown mcflset mcflmset
# Records the current locale as passed to mclocale
variable Locale ""
@@ -27,6 +25,9 @@ namespace eval msgcat {
# Records the list of locales to search
variable Loclist {}
+ # Records the locale of the currently sourced message catalogue file
+ variable FileLocale
+
# Records the mapping between source strings and translated strings. The
# dict key is of the form "<locale> <namespace> <src>", where locale and
# namespace should be themselves dict values and the value is
@@ -34,7 +35,7 @@ namespace eval msgcat {
variable Msgs [dict create]
# Map of language codes used in Windows registry to those of ISO-639
- if { $::tcl_platform(platform) eq "windows" } {
+ if {[info sharedlibextension] eq ".dll"} {
variable WinRegToISO639 [dict create {*}{
01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ
1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY
@@ -68,8 +69,8 @@ namespace eval msgcat {
15 pl 0415 pl_PL
16 pt 0416 pt_BR 0816 pt_PT
17 rm 0417 rm_CH
- 18 ro 0418 ro_RO
- 19 ru
+ 18 ro 0418 ro_RO 0818 ro_MO
+ 19 ru 0819 ru_MO
1a hr 041a hr_HR 081a sr_YU 0c1a sr_YU@cyrillic
1b sk 041b sk_SK
1c sq 041c sq_AL
@@ -94,6 +95,7 @@ namespace eval msgcat {
2f mk 042f mk_MK
30 bnt 0430 bnt_TZ
31 ts 0431 ts_ZA
+ 32 tn
33 ven 0433 ven_ZA
34 xh 0434 xh_ZA
35 zu 0435 zu_ZA
@@ -278,6 +280,11 @@ proc msgcat::mcpreferences {} {
# Returns the number of message catalogs that were loaded.
proc msgcat::mcload {langdir} {
+ variable FileLocale
+ # Save the file locale if we are recursively called
+ if {[info exists FileLocale]} {
+ set nestedFileLocale $FileLocale
+ }
set x 0
foreach p [mcpreferences] {
if { $p eq {} } {
@@ -286,9 +293,17 @@ proc msgcat::mcload {langdir} {
set langfile [file join $langdir $p.msg]
if {[file exists $langfile]} {
incr x
+ set FileLocale [string tolower [file tail [file rootname $langfile]]]
+ if {"root" eq $FileLocale} {
+ set FileLocale ""
+ }
uplevel 1 [list ::source -encoding utf-8 $langfile]
+ unset FileLocale
}
}
+ if {[info exists nestedFileLocale]} {
+ set FileLocale $nestedFileLocale
+ }
return $x
}
@@ -315,14 +330,36 @@ proc msgcat::mcset {locale src {dest ""}} {
set locale [string tolower $locale]
- # create nested dictionaries if they do not exist
- if {![dict exists $Msgs $locale]} {
- dict set Msgs $locale [dict create]
+ dict set Msgs $locale $ns $src $dest
+ return $dest
+}
+
+# msgcat::mcflset --
+#
+# Set the translation for a given string in the current file locale.
+#
+# Arguments:
+# src The source string.
+# dest (Optional) The translated string. If omitted,
+# the source string is used.
+#
+# Results:
+# Returns the new locale.
+
+proc msgcat::mcflset {src {dest ""}} {
+ variable FileLocale
+ variable Msgs
+
+ if {![info exists FileLocale]} {
+ return -code error \
+ "must only be used inside a message catalog loaded with ::msgcat::mcload"
}
- if {![dict exists $Msgs $locale $ns]} {
- dict set Msgs $locale $ns [dict create]
+ if {[llength [info level 0]] == 2} { ;# dest not specified
+ set dest $src
}
- dict set Msgs $locale $ns $src $dest
+
+ set ns [uplevel 1 [list ::namespace current]]
+ dict set Msgs $FileLocale $ns $src $dest
return $dest
}
@@ -349,18 +386,42 @@ proc msgcat::mcmset {locale pairs } {
set locale [string tolower $locale]
set ns [uplevel 1 [list ::namespace current]]
- # create nested dictionaries if they do not exist
- if {![dict exists $Msgs $locale]} {
- dict set Msgs $locale [dict create]
+ foreach {src dest} $pairs {
+ dict set Msgs $locale $ns $src $dest
+ }
+
+ return [expr {$length / 2}]
+}
+
+# msgcat::mcflmset --
+#
+# Set the translation for multiple strings in the mc file locale.
+#
+# Arguments:
+# pairs One or more src/dest pairs (must be even length)
+#
+# Results:
+# Returns the number of pairs processed
+
+proc msgcat::mcflmset {pairs} {
+ variable FileLocale
+ variable Msgs
+
+ if {![info exists FileLocale]} {
+ return -code error \
+ "must only be used inside a message catalog loaded with ::msgcat::mcload"
}
- if {![dict exists $Msgs $locale $ns]} {
- dict set Msgs $locale $ns [dict create]
+ set length [llength $pairs]
+ if {$length % 2} {
+ return -code error "bad translation list:\
+ should be \"[lindex [info level 0] 0] locale {src dest ...}\""
}
+
+ set ns [uplevel 1 [list ::namespace current]]
foreach {src dest} $pairs {
- dict set Msgs $locale $ns $src $dest
+ dict set Msgs $FileLocale $ns $src $dest
}
-
- return $length
+ return [expr {$length / 2}]
}
# msgcat::mcunknown --
@@ -403,10 +464,10 @@ proc msgcat::mcmax {args} {
set max 0
foreach string $args {
set translated [uplevel 1 [list [namespace origin mc] $string]]
- set len [string length $translated]
- if {$len>$max} {
+ set len [string length $translated]
+ if {$len>$max} {
set max $len
- }
+ }
}
return $max
}
@@ -442,7 +503,7 @@ proc msgcat::ConvertLocale {value} {
# Initialize the default locale
proc msgcat::Init {} {
- global env tcl_platform
+ global env
#
# set default locale, try to get from environment
@@ -467,23 +528,52 @@ proc msgcat::Init {} {
}
}
#
- # The rest of this routine is special processing for Windows;
- # all other platforms, get out now.
+ # The rest of this routine is special processing for Windows or
+ # Cygwin. All other platforms, get out now.
#
- if {$tcl_platform(platform) ne "windows"} {
+ if {([info sharedlibextension] ne ".dll")
+ || [catch {package require registry}]} {
mclocale C
return
}
#
- # On Windows, try to set locale depending on registry settings,
- # or fall back on locale of "C".
+ # On Windows or Cygwin, try to set locale depending on registry
+ # settings, or fall back on locale of "C".
#
+
+ # First check registry value LocalName present from Windows Vista
+ # which contains the local string as RFC5646, composed of:
+ # [a-z]{2,3} : language
+ # -[a-z]{4} : script (optional, translated by table Latn->latin)
+ # -[a-z]{2}|[0-9]{3} : territory (optional, numerical region codes not used)
+ # (-.*)* : variant, extension, private use (optional, not used)
+ # Those are translated to local strings.
+ # Examples: de-CH -> de_ch, sr-Latn-CS -> sr_cs@latin, es-419 -> es
+ #
+ set key {HKEY_CURRENT_USER\Control Panel\International}
+ if {([registry values $key "LocaleName"] ne "")
+ && [regexp {^([a-z]{2,3})(?:-([a-z]{4}))?(?:-([a-z]{2}))?(?:-.+)?$}\
+ [string tolower [registry get $key "LocaleName"]] match locale\
+ script territory]} {
+ if {"" ne $territory} {
+ append locale _ $territory
+ }
+ set modifierDict [dict create latn latin cyrl cyrillic]
+ if {[dict exists $modifierDict $script]} {
+ append locale @ [dict get $modifierDict $script]
+ }
+ if {![catch {
+ mclocale [ConvertLocale $locale]
+ }]} {
+ return
+ }
+ }
+
+ # then check key locale which contains a numerical language ID
if {[catch {
- package require registry
- set key {HKEY_CURRENT_USER\Control Panel\International}
set locale [registry get $key "locale"]
}]} {
- mclocale C
+ mclocale C
return
}
#
diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
index 63ed8ed..832bf81 100644
--- a/library/msgcat/pkgIndex.tcl
+++ b/library/msgcat/pkgIndex.tcl
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded msgcat 1.4.3 [list source [file join $dir msgcat.tcl]]
+package ifneeded msgcat 1.5.0 [list source [file join $dir msgcat.tcl]]
diff --git a/library/msgs/uk.msg b/library/msgs/uk.msg
index 3e24f86..7d4c64a 100755
--- a/library/msgs/uk.msg
+++ b/library/msgs/uk.msg
@@ -33,7 +33,7 @@ namespace eval ::tcl::clock {
::msgcat::mcset uk MONTHS_FULL [list \
"\u0441\u0456\u0447\u043d\u044f"\
"\u043b\u044e\u0442\u043e\u0433\u043e"\
- "\u0431\u0435\u0440\u0435\u0436\u043d\u044f"\
+ "\u0431\u0435\u0440\u0435\u0437\u043d\u044f"\
"\u043a\u0432\u0456\u0442\u043d\u044f"\
"\u0442\u0440\u0430\u0432\u043d\u044f"\
"\u0447\u0435\u0440\u0432\u043d\u044f"\
diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl
index d6bca2f..fc77fa1 100644
--- a/library/opt/optparse.tcl
+++ b/library/opt/optparse.tcl
@@ -7,8 +7,6 @@
# of Tcl. It is NOT supported and you should not rely
# on it. If your code does rely on this package you
# may directly incorporate this code into your application.
-#
-# RCS: @(#) $Id: optparse.tcl,v 1.13 2010/05/27 09:18:12 nijtmans Exp $
package require Tcl 8.2
# When this version number changes, update the pkgIndex.tcl file
diff --git a/library/package.tcl b/library/package.tcl
index b9d9bc5..c30431c 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -3,8 +3,6 @@
# utility procs formerly in init.tcl which can be loaded on demand
# for package management.
#
-# RCS: @(#) $Id: package.tcl,v 1.39 2010/06/14 13:48:25 nijtmans Exp $
-#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
@@ -401,7 +399,7 @@ proc pkg_mkIndex {args} {
break
}
lappend cmd ::tcl::Pkg::Create -name $name -version $version
- foreach spec $files($pkg) {
+ foreach spec [lsort -index 0 $files($pkg)] {
foreach {file type procs} $spec {
if {$direct} {
set procs {}
diff --git a/library/parray.tcl b/library/parray.tcl
index e331d4d..3ce9817 100644
--- a/library/parray.tcl
+++ b/library/parray.tcl
@@ -1,8 +1,6 @@
# parray:
# Print the contents of a global array on stdout.
#
-# RCS: @(#) $Id: parray.tcl,v 1.4 2005/06/03 10:02:23 dkf Exp $
-#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
diff --git a/library/platform/pkgIndex.tcl b/library/platform/pkgIndex.tcl
index 35da3b7..220a67b 100644
--- a/library/platform/pkgIndex.tcl
+++ b/library/platform/pkgIndex.tcl
@@ -1,3 +1,3 @@
-package ifneeded platform 1.0.9 [list source [file join $dir platform.tcl]]
+package ifneeded platform 1.0.10 [list source [file join $dir platform.tcl]]
package ifneeded platform::shell 1.1.4 [list source [file join $dir shell.tcl]]
diff --git a/library/platform/platform.tcl b/library/platform/platform.tcl
index 572a8b4..dd2e66b 100644
--- a/library/platform/platform.tcl
+++ b/library/platform/platform.tcl
@@ -194,42 +194,45 @@ proc ::platform::identify {} {
# Do not look into /lib64 even if present, if the cpu
# doesn't fit.
+ # TODO: Determine the prefixes (i386, x86_64, ...) for
+ # other cpus. The path after the generic one is utterly
+ # specific to intel right now. Ok, on Ubuntu, possibly
+ # other Debian systems we may apparently be able to query
+ # the necessary CPU code. If we can't we simply use the
+ # hardwired fallback.
+
switch -exact -- $tcl_platform(wordSize) {
4 {
- set base /lib
+ lappend bases /lib
+ if {[catch {
+ exec dpkg-architecture -qDEB_HOST_MULTIARCH
+ } res]} {
+ lappend bases /lib/i386-linux-gnu
+ } else {
+ # dpkg-arch returns the full tripled, not just cpu.
+ lappend bases /lib/$res
+ }
}
8 {
- set base /lib64
+ lappend bases /lib64
+ if {[catch {
+ exec dpkg-architecture -qDEB_HOST_MULTIARCH
+ } res]} {
+ lappend bases /lib/x86_64-linux-gnu
+ } else {
+ # dpkg-arch returns the full tripled, not just cpu.
+ lappend bases /lib/$res
+ }
}
default {
return -code error "Bad wordSize $tcl_platform(wordSize), expected 4 or 8"
}
}
- set libclist [lsort [glob -nocomplain -directory $base libc*]]
- if {[llength $libclist]} {
- set libc [lindex $libclist 0]
-
- # Try executing the library first. This should suceed
- # for a glibc library, and return the version
- # information.
-
- if {![catch {
- set vdata [lindex [split [exec $libc] \n] 0]
- }]} {
- regexp {([0-9]+(\.[0-9]+)*)} $vdata -> v
- foreach {major minor} [split $v .] break
- set v glibc${major}.${minor}
- } else {
- # We had trouble executing the library. We are now
- # inspecting its name to determine the version
- # number. This code by Larry McVoy.
-
- if {[regexp -- {libc-([0-9]+)\.([0-9]+)} $libc -> major minor]} {
- set v glibc${major}.${minor}
- }
- }
+ foreach base $bases {
+ if {[LibcVersion $base -> v]} break
}
+
append plat -$v
return "${plat}-${cpu}"
}
@@ -238,6 +241,38 @@ proc ::platform::identify {} {
return $id
}
+proc ::platform::LibcVersion {base _->_ vv} {
+ upvar 1 $vv v
+ set libclist [lsort [glob -nocomplain -directory $base libc*]]
+
+ if {![llength $libclist]} { return 0 }
+
+ set libc [lindex $libclist 0]
+
+ # Try executing the library first. This should suceed
+ # for a glibc library, and return the version
+ # information.
+
+ if {![catch {
+ set vdata [lindex [split [exec $libc] \n] 0]
+ }]} {
+ regexp {([0-9]+(\.[0-9]+)*)} $vdata -> v
+ foreach {major minor} [split $v .] break
+ set v glibc${major}.${minor}
+ return 1
+ } else {
+ # We had trouble executing the library. We are now
+ # inspecting its name to determine the version
+ # number. This code by Larry McVoy.
+
+ if {[regexp -- {libc-([0-9]+)\.([0-9]+)} $libc -> major minor]} {
+ set v glibc${major}.${minor}
+ return 1
+ }
+ }
+ return 0
+}
+
# -- platform::patterns
#
# Given an exact platform identifier, i.e. _not_ the generic
@@ -333,7 +368,7 @@ proc ::platform::patterns {id} {
# ### ### ### ######### ######### #########
## Ready
-package provide platform 1.0.9
+package provide platform 1.0.10
# ### ### ### ######### ######### #########
## Demo application
diff --git a/library/platform/shell.tcl b/library/platform/shell.tcl
index e0a129a..d37cdcd 100644
--- a/library/platform/shell.tcl
+++ b/library/platform/shell.tcl
@@ -187,7 +187,7 @@ proc ::platform::shell::TEMP {} {
}
}
}
- if {[string compare $channel ""]} {
+ if {$channel != ""} {
return -code error "Failed to open a temporary file: $channel"
} else {
return -code error "Failed to find an unused temporary file name"
diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl
index f07dee4..55af4b3 100755
--- a/library/reg/pkgIndex.tcl
+++ b/library/reg/pkgIndex.tcl
@@ -1,9 +1,9 @@
-if {![package vsatisfies [package provide Tcl] 8]} {return}
-if {[string compare $::tcl_platform(platform) windows]} {return}
-if {[info exists ::tcl_platform(debug)]} {
- package ifneeded registry 1.3 \
+if {([info commands ::tcl::pkgconfig] eq "")
+ || ([info sharedlibextension] ne ".dll")} return
+if {[::tcl::pkgconfig get debug]} {
+ package ifneeded registry 1.3.0 \
[list load [file join $dir tclreg13g.dll] registry]
} else {
- package ifneeded registry 1.3 \
+ package ifneeded registry 1.3.0 \
[list load [file join $dir tclreg13.dll] registry]
}
diff --git a/library/safe.tcl b/library/safe.tcl
index 0cae5fd..394aa97 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -11,8 +11,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: safe.tcl,v 1.41 2010/09/02 18:31:00 andreas_kupries Exp $
#
# The implementation is based on namespaces. These naming conventions are
@@ -467,8 +465,19 @@ proc ::safe::InterpInit {
# This alias lets the slave have access to a subset of the 'file'
# command functionality.
- AliasSubset $slave file \
- file dir.* join root.* ext.* tail path.* split
+ ::interp expose $slave file
+ foreach subcommand {dirname extension rootname tail} {
+ ::interp alias $slave ::tcl::file::$subcommand {} \
+ ::safe::AliasFileSubcommand $slave $subcommand
+ }
+ foreach subcommand {
+ atime attributes copy delete executable exists isdirectory isfile
+ link lstat mtime mkdir nativename normalize owned readable readlink
+ rename size stat tempfile type volumes writable
+ } {
+ ::interp alias $slave ::tcl::file::$subcommand {} \
+ ::safe::BadSubcommand $slave file $subcommand
+ }
# Subcommands of info
foreach {subcommand alias} {
@@ -485,24 +494,25 @@ proc ::safe::InterpInit {
if {[catch {::interp eval $slave {
source [file join $tcl_library init.tcl]
- }} msg]} {
+ }} msg opt]} {
Log $slave "can't source init.tcl ($msg)"
- return -code error "can't source init.tcl into slave $slave ($msg)"
+ return -options $opt "can't source init.tcl into slave $slave ($msg)"
}
if {[catch {::interp eval $slave {
source [file join $tcl_library tm.tcl]
- }} msg]} {
+ }} msg opt]} {
Log $slave "can't source tm.tcl ($msg)"
- return -code error "can't source tm.tcl into slave $slave ($msg)"
+ return -options $opt "can't source tm.tcl into slave $slave ($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
- ::interp eval $slave [list \
- ::tcl::tm::add {*}$state(tm_path_slave)]
-
+ if {[llength $state(tm_path_slave)] > 0} {
+ ::interp eval $slave [list \
+ ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]]
+ }
return $slave
}
@@ -666,6 +676,17 @@ proc ::safe::CheckFileName {slave file} {
}
}
+# AliasFileSubcommand handles selected subcommands of [file] in safe
+# interpreters that are *almost* safe. In particular, it just acts to
+# prevent discovery of what home directories exist.
+
+proc ::safe::AliasFileSubcommand {slave subcommand name} {
+ if {[string match ~* $name]} {
+ set name ./$name
+ }
+ tailcall ::interp invokehidden $slave tcl:file:$subcommand $name
+}
+
# AliasGlob is the target of the "glob" alias in safe interpreters.
proc ::safe::AliasGlob {slave args} {
@@ -681,9 +702,9 @@ proc ::safe::AliasGlob {slave args} {
}
if {$::tcl_platform(platform) eq "windows"} {
- set dirPartRE {^(.*)[\\/]}
+ set dirPartRE {^(.*)[\\/]([^\\/]*)$}
} else {
- set dirPartRE {^(.*)/}
+ set dirPartRE {^(.*)/([^/]*)$}
}
set dir {}
@@ -736,9 +757,7 @@ proc ::safe::AliasGlob {slave args} {
DirInAccessPath $slave $dir
} on error msg {
Log $slave $msg
- if {$got(-nocomplain)} {
- return
- }
+ if {$got(-nocomplain)} return
return -code error "permission denied"
}
lappend cmd -directory $dir
@@ -751,20 +770,33 @@ proc ::safe::AliasGlob {slave args} {
# Process remaining pattern arguments
set firstPattern [llength $cmd]
- while {$at < [llength $args]} {
- set opt [lindex $args $at]
- incr at
- if {[regexp $dirPartRE $opt -> thedir]} {
- try {
- set thedir [file join $virtualdir $thedir]
- DirInAccessPath $slave [TranslatePath $slave $thedir]
- } on error msg {
- Log $slave $msg
- if {$got(-nocomplain)} {
- continue
+ foreach opt [lrange $args $at end] {
+ if {![regexp $dirPartRE $opt -> thedir thefile]} {
+ set thedir .
+ } elseif {[string match ~* $thedir]} {
+ set thedir ./$thedir
+ }
+ if {$thedir eq "*" &&
+ ($thefile eq "pkgIndex.tcl" || $thefile eq "*.tm")} {
+ set mapped 0
+ foreach d [glob -directory [TranslatePath $slave $virtualdir] \
+ -types d -tails *] {
+ catch {
+ DirInAccessPath $slave \
+ [TranslatePath $slave [file join $virtualdir $d]]
+ lappend cmd [file join $d $thefile]
+ set mapped 1
}
- return -code error "permission denied"
}
+ if {$mapped} continue
+ }
+ try {
+ DirInAccessPath $slave [TranslatePath $slave \
+ [file join $virtualdir $thedir]]
+ } on error msg {
+ Log $slave $msg
+ if {$got(-nocomplain)} continue
+ return -code error "permission denied"
}
lappend cmd $opt
}
@@ -781,7 +813,7 @@ proc ::safe::AliasGlob {slave args} {
return -code error "script error"
}
- Log $slave "GLOB @ $entries" NOTICE
+ Log $slave "GLOB < $entries" NOTICE
# Translate path back to what the slave should see.
set res {}
@@ -793,7 +825,7 @@ proc ::safe::AliasGlob {slave args} {
lappend res $p
}
- Log $slave "GLOB @ $res" NOTICE
+ Log $slave "GLOB > $res" NOTICE
return $res
}
@@ -850,6 +882,7 @@ proc ::safe::AliasSource {slave args} {
# because we want to control [info script] in the slave so information
# doesn't leak so much. [Bug 2913625]
set old [::interp eval $slave {info script}]
+ set replacementMsg "script error"
set code [catch {
set f [open $realfile]
fconfigure $f -eofchar \032
@@ -859,14 +892,17 @@ proc ::safe::AliasSource {slave args} {
set contents [read $f]
close $f
::interp eval $slave [list info script $file]
- ::interp eval $slave $contents
} msg opt]
+ if {$code == 0} {
+ set code [catch {::interp eval $slave $contents} msg opt]
+ set replacementMsg $msg
+ }
catch {interp eval $slave [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
- return -code error "script error"
+ return -code error $replacementMsg
}
return -code $code -options $opt $msg
}
@@ -982,58 +1018,33 @@ proc ::safe::DirInAccessPath {slave dir} {
}
}
-# This procedure enables access from a safe interpreter to only a subset
-# of the subcommands of a command:
+# This procedure is used to report an attempt to use an unsafe member of an
+# ensemble command.
-proc ::safe::Subset {slave command okpat args} {
- set subcommand [lindex $args 0]
- if {[regexp $okpat $subcommand]} {
- return [$command {*}$args]
- }
+proc ::safe::BadSubcommand {slave command subcommand args} {
set msg "not allowed to invoke subcommand $subcommand of $command"
Log $slave $msg
- return -code error $msg
-}
-
-# This procedure installs an alias in a slave that invokes "safesubset" in
-# the master to execute allowed subcommands. It precomputes the pattern of
-# allowed subcommands; you can use wildcards in the pattern if you wish to
-# allow subcommand abbreviation.
-#
-# Syntax is: AliasSubset slave alias target subcommand1 subcommand2...
-
-proc ::safe::AliasSubset {slave alias target args} {
- set pat "^([join $args |])\$"
- ::interp alias $slave $alias {}\
- [namespace current]::Subset $slave $target $pat
+ return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg
}
# AliasEncoding is the target of the "encoding" alias in safe interpreters.
proc ::safe::AliasEncoding {slave option args} {
- # Careful; do not want empty option to get through to the [string equal]
- if {[regexp {^(name.*|convert.*|)$} $option]} {
- return [::interp invokehidden $slave encoding $option {*}$args]
- }
-
- if {[string equal -length [string length $option] $option "system"]} {
- if {![llength $args]} {
- # passed all the tests , lets source it:
- try {
- return [::interp invokehidden $slave encoding system]
- } on error msg {
- Log $slave $msg
- return -code error "script error"
- }
+ # Note that [encoding dirs] is not supported in safe slaves at all
+ set subcommands {convertfrom convertto names system}
+ try {
+ set option [tcl::prefix match -error [list -level 1 -errorcode \
+ [list TCL LOOKUP INDEX option $option]] $subcommands $option]
+ # Special case: [encoding system] ok, but [encoding system foo] not
+ if {$option eq "system" && [llength $args]} {
+ return -code error -errorcode {TCL WRONGARGS} \
+ "wrong # args: should be \"encoding system\""
}
- set msg "wrong # args: should be \"encoding system\""
- set code {TCL WRONGARGS}
- } else {
- set msg "bad option \"$option\": must be convertfrom, convertto, names, or system"
- set code [list TCL LOOKUP INDEX option $option]
+ } on error {msg options} {
+ Log $slave $msg
+ return -options $options $msg
}
- Log $slave $msg
- return -code error -errorcode $code $msg
+ tailcall ::interp invokehidden $slave encoding $option {*}$args
}
# Various minor hiding of platform features. [Bug 2913625]
diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index fe80272..4b0a9bc 100644
--- a/library/tcltest/pkgIndex.tcl
+++ b/library/tcltest/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 tcltest 2.3.2 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.3.5 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 1bfbaa9..83ec9d3 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -15,8 +15,6 @@
# Copyright (c) 2000 by Ajuba Solutions
# Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
# All rights reserved.
-#
-# RCS: @(#) $Id: tcltest.tcl,v 1.106 2009/09/01 14:13:23 dgp Exp $
package require Tcl 8.5 ;# -verbose line uses [info frame]
namespace eval tcltest {
@@ -24,7 +22,7 @@ namespace eval tcltest {
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the install directory in the Makefiles. When the minor version
# changes (new feature) be sure to update the man page as well.
- variable Version 2.3.2
+ variable Version 2.3.5
# Compatibility support for dumb variables defined in tcltest 1
# Do not use these. Call [package provide Tcl] and [info patchlevel]
@@ -485,8 +483,10 @@ namespace eval tcltest {
variable Verify
variable Usage
variable OptionControlledVariables
+ variable DefaultValue
set Usage($option) $usage
set Verify($option) $verify
+ set DefaultValue($option) $value
if {[catch {$verify $value} msg]} {
return -code error $msg
} else {
@@ -601,7 +601,9 @@ namespace eval tcltest {
}
}
proc configure args {
- RemoveAutoConfigureTraces
+ if {[llength $args] > 1} {
+ RemoveAutoConfigureTraces
+ }
set code [catch {Configure {*}$args} msg]
return -code $code $msg
}
@@ -710,7 +712,7 @@ namespace eval tcltest {
}
}
}
- Option -limitconstraints false {
+ Option -limitconstraints 0 {
whether to run only tests with the constraints
} AcceptBoolean limitConstraints
trace variable Option(-limitconstraints) w \
@@ -797,6 +799,29 @@ namespace eval tcltest {
trace variable Option(-errfile) w \
[namespace code {errorChannel $Option(-errfile) ;#}]
+ proc loadIntoSlaveInterpreter {slave args} {
+ variable Version
+ interp eval $slave [package ifneeded tcltest $Version]
+ interp eval $slave "tcltest::configure {*}{$args}"
+ interp alias $slave ::tcltest::ReportToMaster \
+ {} ::tcltest::ReportedFromSlave
+ }
+ proc ReportedFromSlave {total passed skipped failed because newfiles} {
+ variable numTests
+ variable skippedBecause
+ variable createdNewFiles
+ incr numTests(Total) $total
+ incr numTests(Passed) $passed
+ incr numTests(Skipped) $skipped
+ incr numTests(Failed) $failed
+ foreach {constraint count} $because {
+ incr skippedBecause($constraint) $count
+ }
+ foreach {testfile created} $newfiles {
+ lappend createdNewFiles($testfile) {*}$created
+ }
+ return
+ }
}
#####################################################################
@@ -2356,6 +2381,14 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
FillFilesExisted
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) \
+ $numTests(Failed) [array get skippedBecause] \
+ [array get createdNewFiles]
+ set testSingleFile false
+ }
+
# Call the cleanup hook
cleanupTestsHook
@@ -2687,6 +2720,7 @@ proc tcltest::runAllTests { {shell ""} } {
variable numTestFiles
variable numTests
variable failFiles
+ variable DefaultValue
FillFilesExisted
if {[llength [info level 0]] == 1} {
@@ -2751,7 +2785,12 @@ proc tcltest::runAllTests { {shell ""} } {
set childargv [list]
foreach opt [Configure] {
if {[string equal $opt -outfile]} {continue}
- lappend childargv $opt [Configure $opt]
+ set value [Configure $opt]
+ # Don't bother passing default configuration options
+ if {[string equal $value $DefaultValue($opt)]} {
+ continue
+ }
+ lappend childargv $opt $value
}
set cmd [linsert $childargv 0 | $shell $file]
if {[catch {
diff --git a/library/tzdata/Africa/Cairo b/library/tzdata/Africa/Cairo
index 10d7193..165d8c4 100644
--- a/library/tzdata/Africa/Cairo
+++ b/library/tzdata/Africa/Cairo
@@ -125,182 +125,4 @@ set TZData(:Africa/Cairo) {
{1281474000 7200 0 EET}
{1284069600 10800 1 EEST}
{1285880400 7200 0 EET}
- {1304028000 10800 1 EEST}
- {1317330000 7200 0 EET}
- {1335477600 10800 1 EEST}
- {1348779600 7200 0 EET}
- {1366927200 10800 1 EEST}
- {1380229200 7200 0 EET}
- {1398376800 10800 1 EEST}
- {1411678800 7200 0 EET}
- {1429826400 10800 1 EEST}
- {1443128400 7200 0 EET}
- {1461880800 10800 1 EEST}
- {1475182800 7200 0 EET}
- {1493330400 10800 1 EEST}
- {1506632400 7200 0 EET}
- {1524780000 10800 1 EEST}
- {1538082000 7200 0 EET}
- {1556229600 10800 1 EEST}
- {1569531600 7200 0 EET}
- {1587679200 10800 1 EEST}
- {1600981200 7200 0 EET}
- {1619733600 10800 1 EEST}
- {1633035600 7200 0 EET}
- {1651183200 10800 1 EEST}
- {1664485200 7200 0 EET}
- {1682632800 10800 1 EEST}
- {1695934800 7200 0 EET}
- {1714082400 10800 1 EEST}
- {1727384400 7200 0 EET}
- {1745532000 10800 1 EEST}
- {1758834000 7200 0 EET}
- {1776981600 10800 1 EEST}
- {1790283600 7200 0 EET}
- {1809036000 10800 1 EEST}
- {1822338000 7200 0 EET}
- {1840485600 10800 1 EEST}
- {1853787600 7200 0 EET}
- {1871935200 10800 1 EEST}
- {1885237200 7200 0 EET}
- {1903384800 10800 1 EEST}
- {1916686800 7200 0 EET}
- {1934834400 10800 1 EEST}
- {1948136400 7200 0 EET}
- {1966888800 10800 1 EEST}
- {1980190800 7200 0 EET}
- {1998338400 10800 1 EEST}
- {2011640400 7200 0 EET}
- {2029788000 10800 1 EEST}
- {2043090000 7200 0 EET}
- {2061237600 10800 1 EEST}
- {2074539600 7200 0 EET}
- {2092687200 10800 1 EEST}
- {2105989200 7200 0 EET}
- {2124136800 10800 1 EEST}
- {2137438800 7200 0 EET}
- {2156191200 10800 1 EEST}
- {2169493200 7200 0 EET}
- {2187640800 10800 1 EEST}
- {2200942800 7200 0 EET}
- {2219090400 10800 1 EEST}
- {2232392400 7200 0 EET}
- {2250540000 10800 1 EEST}
- {2263842000 7200 0 EET}
- {2281989600 10800 1 EEST}
- {2295291600 7200 0 EET}
- {2313439200 10800 1 EEST}
- {2326741200 7200 0 EET}
- {2345493600 10800 1 EEST}
- {2358795600 7200 0 EET}
- {2376943200 10800 1 EEST}
- {2390245200 7200 0 EET}
- {2408392800 10800 1 EEST}
- {2421694800 7200 0 EET}
- {2439842400 10800 1 EEST}
- {2453144400 7200 0 EET}
- {2471292000 10800 1 EEST}
- {2484594000 7200 0 EET}
- {2503346400 10800 1 EEST}
- {2516648400 7200 0 EET}
- {2534796000 10800 1 EEST}
- {2548098000 7200 0 EET}
- {2566245600 10800 1 EEST}
- {2579547600 7200 0 EET}
- {2597695200 10800 1 EEST}
- {2610997200 7200 0 EET}
- {2629144800 10800 1 EEST}
- {2642446800 7200 0 EET}
- {2660594400 10800 1 EEST}
- {2673896400 7200 0 EET}
- {2692648800 10800 1 EEST}
- {2705950800 7200 0 EET}
- {2724098400 10800 1 EEST}
- {2737400400 7200 0 EET}
- {2755548000 10800 1 EEST}
- {2768850000 7200 0 EET}
- {2786997600 10800 1 EEST}
- {2800299600 7200 0 EET}
- {2818447200 10800 1 EEST}
- {2831749200 7200 0 EET}
- {2850501600 10800 1 EEST}
- {2863803600 7200 0 EET}
- {2881951200 10800 1 EEST}
- {2895253200 7200 0 EET}
- {2913400800 10800 1 EEST}
- {2926702800 7200 0 EET}
- {2944850400 10800 1 EEST}
- {2958152400 7200 0 EET}
- {2976300000 10800 1 EEST}
- {2989602000 7200 0 EET}
- {3007749600 10800 1 EEST}
- {3021051600 7200 0 EET}
- {3039804000 10800 1 EEST}
- {3053106000 7200 0 EET}
- {3071253600 10800 1 EEST}
- {3084555600 7200 0 EET}
- {3102703200 10800 1 EEST}
- {3116005200 7200 0 EET}
- {3134152800 10800 1 EEST}
- {3147454800 7200 0 EET}
- {3165602400 10800 1 EEST}
- {3178904400 7200 0 EET}
- {3197052000 10800 1 EEST}
- {3210354000 7200 0 EET}
- {3229106400 10800 1 EEST}
- {3242408400 7200 0 EET}
- {3260556000 10800 1 EEST}
- {3273858000 7200 0 EET}
- {3292005600 10800 1 EEST}
- {3305307600 7200 0 EET}
- {3323455200 10800 1 EEST}
- {3336757200 7200 0 EET}
- {3354904800 10800 1 EEST}
- {3368206800 7200 0 EET}
- {3386959200 10800 1 EEST}
- {3400261200 7200 0 EET}
- {3418408800 10800 1 EEST}
- {3431710800 7200 0 EET}
- {3449858400 10800 1 EEST}
- {3463160400 7200 0 EET}
- {3481308000 10800 1 EEST}
- {3494610000 7200 0 EET}
- {3512757600 10800 1 EEST}
- {3526059600 7200 0 EET}
- {3544207200 10800 1 EEST}
- {3557509200 7200 0 EET}
- {3576261600 10800 1 EEST}
- {3589563600 7200 0 EET}
- {3607711200 10800 1 EEST}
- {3621013200 7200 0 EET}
- {3639160800 10800 1 EEST}
- {3652462800 7200 0 EET}
- {3670610400 10800 1 EEST}
- {3683912400 7200 0 EET}
- {3702060000 10800 1 EEST}
- {3715362000 7200 0 EET}
- {3734114400 10800 1 EEST}
- {3747416400 7200 0 EET}
- {3765564000 10800 1 EEST}
- {3778866000 7200 0 EET}
- {3797013600 10800 1 EEST}
- {3810315600 7200 0 EET}
- {3828463200 10800 1 EEST}
- {3841765200 7200 0 EET}
- {3859912800 10800 1 EEST}
- {3873214800 7200 0 EET}
- {3891362400 10800 1 EEST}
- {3904664400 7200 0 EET}
- {3923416800 10800 1 EEST}
- {3936718800 7200 0 EET}
- {3954866400 10800 1 EEST}
- {3968168400 7200 0 EET}
- {3986316000 10800 1 EEST}
- {3999618000 7200 0 EET}
- {4017765600 10800 1 EEST}
- {4031067600 7200 0 EET}
- {4049215200 10800 1 EEST}
- {4062517200 7200 0 EET}
- {4080664800 10800 1 EEST}
- {4093966800 7200 0 EET}
}
diff --git a/library/tzdata/Africa/Casablanca b/library/tzdata/Africa/Casablanca
index 996dd5d..41f8742 100644
--- a/library/tzdata/Africa/Casablanca
+++ b/library/tzdata/Africa/Casablanca
@@ -27,4 +27,184 @@ set TZData(:Africa/Casablanca) {
{1250809200 0 0 WET}
{1272758400 3600 1 WEST}
{1281222000 0 0 WET}
+ {1301788800 3600 1 WEST}
+ {1312066800 0 0 WET}
+ {1335664800 3600 1 WEST}
+ {1342749600 0 0 WET}
+ {1345428000 3600 1 WEST}
+ {1348970400 0 0 WET}
+ {1367114400 3600 1 WEST}
+ {1380420000 0 0 WET}
+ {1398564000 3600 1 WEST}
+ {1411869600 0 0 WET}
+ {1430013600 3600 1 WEST}
+ {1443319200 0 0 WET}
+ {1461463200 3600 1 WEST}
+ {1474768800 0 0 WET}
+ {1493517600 3600 1 WEST}
+ {1506218400 0 0 WET}
+ {1524967200 3600 1 WEST}
+ {1538272800 0 0 WET}
+ {1556416800 3600 1 WEST}
+ {1569722400 0 0 WET}
+ {1587866400 3600 1 WEST}
+ {1601172000 0 0 WET}
+ {1619316000 3600 1 WEST}
+ {1632621600 0 0 WET}
+ {1650765600 3600 1 WEST}
+ {1664071200 0 0 WET}
+ {1682820000 3600 1 WEST}
+ {1695520800 0 0 WET}
+ {1714269600 3600 1 WEST}
+ {1727575200 0 0 WET}
+ {1745719200 3600 1 WEST}
+ {1759024800 0 0 WET}
+ {1777168800 3600 1 WEST}
+ {1790474400 0 0 WET}
+ {1808618400 3600 1 WEST}
+ {1821924000 0 0 WET}
+ {1840672800 3600 1 WEST}
+ {1853373600 0 0 WET}
+ {1872122400 3600 1 WEST}
+ {1885428000 0 0 WET}
+ {1903572000 3600 1 WEST}
+ {1916877600 0 0 WET}
+ {1935021600 3600 1 WEST}
+ {1948327200 0 0 WET}
+ {1966471200 3600 1 WEST}
+ {1979776800 0 0 WET}
+ {1997920800 3600 1 WEST}
+ {2011226400 0 0 WET}
+ {2029975200 3600 1 WEST}
+ {2042676000 0 0 WET}
+ {2061424800 3600 1 WEST}
+ {2074730400 0 0 WET}
+ {2092874400 3600 1 WEST}
+ {2106180000 0 0 WET}
+ {2124324000 3600 1 WEST}
+ {2137629600 0 0 WET}
+ {2155773600 3600 1 WEST}
+ {2169079200 0 0 WET}
+ {2187223200 3600 1 WEST}
+ {2200528800 0 0 WET}
+ {2219277600 3600 1 WEST}
+ {2232583200 0 0 WET}
+ {2250727200 3600 1 WEST}
+ {2264032800 0 0 WET}
+ {2282176800 3600 1 WEST}
+ {2295482400 0 0 WET}
+ {2313626400 3600 1 WEST}
+ {2326932000 0 0 WET}
+ {2345076000 3600 1 WEST}
+ {2358381600 0 0 WET}
+ {2377130400 3600 1 WEST}
+ {2389831200 0 0 WET}
+ {2408580000 3600 1 WEST}
+ {2421885600 0 0 WET}
+ {2440029600 3600 1 WEST}
+ {2453335200 0 0 WET}
+ {2471479200 3600 1 WEST}
+ {2484784800 0 0 WET}
+ {2502928800 3600 1 WEST}
+ {2516234400 0 0 WET}
+ {2534378400 3600 1 WEST}
+ {2547684000 0 0 WET}
+ {2566432800 3600 1 WEST}
+ {2579133600 0 0 WET}
+ {2597882400 3600 1 WEST}
+ {2611188000 0 0 WET}
+ {2629332000 3600 1 WEST}
+ {2642637600 0 0 WET}
+ {2660781600 3600 1 WEST}
+ {2674087200 0 0 WET}
+ {2692231200 3600 1 WEST}
+ {2705536800 0 0 WET}
+ {2724285600 3600 1 WEST}
+ {2736986400 0 0 WET}
+ {2755735200 3600 1 WEST}
+ {2769040800 0 0 WET}
+ {2787184800 3600 1 WEST}
+ {2800490400 0 0 WET}
+ {2818634400 3600 1 WEST}
+ {2831940000 0 0 WET}
+ {2850084000 3600 1 WEST}
+ {2863389600 0 0 WET}
+ {2881533600 3600 1 WEST}
+ {2894839200 0 0 WET}
+ {2913588000 3600 1 WEST}
+ {2926288800 0 0 WET}
+ {2945037600 3600 1 WEST}
+ {2958343200 0 0 WET}
+ {2976487200 3600 1 WEST}
+ {2989792800 0 0 WET}
+ {3007936800 3600 1 WEST}
+ {3021242400 0 0 WET}
+ {3039386400 3600 1 WEST}
+ {3052692000 0 0 WET}
+ {3070836000 3600 1 WEST}
+ {3084141600 0 0 WET}
+ {3102890400 3600 1 WEST}
+ {3116196000 0 0 WET}
+ {3134340000 3600 1 WEST}
+ {3147645600 0 0 WET}
+ {3165789600 3600 1 WEST}
+ {3179095200 0 0 WET}
+ {3197239200 3600 1 WEST}
+ {3210544800 0 0 WET}
+ {3228688800 3600 1 WEST}
+ {3241994400 0 0 WET}
+ {3260743200 3600 1 WEST}
+ {3273444000 0 0 WET}
+ {3292192800 3600 1 WEST}
+ {3305498400 0 0 WET}
+ {3323642400 3600 1 WEST}
+ {3336948000 0 0 WET}
+ {3355092000 3600 1 WEST}
+ {3368397600 0 0 WET}
+ {3386541600 3600 1 WEST}
+ {3399847200 0 0 WET}
+ {3417991200 3600 1 WEST}
+ {3431296800 0 0 WET}
+ {3450045600 3600 1 WEST}
+ {3462746400 0 0 WET}
+ {3481495200 3600 1 WEST}
+ {3494800800 0 0 WET}
+ {3512944800 3600 1 WEST}
+ {3526250400 0 0 WET}
+ {3544394400 3600 1 WEST}
+ {3557700000 0 0 WET}
+ {3575844000 3600 1 WEST}
+ {3589149600 0 0 WET}
+ {3607898400 3600 1 WEST}
+ {3620599200 0 0 WET}
+ {3639348000 3600 1 WEST}
+ {3652653600 0 0 WET}
+ {3670797600 3600 1 WEST}
+ {3684103200 0 0 WET}
+ {3702247200 3600 1 WEST}
+ {3715552800 0 0 WET}
+ {3733696800 3600 1 WEST}
+ {3747002400 0 0 WET}
+ {3765146400 3600 1 WEST}
+ {3778452000 0 0 WET}
+ {3797200800 3600 1 WEST}
+ {3809901600 0 0 WET}
+ {3828650400 3600 1 WEST}
+ {3841956000 0 0 WET}
+ {3860100000 3600 1 WEST}
+ {3873405600 0 0 WET}
+ {3891549600 3600 1 WEST}
+ {3904855200 0 0 WET}
+ {3922999200 3600 1 WEST}
+ {3936304800 0 0 WET}
+ {3954448800 3600 1 WEST}
+ {3967754400 0 0 WET}
+ {3986503200 3600 1 WEST}
+ {3999808800 0 0 WET}
+ {4017952800 3600 1 WEST}
+ {4031258400 0 0 WET}
+ {4049402400 3600 1 WEST}
+ {4062708000 0 0 WET}
+ {4080852000 3600 1 WEST}
+ {4094157600 0 0 WET}
}
diff --git a/library/tzdata/Africa/Dar_es_Salaam b/library/tzdata/Africa/Dar_es_Salaam
index e427b9c..98151ec 100644
--- a/library/tzdata/Africa/Dar_es_Salaam
+++ b/library/tzdata/Africa/Dar_es_Salaam
@@ -3,6 +3,6 @@
set TZData(:Africa/Dar_es_Salaam) {
{-9223372036854775808 9428 0 LMT}
{-1230777428 10800 0 EAT}
- {-694321200 9885 0 BEAUT}
- {-284006685 10800 0 EAT}
+ {-694321200 9900 0 BEAUT}
+ {-284006700 10800 0 EAT}
}
diff --git a/library/tzdata/Africa/Juba b/library/tzdata/Africa/Juba
new file mode 100644
index 0000000..7495981
--- /dev/null
+++ b/library/tzdata/Africa/Juba
@@ -0,0 +1,39 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Africa/Juba) {
+ {-9223372036854775808 7584 0 LMT}
+ {-1230775584 7200 0 CAT}
+ {10360800 10800 1 CAST}
+ {24786000 7200 0 CAT}
+ {41810400 10800 1 CAST}
+ {56322000 7200 0 CAT}
+ {73432800 10800 1 CAST}
+ {87944400 7200 0 CAT}
+ {104882400 10800 1 CAST}
+ {119480400 7200 0 CAT}
+ {136332000 10800 1 CAST}
+ {151016400 7200 0 CAT}
+ {167781600 10800 1 CAST}
+ {182552400 7200 0 CAT}
+ {199231200 10800 1 CAST}
+ {214174800 7200 0 CAT}
+ {230680800 10800 1 CAST}
+ {245710800 7200 0 CAT}
+ {262735200 10800 1 CAST}
+ {277246800 7200 0 CAT}
+ {294184800 10800 1 CAST}
+ {308782800 7200 0 CAT}
+ {325634400 10800 1 CAST}
+ {340405200 7200 0 CAT}
+ {357084000 10800 1 CAST}
+ {371941200 7200 0 CAT}
+ {388533600 10800 1 CAST}
+ {403477200 7200 0 CAT}
+ {419983200 10800 1 CAST}
+ {435013200 7200 0 CAT}
+ {452037600 10800 1 CAST}
+ {466635600 7200 0 CAT}
+ {483487200 10800 1 CAST}
+ {498171600 7200 0 CAT}
+ {947930400 10800 0 EAT}
+}
diff --git a/library/tzdata/Africa/Kampala b/library/tzdata/Africa/Kampala
index ab3f085..4cc9be1 100644
--- a/library/tzdata/Africa/Kampala
+++ b/library/tzdata/Africa/Kampala
@@ -4,6 +4,6 @@ set TZData(:Africa/Kampala) {
{-9223372036854775808 7780 0 LMT}
{-1309745380 10800 0 EAT}
{-1262314800 9000 0 BEAT}
- {-694319400 9885 0 BEAUT}
- {-410237085 10800 0 EAT}
+ {-694319400 9900 0 BEAUT}
+ {-410237100 10800 0 EAT}
}
diff --git a/library/tzdata/Africa/Nairobi b/library/tzdata/Africa/Nairobi
index 99b0d70..6846069 100644
--- a/library/tzdata/Africa/Nairobi
+++ b/library/tzdata/Africa/Nairobi
@@ -4,6 +4,6 @@ set TZData(:Africa/Nairobi) {
{-9223372036854775808 8836 0 LMT}
{-1309746436 10800 0 EAT}
{-1262314800 9000 0 BEAT}
- {-946780200 9885 0 BEAUT}
- {-315629085 10800 0 EAT}
+ {-946780200 9900 0 BEAUT}
+ {-315629100 10800 0 EAT}
}
diff --git a/library/tzdata/America/Araguaina b/library/tzdata/America/Araguaina
index 5073c56..dc1b543 100644
--- a/library/tzdata/America/Araguaina
+++ b/library/tzdata/America/Araguaina
@@ -54,4 +54,179 @@ set TZData(:America/Araguaina) {
{1036292400 -7200 1 BRST}
{1045360800 -10800 0 BRT}
{1064368800 -10800 0 BRT}
+ {1350788400 -7200 0 BRST}
+ {1361066400 -10800 0 BRT}
+ {1382238000 -7200 1 BRST}
+ {1392516000 -10800 0 BRT}
+ {1413687600 -7200 1 BRST}
+ {1424570400 -10800 0 BRT}
+ {1445137200 -7200 1 BRST}
+ {1456020000 -10800 0 BRT}
+ {1476586800 -7200 1 BRST}
+ {1487469600 -10800 0 BRT}
+ {1508036400 -7200 1 BRST}
+ {1518919200 -10800 0 BRT}
+ {1540090800 -7200 1 BRST}
+ {1550368800 -10800 0 BRT}
+ {1571540400 -7200 1 BRST}
+ {1581818400 -10800 0 BRT}
+ {1602990000 -7200 1 BRST}
+ {1613872800 -10800 0 BRT}
+ {1634439600 -7200 1 BRST}
+ {1645322400 -10800 0 BRT}
+ {1665889200 -7200 1 BRST}
+ {1677376800 -10800 0 BRT}
+ {1697338800 -7200 1 BRST}
+ {1708221600 -10800 0 BRT}
+ {1729393200 -7200 1 BRST}
+ {1739671200 -10800 0 BRT}
+ {1760842800 -7200 1 BRST}
+ {1771725600 -10800 0 BRT}
+ {1792292400 -7200 1 BRST}
+ {1803175200 -10800 0 BRT}
+ {1823742000 -7200 1 BRST}
+ {1834624800 -10800 0 BRT}
+ {1855191600 -7200 1 BRST}
+ {1866074400 -10800 0 BRT}
+ {1887246000 -7200 1 BRST}
+ {1897524000 -10800 0 BRT}
+ {1918695600 -7200 1 BRST}
+ {1928973600 -10800 0 BRT}
+ {1950145200 -7200 1 BRST}
+ {1960423200 -10800 0 BRT}
+ {1981594800 -7200 1 BRST}
+ {1992477600 -10800 0 BRT}
+ {2013044400 -7200 1 BRST}
+ {2024532000 -10800 0 BRT}
+ {2044494000 -7200 1 BRST}
+ {2055376800 -10800 0 BRT}
+ {2076548400 -7200 1 BRST}
+ {2086826400 -10800 0 BRT}
+ {2107998000 -7200 1 BRST}
+ {2118880800 -10800 0 BRT}
+ {2139447600 -7200 1 BRST}
+ {2150330400 -10800 0 BRT}
+ {2170897200 -7200 1 BRST}
+ {2181780000 -10800 0 BRT}
+ {2202346800 -7200 1 BRST}
+ {2213229600 -10800 0 BRT}
+ {2234401200 -7200 1 BRST}
+ {2244679200 -10800 0 BRT}
+ {2265850800 -7200 1 BRST}
+ {2276128800 -10800 0 BRT}
+ {2297300400 -7200 1 BRST}
+ {2307578400 -10800 0 BRT}
+ {2328750000 -7200 1 BRST}
+ {2339632800 -10800 0 BRT}
+ {2360199600 -7200 1 BRST}
+ {2371082400 -10800 0 BRT}
+ {2391649200 -7200 1 BRST}
+ {2402532000 -10800 0 BRT}
+ {2423703600 -7200 1 BRST}
+ {2433981600 -10800 0 BRT}
+ {2455153200 -7200 1 BRST}
+ {2465431200 -10800 0 BRT}
+ {2486602800 -7200 1 BRST}
+ {2497485600 -10800 0 BRT}
+ {2518052400 -7200 1 BRST}
+ {2528935200 -10800 0 BRT}
+ {2549502000 -7200 1 BRST}
+ {2560384800 -10800 0 BRT}
+ {2580951600 -7200 1 BRST}
+ {2591834400 -10800 0 BRT}
+ {2613006000 -7200 1 BRST}
+ {2623284000 -10800 0 BRT}
+ {2644455600 -7200 1 BRST}
+ {2654733600 -10800 0 BRT}
+ {2675905200 -7200 1 BRST}
+ {2686788000 -10800 0 BRT}
+ {2707354800 -7200 1 BRST}
+ {2718237600 -10800 0 BRT}
+ {2738804400 -7200 1 BRST}
+ {2749687200 -10800 0 BRT}
+ {2770858800 -7200 1 BRST}
+ {2781136800 -10800 0 BRT}
+ {2802308400 -7200 1 BRST}
+ {2812586400 -10800 0 BRT}
+ {2833758000 -7200 1 BRST}
+ {2844036000 -10800 0 BRT}
+ {2865207600 -7200 1 BRST}
+ {2876090400 -10800 0 BRT}
+ {2896657200 -7200 1 BRST}
+ {2907540000 -10800 0 BRT}
+ {2928106800 -7200 1 BRST}
+ {2938989600 -10800 0 BRT}
+ {2960161200 -7200 1 BRST}
+ {2970439200 -10800 0 BRT}
+ {2991610800 -7200 1 BRST}
+ {3001888800 -10800 0 BRT}
+ {3023060400 -7200 1 BRST}
+ {3033943200 -10800 0 BRT}
+ {3054510000 -7200 1 BRST}
+ {3065392800 -10800 0 BRT}
+ {3085959600 -7200 1 BRST}
+ {3096842400 -10800 0 BRT}
+ {3118014000 -7200 1 BRST}
+ {3128292000 -10800 0 BRT}
+ {3149463600 -7200 1 BRST}
+ {3159741600 -10800 0 BRT}
+ {3180913200 -7200 1 BRST}
+ {3191191200 -10800 0 BRT}
+ {3212362800 -7200 1 BRST}
+ {3223245600 -10800 0 BRT}
+ {3243812400 -7200 1 BRST}
+ {3254695200 -10800 0 BRT}
+ {3275262000 -7200 1 BRST}
+ {3286144800 -10800 0 BRT}
+ {3307316400 -7200 1 BRST}
+ {3317594400 -10800 0 BRT}
+ {3338766000 -7200 1 BRST}
+ {3349044000 -10800 0 BRT}
+ {3370215600 -7200 1 BRST}
+ {3381098400 -10800 0 BRT}
+ {3401665200 -7200 1 BRST}
+ {3412548000 -10800 0 BRT}
+ {3433114800 -7200 1 BRST}
+ {3443997600 -10800 0 BRT}
+ {3464564400 -7200 1 BRST}
+ {3475447200 -10800 0 BRT}
+ {3496618800 -7200 1 BRST}
+ {3506896800 -10800 0 BRT}
+ {3528068400 -7200 1 BRST}
+ {3538346400 -10800 0 BRT}
+ {3559518000 -7200 1 BRST}
+ {3570400800 -10800 0 BRT}
+ {3590967600 -7200 1 BRST}
+ {3601850400 -10800 0 BRT}
+ {3622417200 -7200 1 BRST}
+ {3633300000 -10800 0 BRT}
+ {3654471600 -7200 1 BRST}
+ {3664749600 -10800 0 BRT}
+ {3685921200 -7200 1 BRST}
+ {3696199200 -10800 0 BRT}
+ {3717370800 -7200 1 BRST}
+ {3727648800 -10800 0 BRT}
+ {3748820400 -7200 1 BRST}
+ {3759703200 -10800 0 BRT}
+ {3780270000 -7200 1 BRST}
+ {3791152800 -10800 0 BRT}
+ {3811719600 -7200 1 BRST}
+ {3822602400 -10800 0 BRT}
+ {3843774000 -7200 1 BRST}
+ {3854052000 -10800 0 BRT}
+ {3875223600 -7200 1 BRST}
+ {3885501600 -10800 0 BRT}
+ {3906673200 -7200 1 BRST}
+ {3917556000 -10800 0 BRT}
+ {3938122800 -7200 1 BRST}
+ {3949005600 -10800 0 BRT}
+ {3969572400 -7200 1 BRST}
+ {3980455200 -10800 0 BRT}
+ {4001626800 -7200 1 BRST}
+ {4011904800 -10800 0 BRT}
+ {4033076400 -7200 1 BRST}
+ {4043354400 -10800 0 BRT}
+ {4064526000 -7200 1 BRST}
+ {4074804000 -10800 0 BRT}
+ {4095975600 -7200 1 BRST}
}
diff --git a/library/tzdata/America/Atikokan b/library/tzdata/America/Atikokan
index ca0ac1c..e72b04f 100755
--- a/library/tzdata/America/Atikokan
+++ b/library/tzdata/America/Atikokan
@@ -4,7 +4,7 @@ set TZData(:America/Atikokan) {
{-9223372036854775808 -21988 0 LMT}
{-2366733212 -21600 0 CST}
{-1632067200 -18000 1 CDT}
- {-1614790800 -21600 0 CST}
+ {-1615136400 -21600 0 CST}
{-923248800 -18000 1 CDT}
{-880214400 -18000 0 CWT}
{-769395600 -18000 1 CPT}
diff --git a/library/tzdata/America/Bahia b/library/tzdata/America/Bahia
index b10a939..ac67b71 100644
--- a/library/tzdata/America/Bahia
+++ b/library/tzdata/America/Bahia
@@ -62,4 +62,7 @@ set TZData(:America/Bahia) {
{1036292400 -7200 1 BRST}
{1045360800 -10800 0 BRT}
{1064368800 -10800 0 BRT}
+ {1318734000 -7200 0 BRST}
+ {1330221600 -10800 0 BRT}
+ {1350784800 -10800 0 BRT}
}
diff --git a/library/tzdata/America/Blanc-Sablon b/library/tzdata/America/Blanc-Sablon
index 47f161a..d5485e8 100755
--- a/library/tzdata/America/Blanc-Sablon
+++ b/library/tzdata/America/Blanc-Sablon
@@ -4,7 +4,7 @@ set TZData(:America/Blanc-Sablon) {
{-9223372036854775808 -13708 0 LMT}
{-2713896692 -14400 0 AST}
{-1632074400 -10800 1 ADT}
- {-1614798000 -14400 0 AST}
+ {-1615143600 -14400 0 AST}
{-880221600 -10800 1 AWT}
{-769395600 -10800 1 APT}
{-765399600 -14400 0 AST}
diff --git a/library/tzdata/America/Creston b/library/tzdata/America/Creston
new file mode 100644
index 0000000..30369a9
--- /dev/null
+++ b/library/tzdata/America/Creston
@@ -0,0 +1,8 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Creston) {
+ {-9223372036854775808 -27964 0 LMT}
+ {-2713882436 -25200 0 MST}
+ {-1680454800 -28800 0 PST}
+ {-1627833600 -25200 0 MST}
+}
diff --git a/library/tzdata/America/Dawson_Creek b/library/tzdata/America/Dawson_Creek
index 9f8c921..a0b5c44 100644
--- a/library/tzdata/America/Dawson_Creek
+++ b/library/tzdata/America/Dawson_Creek
@@ -4,7 +4,7 @@ set TZData(:America/Dawson_Creek) {
{-9223372036854775808 -28856 0 LMT}
{-2713881544 -28800 0 PST}
{-1632060000 -25200 1 PDT}
- {-1614783600 -28800 0 PST}
+ {-1615129200 -28800 0 PST}
{-880207200 -25200 1 PWT}
{-769395600 -25200 1 PPT}
{-765385200 -28800 0 PST}
diff --git a/library/tzdata/America/Edmonton b/library/tzdata/America/Edmonton
index c4252f8..1ed38be 100644
--- a/library/tzdata/America/Edmonton
+++ b/library/tzdata/America/Edmonton
@@ -4,7 +4,7 @@ set TZData(:America/Edmonton) {
{-9223372036854775808 -27232 0 LMT}
{-1998663968 -25200 0 MST}
{-1632063600 -21600 1 MDT}
- {-1614787200 -25200 0 MST}
+ {-1615132800 -25200 0 MST}
{-1600614000 -21600 1 MDT}
{-1596816000 -25200 0 MST}
{-1567954800 -21600 1 MDT}
diff --git a/library/tzdata/America/Glace_Bay b/library/tzdata/America/Glace_Bay
index 84b4822..8ee9eec 100644
--- a/library/tzdata/America/Glace_Bay
+++ b/library/tzdata/America/Glace_Bay
@@ -4,7 +4,7 @@ set TZData(:America/Glace_Bay) {
{-9223372036854775808 -14388 0 LMT}
{-2131646412 -14400 0 AST}
{-1632074400 -10800 1 ADT}
- {-1614798000 -14400 0 AST}
+ {-1615143600 -14400 0 AST}
{-880221600 -10800 1 AWT}
{-769395600 -10800 1 APT}
{-765399600 -14400 0 AST}
diff --git a/library/tzdata/America/Goose_Bay b/library/tzdata/America/Goose_Bay
index f93b612..7b7b3d8 100644
--- a/library/tzdata/America/Goose_Bay
+++ b/library/tzdata/America/Goose_Bay
@@ -5,7 +5,7 @@ set TZData(:America/Goose_Bay) {
{-2713895900 -12652 0 NST}
{-1640982548 -12652 0 NST}
{-1632076148 -9052 1 NDT}
- {-1614799748 -12652 0 NST}
+ {-1615145348 -12652 0 NST}
{-1609446548 -12652 0 NST}
{-1096921748 -12600 0 NST}
{-1072989000 -12600 0 NST}
@@ -157,181 +157,182 @@ set TZData(:America/Goose_Bay) {
{1268539260 -10800 1 ADT}
{1289098860 -14400 0 AST}
{1299988860 -10800 1 ADT}
- {1320548460 -14400 0 AST}
- {1331438460 -10800 1 ADT}
- {1351998060 -14400 0 AST}
- {1362888060 -10800 1 ADT}
- {1383447660 -14400 0 AST}
- {1394337660 -10800 1 ADT}
- {1414897260 -14400 0 AST}
- {1425787260 -10800 1 ADT}
- {1446346860 -14400 0 AST}
- {1457841660 -10800 1 ADT}
- {1478401260 -14400 0 AST}
- {1489291260 -10800 1 ADT}
- {1509850860 -14400 0 AST}
- {1520740860 -10800 1 ADT}
- {1541300460 -14400 0 AST}
- {1552190460 -10800 1 ADT}
- {1572750060 -14400 0 AST}
- {1583640060 -10800 1 ADT}
- {1604199660 -14400 0 AST}
- {1615694460 -10800 1 ADT}
- {1636254060 -14400 0 AST}
- {1647144060 -10800 1 ADT}
- {1667703660 -14400 0 AST}
- {1678593660 -10800 1 ADT}
- {1699153260 -14400 0 AST}
- {1710043260 -10800 1 ADT}
- {1730602860 -14400 0 AST}
- {1741492860 -10800 1 ADT}
- {1762052460 -14400 0 AST}
- {1772942460 -10800 1 ADT}
- {1793502060 -14400 0 AST}
- {1804996860 -10800 1 ADT}
- {1825556460 -14400 0 AST}
- {1836446460 -10800 1 ADT}
- {1857006060 -14400 0 AST}
- {1867896060 -10800 1 ADT}
- {1888455660 -14400 0 AST}
- {1899345660 -10800 1 ADT}
- {1919905260 -14400 0 AST}
- {1930795260 -10800 1 ADT}
- {1951354860 -14400 0 AST}
- {1962849660 -10800 1 ADT}
- {1983409260 -14400 0 AST}
- {1994299260 -10800 1 ADT}
- {2014858860 -14400 0 AST}
- {2025748860 -10800 1 ADT}
- {2046308460 -14400 0 AST}
- {2057198460 -10800 1 ADT}
- {2077758060 -14400 0 AST}
- {2088648060 -10800 1 ADT}
- {2109207660 -14400 0 AST}
- {2120097660 -10800 1 ADT}
- {2140657260 -14400 0 AST}
- {2152152060 -10800 1 ADT}
- {2172711660 -14400 0 AST}
- {2183601660 -10800 1 ADT}
- {2204161260 -14400 0 AST}
- {2215051260 -10800 1 ADT}
- {2235610860 -14400 0 AST}
- {2246500860 -10800 1 ADT}
- {2267060460 -14400 0 AST}
- {2277950460 -10800 1 ADT}
- {2298510060 -14400 0 AST}
- {2309400060 -10800 1 ADT}
- {2329959660 -14400 0 AST}
- {2341454460 -10800 1 ADT}
- {2362014060 -14400 0 AST}
- {2372904060 -10800 1 ADT}
- {2393463660 -14400 0 AST}
- {2404353660 -10800 1 ADT}
- {2424913260 -14400 0 AST}
- {2435803260 -10800 1 ADT}
- {2456362860 -14400 0 AST}
- {2467252860 -10800 1 ADT}
- {2487812460 -14400 0 AST}
- {2499307260 -10800 1 ADT}
- {2519866860 -14400 0 AST}
- {2530756860 -10800 1 ADT}
- {2551316460 -14400 0 AST}
- {2562206460 -10800 1 ADT}
- {2582766060 -14400 0 AST}
- {2593656060 -10800 1 ADT}
- {2614215660 -14400 0 AST}
- {2625105660 -10800 1 ADT}
- {2645665260 -14400 0 AST}
- {2656555260 -10800 1 ADT}
- {2677114860 -14400 0 AST}
- {2688609660 -10800 1 ADT}
- {2709169260 -14400 0 AST}
- {2720059260 -10800 1 ADT}
- {2740618860 -14400 0 AST}
- {2751508860 -10800 1 ADT}
- {2772068460 -14400 0 AST}
- {2782958460 -10800 1 ADT}
- {2803518060 -14400 0 AST}
- {2814408060 -10800 1 ADT}
- {2834967660 -14400 0 AST}
- {2846462460 -10800 1 ADT}
- {2867022060 -14400 0 AST}
- {2877912060 -10800 1 ADT}
- {2898471660 -14400 0 AST}
- {2909361660 -10800 1 ADT}
- {2929921260 -14400 0 AST}
- {2940811260 -10800 1 ADT}
- {2961370860 -14400 0 AST}
- {2972260860 -10800 1 ADT}
- {2992820460 -14400 0 AST}
- {3003710460 -10800 1 ADT}
- {3024270060 -14400 0 AST}
- {3035764860 -10800 1 ADT}
- {3056324460 -14400 0 AST}
- {3067214460 -10800 1 ADT}
- {3087774060 -14400 0 AST}
- {3098664060 -10800 1 ADT}
- {3119223660 -14400 0 AST}
- {3130113660 -10800 1 ADT}
- {3150673260 -14400 0 AST}
- {3161563260 -10800 1 ADT}
- {3182122860 -14400 0 AST}
- {3193012860 -10800 1 ADT}
- {3213572460 -14400 0 AST}
- {3225067260 -10800 1 ADT}
- {3245626860 -14400 0 AST}
- {3256516860 -10800 1 ADT}
- {3277076460 -14400 0 AST}
- {3287966460 -10800 1 ADT}
- {3308526060 -14400 0 AST}
- {3319416060 -10800 1 ADT}
- {3339975660 -14400 0 AST}
- {3350865660 -10800 1 ADT}
- {3371425260 -14400 0 AST}
- {3382920060 -10800 1 ADT}
- {3403479660 -14400 0 AST}
- {3414369660 -10800 1 ADT}
- {3434929260 -14400 0 AST}
- {3445819260 -10800 1 ADT}
- {3466378860 -14400 0 AST}
- {3477268860 -10800 1 ADT}
- {3497828460 -14400 0 AST}
- {3508718460 -10800 1 ADT}
- {3529278060 -14400 0 AST}
- {3540168060 -10800 1 ADT}
- {3560727660 -14400 0 AST}
- {3572222460 -10800 1 ADT}
- {3592782060 -14400 0 AST}
- {3603672060 -10800 1 ADT}
- {3624231660 -14400 0 AST}
- {3635121660 -10800 1 ADT}
- {3655681260 -14400 0 AST}
- {3666571260 -10800 1 ADT}
- {3687130860 -14400 0 AST}
- {3698020860 -10800 1 ADT}
- {3718580460 -14400 0 AST}
- {3730075260 -10800 1 ADT}
- {3750634860 -14400 0 AST}
- {3761524860 -10800 1 ADT}
- {3782084460 -14400 0 AST}
- {3792974460 -10800 1 ADT}
- {3813534060 -14400 0 AST}
- {3824424060 -10800 1 ADT}
- {3844983660 -14400 0 AST}
- {3855873660 -10800 1 ADT}
- {3876433260 -14400 0 AST}
- {3887323260 -10800 1 ADT}
- {3907882860 -14400 0 AST}
- {3919377660 -10800 1 ADT}
- {3939937260 -14400 0 AST}
- {3950827260 -10800 1 ADT}
- {3971386860 -14400 0 AST}
- {3982276860 -10800 1 ADT}
- {4002836460 -14400 0 AST}
- {4013726460 -10800 1 ADT}
- {4034286060 -14400 0 AST}
- {4045176060 -10800 1 ADT}
- {4065735660 -14400 0 AST}
- {4076625660 -10800 1 ADT}
- {4097185260 -14400 0 AST}
+ {1320116400 -10800 0 ADT}
+ {1320555600 -14400 0 AST}
+ {1331445600 -10800 1 ADT}
+ {1352005200 -14400 0 AST}
+ {1362895200 -10800 1 ADT}
+ {1383454800 -14400 0 AST}
+ {1394344800 -10800 1 ADT}
+ {1414904400 -14400 0 AST}
+ {1425794400 -10800 1 ADT}
+ {1446354000 -14400 0 AST}
+ {1457848800 -10800 1 ADT}
+ {1478408400 -14400 0 AST}
+ {1489298400 -10800 1 ADT}
+ {1509858000 -14400 0 AST}
+ {1520748000 -10800 1 ADT}
+ {1541307600 -14400 0 AST}
+ {1552197600 -10800 1 ADT}
+ {1572757200 -14400 0 AST}
+ {1583647200 -10800 1 ADT}
+ {1604206800 -14400 0 AST}
+ {1615701600 -10800 1 ADT}
+ {1636261200 -14400 0 AST}
+ {1647151200 -10800 1 ADT}
+ {1667710800 -14400 0 AST}
+ {1678600800 -10800 1 ADT}
+ {1699160400 -14400 0 AST}
+ {1710050400 -10800 1 ADT}
+ {1730610000 -14400 0 AST}
+ {1741500000 -10800 1 ADT}
+ {1762059600 -14400 0 AST}
+ {1772949600 -10800 1 ADT}
+ {1793509200 -14400 0 AST}
+ {1805004000 -10800 1 ADT}
+ {1825563600 -14400 0 AST}
+ {1836453600 -10800 1 ADT}
+ {1857013200 -14400 0 AST}
+ {1867903200 -10800 1 ADT}
+ {1888462800 -14400 0 AST}
+ {1899352800 -10800 1 ADT}
+ {1919912400 -14400 0 AST}
+ {1930802400 -10800 1 ADT}
+ {1951362000 -14400 0 AST}
+ {1962856800 -10800 1 ADT}
+ {1983416400 -14400 0 AST}
+ {1994306400 -10800 1 ADT}
+ {2014866000 -14400 0 AST}
+ {2025756000 -10800 1 ADT}
+ {2046315600 -14400 0 AST}
+ {2057205600 -10800 1 ADT}
+ {2077765200 -14400 0 AST}
+ {2088655200 -10800 1 ADT}
+ {2109214800 -14400 0 AST}
+ {2120104800 -10800 1 ADT}
+ {2140664400 -14400 0 AST}
+ {2152159200 -10800 1 ADT}
+ {2172718800 -14400 0 AST}
+ {2183608800 -10800 1 ADT}
+ {2204168400 -14400 0 AST}
+ {2215058400 -10800 1 ADT}
+ {2235618000 -14400 0 AST}
+ {2246508000 -10800 1 ADT}
+ {2267067600 -14400 0 AST}
+ {2277957600 -10800 1 ADT}
+ {2298517200 -14400 0 AST}
+ {2309407200 -10800 1 ADT}
+ {2329966800 -14400 0 AST}
+ {2341461600 -10800 1 ADT}
+ {2362021200 -14400 0 AST}
+ {2372911200 -10800 1 ADT}
+ {2393470800 -14400 0 AST}
+ {2404360800 -10800 1 ADT}
+ {2424920400 -14400 0 AST}
+ {2435810400 -10800 1 ADT}
+ {2456370000 -14400 0 AST}
+ {2467260000 -10800 1 ADT}
+ {2487819600 -14400 0 AST}
+ {2499314400 -10800 1 ADT}
+ {2519874000 -14400 0 AST}
+ {2530764000 -10800 1 ADT}
+ {2551323600 -14400 0 AST}
+ {2562213600 -10800 1 ADT}
+ {2582773200 -14400 0 AST}
+ {2593663200 -10800 1 ADT}
+ {2614222800 -14400 0 AST}
+ {2625112800 -10800 1 ADT}
+ {2645672400 -14400 0 AST}
+ {2656562400 -10800 1 ADT}
+ {2677122000 -14400 0 AST}
+ {2688616800 -10800 1 ADT}
+ {2709176400 -14400 0 AST}
+ {2720066400 -10800 1 ADT}
+ {2740626000 -14400 0 AST}
+ {2751516000 -10800 1 ADT}
+ {2772075600 -14400 0 AST}
+ {2782965600 -10800 1 ADT}
+ {2803525200 -14400 0 AST}
+ {2814415200 -10800 1 ADT}
+ {2834974800 -14400 0 AST}
+ {2846469600 -10800 1 ADT}
+ {2867029200 -14400 0 AST}
+ {2877919200 -10800 1 ADT}
+ {2898478800 -14400 0 AST}
+ {2909368800 -10800 1 ADT}
+ {2929928400 -14400 0 AST}
+ {2940818400 -10800 1 ADT}
+ {2961378000 -14400 0 AST}
+ {2972268000 -10800 1 ADT}
+ {2992827600 -14400 0 AST}
+ {3003717600 -10800 1 ADT}
+ {3024277200 -14400 0 AST}
+ {3035772000 -10800 1 ADT}
+ {3056331600 -14400 0 AST}
+ {3067221600 -10800 1 ADT}
+ {3087781200 -14400 0 AST}
+ {3098671200 -10800 1 ADT}
+ {3119230800 -14400 0 AST}
+ {3130120800 -10800 1 ADT}
+ {3150680400 -14400 0 AST}
+ {3161570400 -10800 1 ADT}
+ {3182130000 -14400 0 AST}
+ {3193020000 -10800 1 ADT}
+ {3213579600 -14400 0 AST}
+ {3225074400 -10800 1 ADT}
+ {3245634000 -14400 0 AST}
+ {3256524000 -10800 1 ADT}
+ {3277083600 -14400 0 AST}
+ {3287973600 -10800 1 ADT}
+ {3308533200 -14400 0 AST}
+ {3319423200 -10800 1 ADT}
+ {3339982800 -14400 0 AST}
+ {3350872800 -10800 1 ADT}
+ {3371432400 -14400 0 AST}
+ {3382927200 -10800 1 ADT}
+ {3403486800 -14400 0 AST}
+ {3414376800 -10800 1 ADT}
+ {3434936400 -14400 0 AST}
+ {3445826400 -10800 1 ADT}
+ {3466386000 -14400 0 AST}
+ {3477276000 -10800 1 ADT}
+ {3497835600 -14400 0 AST}
+ {3508725600 -10800 1 ADT}
+ {3529285200 -14400 0 AST}
+ {3540175200 -10800 1 ADT}
+ {3560734800 -14400 0 AST}
+ {3572229600 -10800 1 ADT}
+ {3592789200 -14400 0 AST}
+ {3603679200 -10800 1 ADT}
+ {3624238800 -14400 0 AST}
+ {3635128800 -10800 1 ADT}
+ {3655688400 -14400 0 AST}
+ {3666578400 -10800 1 ADT}
+ {3687138000 -14400 0 AST}
+ {3698028000 -10800 1 ADT}
+ {3718587600 -14400 0 AST}
+ {3730082400 -10800 1 ADT}
+ {3750642000 -14400 0 AST}
+ {3761532000 -10800 1 ADT}
+ {3782091600 -14400 0 AST}
+ {3792981600 -10800 1 ADT}
+ {3813541200 -14400 0 AST}
+ {3824431200 -10800 1 ADT}
+ {3844990800 -14400 0 AST}
+ {3855880800 -10800 1 ADT}
+ {3876440400 -14400 0 AST}
+ {3887330400 -10800 1 ADT}
+ {3907890000 -14400 0 AST}
+ {3919384800 -10800 1 ADT}
+ {3939944400 -14400 0 AST}
+ {3950834400 -10800 1 ADT}
+ {3971394000 -14400 0 AST}
+ {3982284000 -10800 1 ADT}
+ {4002843600 -14400 0 AST}
+ {4013733600 -10800 1 ADT}
+ {4034293200 -14400 0 AST}
+ {4045183200 -10800 1 ADT}
+ {4065742800 -14400 0 AST}
+ {4076632800 -10800 1 ADT}
+ {4097192400 -14400 0 AST}
}
diff --git a/library/tzdata/America/Halifax b/library/tzdata/America/Halifax
index 76f016a..08e3754 100644
--- a/library/tzdata/America/Halifax
+++ b/library/tzdata/America/Halifax
@@ -7,7 +7,7 @@ set TZData(:America/Halifax) {
{-1680469200 -14400 0 AST}
{-1640980800 -14400 0 AST}
{-1632074400 -10800 1 ADT}
- {-1614798000 -14400 0 AST}
+ {-1615143600 -14400 0 AST}
{-1609444800 -14400 0 AST}
{-1566763200 -10800 1 ADT}
{-1557090000 -14400 0 AST}
diff --git a/library/tzdata/America/Havana b/library/tzdata/America/Havana
index 7fc6305..89cbc9a 100644
--- a/library/tzdata/America/Havana
+++ b/library/tzdata/America/Havana
@@ -104,182 +104,182 @@ set TZData(:America/Havana) {
{1256446800 -18000 0 CST}
{1268542800 -14400 1 CDT}
{1288501200 -18000 0 CST}
- {1299992400 -14400 1 CDT}
- {1319950800 -18000 0 CST}
- {1331442000 -14400 1 CDT}
- {1351400400 -18000 0 CST}
+ {1300597200 -14400 1 CDT}
+ {1321160400 -18000 0 CST}
+ {1333256400 -14400 1 CDT}
+ {1352005200 -18000 0 CST}
{1362891600 -14400 1 CDT}
- {1382850000 -18000 0 CST}
+ {1383454800 -18000 0 CST}
{1394341200 -14400 1 CDT}
- {1414299600 -18000 0 CST}
+ {1414904400 -18000 0 CST}
{1425790800 -14400 1 CDT}
- {1445749200 -18000 0 CST}
+ {1446354000 -18000 0 CST}
{1457845200 -14400 1 CDT}
- {1477803600 -18000 0 CST}
+ {1478408400 -18000 0 CST}
{1489294800 -14400 1 CDT}
- {1509253200 -18000 0 CST}
+ {1509858000 -18000 0 CST}
{1520744400 -14400 1 CDT}
- {1540702800 -18000 0 CST}
+ {1541307600 -18000 0 CST}
{1552194000 -14400 1 CDT}
- {1572152400 -18000 0 CST}
+ {1572757200 -18000 0 CST}
{1583643600 -14400 1 CDT}
- {1603602000 -18000 0 CST}
+ {1604206800 -18000 0 CST}
{1615698000 -14400 1 CDT}
- {1635656400 -18000 0 CST}
+ {1636261200 -18000 0 CST}
{1647147600 -14400 1 CDT}
- {1667106000 -18000 0 CST}
+ {1667710800 -18000 0 CST}
{1678597200 -14400 1 CDT}
- {1698555600 -18000 0 CST}
+ {1699160400 -18000 0 CST}
{1710046800 -14400 1 CDT}
- {1730005200 -18000 0 CST}
+ {1730610000 -18000 0 CST}
{1741496400 -14400 1 CDT}
- {1761454800 -18000 0 CST}
+ {1762059600 -18000 0 CST}
{1772946000 -14400 1 CDT}
- {1792904400 -18000 0 CST}
+ {1793509200 -18000 0 CST}
{1805000400 -14400 1 CDT}
- {1824958800 -18000 0 CST}
+ {1825563600 -18000 0 CST}
{1836450000 -14400 1 CDT}
- {1856408400 -18000 0 CST}
+ {1857013200 -18000 0 CST}
{1867899600 -14400 1 CDT}
- {1887858000 -18000 0 CST}
+ {1888462800 -18000 0 CST}
{1899349200 -14400 1 CDT}
- {1919307600 -18000 0 CST}
+ {1919912400 -18000 0 CST}
{1930798800 -14400 1 CDT}
- {1950757200 -18000 0 CST}
+ {1951362000 -18000 0 CST}
{1962853200 -14400 1 CDT}
- {1982811600 -18000 0 CST}
+ {1983416400 -18000 0 CST}
{1994302800 -14400 1 CDT}
- {2014261200 -18000 0 CST}
+ {2014866000 -18000 0 CST}
{2025752400 -14400 1 CDT}
- {2045710800 -18000 0 CST}
+ {2046315600 -18000 0 CST}
{2057202000 -14400 1 CDT}
- {2077160400 -18000 0 CST}
+ {2077765200 -18000 0 CST}
{2088651600 -14400 1 CDT}
- {2108610000 -18000 0 CST}
+ {2109214800 -18000 0 CST}
{2120101200 -14400 1 CDT}
- {2140059600 -18000 0 CST}
+ {2140664400 -18000 0 CST}
{2152155600 -14400 1 CDT}
- {2172114000 -18000 0 CST}
+ {2172718800 -18000 0 CST}
{2183605200 -14400 1 CDT}
- {2203563600 -18000 0 CST}
+ {2204168400 -18000 0 CST}
{2215054800 -14400 1 CDT}
- {2235013200 -18000 0 CST}
+ {2235618000 -18000 0 CST}
{2246504400 -14400 1 CDT}
- {2266462800 -18000 0 CST}
+ {2267067600 -18000 0 CST}
{2277954000 -14400 1 CDT}
- {2297912400 -18000 0 CST}
+ {2298517200 -18000 0 CST}
{2309403600 -14400 1 CDT}
- {2329362000 -18000 0 CST}
+ {2329966800 -18000 0 CST}
{2341458000 -14400 1 CDT}
- {2361416400 -18000 0 CST}
+ {2362021200 -18000 0 CST}
{2372907600 -14400 1 CDT}
- {2392866000 -18000 0 CST}
+ {2393470800 -18000 0 CST}
{2404357200 -14400 1 CDT}
- {2424315600 -18000 0 CST}
+ {2424920400 -18000 0 CST}
{2435806800 -14400 1 CDT}
- {2455765200 -18000 0 CST}
+ {2456370000 -18000 0 CST}
{2467256400 -14400 1 CDT}
- {2487214800 -18000 0 CST}
+ {2487819600 -18000 0 CST}
{2499310800 -14400 1 CDT}
- {2519269200 -18000 0 CST}
+ {2519874000 -18000 0 CST}
{2530760400 -14400 1 CDT}
- {2550718800 -18000 0 CST}
+ {2551323600 -18000 0 CST}
{2562210000 -14400 1 CDT}
- {2582168400 -18000 0 CST}
+ {2582773200 -18000 0 CST}
{2593659600 -14400 1 CDT}
- {2613618000 -18000 0 CST}
+ {2614222800 -18000 0 CST}
{2625109200 -14400 1 CDT}
- {2645067600 -18000 0 CST}
+ {2645672400 -18000 0 CST}
{2656558800 -14400 1 CDT}
- {2676517200 -18000 0 CST}
+ {2677122000 -18000 0 CST}
{2688613200 -14400 1 CDT}
- {2708571600 -18000 0 CST}
+ {2709176400 -18000 0 CST}
{2720062800 -14400 1 CDT}
- {2740021200 -18000 0 CST}
+ {2740626000 -18000 0 CST}
{2751512400 -14400 1 CDT}
- {2771470800 -18000 0 CST}
+ {2772075600 -18000 0 CST}
{2782962000 -14400 1 CDT}
- {2802920400 -18000 0 CST}
+ {2803525200 -18000 0 CST}
{2814411600 -14400 1 CDT}
- {2834370000 -18000 0 CST}
+ {2834974800 -18000 0 CST}
{2846466000 -14400 1 CDT}
- {2866424400 -18000 0 CST}
+ {2867029200 -18000 0 CST}
{2877915600 -14400 1 CDT}
- {2897874000 -18000 0 CST}
+ {2898478800 -18000 0 CST}
{2909365200 -14400 1 CDT}
- {2929323600 -18000 0 CST}
+ {2929928400 -18000 0 CST}
{2940814800 -14400 1 CDT}
- {2960773200 -18000 0 CST}
+ {2961378000 -18000 0 CST}
{2972264400 -14400 1 CDT}
- {2992222800 -18000 0 CST}
+ {2992827600 -18000 0 CST}
{3003714000 -14400 1 CDT}
- {3023672400 -18000 0 CST}
+ {3024277200 -18000 0 CST}
{3035768400 -14400 1 CDT}
- {3055726800 -18000 0 CST}
+ {3056331600 -18000 0 CST}
{3067218000 -14400 1 CDT}
- {3087176400 -18000 0 CST}
+ {3087781200 -18000 0 CST}
{3098667600 -14400 1 CDT}
- {3118626000 -18000 0 CST}
+ {3119230800 -18000 0 CST}
{3130117200 -14400 1 CDT}
- {3150075600 -18000 0 CST}
+ {3150680400 -18000 0 CST}
{3161566800 -14400 1 CDT}
- {3181525200 -18000 0 CST}
+ {3182130000 -18000 0 CST}
{3193016400 -14400 1 CDT}
- {3212974800 -18000 0 CST}
+ {3213579600 -18000 0 CST}
{3225070800 -14400 1 CDT}
- {3245029200 -18000 0 CST}
+ {3245634000 -18000 0 CST}
{3256520400 -14400 1 CDT}
- {3276478800 -18000 0 CST}
+ {3277083600 -18000 0 CST}
{3287970000 -14400 1 CDT}
- {3307928400 -18000 0 CST}
+ {3308533200 -18000 0 CST}
{3319419600 -14400 1 CDT}
- {3339378000 -18000 0 CST}
+ {3339982800 -18000 0 CST}
{3350869200 -14400 1 CDT}
- {3370827600 -18000 0 CST}
+ {3371432400 -18000 0 CST}
{3382923600 -14400 1 CDT}
- {3402882000 -18000 0 CST}
+ {3403486800 -18000 0 CST}
{3414373200 -14400 1 CDT}
- {3434331600 -18000 0 CST}
+ {3434936400 -18000 0 CST}
{3445822800 -14400 1 CDT}
- {3465781200 -18000 0 CST}
+ {3466386000 -18000 0 CST}
{3477272400 -14400 1 CDT}
- {3497230800 -18000 0 CST}
+ {3497835600 -18000 0 CST}
{3508722000 -14400 1 CDT}
- {3528680400 -18000 0 CST}
+ {3529285200 -18000 0 CST}
{3540171600 -14400 1 CDT}
- {3560130000 -18000 0 CST}
+ {3560734800 -18000 0 CST}
{3572226000 -14400 1 CDT}
- {3592184400 -18000 0 CST}
+ {3592789200 -18000 0 CST}
{3603675600 -14400 1 CDT}
- {3623634000 -18000 0 CST}
+ {3624238800 -18000 0 CST}
{3635125200 -14400 1 CDT}
- {3655083600 -18000 0 CST}
+ {3655688400 -18000 0 CST}
{3666574800 -14400 1 CDT}
- {3686533200 -18000 0 CST}
+ {3687138000 -18000 0 CST}
{3698024400 -14400 1 CDT}
- {3717982800 -18000 0 CST}
+ {3718587600 -18000 0 CST}
{3730078800 -14400 1 CDT}
- {3750037200 -18000 0 CST}
+ {3750642000 -18000 0 CST}
{3761528400 -14400 1 CDT}
- {3781486800 -18000 0 CST}
+ {3782091600 -18000 0 CST}
{3792978000 -14400 1 CDT}
- {3812936400 -18000 0 CST}
+ {3813541200 -18000 0 CST}
{3824427600 -14400 1 CDT}
- {3844386000 -18000 0 CST}
+ {3844990800 -18000 0 CST}
{3855877200 -14400 1 CDT}
- {3875835600 -18000 0 CST}
+ {3876440400 -18000 0 CST}
{3887326800 -14400 1 CDT}
- {3907285200 -18000 0 CST}
+ {3907890000 -18000 0 CST}
{3919381200 -14400 1 CDT}
- {3939339600 -18000 0 CST}
+ {3939944400 -18000 0 CST}
{3950830800 -14400 1 CDT}
- {3970789200 -18000 0 CST}
+ {3971394000 -18000 0 CST}
{3982280400 -14400 1 CDT}
- {4002238800 -18000 0 CST}
+ {4002843600 -18000 0 CST}
{4013730000 -14400 1 CDT}
- {4033688400 -18000 0 CST}
+ {4034293200 -18000 0 CST}
{4045179600 -14400 1 CDT}
- {4065138000 -18000 0 CST}
+ {4065742800 -18000 0 CST}
{4076629200 -14400 1 CDT}
- {4096587600 -18000 0 CST}
+ {4097192400 -18000 0 CST}
}
diff --git a/library/tzdata/America/Juneau b/library/tzdata/America/Juneau
index 88fe0ce..fead810 100644
--- a/library/tzdata/America/Juneau
+++ b/library/tzdata/America/Juneau
@@ -32,8 +32,9 @@ set TZData(:America/Juneau) {
{278499600 -28800 0 PST}
{294228000 -25200 1 PDT}
{309949200 -28800 0 PST}
- {325677600 -25200 1 PDT}
- {341398800 -28800 0 PST}
+ {325677600 -32400 0 YST}
+ {325681200 -28800 1 YDT}
+ {341406000 -28800 0 PST}
{357127200 -25200 1 PDT}
{372848400 -28800 0 PST}
{388576800 -25200 1 PDT}
diff --git a/library/tzdata/America/Kralendijk b/library/tzdata/America/Kralendijk
new file mode 100644
index 0000000..8b6db86
--- /dev/null
+++ b/library/tzdata/America/Kralendijk
@@ -0,0 +1,5 @@
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Curacao)]} {
+ LoadTimeZoneFile America/Curacao
+}
+set TZData(:America/Kralendijk) $TZData(:America/Curacao)
diff --git a/library/tzdata/America/Lower_Princes b/library/tzdata/America/Lower_Princes
new file mode 100644
index 0000000..94c9197
--- /dev/null
+++ b/library/tzdata/America/Lower_Princes
@@ -0,0 +1,5 @@
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Curacao)]} {
+ LoadTimeZoneFile America/Curacao
+}
+set TZData(:America/Lower_Princes) $TZData(:America/Curacao)
diff --git a/library/tzdata/America/Metlakatla b/library/tzdata/America/Metlakatla
new file mode 100644
index 0000000..e8af1c0
--- /dev/null
+++ b/library/tzdata/America/Metlakatla
@@ -0,0 +1,43 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Metlakatla) {
+ {-9223372036854775808 54822 0 LMT}
+ {-3225366822 -31578 0 LMT}
+ {-2188955622 -28800 0 PST}
+ {-883584000 -28800 0 PST}
+ {-880207200 -25200 1 PWT}
+ {-769395600 -25200 1 PPT}
+ {-765385200 -28800 0 PST}
+ {-757353600 -28800 0 PST}
+ {-31507200 -28800 0 PST}
+ {-21477600 -25200 1 PDT}
+ {-5756400 -28800 0 PST}
+ {9972000 -25200 1 PDT}
+ {25693200 -28800 0 PST}
+ {41421600 -25200 1 PDT}
+ {57747600 -28800 0 PST}
+ {73476000 -25200 1 PDT}
+ {89197200 -28800 0 PST}
+ {104925600 -25200 1 PDT}
+ {120646800 -28800 0 PST}
+ {126698400 -25200 1 PDT}
+ {152096400 -28800 0 PST}
+ {162381600 -25200 1 PDT}
+ {183546000 -28800 0 PST}
+ {199274400 -25200 1 PDT}
+ {215600400 -28800 0 PST}
+ {230724000 -25200 1 PDT}
+ {247050000 -28800 0 PST}
+ {262778400 -25200 1 PDT}
+ {278499600 -28800 0 PST}
+ {294228000 -25200 1 PDT}
+ {309949200 -28800 0 PST}
+ {325677600 -25200 1 PDT}
+ {341398800 -28800 0 PST}
+ {357127200 -25200 1 PDT}
+ {372848400 -28800 0 PST}
+ {388576800 -25200 1 PDT}
+ {404902800 -28800 0 PST}
+ {420026400 -25200 1 PDT}
+ {436356000 -28800 0 MeST}
+}
diff --git a/library/tzdata/America/Moncton b/library/tzdata/America/Moncton
index 408e3a1..d286c88 100755
--- a/library/tzdata/America/Moncton
+++ b/library/tzdata/America/Moncton
@@ -5,7 +5,7 @@ set TZData(:America/Moncton) {
{-2715882052 -18000 0 EST}
{-2131642800 -14400 0 AST}
{-1632074400 -10800 1 ADT}
- {-1614798000 -14400 0 AST}
+ {-1615143600 -14400 0 AST}
{-1167595200 -14400 0 AST}
{-1153681200 -10800 1 ADT}
{-1145822400 -14400 0 AST}
diff --git a/library/tzdata/America/Montreal b/library/tzdata/America/Montreal
index b9535eb..bebe7dc 100644
--- a/library/tzdata/America/Montreal
+++ b/library/tzdata/America/Montreal
@@ -7,7 +7,7 @@ set TZData(:America/Montreal) {
{-1662753600 -18000 0 EST}
{-1640977200 -18000 0 EST}
{-1632070800 -14400 1 EDT}
- {-1614794400 -18000 0 EST}
+ {-1615140000 -18000 0 EST}
{-1609441200 -18000 0 EST}
{-1601742600 -14400 1 EDT}
{-1583775000 -18000 0 EST}
diff --git a/library/tzdata/America/Nipigon b/library/tzdata/America/Nipigon
index e98bb8c..30690aa 100644
--- a/library/tzdata/America/Nipigon
+++ b/library/tzdata/America/Nipigon
@@ -4,7 +4,7 @@ set TZData(:America/Nipigon) {
{-9223372036854775808 -21184 0 LMT}
{-2366734016 -18000 0 EST}
{-1632070800 -14400 1 EDT}
- {-1614794400 -18000 0 EST}
+ {-1615140000 -18000 0 EST}
{-923252400 -14400 1 EDT}
{-880218000 -14400 0 EWT}
{-769395600 -14400 1 EPT}
diff --git a/library/tzdata/America/North_Dakota/Beulah b/library/tzdata/America/North_Dakota/Beulah
new file mode 100644
index 0000000..95407c6
--- /dev/null
+++ b/library/tzdata/America/North_Dakota/Beulah
@@ -0,0 +1,279 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/North_Dakota/Beulah) {
+ {-9223372036854775808 -24427 0 LMT}
+ {-2717643600 -25200 0 MST}
+ {-1633273200 -21600 1 MDT}
+ {-1615132800 -25200 0 MST}
+ {-1601823600 -21600 1 MDT}
+ {-1583683200 -25200 0 MST}
+ {-880210800 -21600 1 MWT}
+ {-769395600 -21600 1 MPT}
+ {-765388800 -25200 0 MST}
+ {-84380400 -21600 1 MDT}
+ {-68659200 -25200 0 MST}
+ {-52930800 -21600 1 MDT}
+ {-37209600 -25200 0 MST}
+ {-21481200 -21600 1 MDT}
+ {-5760000 -25200 0 MST}
+ {9968400 -21600 1 MDT}
+ {25689600 -25200 0 MST}
+ {41418000 -21600 1 MDT}
+ {57744000 -25200 0 MST}
+ {73472400 -21600 1 MDT}
+ {89193600 -25200 0 MST}
+ {104922000 -21600 1 MDT}
+ {120643200 -25200 0 MST}
+ {126694800 -21600 1 MDT}
+ {152092800 -25200 0 MST}
+ {162378000 -21600 1 MDT}
+ {183542400 -25200 0 MST}
+ {199270800 -21600 1 MDT}
+ {215596800 -25200 0 MST}
+ {230720400 -21600 1 MDT}
+ {247046400 -25200 0 MST}
+ {262774800 -21600 1 MDT}
+ {278496000 -25200 0 MST}
+ {294224400 -21600 1 MDT}
+ {309945600 -25200 0 MST}
+ {325674000 -21600 1 MDT}
+ {341395200 -25200 0 MST}
+ {357123600 -21600 1 MDT}
+ {372844800 -25200 0 MST}
+ {388573200 -21600 1 MDT}
+ {404899200 -25200 0 MST}
+ {420022800 -21600 1 MDT}
+ {436348800 -25200 0 MST}
+ {452077200 -21600 1 MDT}
+ {467798400 -25200 0 MST}
+ {483526800 -21600 1 MDT}
+ {499248000 -25200 0 MST}
+ {514976400 -21600 1 MDT}
+ {530697600 -25200 0 MST}
+ {544611600 -21600 1 MDT}
+ {562147200 -25200 0 MST}
+ {576061200 -21600 1 MDT}
+ {594201600 -25200 0 MST}
+ {607510800 -21600 1 MDT}
+ {625651200 -25200 0 MST}
+ {638960400 -21600 1 MDT}
+ {657100800 -25200 0 MST}
+ {671014800 -21600 1 MDT}
+ {688550400 -25200 0 MST}
+ {702464400 -21600 1 MDT}
+ {720000000 -25200 0 MST}
+ {733914000 -21600 1 MDT}
+ {752054400 -25200 0 MST}
+ {765363600 -21600 1 MDT}
+ {783504000 -25200 0 MST}
+ {796813200 -21600 1 MDT}
+ {814953600 -25200 0 MST}
+ {828867600 -21600 1 MDT}
+ {846403200 -25200 0 MST}
+ {860317200 -21600 1 MDT}
+ {877852800 -25200 0 MST}
+ {891766800 -21600 1 MDT}
+ {909302400 -25200 0 MST}
+ {923216400 -21600 1 MDT}
+ {941356800 -25200 0 MST}
+ {954666000 -21600 1 MDT}
+ {972806400 -25200 0 MST}
+ {986115600 -21600 1 MDT}
+ {1004256000 -25200 0 MST}
+ {1018170000 -21600 1 MDT}
+ {1035705600 -25200 0 MST}
+ {1049619600 -21600 1 MDT}
+ {1067155200 -25200 0 MST}
+ {1081069200 -21600 1 MDT}
+ {1099209600 -25200 0 MST}
+ {1112518800 -21600 1 MDT}
+ {1130659200 -25200 0 MST}
+ {1143968400 -21600 1 MDT}
+ {1162108800 -25200 0 MST}
+ {1173603600 -21600 1 MDT}
+ {1194163200 -25200 0 MST}
+ {1205053200 -21600 1 MDT}
+ {1225612800 -25200 0 MST}
+ {1236502800 -21600 1 MDT}
+ {1257062400 -25200 0 MST}
+ {1268557200 -21600 1 MDT}
+ {1289120400 -21600 0 CST}
+ {1300003200 -18000 1 CDT}
+ {1320562800 -21600 0 CST}
+ {1331452800 -18000 1 CDT}
+ {1352012400 -21600 0 CST}
+ {1362902400 -18000 1 CDT}
+ {1383462000 -21600 0 CST}
+ {1394352000 -18000 1 CDT}
+ {1414911600 -21600 0 CST}
+ {1425801600 -18000 1 CDT}
+ {1446361200 -21600 0 CST}
+ {1457856000 -18000 1 CDT}
+ {1478415600 -21600 0 CST}
+ {1489305600 -18000 1 CDT}
+ {1509865200 -21600 0 CST}
+ {1520755200 -18000 1 CDT}
+ {1541314800 -21600 0 CST}
+ {1552204800 -18000 1 CDT}
+ {1572764400 -21600 0 CST}
+ {1583654400 -18000 1 CDT}
+ {1604214000 -21600 0 CST}
+ {1615708800 -18000 1 CDT}
+ {1636268400 -21600 0 CST}
+ {1647158400 -18000 1 CDT}
+ {1667718000 -21600 0 CST}
+ {1678608000 -18000 1 CDT}
+ {1699167600 -21600 0 CST}
+ {1710057600 -18000 1 CDT}
+ {1730617200 -21600 0 CST}
+ {1741507200 -18000 1 CDT}
+ {1762066800 -21600 0 CST}
+ {1772956800 -18000 1 CDT}
+ {1793516400 -21600 0 CST}
+ {1805011200 -18000 1 CDT}
+ {1825570800 -21600 0 CST}
+ {1836460800 -18000 1 CDT}
+ {1857020400 -21600 0 CST}
+ {1867910400 -18000 1 CDT}
+ {1888470000 -21600 0 CST}
+ {1899360000 -18000 1 CDT}
+ {1919919600 -21600 0 CST}
+ {1930809600 -18000 1 CDT}
+ {1951369200 -21600 0 CST}
+ {1962864000 -18000 1 CDT}
+ {1983423600 -21600 0 CST}
+ {1994313600 -18000 1 CDT}
+ {2014873200 -21600 0 CST}
+ {2025763200 -18000 1 CDT}
+ {2046322800 -21600 0 CST}
+ {2057212800 -18000 1 CDT}
+ {2077772400 -21600 0 CST}
+ {2088662400 -18000 1 CDT}
+ {2109222000 -21600 0 CST}
+ {2120112000 -18000 1 CDT}
+ {2140671600 -21600 0 CST}
+ {2152166400 -18000 1 CDT}
+ {2172726000 -21600 0 CST}
+ {2183616000 -18000 1 CDT}
+ {2204175600 -21600 0 CST}
+ {2215065600 -18000 1 CDT}
+ {2235625200 -21600 0 CST}
+ {2246515200 -18000 1 CDT}
+ {2267074800 -21600 0 CST}
+ {2277964800 -18000 1 CDT}
+ {2298524400 -21600 0 CST}
+ {2309414400 -18000 1 CDT}
+ {2329974000 -21600 0 CST}
+ {2341468800 -18000 1 CDT}
+ {2362028400 -21600 0 CST}
+ {2372918400 -18000 1 CDT}
+ {2393478000 -21600 0 CST}
+ {2404368000 -18000 1 CDT}
+ {2424927600 -21600 0 CST}
+ {2435817600 -18000 1 CDT}
+ {2456377200 -21600 0 CST}
+ {2467267200 -18000 1 CDT}
+ {2487826800 -21600 0 CST}
+ {2499321600 -18000 1 CDT}
+ {2519881200 -21600 0 CST}
+ {2530771200 -18000 1 CDT}
+ {2551330800 -21600 0 CST}
+ {2562220800 -18000 1 CDT}
+ {2582780400 -21600 0 CST}
+ {2593670400 -18000 1 CDT}
+ {2614230000 -21600 0 CST}
+ {2625120000 -18000 1 CDT}
+ {2645679600 -21600 0 CST}
+ {2656569600 -18000 1 CDT}
+ {2677129200 -21600 0 CST}
+ {2688624000 -18000 1 CDT}
+ {2709183600 -21600 0 CST}
+ {2720073600 -18000 1 CDT}
+ {2740633200 -21600 0 CST}
+ {2751523200 -18000 1 CDT}
+ {2772082800 -21600 0 CST}
+ {2782972800 -18000 1 CDT}
+ {2803532400 -21600 0 CST}
+ {2814422400 -18000 1 CDT}
+ {2834982000 -21600 0 CST}
+ {2846476800 -18000 1 CDT}
+ {2867036400 -21600 0 CST}
+ {2877926400 -18000 1 CDT}
+ {2898486000 -21600 0 CST}
+ {2909376000 -18000 1 CDT}
+ {2929935600 -21600 0 CST}
+ {2940825600 -18000 1 CDT}
+ {2961385200 -21600 0 CST}
+ {2972275200 -18000 1 CDT}
+ {2992834800 -21600 0 CST}
+ {3003724800 -18000 1 CDT}
+ {3024284400 -21600 0 CST}
+ {3035779200 -18000 1 CDT}
+ {3056338800 -21600 0 CST}
+ {3067228800 -18000 1 CDT}
+ {3087788400 -21600 0 CST}
+ {3098678400 -18000 1 CDT}
+ {3119238000 -21600 0 CST}
+ {3130128000 -18000 1 CDT}
+ {3150687600 -21600 0 CST}
+ {3161577600 -18000 1 CDT}
+ {3182137200 -21600 0 CST}
+ {3193027200 -18000 1 CDT}
+ {3213586800 -21600 0 CST}
+ {3225081600 -18000 1 CDT}
+ {3245641200 -21600 0 CST}
+ {3256531200 -18000 1 CDT}
+ {3277090800 -21600 0 CST}
+ {3287980800 -18000 1 CDT}
+ {3308540400 -21600 0 CST}
+ {3319430400 -18000 1 CDT}
+ {3339990000 -21600 0 CST}
+ {3350880000 -18000 1 CDT}
+ {3371439600 -21600 0 CST}
+ {3382934400 -18000 1 CDT}
+ {3403494000 -21600 0 CST}
+ {3414384000 -18000 1 CDT}
+ {3434943600 -21600 0 CST}
+ {3445833600 -18000 1 CDT}
+ {3466393200 -21600 0 CST}
+ {3477283200 -18000 1 CDT}
+ {3497842800 -21600 0 CST}
+ {3508732800 -18000 1 CDT}
+ {3529292400 -21600 0 CST}
+ {3540182400 -18000 1 CDT}
+ {3560742000 -21600 0 CST}
+ {3572236800 -18000 1 CDT}
+ {3592796400 -21600 0 CST}
+ {3603686400 -18000 1 CDT}
+ {3624246000 -21600 0 CST}
+ {3635136000 -18000 1 CDT}
+ {3655695600 -21600 0 CST}
+ {3666585600 -18000 1 CDT}
+ {3687145200 -21600 0 CST}
+ {3698035200 -18000 1 CDT}
+ {3718594800 -21600 0 CST}
+ {3730089600 -18000 1 CDT}
+ {3750649200 -21600 0 CST}
+ {3761539200 -18000 1 CDT}
+ {3782098800 -21600 0 CST}
+ {3792988800 -18000 1 CDT}
+ {3813548400 -21600 0 CST}
+ {3824438400 -18000 1 CDT}
+ {3844998000 -21600 0 CST}
+ {3855888000 -18000 1 CDT}
+ {3876447600 -21600 0 CST}
+ {3887337600 -18000 1 CDT}
+ {3907897200 -21600 0 CST}
+ {3919392000 -18000 1 CDT}
+ {3939951600 -21600 0 CST}
+ {3950841600 -18000 1 CDT}
+ {3971401200 -21600 0 CST}
+ {3982291200 -18000 1 CDT}
+ {4002850800 -21600 0 CST}
+ {4013740800 -18000 1 CDT}
+ {4034300400 -21600 0 CST}
+ {4045190400 -18000 1 CDT}
+ {4065750000 -21600 0 CST}
+ {4076640000 -18000 1 CDT}
+ {4097199600 -21600 0 CST}
+}
diff --git a/library/tzdata/America/Port-au-Prince b/library/tzdata/America/Port-au-Prince
index 04ee62c..639972b 100644
--- a/library/tzdata/America/Port-au-Prince
+++ b/library/tzdata/America/Port-au-Prince
@@ -38,4 +38,6 @@ set TZData(:America/Port-au-Prince) {
{1130644800 -18000 0 EST}
{1143954000 -14400 1 EDT}
{1162094400 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
}
diff --git a/library/tzdata/America/Rainy_River b/library/tzdata/America/Rainy_River
index 331bac6..a2b11aa 100644
--- a/library/tzdata/America/Rainy_River
+++ b/library/tzdata/America/Rainy_River
@@ -4,7 +4,7 @@ set TZData(:America/Rainy_River) {
{-9223372036854775808 -22696 0 LMT}
{-2366732504 -21600 0 CST}
{-1632067200 -18000 1 CDT}
- {-1614790800 -21600 0 CST}
+ {-1615136400 -21600 0 CST}
{-923248800 -18000 1 CDT}
{-880214400 -18000 0 CWT}
{-769395600 -18000 1 CPT}
diff --git a/library/tzdata/America/Regina b/library/tzdata/America/Regina
index 2030d75..e42b5be 100644
--- a/library/tzdata/America/Regina
+++ b/library/tzdata/America/Regina
@@ -4,7 +4,7 @@ set TZData(:America/Regina) {
{-9223372036854775808 -25116 0 LMT}
{-2030202084 -25200 0 MST}
{-1632063600 -21600 1 MDT}
- {-1614787200 -25200 0 MST}
+ {-1615132800 -25200 0 MST}
{-1251651600 -21600 1 MDT}
{-1238349600 -25200 0 MST}
{-1220202000 -21600 1 MDT}
diff --git a/library/tzdata/America/Resolute b/library/tzdata/America/Resolute
index 50ab9df..b4c0bab 100755
--- a/library/tzdata/America/Resolute
+++ b/library/tzdata/America/Resolute
@@ -59,191 +59,190 @@ set TZData(:America/Resolute) {
{1130655600 -21600 0 CST}
{1143964800 -18000 1 CDT}
{1162108800 -18000 0 EST}
- {1162710000 -18000 0 EST}
- {1173596400 -18000 0 CDT}
- {1194159600 -18000 0 EST}
- {1205046000 -18000 0 CDT}
- {1225609200 -18000 0 EST}
- {1236495600 -18000 0 CDT}
- {1257058800 -18000 0 EST}
- {1268550000 -18000 0 CDT}
- {1289113200 -18000 0 EST}
- {1299999600 -18000 0 CDT}
- {1320562800 -18000 0 EST}
- {1331449200 -18000 0 CDT}
- {1352012400 -18000 0 EST}
- {1362898800 -18000 0 CDT}
- {1383462000 -18000 0 EST}
- {1394348400 -18000 0 CDT}
- {1414911600 -18000 0 EST}
- {1425798000 -18000 0 CDT}
- {1446361200 -18000 0 EST}
- {1457852400 -18000 0 CDT}
- {1478415600 -18000 0 EST}
- {1489302000 -18000 0 CDT}
- {1509865200 -18000 0 EST}
- {1520751600 -18000 0 CDT}
- {1541314800 -18000 0 EST}
- {1552201200 -18000 0 CDT}
- {1572764400 -18000 0 EST}
- {1583650800 -18000 0 CDT}
- {1604214000 -18000 0 EST}
- {1615705200 -18000 0 CDT}
- {1636268400 -18000 0 EST}
- {1647154800 -18000 0 CDT}
- {1667718000 -18000 0 EST}
- {1678604400 -18000 0 CDT}
- {1699167600 -18000 0 EST}
- {1710054000 -18000 0 CDT}
- {1730617200 -18000 0 EST}
- {1741503600 -18000 0 CDT}
- {1762066800 -18000 0 EST}
- {1772953200 -18000 0 CDT}
- {1793516400 -18000 0 EST}
- {1805007600 -18000 0 CDT}
- {1825570800 -18000 0 EST}
- {1836457200 -18000 0 CDT}
- {1857020400 -18000 0 EST}
- {1867906800 -18000 0 CDT}
- {1888470000 -18000 0 EST}
- {1899356400 -18000 0 CDT}
- {1919919600 -18000 0 EST}
- {1930806000 -18000 0 CDT}
- {1951369200 -18000 0 EST}
- {1962860400 -18000 0 CDT}
- {1983423600 -18000 0 EST}
- {1994310000 -18000 0 CDT}
- {2014873200 -18000 0 EST}
- {2025759600 -18000 0 CDT}
- {2046322800 -18000 0 EST}
- {2057209200 -18000 0 CDT}
- {2077772400 -18000 0 EST}
- {2088658800 -18000 0 CDT}
- {2109222000 -18000 0 EST}
- {2120108400 -18000 0 CDT}
- {2140671600 -18000 0 EST}
- {2152162800 -18000 0 CDT}
- {2172726000 -18000 0 EST}
- {2183612400 -18000 0 CDT}
- {2204175600 -18000 0 EST}
- {2215062000 -18000 0 CDT}
- {2235625200 -18000 0 EST}
- {2246511600 -18000 0 CDT}
- {2267074800 -18000 0 EST}
- {2277961200 -18000 0 CDT}
- {2298524400 -18000 0 EST}
- {2309410800 -18000 0 CDT}
- {2329974000 -18000 0 EST}
- {2341465200 -18000 0 CDT}
- {2362028400 -18000 0 EST}
- {2372914800 -18000 0 CDT}
- {2393478000 -18000 0 EST}
- {2404364400 -18000 0 CDT}
- {2424927600 -18000 0 EST}
- {2435814000 -18000 0 CDT}
- {2456377200 -18000 0 EST}
- {2467263600 -18000 0 CDT}
- {2487826800 -18000 0 EST}
- {2499318000 -18000 0 CDT}
- {2519881200 -18000 0 EST}
- {2530767600 -18000 0 CDT}
- {2551330800 -18000 0 EST}
- {2562217200 -18000 0 CDT}
- {2582780400 -18000 0 EST}
- {2593666800 -18000 0 CDT}
- {2614230000 -18000 0 EST}
- {2625116400 -18000 0 CDT}
- {2645679600 -18000 0 EST}
- {2656566000 -18000 0 CDT}
- {2677129200 -18000 0 EST}
- {2688620400 -18000 0 CDT}
- {2709183600 -18000 0 EST}
- {2720070000 -18000 0 CDT}
- {2740633200 -18000 0 EST}
- {2751519600 -18000 0 CDT}
- {2772082800 -18000 0 EST}
- {2782969200 -18000 0 CDT}
- {2803532400 -18000 0 EST}
- {2814418800 -18000 0 CDT}
- {2834982000 -18000 0 EST}
- {2846473200 -18000 0 CDT}
- {2867036400 -18000 0 EST}
- {2877922800 -18000 0 CDT}
- {2898486000 -18000 0 EST}
- {2909372400 -18000 0 CDT}
- {2929935600 -18000 0 EST}
- {2940822000 -18000 0 CDT}
- {2961385200 -18000 0 EST}
- {2972271600 -18000 0 CDT}
- {2992834800 -18000 0 EST}
- {3003721200 -18000 0 CDT}
- {3024284400 -18000 0 EST}
- {3035775600 -18000 0 CDT}
- {3056338800 -18000 0 EST}
- {3067225200 -18000 0 CDT}
- {3087788400 -18000 0 EST}
- {3098674800 -18000 0 CDT}
- {3119238000 -18000 0 EST}
- {3130124400 -18000 0 CDT}
- {3150687600 -18000 0 EST}
- {3161574000 -18000 0 CDT}
- {3182137200 -18000 0 EST}
- {3193023600 -18000 0 CDT}
- {3213586800 -18000 0 EST}
- {3225078000 -18000 0 CDT}
- {3245641200 -18000 0 EST}
- {3256527600 -18000 0 CDT}
- {3277090800 -18000 0 EST}
- {3287977200 -18000 0 CDT}
- {3308540400 -18000 0 EST}
- {3319426800 -18000 0 CDT}
- {3339990000 -18000 0 EST}
- {3350876400 -18000 0 CDT}
- {3371439600 -18000 0 EST}
- {3382930800 -18000 0 CDT}
- {3403494000 -18000 0 EST}
- {3414380400 -18000 0 CDT}
- {3434943600 -18000 0 EST}
- {3445830000 -18000 0 CDT}
- {3466393200 -18000 0 EST}
- {3477279600 -18000 0 CDT}
- {3497842800 -18000 0 EST}
- {3508729200 -18000 0 CDT}
- {3529292400 -18000 0 EST}
- {3540178800 -18000 0 CDT}
- {3560742000 -18000 0 EST}
- {3572233200 -18000 0 CDT}
- {3592796400 -18000 0 EST}
- {3603682800 -18000 0 CDT}
- {3624246000 -18000 0 EST}
- {3635132400 -18000 0 CDT}
- {3655695600 -18000 0 EST}
- {3666582000 -18000 0 CDT}
- {3687145200 -18000 0 EST}
- {3698031600 -18000 0 CDT}
- {3718594800 -18000 0 EST}
- {3730086000 -18000 0 CDT}
- {3750649200 -18000 0 EST}
- {3761535600 -18000 0 CDT}
- {3782098800 -18000 0 EST}
- {3792985200 -18000 0 CDT}
- {3813548400 -18000 0 EST}
- {3824434800 -18000 0 CDT}
- {3844998000 -18000 0 EST}
- {3855884400 -18000 0 CDT}
- {3876447600 -18000 0 EST}
- {3887334000 -18000 0 CDT}
- {3907897200 -18000 0 EST}
- {3919388400 -18000 0 CDT}
- {3939951600 -18000 0 EST}
- {3950838000 -18000 0 CDT}
- {3971401200 -18000 0 EST}
- {3982287600 -18000 0 CDT}
- {4002850800 -18000 0 EST}
- {4013737200 -18000 0 CDT}
- {4034300400 -18000 0 EST}
- {4045186800 -18000 0 CDT}
- {4065750000 -18000 0 EST}
- {4076636400 -18000 0 CDT}
- {4097199600 -18000 0 EST}
+ {1173600000 -18000 0 CDT}
+ {1194159600 -21600 0 CST}
+ {1205049600 -18000 1 CDT}
+ {1225609200 -21600 0 CST}
+ {1236499200 -18000 1 CDT}
+ {1257058800 -21600 0 CST}
+ {1268553600 -18000 1 CDT}
+ {1289113200 -21600 0 CST}
+ {1300003200 -18000 1 CDT}
+ {1320562800 -21600 0 CST}
+ {1331452800 -18000 1 CDT}
+ {1352012400 -21600 0 CST}
+ {1362902400 -18000 1 CDT}
+ {1383462000 -21600 0 CST}
+ {1394352000 -18000 1 CDT}
+ {1414911600 -21600 0 CST}
+ {1425801600 -18000 1 CDT}
+ {1446361200 -21600 0 CST}
+ {1457856000 -18000 1 CDT}
+ {1478415600 -21600 0 CST}
+ {1489305600 -18000 1 CDT}
+ {1509865200 -21600 0 CST}
+ {1520755200 -18000 1 CDT}
+ {1541314800 -21600 0 CST}
+ {1552204800 -18000 1 CDT}
+ {1572764400 -21600 0 CST}
+ {1583654400 -18000 1 CDT}
+ {1604214000 -21600 0 CST}
+ {1615708800 -18000 1 CDT}
+ {1636268400 -21600 0 CST}
+ {1647158400 -18000 1 CDT}
+ {1667718000 -21600 0 CST}
+ {1678608000 -18000 1 CDT}
+ {1699167600 -21600 0 CST}
+ {1710057600 -18000 1 CDT}
+ {1730617200 -21600 0 CST}
+ {1741507200 -18000 1 CDT}
+ {1762066800 -21600 0 CST}
+ {1772956800 -18000 1 CDT}
+ {1793516400 -21600 0 CST}
+ {1805011200 -18000 1 CDT}
+ {1825570800 -21600 0 CST}
+ {1836460800 -18000 1 CDT}
+ {1857020400 -21600 0 CST}
+ {1867910400 -18000 1 CDT}
+ {1888470000 -21600 0 CST}
+ {1899360000 -18000 1 CDT}
+ {1919919600 -21600 0 CST}
+ {1930809600 -18000 1 CDT}
+ {1951369200 -21600 0 CST}
+ {1962864000 -18000 1 CDT}
+ {1983423600 -21600 0 CST}
+ {1994313600 -18000 1 CDT}
+ {2014873200 -21600 0 CST}
+ {2025763200 -18000 1 CDT}
+ {2046322800 -21600 0 CST}
+ {2057212800 -18000 1 CDT}
+ {2077772400 -21600 0 CST}
+ {2088662400 -18000 1 CDT}
+ {2109222000 -21600 0 CST}
+ {2120112000 -18000 1 CDT}
+ {2140671600 -21600 0 CST}
+ {2152166400 -18000 1 CDT}
+ {2172726000 -21600 0 CST}
+ {2183616000 -18000 1 CDT}
+ {2204175600 -21600 0 CST}
+ {2215065600 -18000 1 CDT}
+ {2235625200 -21600 0 CST}
+ {2246515200 -18000 1 CDT}
+ {2267074800 -21600 0 CST}
+ {2277964800 -18000 1 CDT}
+ {2298524400 -21600 0 CST}
+ {2309414400 -18000 1 CDT}
+ {2329974000 -21600 0 CST}
+ {2341468800 -18000 1 CDT}
+ {2362028400 -21600 0 CST}
+ {2372918400 -18000 1 CDT}
+ {2393478000 -21600 0 CST}
+ {2404368000 -18000 1 CDT}
+ {2424927600 -21600 0 CST}
+ {2435817600 -18000 1 CDT}
+ {2456377200 -21600 0 CST}
+ {2467267200 -18000 1 CDT}
+ {2487826800 -21600 0 CST}
+ {2499321600 -18000 1 CDT}
+ {2519881200 -21600 0 CST}
+ {2530771200 -18000 1 CDT}
+ {2551330800 -21600 0 CST}
+ {2562220800 -18000 1 CDT}
+ {2582780400 -21600 0 CST}
+ {2593670400 -18000 1 CDT}
+ {2614230000 -21600 0 CST}
+ {2625120000 -18000 1 CDT}
+ {2645679600 -21600 0 CST}
+ {2656569600 -18000 1 CDT}
+ {2677129200 -21600 0 CST}
+ {2688624000 -18000 1 CDT}
+ {2709183600 -21600 0 CST}
+ {2720073600 -18000 1 CDT}
+ {2740633200 -21600 0 CST}
+ {2751523200 -18000 1 CDT}
+ {2772082800 -21600 0 CST}
+ {2782972800 -18000 1 CDT}
+ {2803532400 -21600 0 CST}
+ {2814422400 -18000 1 CDT}
+ {2834982000 -21600 0 CST}
+ {2846476800 -18000 1 CDT}
+ {2867036400 -21600 0 CST}
+ {2877926400 -18000 1 CDT}
+ {2898486000 -21600 0 CST}
+ {2909376000 -18000 1 CDT}
+ {2929935600 -21600 0 CST}
+ {2940825600 -18000 1 CDT}
+ {2961385200 -21600 0 CST}
+ {2972275200 -18000 1 CDT}
+ {2992834800 -21600 0 CST}
+ {3003724800 -18000 1 CDT}
+ {3024284400 -21600 0 CST}
+ {3035779200 -18000 1 CDT}
+ {3056338800 -21600 0 CST}
+ {3067228800 -18000 1 CDT}
+ {3087788400 -21600 0 CST}
+ {3098678400 -18000 1 CDT}
+ {3119238000 -21600 0 CST}
+ {3130128000 -18000 1 CDT}
+ {3150687600 -21600 0 CST}
+ {3161577600 -18000 1 CDT}
+ {3182137200 -21600 0 CST}
+ {3193027200 -18000 1 CDT}
+ {3213586800 -21600 0 CST}
+ {3225081600 -18000 1 CDT}
+ {3245641200 -21600 0 CST}
+ {3256531200 -18000 1 CDT}
+ {3277090800 -21600 0 CST}
+ {3287980800 -18000 1 CDT}
+ {3308540400 -21600 0 CST}
+ {3319430400 -18000 1 CDT}
+ {3339990000 -21600 0 CST}
+ {3350880000 -18000 1 CDT}
+ {3371439600 -21600 0 CST}
+ {3382934400 -18000 1 CDT}
+ {3403494000 -21600 0 CST}
+ {3414384000 -18000 1 CDT}
+ {3434943600 -21600 0 CST}
+ {3445833600 -18000 1 CDT}
+ {3466393200 -21600 0 CST}
+ {3477283200 -18000 1 CDT}
+ {3497842800 -21600 0 CST}
+ {3508732800 -18000 1 CDT}
+ {3529292400 -21600 0 CST}
+ {3540182400 -18000 1 CDT}
+ {3560742000 -21600 0 CST}
+ {3572236800 -18000 1 CDT}
+ {3592796400 -21600 0 CST}
+ {3603686400 -18000 1 CDT}
+ {3624246000 -21600 0 CST}
+ {3635136000 -18000 1 CDT}
+ {3655695600 -21600 0 CST}
+ {3666585600 -18000 1 CDT}
+ {3687145200 -21600 0 CST}
+ {3698035200 -18000 1 CDT}
+ {3718594800 -21600 0 CST}
+ {3730089600 -18000 1 CDT}
+ {3750649200 -21600 0 CST}
+ {3761539200 -18000 1 CDT}
+ {3782098800 -21600 0 CST}
+ {3792988800 -18000 1 CDT}
+ {3813548400 -21600 0 CST}
+ {3824438400 -18000 1 CDT}
+ {3844998000 -21600 0 CST}
+ {3855888000 -18000 1 CDT}
+ {3876447600 -21600 0 CST}
+ {3887337600 -18000 1 CDT}
+ {3907897200 -21600 0 CST}
+ {3919392000 -18000 1 CDT}
+ {3939951600 -21600 0 CST}
+ {3950841600 -18000 1 CDT}
+ {3971401200 -21600 0 CST}
+ {3982291200 -18000 1 CDT}
+ {4002850800 -21600 0 CST}
+ {4013740800 -18000 1 CDT}
+ {4034300400 -21600 0 CST}
+ {4045190400 -18000 1 CDT}
+ {4065750000 -21600 0 CST}
+ {4076640000 -18000 1 CDT}
+ {4097199600 -21600 0 CST}
}
diff --git a/library/tzdata/America/Santiago b/library/tzdata/America/Santiago
index a3cd817..f42ff3d 100644
--- a/library/tzdata/America/Santiago
+++ b/library/tzdata/America/Santiago
@@ -110,10 +110,10 @@ set TZData(:America/Santiago) {
{1255233600 -10800 1 CLST}
{1270350000 -14400 0 CLT}
{1286683200 -10800 1 CLST}
- {1299985200 -14400 0 CLT}
- {1318132800 -10800 1 CLST}
- {1331434800 -14400 0 CLT}
- {1350187200 -10800 1 CLST}
+ {1304823600 -14400 0 CLT}
+ {1313899200 -10800 1 CLST}
+ {1335668400 -14400 0 CLT}
+ {1346558400 -10800 1 CLST}
{1362884400 -14400 0 CLT}
{1381636800 -10800 1 CLST}
{1394334000 -14400 0 CLT}
diff --git a/library/tzdata/America/Sitka b/library/tzdata/America/Sitka
new file mode 100644
index 0000000..8c53d93
--- /dev/null
+++ b/library/tzdata/America/Sitka
@@ -0,0 +1,275 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Sitka) {
+ {-9223372036854775808 53927 0 LMT}
+ {-3225365927 -32473 0 LMT}
+ {-2188954727 -28800 0 PST}
+ {-883584000 -28800 0 PST}
+ {-880207200 -25200 1 PWT}
+ {-769395600 -25200 1 PPT}
+ {-765385200 -28800 0 PST}
+ {-757353600 -28800 0 PST}
+ {-31507200 -28800 0 PST}
+ {-21477600 -25200 1 PDT}
+ {-5756400 -28800 0 PST}
+ {9972000 -25200 1 PDT}
+ {25693200 -28800 0 PST}
+ {41421600 -25200 1 PDT}
+ {57747600 -28800 0 PST}
+ {73476000 -25200 1 PDT}
+ {89197200 -28800 0 PST}
+ {104925600 -25200 1 PDT}
+ {120646800 -28800 0 PST}
+ {126698400 -25200 1 PDT}
+ {152096400 -28800 0 PST}
+ {162381600 -25200 1 PDT}
+ {183546000 -28800 0 PST}
+ {199274400 -25200 1 PDT}
+ {215600400 -28800 0 PST}
+ {230724000 -25200 1 PDT}
+ {247050000 -28800 0 PST}
+ {262778400 -25200 1 PDT}
+ {278499600 -28800 0 PST}
+ {294228000 -25200 1 PDT}
+ {309949200 -28800 0 PST}
+ {325677600 -25200 1 PDT}
+ {341398800 -28800 0 PST}
+ {357127200 -25200 1 PDT}
+ {372848400 -28800 0 PST}
+ {388576800 -25200 1 PDT}
+ {404902800 -28800 0 PST}
+ {420026400 -25200 1 PDT}
+ {439030800 -32400 0 AKST}
+ {452084400 -28800 1 AKDT}
+ {467805600 -32400 0 AKST}
+ {483534000 -28800 1 AKDT}
+ {499255200 -32400 0 AKST}
+ {514983600 -28800 1 AKDT}
+ {530704800 -32400 0 AKST}
+ {544618800 -28800 1 AKDT}
+ {562154400 -32400 0 AKST}
+ {576068400 -28800 1 AKDT}
+ {594208800 -32400 0 AKST}
+ {607518000 -28800 1 AKDT}
+ {625658400 -32400 0 AKST}
+ {638967600 -28800 1 AKDT}
+ {657108000 -32400 0 AKST}
+ {671022000 -28800 1 AKDT}
+ {688557600 -32400 0 AKST}
+ {702471600 -28800 1 AKDT}
+ {720007200 -32400 0 AKST}
+ {733921200 -28800 1 AKDT}
+ {752061600 -32400 0 AKST}
+ {765370800 -28800 1 AKDT}
+ {783511200 -32400 0 AKST}
+ {796820400 -28800 1 AKDT}
+ {814960800 -32400 0 AKST}
+ {828874800 -28800 1 AKDT}
+ {846410400 -32400 0 AKST}
+ {860324400 -28800 1 AKDT}
+ {877860000 -32400 0 AKST}
+ {891774000 -28800 1 AKDT}
+ {909309600 -32400 0 AKST}
+ {923223600 -28800 1 AKDT}
+ {941364000 -32400 0 AKST}
+ {954673200 -28800 1 AKDT}
+ {972813600 -32400 0 AKST}
+ {986122800 -28800 1 AKDT}
+ {1004263200 -32400 0 AKST}
+ {1018177200 -28800 1 AKDT}
+ {1035712800 -32400 0 AKST}
+ {1049626800 -28800 1 AKDT}
+ {1067162400 -32400 0 AKST}
+ {1081076400 -28800 1 AKDT}
+ {1099216800 -32400 0 AKST}
+ {1112526000 -28800 1 AKDT}
+ {1130666400 -32400 0 AKST}
+ {1143975600 -28800 1 AKDT}
+ {1162116000 -32400 0 AKST}
+ {1173610800 -28800 1 AKDT}
+ {1194170400 -32400 0 AKST}
+ {1205060400 -28800 1 AKDT}
+ {1225620000 -32400 0 AKST}
+ {1236510000 -28800 1 AKDT}
+ {1257069600 -32400 0 AKST}
+ {1268564400 -28800 1 AKDT}
+ {1289124000 -32400 0 AKST}
+ {1300014000 -28800 1 AKDT}
+ {1320573600 -32400 0 AKST}
+ {1331463600 -28800 1 AKDT}
+ {1352023200 -32400 0 AKST}
+ {1362913200 -28800 1 AKDT}
+ {1383472800 -32400 0 AKST}
+ {1394362800 -28800 1 AKDT}
+ {1414922400 -32400 0 AKST}
+ {1425812400 -28800 1 AKDT}
+ {1446372000 -32400 0 AKST}
+ {1457866800 -28800 1 AKDT}
+ {1478426400 -32400 0 AKST}
+ {1489316400 -28800 1 AKDT}
+ {1509876000 -32400 0 AKST}
+ {1520766000 -28800 1 AKDT}
+ {1541325600 -32400 0 AKST}
+ {1552215600 -28800 1 AKDT}
+ {1572775200 -32400 0 AKST}
+ {1583665200 -28800 1 AKDT}
+ {1604224800 -32400 0 AKST}
+ {1615719600 -28800 1 AKDT}
+ {1636279200 -32400 0 AKST}
+ {1647169200 -28800 1 AKDT}
+ {1667728800 -32400 0 AKST}
+ {1678618800 -28800 1 AKDT}
+ {1699178400 -32400 0 AKST}
+ {1710068400 -28800 1 AKDT}
+ {1730628000 -32400 0 AKST}
+ {1741518000 -28800 1 AKDT}
+ {1762077600 -32400 0 AKST}
+ {1772967600 -28800 1 AKDT}
+ {1793527200 -32400 0 AKST}
+ {1805022000 -28800 1 AKDT}
+ {1825581600 -32400 0 AKST}
+ {1836471600 -28800 1 AKDT}
+ {1857031200 -32400 0 AKST}
+ {1867921200 -28800 1 AKDT}
+ {1888480800 -32400 0 AKST}
+ {1899370800 -28800 1 AKDT}
+ {1919930400 -32400 0 AKST}
+ {1930820400 -28800 1 AKDT}
+ {1951380000 -32400 0 AKST}
+ {1962874800 -28800 1 AKDT}
+ {1983434400 -32400 0 AKST}
+ {1994324400 -28800 1 AKDT}
+ {2014884000 -32400 0 AKST}
+ {2025774000 -28800 1 AKDT}
+ {2046333600 -32400 0 AKST}
+ {2057223600 -28800 1 AKDT}
+ {2077783200 -32400 0 AKST}
+ {2088673200 -28800 1 AKDT}
+ {2109232800 -32400 0 AKST}
+ {2120122800 -28800 1 AKDT}
+ {2140682400 -32400 0 AKST}
+ {2152177200 -28800 1 AKDT}
+ {2172736800 -32400 0 AKST}
+ {2183626800 -28800 1 AKDT}
+ {2204186400 -32400 0 AKST}
+ {2215076400 -28800 1 AKDT}
+ {2235636000 -32400 0 AKST}
+ {2246526000 -28800 1 AKDT}
+ {2267085600 -32400 0 AKST}
+ {2277975600 -28800 1 AKDT}
+ {2298535200 -32400 0 AKST}
+ {2309425200 -28800 1 AKDT}
+ {2329984800 -32400 0 AKST}
+ {2341479600 -28800 1 AKDT}
+ {2362039200 -32400 0 AKST}
+ {2372929200 -28800 1 AKDT}
+ {2393488800 -32400 0 AKST}
+ {2404378800 -28800 1 AKDT}
+ {2424938400 -32400 0 AKST}
+ {2435828400 -28800 1 AKDT}
+ {2456388000 -32400 0 AKST}
+ {2467278000 -28800 1 AKDT}
+ {2487837600 -32400 0 AKST}
+ {2499332400 -28800 1 AKDT}
+ {2519892000 -32400 0 AKST}
+ {2530782000 -28800 1 AKDT}
+ {2551341600 -32400 0 AKST}
+ {2562231600 -28800 1 AKDT}
+ {2582791200 -32400 0 AKST}
+ {2593681200 -28800 1 AKDT}
+ {2614240800 -32400 0 AKST}
+ {2625130800 -28800 1 AKDT}
+ {2645690400 -32400 0 AKST}
+ {2656580400 -28800 1 AKDT}
+ {2677140000 -32400 0 AKST}
+ {2688634800 -28800 1 AKDT}
+ {2709194400 -32400 0 AKST}
+ {2720084400 -28800 1 AKDT}
+ {2740644000 -32400 0 AKST}
+ {2751534000 -28800 1 AKDT}
+ {2772093600 -32400 0 AKST}
+ {2782983600 -28800 1 AKDT}
+ {2803543200 -32400 0 AKST}
+ {2814433200 -28800 1 AKDT}
+ {2834992800 -32400 0 AKST}
+ {2846487600 -28800 1 AKDT}
+ {2867047200 -32400 0 AKST}
+ {2877937200 -28800 1 AKDT}
+ {2898496800 -32400 0 AKST}
+ {2909386800 -28800 1 AKDT}
+ {2929946400 -32400 0 AKST}
+ {2940836400 -28800 1 AKDT}
+ {2961396000 -32400 0 AKST}
+ {2972286000 -28800 1 AKDT}
+ {2992845600 -32400 0 AKST}
+ {3003735600 -28800 1 AKDT}
+ {3024295200 -32400 0 AKST}
+ {3035790000 -28800 1 AKDT}
+ {3056349600 -32400 0 AKST}
+ {3067239600 -28800 1 AKDT}
+ {3087799200 -32400 0 AKST}
+ {3098689200 -28800 1 AKDT}
+ {3119248800 -32400 0 AKST}
+ {3130138800 -28800 1 AKDT}
+ {3150698400 -32400 0 AKST}
+ {3161588400 -28800 1 AKDT}
+ {3182148000 -32400 0 AKST}
+ {3193038000 -28800 1 AKDT}
+ {3213597600 -32400 0 AKST}
+ {3225092400 -28800 1 AKDT}
+ {3245652000 -32400 0 AKST}
+ {3256542000 -28800 1 AKDT}
+ {3277101600 -32400 0 AKST}
+ {3287991600 -28800 1 AKDT}
+ {3308551200 -32400 0 AKST}
+ {3319441200 -28800 1 AKDT}
+ {3340000800 -32400 0 AKST}
+ {3350890800 -28800 1 AKDT}
+ {3371450400 -32400 0 AKST}
+ {3382945200 -28800 1 AKDT}
+ {3403504800 -32400 0 AKST}
+ {3414394800 -28800 1 AKDT}
+ {3434954400 -32400 0 AKST}
+ {3445844400 -28800 1 AKDT}
+ {3466404000 -32400 0 AKST}
+ {3477294000 -28800 1 AKDT}
+ {3497853600 -32400 0 AKST}
+ {3508743600 -28800 1 AKDT}
+ {3529303200 -32400 0 AKST}
+ {3540193200 -28800 1 AKDT}
+ {3560752800 -32400 0 AKST}
+ {3572247600 -28800 1 AKDT}
+ {3592807200 -32400 0 AKST}
+ {3603697200 -28800 1 AKDT}
+ {3624256800 -32400 0 AKST}
+ {3635146800 -28800 1 AKDT}
+ {3655706400 -32400 0 AKST}
+ {3666596400 -28800 1 AKDT}
+ {3687156000 -32400 0 AKST}
+ {3698046000 -28800 1 AKDT}
+ {3718605600 -32400 0 AKST}
+ {3730100400 -28800 1 AKDT}
+ {3750660000 -32400 0 AKST}
+ {3761550000 -28800 1 AKDT}
+ {3782109600 -32400 0 AKST}
+ {3792999600 -28800 1 AKDT}
+ {3813559200 -32400 0 AKST}
+ {3824449200 -28800 1 AKDT}
+ {3845008800 -32400 0 AKST}
+ {3855898800 -28800 1 AKDT}
+ {3876458400 -32400 0 AKST}
+ {3887348400 -28800 1 AKDT}
+ {3907908000 -32400 0 AKST}
+ {3919402800 -28800 1 AKDT}
+ {3939962400 -32400 0 AKST}
+ {3950852400 -28800 1 AKDT}
+ {3971412000 -32400 0 AKST}
+ {3982302000 -28800 1 AKDT}
+ {4002861600 -32400 0 AKST}
+ {4013751600 -28800 1 AKDT}
+ {4034311200 -32400 0 AKST}
+ {4045201200 -28800 1 AKDT}
+ {4065760800 -32400 0 AKST}
+ {4076650800 -28800 1 AKDT}
+ {4097210400 -32400 0 AKST}
+}
diff --git a/library/tzdata/America/St_Johns b/library/tzdata/America/St_Johns
index 59f92bb..1492961 100644
--- a/library/tzdata/America/St_Johns
+++ b/library/tzdata/America/St_Johns
@@ -7,7 +7,7 @@ set TZData(:America/St_Johns) {
{-1650137348 -12652 0 NST}
{-1640982548 -12652 0 NST}
{-1632076148 -9052 1 NDT}
- {-1614799748 -12652 0 NST}
+ {-1615145348 -12652 0 NST}
{-1609446548 -12652 0 NST}
{-1598650148 -9052 1 NDT}
{-1590100148 -12652 0 NST}
@@ -191,181 +191,182 @@ set TZData(:America/St_Johns) {
{1268537460 -9000 1 NDT}
{1289097060 -12600 0 NST}
{1299987060 -9000 1 NDT}
- {1320546660 -12600 0 NST}
- {1331436660 -9000 1 NDT}
- {1351996260 -12600 0 NST}
- {1362886260 -9000 1 NDT}
- {1383445860 -12600 0 NST}
- {1394335860 -9000 1 NDT}
- {1414895460 -12600 0 NST}
- {1425785460 -9000 1 NDT}
- {1446345060 -12600 0 NST}
- {1457839860 -9000 1 NDT}
- {1478399460 -12600 0 NST}
- {1489289460 -9000 1 NDT}
- {1509849060 -12600 0 NST}
- {1520739060 -9000 1 NDT}
- {1541298660 -12600 0 NST}
- {1552188660 -9000 1 NDT}
- {1572748260 -12600 0 NST}
- {1583638260 -9000 1 NDT}
- {1604197860 -12600 0 NST}
- {1615692660 -9000 1 NDT}
- {1636252260 -12600 0 NST}
- {1647142260 -9000 1 NDT}
- {1667701860 -12600 0 NST}
- {1678591860 -9000 1 NDT}
- {1699151460 -12600 0 NST}
- {1710041460 -9000 1 NDT}
- {1730601060 -12600 0 NST}
- {1741491060 -9000 1 NDT}
- {1762050660 -12600 0 NST}
- {1772940660 -9000 1 NDT}
- {1793500260 -12600 0 NST}
- {1804995060 -9000 1 NDT}
- {1825554660 -12600 0 NST}
- {1836444660 -9000 1 NDT}
- {1857004260 -12600 0 NST}
- {1867894260 -9000 1 NDT}
- {1888453860 -12600 0 NST}
- {1899343860 -9000 1 NDT}
- {1919903460 -12600 0 NST}
- {1930793460 -9000 1 NDT}
- {1951353060 -12600 0 NST}
- {1962847860 -9000 1 NDT}
- {1983407460 -12600 0 NST}
- {1994297460 -9000 1 NDT}
- {2014857060 -12600 0 NST}
- {2025747060 -9000 1 NDT}
- {2046306660 -12600 0 NST}
- {2057196660 -9000 1 NDT}
- {2077756260 -12600 0 NST}
- {2088646260 -9000 1 NDT}
- {2109205860 -12600 0 NST}
- {2120095860 -9000 1 NDT}
- {2140655460 -12600 0 NST}
- {2152150260 -9000 1 NDT}
- {2172709860 -12600 0 NST}
- {2183599860 -9000 1 NDT}
- {2204159460 -12600 0 NST}
- {2215049460 -9000 1 NDT}
- {2235609060 -12600 0 NST}
- {2246499060 -9000 1 NDT}
- {2267058660 -12600 0 NST}
- {2277948660 -9000 1 NDT}
- {2298508260 -12600 0 NST}
- {2309398260 -9000 1 NDT}
- {2329957860 -12600 0 NST}
- {2341452660 -9000 1 NDT}
- {2362012260 -12600 0 NST}
- {2372902260 -9000 1 NDT}
- {2393461860 -12600 0 NST}
- {2404351860 -9000 1 NDT}
- {2424911460 -12600 0 NST}
- {2435801460 -9000 1 NDT}
- {2456361060 -12600 0 NST}
- {2467251060 -9000 1 NDT}
- {2487810660 -12600 0 NST}
- {2499305460 -9000 1 NDT}
- {2519865060 -12600 0 NST}
- {2530755060 -9000 1 NDT}
- {2551314660 -12600 0 NST}
- {2562204660 -9000 1 NDT}
- {2582764260 -12600 0 NST}
- {2593654260 -9000 1 NDT}
- {2614213860 -12600 0 NST}
- {2625103860 -9000 1 NDT}
- {2645663460 -12600 0 NST}
- {2656553460 -9000 1 NDT}
- {2677113060 -12600 0 NST}
- {2688607860 -9000 1 NDT}
- {2709167460 -12600 0 NST}
- {2720057460 -9000 1 NDT}
- {2740617060 -12600 0 NST}
- {2751507060 -9000 1 NDT}
- {2772066660 -12600 0 NST}
- {2782956660 -9000 1 NDT}
- {2803516260 -12600 0 NST}
- {2814406260 -9000 1 NDT}
- {2834965860 -12600 0 NST}
- {2846460660 -9000 1 NDT}
- {2867020260 -12600 0 NST}
- {2877910260 -9000 1 NDT}
- {2898469860 -12600 0 NST}
- {2909359860 -9000 1 NDT}
- {2929919460 -12600 0 NST}
- {2940809460 -9000 1 NDT}
- {2961369060 -12600 0 NST}
- {2972259060 -9000 1 NDT}
- {2992818660 -12600 0 NST}
- {3003708660 -9000 1 NDT}
- {3024268260 -12600 0 NST}
- {3035763060 -9000 1 NDT}
- {3056322660 -12600 0 NST}
- {3067212660 -9000 1 NDT}
- {3087772260 -12600 0 NST}
- {3098662260 -9000 1 NDT}
- {3119221860 -12600 0 NST}
- {3130111860 -9000 1 NDT}
- {3150671460 -12600 0 NST}
- {3161561460 -9000 1 NDT}
- {3182121060 -12600 0 NST}
- {3193011060 -9000 1 NDT}
- {3213570660 -12600 0 NST}
- {3225065460 -9000 1 NDT}
- {3245625060 -12600 0 NST}
- {3256515060 -9000 1 NDT}
- {3277074660 -12600 0 NST}
- {3287964660 -9000 1 NDT}
- {3308524260 -12600 0 NST}
- {3319414260 -9000 1 NDT}
- {3339973860 -12600 0 NST}
- {3350863860 -9000 1 NDT}
- {3371423460 -12600 0 NST}
- {3382918260 -9000 1 NDT}
- {3403477860 -12600 0 NST}
- {3414367860 -9000 1 NDT}
- {3434927460 -12600 0 NST}
- {3445817460 -9000 1 NDT}
- {3466377060 -12600 0 NST}
- {3477267060 -9000 1 NDT}
- {3497826660 -12600 0 NST}
- {3508716660 -9000 1 NDT}
- {3529276260 -12600 0 NST}
- {3540166260 -9000 1 NDT}
- {3560725860 -12600 0 NST}
- {3572220660 -9000 1 NDT}
- {3592780260 -12600 0 NST}
- {3603670260 -9000 1 NDT}
- {3624229860 -12600 0 NST}
- {3635119860 -9000 1 NDT}
- {3655679460 -12600 0 NST}
- {3666569460 -9000 1 NDT}
- {3687129060 -12600 0 NST}
- {3698019060 -9000 1 NDT}
- {3718578660 -12600 0 NST}
- {3730073460 -9000 1 NDT}
- {3750633060 -12600 0 NST}
- {3761523060 -9000 1 NDT}
- {3782082660 -12600 0 NST}
- {3792972660 -9000 1 NDT}
- {3813532260 -12600 0 NST}
- {3824422260 -9000 1 NDT}
- {3844981860 -12600 0 NST}
- {3855871860 -9000 1 NDT}
- {3876431460 -12600 0 NST}
- {3887321460 -9000 1 NDT}
- {3907881060 -12600 0 NST}
- {3919375860 -9000 1 NDT}
- {3939935460 -12600 0 NST}
- {3950825460 -9000 1 NDT}
- {3971385060 -12600 0 NST}
- {3982275060 -9000 1 NDT}
- {4002834660 -12600 0 NST}
- {4013724660 -9000 1 NDT}
- {4034284260 -12600 0 NST}
- {4045174260 -9000 1 NDT}
- {4065733860 -12600 0 NST}
- {4076623860 -9000 1 NDT}
- {4097183460 -12600 0 NST}
+ {1320114600 -9000 0 NDT}
+ {1320553800 -12600 0 NST}
+ {1331443800 -9000 1 NDT}
+ {1352003400 -12600 0 NST}
+ {1362893400 -9000 1 NDT}
+ {1383453000 -12600 0 NST}
+ {1394343000 -9000 1 NDT}
+ {1414902600 -12600 0 NST}
+ {1425792600 -9000 1 NDT}
+ {1446352200 -12600 0 NST}
+ {1457847000 -9000 1 NDT}
+ {1478406600 -12600 0 NST}
+ {1489296600 -9000 1 NDT}
+ {1509856200 -12600 0 NST}
+ {1520746200 -9000 1 NDT}
+ {1541305800 -12600 0 NST}
+ {1552195800 -9000 1 NDT}
+ {1572755400 -12600 0 NST}
+ {1583645400 -9000 1 NDT}
+ {1604205000 -12600 0 NST}
+ {1615699800 -9000 1 NDT}
+ {1636259400 -12600 0 NST}
+ {1647149400 -9000 1 NDT}
+ {1667709000 -12600 0 NST}
+ {1678599000 -9000 1 NDT}
+ {1699158600 -12600 0 NST}
+ {1710048600 -9000 1 NDT}
+ {1730608200 -12600 0 NST}
+ {1741498200 -9000 1 NDT}
+ {1762057800 -12600 0 NST}
+ {1772947800 -9000 1 NDT}
+ {1793507400 -12600 0 NST}
+ {1805002200 -9000 1 NDT}
+ {1825561800 -12600 0 NST}
+ {1836451800 -9000 1 NDT}
+ {1857011400 -12600 0 NST}
+ {1867901400 -9000 1 NDT}
+ {1888461000 -12600 0 NST}
+ {1899351000 -9000 1 NDT}
+ {1919910600 -12600 0 NST}
+ {1930800600 -9000 1 NDT}
+ {1951360200 -12600 0 NST}
+ {1962855000 -9000 1 NDT}
+ {1983414600 -12600 0 NST}
+ {1994304600 -9000 1 NDT}
+ {2014864200 -12600 0 NST}
+ {2025754200 -9000 1 NDT}
+ {2046313800 -12600 0 NST}
+ {2057203800 -9000 1 NDT}
+ {2077763400 -12600 0 NST}
+ {2088653400 -9000 1 NDT}
+ {2109213000 -12600 0 NST}
+ {2120103000 -9000 1 NDT}
+ {2140662600 -12600 0 NST}
+ {2152157400 -9000 1 NDT}
+ {2172717000 -12600 0 NST}
+ {2183607000 -9000 1 NDT}
+ {2204166600 -12600 0 NST}
+ {2215056600 -9000 1 NDT}
+ {2235616200 -12600 0 NST}
+ {2246506200 -9000 1 NDT}
+ {2267065800 -12600 0 NST}
+ {2277955800 -9000 1 NDT}
+ {2298515400 -12600 0 NST}
+ {2309405400 -9000 1 NDT}
+ {2329965000 -12600 0 NST}
+ {2341459800 -9000 1 NDT}
+ {2362019400 -12600 0 NST}
+ {2372909400 -9000 1 NDT}
+ {2393469000 -12600 0 NST}
+ {2404359000 -9000 1 NDT}
+ {2424918600 -12600 0 NST}
+ {2435808600 -9000 1 NDT}
+ {2456368200 -12600 0 NST}
+ {2467258200 -9000 1 NDT}
+ {2487817800 -12600 0 NST}
+ {2499312600 -9000 1 NDT}
+ {2519872200 -12600 0 NST}
+ {2530762200 -9000 1 NDT}
+ {2551321800 -12600 0 NST}
+ {2562211800 -9000 1 NDT}
+ {2582771400 -12600 0 NST}
+ {2593661400 -9000 1 NDT}
+ {2614221000 -12600 0 NST}
+ {2625111000 -9000 1 NDT}
+ {2645670600 -12600 0 NST}
+ {2656560600 -9000 1 NDT}
+ {2677120200 -12600 0 NST}
+ {2688615000 -9000 1 NDT}
+ {2709174600 -12600 0 NST}
+ {2720064600 -9000 1 NDT}
+ {2740624200 -12600 0 NST}
+ {2751514200 -9000 1 NDT}
+ {2772073800 -12600 0 NST}
+ {2782963800 -9000 1 NDT}
+ {2803523400 -12600 0 NST}
+ {2814413400 -9000 1 NDT}
+ {2834973000 -12600 0 NST}
+ {2846467800 -9000 1 NDT}
+ {2867027400 -12600 0 NST}
+ {2877917400 -9000 1 NDT}
+ {2898477000 -12600 0 NST}
+ {2909367000 -9000 1 NDT}
+ {2929926600 -12600 0 NST}
+ {2940816600 -9000 1 NDT}
+ {2961376200 -12600 0 NST}
+ {2972266200 -9000 1 NDT}
+ {2992825800 -12600 0 NST}
+ {3003715800 -9000 1 NDT}
+ {3024275400 -12600 0 NST}
+ {3035770200 -9000 1 NDT}
+ {3056329800 -12600 0 NST}
+ {3067219800 -9000 1 NDT}
+ {3087779400 -12600 0 NST}
+ {3098669400 -9000 1 NDT}
+ {3119229000 -12600 0 NST}
+ {3130119000 -9000 1 NDT}
+ {3150678600 -12600 0 NST}
+ {3161568600 -9000 1 NDT}
+ {3182128200 -12600 0 NST}
+ {3193018200 -9000 1 NDT}
+ {3213577800 -12600 0 NST}
+ {3225072600 -9000 1 NDT}
+ {3245632200 -12600 0 NST}
+ {3256522200 -9000 1 NDT}
+ {3277081800 -12600 0 NST}
+ {3287971800 -9000 1 NDT}
+ {3308531400 -12600 0 NST}
+ {3319421400 -9000 1 NDT}
+ {3339981000 -12600 0 NST}
+ {3350871000 -9000 1 NDT}
+ {3371430600 -12600 0 NST}
+ {3382925400 -9000 1 NDT}
+ {3403485000 -12600 0 NST}
+ {3414375000 -9000 1 NDT}
+ {3434934600 -12600 0 NST}
+ {3445824600 -9000 1 NDT}
+ {3466384200 -12600 0 NST}
+ {3477274200 -9000 1 NDT}
+ {3497833800 -12600 0 NST}
+ {3508723800 -9000 1 NDT}
+ {3529283400 -12600 0 NST}
+ {3540173400 -9000 1 NDT}
+ {3560733000 -12600 0 NST}
+ {3572227800 -9000 1 NDT}
+ {3592787400 -12600 0 NST}
+ {3603677400 -9000 1 NDT}
+ {3624237000 -12600 0 NST}
+ {3635127000 -9000 1 NDT}
+ {3655686600 -12600 0 NST}
+ {3666576600 -9000 1 NDT}
+ {3687136200 -12600 0 NST}
+ {3698026200 -9000 1 NDT}
+ {3718585800 -12600 0 NST}
+ {3730080600 -9000 1 NDT}
+ {3750640200 -12600 0 NST}
+ {3761530200 -9000 1 NDT}
+ {3782089800 -12600 0 NST}
+ {3792979800 -9000 1 NDT}
+ {3813539400 -12600 0 NST}
+ {3824429400 -9000 1 NDT}
+ {3844989000 -12600 0 NST}
+ {3855879000 -9000 1 NDT}
+ {3876438600 -12600 0 NST}
+ {3887328600 -9000 1 NDT}
+ {3907888200 -12600 0 NST}
+ {3919383000 -9000 1 NDT}
+ {3939942600 -12600 0 NST}
+ {3950832600 -9000 1 NDT}
+ {3971392200 -12600 0 NST}
+ {3982282200 -9000 1 NDT}
+ {4002841800 -12600 0 NST}
+ {4013731800 -9000 1 NDT}
+ {4034291400 -12600 0 NST}
+ {4045181400 -9000 1 NDT}
+ {4065741000 -12600 0 NST}
+ {4076631000 -9000 1 NDT}
+ {4097190600 -12600 0 NST}
}
diff --git a/library/tzdata/America/Swift_Current b/library/tzdata/America/Swift_Current
index dc4aa37..ad07762 100644
--- a/library/tzdata/America/Swift_Current
+++ b/library/tzdata/America/Swift_Current
@@ -4,7 +4,7 @@ set TZData(:America/Swift_Current) {
{-9223372036854775808 -25880 0 LMT}
{-2030201320 -25200 0 MST}
{-1632063600 -21600 1 MDT}
- {-1614787200 -25200 0 MST}
+ {-1615132800 -25200 0 MST}
{-880210800 -21600 1 MWT}
{-769395600 -21600 1 MPT}
{-765388800 -25200 0 MST}
diff --git a/library/tzdata/America/Toronto b/library/tzdata/America/Toronto
index e4fc91a..09bf786 100644
--- a/library/tzdata/America/Toronto
+++ b/library/tzdata/America/Toronto
@@ -4,7 +4,7 @@ set TZData(:America/Toronto) {
{-9223372036854775808 -19052 0 LMT}
{-2366736148 -18000 0 EST}
{-1632070800 -14400 1 EDT}
- {-1614794400 -18000 0 EST}
+ {-1615140000 -18000 0 EST}
{-1609441200 -18000 0 EST}
{-1601753400 -14400 1 EDT}
{-1583697600 -18000 0 EST}
diff --git a/library/tzdata/America/Vancouver b/library/tzdata/America/Vancouver
index b2e0415..aef639a 100644
--- a/library/tzdata/America/Vancouver
+++ b/library/tzdata/America/Vancouver
@@ -4,7 +4,7 @@ set TZData(:America/Vancouver) {
{-9223372036854775808 -29548 0 LMT}
{-2713880852 -28800 0 PST}
{-1632060000 -25200 1 PDT}
- {-1614783600 -28800 0 PST}
+ {-1615129200 -28800 0 PST}
{-880207200 -25200 1 PWT}
{-769395600 -25200 1 PPT}
{-765385200 -28800 0 PST}
diff --git a/library/tzdata/America/Winnipeg b/library/tzdata/America/Winnipeg
index 7e6208a..e6efe47 100644
--- a/library/tzdata/America/Winnipeg
+++ b/library/tzdata/America/Winnipeg
@@ -6,7 +6,7 @@ set TZData(:America/Winnipeg) {
{-1694368800 -18000 1 CDT}
{-1681671600 -21600 0 CST}
{-1632067200 -18000 1 CDT}
- {-1614790800 -21600 0 CST}
+ {-1615136400 -21600 0 CST}
{-1029686400 -18000 1 CDT}
{-1018198800 -21600 0 CST}
{-880214400 -18000 1 CWT}
diff --git a/library/tzdata/Antarctica/Casey b/library/tzdata/Antarctica/Casey
index 119d514..cbe3e3c 100644
--- a/library/tzdata/Antarctica/Casey
+++ b/library/tzdata/Antarctica/Casey
@@ -5,4 +5,6 @@ set TZData(:Antarctica/Casey) {
{-31536000 28800 0 WST}
{1255802400 39600 0 CAST}
{1267714800 28800 0 WST}
+ {1319738400 39600 0 CAST}
+ {1329843600 28800 0 WST}
}
diff --git a/library/tzdata/Antarctica/Davis b/library/tzdata/Antarctica/Davis
index 47aece9..2762d2f 100644
--- a/library/tzdata/Antarctica/Davis
+++ b/library/tzdata/Antarctica/Davis
@@ -7,4 +7,6 @@ set TZData(:Antarctica/Davis) {
{-28857600 25200 0 DAVT}
{1255806000 18000 0 DAVT}
{1268251200 25200 0 DAVT}
+ {1319742000 18000 0 DAVT}
+ {1329854400 25200 0 DAVT}
}
diff --git a/library/tzdata/Antarctica/Palmer b/library/tzdata/Antarctica/Palmer
index 1e24754..601a684 100644
--- a/library/tzdata/Antarctica/Palmer
+++ b/library/tzdata/Antarctica/Palmer
@@ -67,16 +67,16 @@ set TZData(:Antarctica/Palmer) {
{1160884800 -10800 1 CLST}
{1173582000 -14400 0 CLT}
{1192334400 -10800 1 CLST}
- {1205031600 -14400 0 CLT}
+ {1206846000 -14400 0 CLT}
{1223784000 -10800 1 CLST}
{1237086000 -14400 0 CLT}
{1255233600 -10800 1 CLST}
- {1268535600 -14400 0 CLT}
+ {1270350000 -14400 0 CLT}
{1286683200 -10800 1 CLST}
- {1299985200 -14400 0 CLT}
- {1318132800 -10800 1 CLST}
- {1331434800 -14400 0 CLT}
- {1350187200 -10800 1 CLST}
+ {1304823600 -14400 0 CLT}
+ {1313899200 -10800 1 CLST}
+ {1335668400 -14400 0 CLT}
+ {1346558400 -10800 1 CLST}
{1362884400 -14400 0 CLT}
{1381636800 -10800 1 CLST}
{1394334000 -14400 0 CLT}
diff --git a/library/tzdata/Asia/Amman b/library/tzdata/Asia/Amman
index bf30508..33f0ba7 100644
--- a/library/tzdata/Asia/Amman
+++ b/library/tzdata/Asia/Amman
@@ -70,8 +70,7 @@ set TZData(:Asia/Amman) {
{1301608800 10800 1 EEST}
{1319752800 7200 0 EET}
{1333058400 10800 1 EEST}
- {1351202400 7200 0 EET}
- {1364508000 10800 1 EEST}
+ {1364504400 10800 1 EEST}
{1382652000 7200 0 EET}
{1395957600 10800 1 EEST}
{1414706400 7200 0 EET}
diff --git a/library/tzdata/Asia/Anadyr b/library/tzdata/Asia/Anadyr
index 47a1a8c..50ace50 100644
--- a/library/tzdata/Asia/Anadyr
+++ b/library/tzdata/Asia/Anadyr
@@ -68,182 +68,5 @@ set TZData(:Asia/Anadyr) {
{1269698400 39600 0 ANAMMTT}
{1269702000 43200 1 ANAST}
{1288450800 39600 0 ANAT}
- {1301151600 43200 1 ANAST}
- {1319900400 39600 0 ANAT}
- {1332601200 43200 1 ANAST}
- {1351350000 39600 0 ANAT}
- {1364655600 43200 1 ANAST}
- {1382799600 39600 0 ANAT}
- {1396105200 43200 1 ANAST}
- {1414249200 39600 0 ANAT}
- {1427554800 43200 1 ANAST}
- {1445698800 39600 0 ANAT}
- {1459004400 43200 1 ANAST}
- {1477753200 39600 0 ANAT}
- {1490454000 43200 1 ANAST}
- {1509202800 39600 0 ANAT}
- {1521903600 43200 1 ANAST}
- {1540652400 39600 0 ANAT}
- {1553958000 43200 1 ANAST}
- {1572102000 39600 0 ANAT}
- {1585407600 43200 1 ANAST}
- {1603551600 39600 0 ANAT}
- {1616857200 43200 1 ANAST}
- {1635606000 39600 0 ANAT}
- {1648306800 43200 1 ANAST}
- {1667055600 39600 0 ANAT}
- {1679756400 43200 1 ANAST}
- {1698505200 39600 0 ANAT}
- {1711810800 43200 1 ANAST}
- {1729954800 39600 0 ANAT}
- {1743260400 43200 1 ANAST}
- {1761404400 39600 0 ANAT}
- {1774710000 43200 1 ANAST}
- {1792854000 39600 0 ANAT}
- {1806159600 43200 1 ANAST}
- {1824908400 39600 0 ANAT}
- {1837609200 43200 1 ANAST}
- {1856358000 39600 0 ANAT}
- {1869058800 43200 1 ANAST}
- {1887807600 39600 0 ANAT}
- {1901113200 43200 1 ANAST}
- {1919257200 39600 0 ANAT}
- {1932562800 43200 1 ANAST}
- {1950706800 39600 0 ANAT}
- {1964012400 43200 1 ANAST}
- {1982761200 39600 0 ANAT}
- {1995462000 43200 1 ANAST}
- {2014210800 39600 0 ANAT}
- {2026911600 43200 1 ANAST}
- {2045660400 39600 0 ANAT}
- {2058361200 43200 1 ANAST}
- {2077110000 39600 0 ANAT}
- {2090415600 43200 1 ANAST}
- {2108559600 39600 0 ANAT}
- {2121865200 43200 1 ANAST}
- {2140009200 39600 0 ANAT}
- {2153314800 43200 1 ANAST}
- {2172063600 39600 0 ANAT}
- {2184764400 43200 1 ANAST}
- {2203513200 39600 0 ANAT}
- {2216214000 43200 1 ANAST}
- {2234962800 39600 0 ANAT}
- {2248268400 43200 1 ANAST}
- {2266412400 39600 0 ANAT}
- {2279718000 43200 1 ANAST}
- {2297862000 39600 0 ANAT}
- {2311167600 43200 1 ANAST}
- {2329311600 39600 0 ANAT}
- {2342617200 43200 1 ANAST}
- {2361366000 39600 0 ANAT}
- {2374066800 43200 1 ANAST}
- {2392815600 39600 0 ANAT}
- {2405516400 43200 1 ANAST}
- {2424265200 39600 0 ANAT}
- {2437570800 43200 1 ANAST}
- {2455714800 39600 0 ANAT}
- {2469020400 43200 1 ANAST}
- {2487164400 39600 0 ANAT}
- {2500470000 43200 1 ANAST}
- {2519218800 39600 0 ANAT}
- {2531919600 43200 1 ANAST}
- {2550668400 39600 0 ANAT}
- {2563369200 43200 1 ANAST}
- {2582118000 39600 0 ANAT}
- {2595423600 43200 1 ANAST}
- {2613567600 39600 0 ANAT}
- {2626873200 43200 1 ANAST}
- {2645017200 39600 0 ANAT}
- {2658322800 43200 1 ANAST}
- {2676466800 39600 0 ANAT}
- {2689772400 43200 1 ANAST}
- {2708521200 39600 0 ANAT}
- {2721222000 43200 1 ANAST}
- {2739970800 39600 0 ANAT}
- {2752671600 43200 1 ANAST}
- {2771420400 39600 0 ANAT}
- {2784726000 43200 1 ANAST}
- {2802870000 39600 0 ANAT}
- {2816175600 43200 1 ANAST}
- {2834319600 39600 0 ANAT}
- {2847625200 43200 1 ANAST}
- {2866374000 39600 0 ANAT}
- {2879074800 43200 1 ANAST}
- {2897823600 39600 0 ANAT}
- {2910524400 43200 1 ANAST}
- {2929273200 39600 0 ANAT}
- {2941974000 43200 1 ANAST}
- {2960722800 39600 0 ANAT}
- {2974028400 43200 1 ANAST}
- {2992172400 39600 0 ANAT}
- {3005478000 43200 1 ANAST}
- {3023622000 39600 0 ANAT}
- {3036927600 43200 1 ANAST}
- {3055676400 39600 0 ANAT}
- {3068377200 43200 1 ANAST}
- {3087126000 39600 0 ANAT}
- {3099826800 43200 1 ANAST}
- {3118575600 39600 0 ANAT}
- {3131881200 43200 1 ANAST}
- {3150025200 39600 0 ANAT}
- {3163330800 43200 1 ANAST}
- {3181474800 39600 0 ANAT}
- {3194780400 43200 1 ANAST}
- {3212924400 39600 0 ANAT}
- {3226230000 43200 1 ANAST}
- {3244978800 39600 0 ANAT}
- {3257679600 43200 1 ANAST}
- {3276428400 39600 0 ANAT}
- {3289129200 43200 1 ANAST}
- {3307878000 39600 0 ANAT}
- {3321183600 43200 1 ANAST}
- {3339327600 39600 0 ANAT}
- {3352633200 43200 1 ANAST}
- {3370777200 39600 0 ANAT}
- {3384082800 43200 1 ANAST}
- {3402831600 39600 0 ANAT}
- {3415532400 43200 1 ANAST}
- {3434281200 39600 0 ANAT}
- {3446982000 43200 1 ANAST}
- {3465730800 39600 0 ANAT}
- {3479036400 43200 1 ANAST}
- {3497180400 39600 0 ANAT}
- {3510486000 43200 1 ANAST}
- {3528630000 39600 0 ANAT}
- {3541935600 43200 1 ANAST}
- {3560079600 39600 0 ANAT}
- {3573385200 43200 1 ANAST}
- {3592134000 39600 0 ANAT}
- {3604834800 43200 1 ANAST}
- {3623583600 39600 0 ANAT}
- {3636284400 43200 1 ANAST}
- {3655033200 39600 0 ANAT}
- {3668338800 43200 1 ANAST}
- {3686482800 39600 0 ANAT}
- {3699788400 43200 1 ANAST}
- {3717932400 39600 0 ANAT}
- {3731238000 43200 1 ANAST}
- {3749986800 39600 0 ANAT}
- {3762687600 43200 1 ANAST}
- {3781436400 39600 0 ANAT}
- {3794137200 43200 1 ANAST}
- {3812886000 39600 0 ANAT}
- {3825586800 43200 1 ANAST}
- {3844335600 39600 0 ANAT}
- {3857641200 43200 1 ANAST}
- {3875785200 39600 0 ANAT}
- {3889090800 43200 1 ANAST}
- {3907234800 39600 0 ANAT}
- {3920540400 43200 1 ANAST}
- {3939289200 39600 0 ANAT}
- {3951990000 43200 1 ANAST}
- {3970738800 39600 0 ANAT}
- {3983439600 43200 1 ANAST}
- {4002188400 39600 0 ANAT}
- {4015494000 43200 1 ANAST}
- {4033638000 39600 0 ANAT}
- {4046943600 43200 1 ANAST}
- {4065087600 39600 0 ANAT}
- {4078393200 43200 1 ANAST}
- {4096537200 39600 0 ANAT}
+ {1301151600 43200 0 ANAT}
}
diff --git a/library/tzdata/Asia/Damascus b/library/tzdata/Asia/Damascus
index 2ea1770..fafef49 100644
--- a/library/tzdata/Asia/Damascus
+++ b/library/tzdata/Asia/Damascus
@@ -101,180 +101,180 @@ set TZData(:Asia/Damascus) {
{1288299600 7200 0 EET}
{1301608800 10800 1 EEST}
{1319749200 7200 0 EET}
- {1333663200 10800 1 EEST}
+ {1333058400 10800 1 EEST}
{1351198800 7200 0 EET}
- {1365112800 10800 1 EEST}
+ {1364508000 10800 1 EEST}
{1382648400 7200 0 EET}
- {1396562400 10800 1 EEST}
+ {1395957600 10800 1 EEST}
{1414702800 7200 0 EET}
- {1428012000 10800 1 EEST}
+ {1427407200 10800 1 EEST}
{1446152400 7200 0 EET}
- {1459461600 10800 1 EEST}
+ {1458856800 10800 1 EEST}
{1477602000 7200 0 EET}
- {1491516000 10800 1 EEST}
+ {1490911200 10800 1 EEST}
{1509051600 7200 0 EET}
- {1522965600 10800 1 EEST}
+ {1522360800 10800 1 EEST}
{1540501200 7200 0 EET}
- {1554415200 10800 1 EEST}
+ {1553810400 10800 1 EEST}
{1571950800 7200 0 EET}
- {1585864800 10800 1 EEST}
+ {1585260000 10800 1 EEST}
{1604005200 7200 0 EET}
- {1617314400 10800 1 EEST}
+ {1616709600 10800 1 EEST}
{1635454800 7200 0 EET}
- {1648764000 10800 1 EEST}
+ {1648159200 10800 1 EEST}
{1666904400 7200 0 EET}
- {1680818400 10800 1 EEST}
+ {1680213600 10800 1 EEST}
{1698354000 7200 0 EET}
- {1712268000 10800 1 EEST}
+ {1711663200 10800 1 EEST}
{1729803600 7200 0 EET}
- {1743717600 10800 1 EEST}
+ {1743112800 10800 1 EEST}
{1761858000 7200 0 EET}
- {1775167200 10800 1 EEST}
+ {1774562400 10800 1 EEST}
{1793307600 7200 0 EET}
- {1806616800 10800 1 EEST}
+ {1806012000 10800 1 EEST}
{1824757200 7200 0 EET}
- {1838671200 10800 1 EEST}
+ {1838066400 10800 1 EEST}
{1856206800 7200 0 EET}
- {1870120800 10800 1 EEST}
+ {1869516000 10800 1 EEST}
{1887656400 7200 0 EET}
- {1901570400 10800 1 EEST}
+ {1900965600 10800 1 EEST}
{1919106000 7200 0 EET}
- {1933020000 10800 1 EEST}
+ {1932415200 10800 1 EEST}
{1951160400 7200 0 EET}
- {1964469600 10800 1 EEST}
+ {1963864800 10800 1 EEST}
{1982610000 7200 0 EET}
- {1995919200 10800 1 EEST}
+ {1995314400 10800 1 EEST}
{2014059600 7200 0 EET}
- {2027973600 10800 1 EEST}
+ {2027368800 10800 1 EEST}
{2045509200 7200 0 EET}
- {2059423200 10800 1 EEST}
+ {2058818400 10800 1 EEST}
{2076958800 7200 0 EET}
- {2090872800 10800 1 EEST}
+ {2090268000 10800 1 EEST}
{2109013200 7200 0 EET}
- {2122322400 10800 1 EEST}
+ {2121717600 10800 1 EEST}
{2140462800 7200 0 EET}
- {2153772000 10800 1 EEST}
+ {2153167200 10800 1 EEST}
{2171912400 7200 0 EET}
- {2185221600 10800 1 EEST}
+ {2184616800 10800 1 EEST}
{2203362000 7200 0 EET}
- {2217276000 10800 1 EEST}
+ {2216671200 10800 1 EEST}
{2234811600 7200 0 EET}
- {2248725600 10800 1 EEST}
+ {2248120800 10800 1 EEST}
{2266261200 7200 0 EET}
- {2280175200 10800 1 EEST}
+ {2279570400 10800 1 EEST}
{2298315600 7200 0 EET}
- {2311624800 10800 1 EEST}
+ {2311020000 10800 1 EEST}
{2329765200 7200 0 EET}
- {2343074400 10800 1 EEST}
+ {2342469600 10800 1 EEST}
{2361214800 7200 0 EET}
- {2375128800 10800 1 EEST}
+ {2374524000 10800 1 EEST}
{2392664400 7200 0 EET}
- {2406578400 10800 1 EEST}
+ {2405973600 10800 1 EEST}
{2424114000 7200 0 EET}
- {2438028000 10800 1 EEST}
+ {2437423200 10800 1 EEST}
{2455563600 7200 0 EET}
- {2469477600 10800 1 EEST}
+ {2468872800 10800 1 EEST}
{2487618000 7200 0 EET}
- {2500927200 10800 1 EEST}
+ {2500322400 10800 1 EEST}
{2519067600 7200 0 EET}
- {2532376800 10800 1 EEST}
+ {2531772000 10800 1 EEST}
{2550517200 7200 0 EET}
- {2564431200 10800 1 EEST}
+ {2563826400 10800 1 EEST}
{2581966800 7200 0 EET}
- {2595880800 10800 1 EEST}
+ {2595276000 10800 1 EEST}
{2613416400 7200 0 EET}
- {2627330400 10800 1 EEST}
+ {2626725600 10800 1 EEST}
{2645470800 7200 0 EET}
- {2658780000 10800 1 EEST}
+ {2658175200 10800 1 EEST}
{2676920400 7200 0 EET}
- {2690229600 10800 1 EEST}
+ {2689624800 10800 1 EEST}
{2708370000 7200 0 EET}
- {2722284000 10800 1 EEST}
+ {2721679200 10800 1 EEST}
{2739819600 7200 0 EET}
- {2753733600 10800 1 EEST}
+ {2753128800 10800 1 EEST}
{2771269200 7200 0 EET}
- {2785183200 10800 1 EEST}
+ {2784578400 10800 1 EEST}
{2802718800 7200 0 EET}
- {2816632800 10800 1 EEST}
+ {2816028000 10800 1 EEST}
{2834773200 7200 0 EET}
- {2848082400 10800 1 EEST}
+ {2847477600 10800 1 EEST}
{2866222800 7200 0 EET}
- {2879532000 10800 1 EEST}
+ {2878927200 10800 1 EEST}
{2897672400 7200 0 EET}
- {2911586400 10800 1 EEST}
+ {2910981600 10800 1 EEST}
{2929122000 7200 0 EET}
- {2943036000 10800 1 EEST}
+ {2942431200 10800 1 EEST}
{2960571600 7200 0 EET}
- {2974485600 10800 1 EEST}
+ {2973880800 10800 1 EEST}
{2992626000 7200 0 EET}
- {3005935200 10800 1 EEST}
+ {3005330400 10800 1 EEST}
{3024075600 7200 0 EET}
- {3037384800 10800 1 EEST}
+ {3036780000 10800 1 EEST}
{3055525200 7200 0 EET}
- {3068834400 10800 1 EEST}
+ {3068229600 10800 1 EEST}
{3086974800 7200 0 EET}
- {3100888800 10800 1 EEST}
+ {3100284000 10800 1 EEST}
{3118424400 7200 0 EET}
- {3132338400 10800 1 EEST}
+ {3131733600 10800 1 EEST}
{3149874000 7200 0 EET}
- {3163788000 10800 1 EEST}
+ {3163183200 10800 1 EEST}
{3181928400 7200 0 EET}
- {3195237600 10800 1 EEST}
+ {3194632800 10800 1 EEST}
{3213378000 7200 0 EET}
- {3226687200 10800 1 EEST}
+ {3226082400 10800 1 EEST}
{3244827600 7200 0 EET}
- {3258741600 10800 1 EEST}
+ {3258136800 10800 1 EEST}
{3276277200 7200 0 EET}
- {3290191200 10800 1 EEST}
+ {3289586400 10800 1 EEST}
{3307726800 7200 0 EET}
- {3321640800 10800 1 EEST}
+ {3321036000 10800 1 EEST}
{3339176400 7200 0 EET}
- {3353090400 10800 1 EEST}
+ {3352485600 10800 1 EEST}
{3371230800 7200 0 EET}
- {3384540000 10800 1 EEST}
+ {3383935200 10800 1 EEST}
{3402680400 7200 0 EET}
- {3415989600 10800 1 EEST}
+ {3415384800 10800 1 EEST}
{3434130000 7200 0 EET}
- {3448044000 10800 1 EEST}
+ {3447439200 10800 1 EEST}
{3465579600 7200 0 EET}
- {3479493600 10800 1 EEST}
+ {3478888800 10800 1 EEST}
{3497029200 7200 0 EET}
- {3510943200 10800 1 EEST}
+ {3510338400 10800 1 EEST}
{3529083600 7200 0 EET}
- {3542392800 10800 1 EEST}
+ {3541788000 10800 1 EEST}
{3560533200 7200 0 EET}
- {3573842400 10800 1 EEST}
+ {3573237600 10800 1 EEST}
{3591982800 7200 0 EET}
- {3605896800 10800 1 EEST}
+ {3605292000 10800 1 EEST}
{3623432400 7200 0 EET}
- {3637346400 10800 1 EEST}
+ {3636741600 10800 1 EEST}
{3654882000 7200 0 EET}
- {3668796000 10800 1 EEST}
+ {3668191200 10800 1 EEST}
{3686331600 7200 0 EET}
- {3700245600 10800 1 EEST}
+ {3699640800 10800 1 EEST}
{3718386000 7200 0 EET}
- {3731695200 10800 1 EEST}
+ {3731090400 10800 1 EEST}
{3749835600 7200 0 EET}
- {3763144800 10800 1 EEST}
+ {3762540000 10800 1 EEST}
{3781285200 7200 0 EET}
- {3795199200 10800 1 EEST}
+ {3794594400 10800 1 EEST}
{3812734800 7200 0 EET}
- {3826648800 10800 1 EEST}
+ {3826044000 10800 1 EEST}
{3844184400 7200 0 EET}
- {3858098400 10800 1 EEST}
+ {3857493600 10800 1 EEST}
{3876238800 7200 0 EET}
- {3889548000 10800 1 EEST}
+ {3888943200 10800 1 EEST}
{3907688400 7200 0 EET}
- {3920997600 10800 1 EEST}
+ {3920392800 10800 1 EEST}
{3939138000 7200 0 EET}
- {3952447200 10800 1 EEST}
+ {3951842400 10800 1 EEST}
{3970587600 7200 0 EET}
- {3984501600 10800 1 EEST}
+ {3983896800 10800 1 EEST}
{4002037200 7200 0 EET}
- {4015951200 10800 1 EEST}
+ {4015346400 10800 1 EEST}
{4033486800 7200 0 EET}
- {4047400800 10800 1 EEST}
+ {4046796000 10800 1 EEST}
{4065541200 7200 0 EET}
- {4078850400 10800 1 EEST}
+ {4078245600 10800 1 EEST}
{4096990800 7200 0 EET}
}
diff --git a/library/tzdata/Asia/Gaza b/library/tzdata/Asia/Gaza
index f26221e..43e1847 100644
--- a/library/tzdata/Asia/Gaza
+++ b/library/tzdata/Asia/Gaza
@@ -89,188 +89,13 @@ set TZData(:Asia/Gaza) {
{1175378400 10800 1 EEST}
{1189638000 7200 0 EET}
{1207000800 10800 1 EEST}
- {1219964400 7200 0 EET}
+ {1219957200 7200 0 EET}
{1238104800 10800 1 EEST}
{1252018800 7200 0 EET}
{1269640860 10800 1 EEST}
{1281474000 7200 0 EET}
- {1283472000 7200 0 EET}
- {1301090460 10800 1 EEST}
- {1314918000 7200 0 EET}
- {1333144860 10800 1 EEST}
- {1346972400 7200 0 EET}
- {1364594460 10800 1 EEST}
- {1378422000 7200 0 EET}
- {1396044060 10800 1 EEST}
- {1409871600 7200 0 EET}
- {1427493660 10800 1 EEST}
- {1441321200 7200 0 EET}
- {1458943260 10800 1 EEST}
- {1472770800 7200 0 EET}
- {1490392860 10800 1 EEST}
- {1504220400 7200 0 EET}
- {1522447260 10800 1 EEST}
- {1536274800 7200 0 EET}
- {1553896860 10800 1 EEST}
- {1567724400 7200 0 EET}
- {1585346460 10800 1 EEST}
- {1599174000 7200 0 EET}
- {1616796060 10800 1 EEST}
- {1630623600 7200 0 EET}
- {1648245660 10800 1 EEST}
- {1662073200 7200 0 EET}
- {1679695260 10800 1 EEST}
- {1693522800 7200 0 EET}
- {1711749660 10800 1 EEST}
- {1725577200 7200 0 EET}
- {1743199260 10800 1 EEST}
- {1757026800 7200 0 EET}
- {1774648860 10800 1 EEST}
- {1788476400 7200 0 EET}
- {1806098460 10800 1 EEST}
- {1819926000 7200 0 EET}
- {1837548060 10800 1 EEST}
- {1851375600 7200 0 EET}
- {1869602460 10800 1 EEST}
- {1883430000 7200 0 EET}
- {1901052060 10800 1 EEST}
- {1914879600 7200 0 EET}
- {1932501660 10800 1 EEST}
- {1946329200 7200 0 EET}
- {1963951260 10800 1 EEST}
- {1977778800 7200 0 EET}
- {1995400860 10800 1 EEST}
- {2009228400 7200 0 EET}
- {2026850460 10800 1 EEST}
- {2040678000 7200 0 EET}
- {2058904860 10800 1 EEST}
- {2072732400 7200 0 EET}
- {2090354460 10800 1 EEST}
- {2104182000 7200 0 EET}
- {2121804060 10800 1 EEST}
- {2135631600 7200 0 EET}
- {2153253660 10800 1 EEST}
- {2167081200 7200 0 EET}
- {2184703260 10800 1 EEST}
- {2198530800 7200 0 EET}
- {2216757660 10800 1 EEST}
- {2230585200 7200 0 EET}
- {2248207260 10800 1 EEST}
- {2262034800 7200 0 EET}
- {2279656860 10800 1 EEST}
- {2293484400 7200 0 EET}
- {2311106460 10800 1 EEST}
- {2324934000 7200 0 EET}
- {2342556060 10800 1 EEST}
- {2356383600 7200 0 EET}
- {2374005660 10800 1 EEST}
- {2387833200 7200 0 EET}
- {2406060060 10800 1 EEST}
- {2419887600 7200 0 EET}
- {2437509660 10800 1 EEST}
- {2451337200 7200 0 EET}
- {2468959260 10800 1 EEST}
- {2482786800 7200 0 EET}
- {2500408860 10800 1 EEST}
- {2514236400 7200 0 EET}
- {2531858460 10800 1 EEST}
- {2545686000 7200 0 EET}
- {2563308060 10800 1 EEST}
- {2577135600 7200 0 EET}
- {2595362460 10800 1 EEST}
- {2609190000 7200 0 EET}
- {2626812060 10800 1 EEST}
- {2640639600 7200 0 EET}
- {2658261660 10800 1 EEST}
- {2672089200 7200 0 EET}
- {2689711260 10800 1 EEST}
- {2703538800 7200 0 EET}
- {2721160860 10800 1 EEST}
- {2734988400 7200 0 EET}
- {2753215260 10800 1 EEST}
- {2767042800 7200 0 EET}
- {2784664860 10800 1 EEST}
- {2798492400 7200 0 EET}
- {2816114460 10800 1 EEST}
- {2829942000 7200 0 EET}
- {2847564060 10800 1 EEST}
- {2861391600 7200 0 EET}
- {2879013660 10800 1 EEST}
- {2892841200 7200 0 EET}
- {2910463260 10800 1 EEST}
- {2924290800 7200 0 EET}
- {2942517660 10800 1 EEST}
- {2956345200 7200 0 EET}
- {2973967260 10800 1 EEST}
- {2987794800 7200 0 EET}
- {3005416860 10800 1 EEST}
- {3019244400 7200 0 EET}
- {3036866460 10800 1 EEST}
- {3050694000 7200 0 EET}
- {3068316060 10800 1 EEST}
- {3082143600 7200 0 EET}
- {3100370460 10800 1 EEST}
- {3114198000 7200 0 EET}
- {3131820060 10800 1 EEST}
- {3145647600 7200 0 EET}
- {3163269660 10800 1 EEST}
- {3177097200 7200 0 EET}
- {3194719260 10800 1 EEST}
- {3208546800 7200 0 EET}
- {3226168860 10800 1 EEST}
- {3239996400 7200 0 EET}
- {3257618460 10800 1 EEST}
- {3271446000 7200 0 EET}
- {3289672860 10800 1 EEST}
- {3303500400 7200 0 EET}
- {3321122460 10800 1 EEST}
- {3334950000 7200 0 EET}
- {3352572060 10800 1 EEST}
- {3366399600 7200 0 EET}
- {3384021660 10800 1 EEST}
- {3397849200 7200 0 EET}
- {3415471260 10800 1 EEST}
- {3429298800 7200 0 EET}
- {3446920860 10800 1 EEST}
- {3460748400 7200 0 EET}
- {3478975260 10800 1 EEST}
- {3492802800 7200 0 EET}
- {3510424860 10800 1 EEST}
- {3524252400 7200 0 EET}
- {3541874460 10800 1 EEST}
- {3555702000 7200 0 EET}
- {3573324060 10800 1 EEST}
- {3587151600 7200 0 EET}
- {3604773660 10800 1 EEST}
- {3618601200 7200 0 EET}
- {3636828060 10800 1 EEST}
- {3650655600 7200 0 EET}
- {3668277660 10800 1 EEST}
- {3682105200 7200 0 EET}
- {3699727260 10800 1 EEST}
- {3713554800 7200 0 EET}
- {3731176860 10800 1 EEST}
- {3745004400 7200 0 EET}
- {3762626460 10800 1 EEST}
- {3776454000 7200 0 EET}
- {3794076060 10800 1 EEST}
- {3807903600 7200 0 EET}
- {3826130460 10800 1 EEST}
- {3839958000 7200 0 EET}
- {3857580060 10800 1 EEST}
- {3871407600 7200 0 EET}
- {3889029660 10800 1 EEST}
- {3902857200 7200 0 EET}
- {3920479260 10800 1 EEST}
- {3934306800 7200 0 EET}
- {3951928860 10800 1 EEST}
- {3965756400 7200 0 EET}
- {3983983260 10800 1 EEST}
- {3997810800 7200 0 EET}
- {4015432860 10800 1 EEST}
- {4029260400 7200 0 EET}
- {4046882460 10800 1 EEST}
- {4060710000 7200 0 EET}
- {4078332060 10800 1 EEST}
- {4092159600 7200 0 EET}
+ {1301738460 10800 1 EEST}
+ {1312146000 7200 0 EET}
+ {1333058400 10800 1 EEST}
+ {1348178400 7200 0 EET}
}
diff --git a/library/tzdata/Asia/Hebron b/library/tzdata/Asia/Hebron
new file mode 100644
index 0000000..98bb353
--- /dev/null
+++ b/library/tzdata/Asia/Hebron
@@ -0,0 +1,104 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Asia/Hebron) {
+ {-9223372036854775808 8423 0 LMT}
+ {-2185410023 7200 0 EET}
+ {-933645600 10800 1 EET}
+ {-857358000 7200 0 EET}
+ {-844300800 10800 1 EET}
+ {-825822000 7200 0 EET}
+ {-812685600 10800 1 EET}
+ {-794199600 7200 0 EET}
+ {-779853600 10800 1 EET}
+ {-762656400 7200 0 EET}
+ {-748310400 10800 1 EET}
+ {-731127600 7200 0 EET}
+ {-682653600 7200 0 EET}
+ {-399088800 10800 1 EEST}
+ {-386650800 7200 0 EET}
+ {-368330400 10800 1 EEST}
+ {-355114800 7200 0 EET}
+ {-336790800 10800 1 EEST}
+ {-323654400 7200 0 EET}
+ {-305168400 10800 1 EEST}
+ {-292032000 7200 0 EET}
+ {-273632400 10800 1 EEST}
+ {-260496000 7200 0 EET}
+ {-242096400 10800 1 EEST}
+ {-228960000 7200 0 EET}
+ {-210560400 10800 1 EEST}
+ {-197424000 7200 0 EET}
+ {-178938000 10800 1 EEST}
+ {-165801600 7200 0 EET}
+ {-147402000 10800 1 EEST}
+ {-134265600 7200 0 EET}
+ {-115866000 10800 1 EEST}
+ {-102643200 7200 0 EET}
+ {-84330000 10800 1 EEST}
+ {-81313200 10800 0 IST}
+ {142376400 10800 1 IDT}
+ {150843600 7200 0 IST}
+ {167176800 10800 1 IDT}
+ {178664400 7200 0 IST}
+ {482277600 10800 1 IDT}
+ {495579600 7200 0 IST}
+ {516751200 10800 1 IDT}
+ {526424400 7200 0 IST}
+ {545436000 10800 1 IDT}
+ {558478800 7200 0 IST}
+ {576540000 10800 1 IDT}
+ {589237200 7200 0 IST}
+ {609890400 10800 1 IDT}
+ {620773200 7200 0 IST}
+ {638316000 10800 1 IDT}
+ {651618000 7200 0 IST}
+ {669765600 10800 1 IDT}
+ {683672400 7200 0 IST}
+ {701820000 10800 1 IDT}
+ {715726800 7200 0 IST}
+ {733701600 10800 1 IDT}
+ {747176400 7200 0 IST}
+ {765151200 10800 1 IDT}
+ {778021200 7200 0 IST}
+ {796600800 10800 1 IDT}
+ {810075600 7200 0 IST}
+ {820447200 7200 0 EET}
+ {828655200 10800 1 EEST}
+ {843170400 7200 0 EET}
+ {860104800 10800 1 EEST}
+ {874620000 7200 0 EET}
+ {891554400 10800 1 EEST}
+ {906069600 7200 0 EET}
+ {915141600 7200 0 EET}
+ {924213600 10800 1 EEST}
+ {939934800 7200 0 EET}
+ {956268000 10800 1 EEST}
+ {971989200 7200 0 EET}
+ {987717600 10800 1 EEST}
+ {1003438800 7200 0 EET}
+ {1019167200 10800 1 EEST}
+ {1034888400 7200 0 EET}
+ {1050616800 10800 1 EEST}
+ {1066338000 7200 0 EET}
+ {1082066400 10800 1 EEST}
+ {1096581600 7200 0 EET}
+ {1113516000 10800 1 EEST}
+ {1128380400 7200 0 EET}
+ {1143842400 10800 1 EEST}
+ {1158872400 7200 0 EET}
+ {1175378400 10800 1 EEST}
+ {1189638000 7200 0 EET}
+ {1207000800 10800 1 EEST}
+ {1217541600 10800 1 EEST}
+ {1220216400 7200 0 EET}
+ {1238104800 10800 1 EEST}
+ {1252018800 7200 0 EET}
+ {1269640860 10800 1 EEST}
+ {1281474000 7200 0 EET}
+ {1301652060 10800 1 EEST}
+ {1312146000 7200 0 EET}
+ {1314655200 10800 1 EEST}
+ {1317340800 7200 0 EET}
+ {1333058400 10800 1 EEST}
+ {1348178400 7200 0 EET}
+}
diff --git a/library/tzdata/Asia/Hong_Kong b/library/tzdata/Asia/Hong_Kong
index 8304a62..928cde6 100644
--- a/library/tzdata/Asia/Hong_Kong
+++ b/library/tzdata/Asia/Hong_Kong
@@ -70,8 +70,6 @@ set TZData(:Asia/Hong_Kong) {
{182889000 28800 0 HKT}
{198617400 32400 1 HKST}
{214338600 28800 0 HKT}
- {230067000 32400 1 HKST}
- {245788200 28800 0 HKT}
{295385400 32400 1 HKST}
{309292200 28800 0 HKT}
}
diff --git a/library/tzdata/Asia/Irkutsk b/library/tzdata/Asia/Irkutsk
index 771ebc9..bca1dcc 100644
--- a/library/tzdata/Asia/Irkutsk
+++ b/library/tzdata/Asia/Irkutsk
@@ -67,182 +67,5 @@ set TZData(:Asia/Irkutsk) {
{1256407200 28800 0 IRKT}
{1269712800 32400 1 IRKST}
{1288461600 28800 0 IRKT}
- {1301162400 32400 1 IRKST}
- {1319911200 28800 0 IRKT}
- {1332612000 32400 1 IRKST}
- {1351360800 28800 0 IRKT}
- {1364666400 32400 1 IRKST}
- {1382810400 28800 0 IRKT}
- {1396116000 32400 1 IRKST}
- {1414260000 28800 0 IRKT}
- {1427565600 32400 1 IRKST}
- {1445709600 28800 0 IRKT}
- {1459015200 32400 1 IRKST}
- {1477764000 28800 0 IRKT}
- {1490464800 32400 1 IRKST}
- {1509213600 28800 0 IRKT}
- {1521914400 32400 1 IRKST}
- {1540663200 28800 0 IRKT}
- {1553968800 32400 1 IRKST}
- {1572112800 28800 0 IRKT}
- {1585418400 32400 1 IRKST}
- {1603562400 28800 0 IRKT}
- {1616868000 32400 1 IRKST}
- {1635616800 28800 0 IRKT}
- {1648317600 32400 1 IRKST}
- {1667066400 28800 0 IRKT}
- {1679767200 32400 1 IRKST}
- {1698516000 28800 0 IRKT}
- {1711821600 32400 1 IRKST}
- {1729965600 28800 0 IRKT}
- {1743271200 32400 1 IRKST}
- {1761415200 28800 0 IRKT}
- {1774720800 32400 1 IRKST}
- {1792864800 28800 0 IRKT}
- {1806170400 32400 1 IRKST}
- {1824919200 28800 0 IRKT}
- {1837620000 32400 1 IRKST}
- {1856368800 28800 0 IRKT}
- {1869069600 32400 1 IRKST}
- {1887818400 28800 0 IRKT}
- {1901124000 32400 1 IRKST}
- {1919268000 28800 0 IRKT}
- {1932573600 32400 1 IRKST}
- {1950717600 28800 0 IRKT}
- {1964023200 32400 1 IRKST}
- {1982772000 28800 0 IRKT}
- {1995472800 32400 1 IRKST}
- {2014221600 28800 0 IRKT}
- {2026922400 32400 1 IRKST}
- {2045671200 28800 0 IRKT}
- {2058372000 32400 1 IRKST}
- {2077120800 28800 0 IRKT}
- {2090426400 32400 1 IRKST}
- {2108570400 28800 0 IRKT}
- {2121876000 32400 1 IRKST}
- {2140020000 28800 0 IRKT}
- {2153325600 32400 1 IRKST}
- {2172074400 28800 0 IRKT}
- {2184775200 32400 1 IRKST}
- {2203524000 28800 0 IRKT}
- {2216224800 32400 1 IRKST}
- {2234973600 28800 0 IRKT}
- {2248279200 32400 1 IRKST}
- {2266423200 28800 0 IRKT}
- {2279728800 32400 1 IRKST}
- {2297872800 28800 0 IRKT}
- {2311178400 32400 1 IRKST}
- {2329322400 28800 0 IRKT}
- {2342628000 32400 1 IRKST}
- {2361376800 28800 0 IRKT}
- {2374077600 32400 1 IRKST}
- {2392826400 28800 0 IRKT}
- {2405527200 32400 1 IRKST}
- {2424276000 28800 0 IRKT}
- {2437581600 32400 1 IRKST}
- {2455725600 28800 0 IRKT}
- {2469031200 32400 1 IRKST}
- {2487175200 28800 0 IRKT}
- {2500480800 32400 1 IRKST}
- {2519229600 28800 0 IRKT}
- {2531930400 32400 1 IRKST}
- {2550679200 28800 0 IRKT}
- {2563380000 32400 1 IRKST}
- {2582128800 28800 0 IRKT}
- {2595434400 32400 1 IRKST}
- {2613578400 28800 0 IRKT}
- {2626884000 32400 1 IRKST}
- {2645028000 28800 0 IRKT}
- {2658333600 32400 1 IRKST}
- {2676477600 28800 0 IRKT}
- {2689783200 32400 1 IRKST}
- {2708532000 28800 0 IRKT}
- {2721232800 32400 1 IRKST}
- {2739981600 28800 0 IRKT}
- {2752682400 32400 1 IRKST}
- {2771431200 28800 0 IRKT}
- {2784736800 32400 1 IRKST}
- {2802880800 28800 0 IRKT}
- {2816186400 32400 1 IRKST}
- {2834330400 28800 0 IRKT}
- {2847636000 32400 1 IRKST}
- {2866384800 28800 0 IRKT}
- {2879085600 32400 1 IRKST}
- {2897834400 28800 0 IRKT}
- {2910535200 32400 1 IRKST}
- {2929284000 28800 0 IRKT}
- {2941984800 32400 1 IRKST}
- {2960733600 28800 0 IRKT}
- {2974039200 32400 1 IRKST}
- {2992183200 28800 0 IRKT}
- {3005488800 32400 1 IRKST}
- {3023632800 28800 0 IRKT}
- {3036938400 32400 1 IRKST}
- {3055687200 28800 0 IRKT}
- {3068388000 32400 1 IRKST}
- {3087136800 28800 0 IRKT}
- {3099837600 32400 1 IRKST}
- {3118586400 28800 0 IRKT}
- {3131892000 32400 1 IRKST}
- {3150036000 28800 0 IRKT}
- {3163341600 32400 1 IRKST}
- {3181485600 28800 0 IRKT}
- {3194791200 32400 1 IRKST}
- {3212935200 28800 0 IRKT}
- {3226240800 32400 1 IRKST}
- {3244989600 28800 0 IRKT}
- {3257690400 32400 1 IRKST}
- {3276439200 28800 0 IRKT}
- {3289140000 32400 1 IRKST}
- {3307888800 28800 0 IRKT}
- {3321194400 32400 1 IRKST}
- {3339338400 28800 0 IRKT}
- {3352644000 32400 1 IRKST}
- {3370788000 28800 0 IRKT}
- {3384093600 32400 1 IRKST}
- {3402842400 28800 0 IRKT}
- {3415543200 32400 1 IRKST}
- {3434292000 28800 0 IRKT}
- {3446992800 32400 1 IRKST}
- {3465741600 28800 0 IRKT}
- {3479047200 32400 1 IRKST}
- {3497191200 28800 0 IRKT}
- {3510496800 32400 1 IRKST}
- {3528640800 28800 0 IRKT}
- {3541946400 32400 1 IRKST}
- {3560090400 28800 0 IRKT}
- {3573396000 32400 1 IRKST}
- {3592144800 28800 0 IRKT}
- {3604845600 32400 1 IRKST}
- {3623594400 28800 0 IRKT}
- {3636295200 32400 1 IRKST}
- {3655044000 28800 0 IRKT}
- {3668349600 32400 1 IRKST}
- {3686493600 28800 0 IRKT}
- {3699799200 32400 1 IRKST}
- {3717943200 28800 0 IRKT}
- {3731248800 32400 1 IRKST}
- {3749997600 28800 0 IRKT}
- {3762698400 32400 1 IRKST}
- {3781447200 28800 0 IRKT}
- {3794148000 32400 1 IRKST}
- {3812896800 28800 0 IRKT}
- {3825597600 32400 1 IRKST}
- {3844346400 28800 0 IRKT}
- {3857652000 32400 1 IRKST}
- {3875796000 28800 0 IRKT}
- {3889101600 32400 1 IRKST}
- {3907245600 28800 0 IRKT}
- {3920551200 32400 1 IRKST}
- {3939300000 28800 0 IRKT}
- {3952000800 32400 1 IRKST}
- {3970749600 28800 0 IRKT}
- {3983450400 32400 1 IRKST}
- {4002199200 28800 0 IRKT}
- {4015504800 32400 1 IRKST}
- {4033648800 28800 0 IRKT}
- {4046954400 32400 1 IRKST}
- {4065098400 28800 0 IRKT}
- {4078404000 32400 1 IRKST}
- {4096548000 28800 0 IRKT}
+ {1301162400 32400 0 IRKT}
}
diff --git a/library/tzdata/Asia/Jerusalem b/library/tzdata/Asia/Jerusalem
index 48e213d..613eadd 100644
--- a/library/tzdata/Asia/Jerusalem
+++ b/library/tzdata/Asia/Jerusalem
@@ -96,53 +96,177 @@ set TZData(:Asia/Jerusalem) {
{1333065600 10800 1 IDT}
{1348354800 7200 0 IST}
{1364515200 10800 1 IDT}
- {1378594800 7200 0 IST}
+ {1381014000 7200 0 IST}
{1395964800 10800 1 IDT}
- {1411858800 7200 0 IST}
+ {1412463600 7200 0 IST}
{1427414400 10800 1 IDT}
- {1442703600 7200 0 IST}
- {1459468800 10800 1 IDT}
- {1475967600 7200 0 IST}
- {1490918400 10800 1 IDT}
- {1506207600 7200 0 IST}
- {1522368000 10800 1 IDT}
- {1537052400 7200 0 IST}
+ {1443913200 7200 0 IST}
+ {1458864000 10800 1 IDT}
+ {1475362800 7200 0 IST}
+ {1490313600 10800 1 IDT}
+ {1507417200 7200 0 IST}
+ {1521763200 10800 1 IDT}
+ {1538866800 7200 0 IST}
{1553817600 10800 1 IDT}
{1570316400 7200 0 IST}
{1585267200 10800 1 IDT}
- {1601161200 7200 0 IST}
+ {1601766000 7200 0 IST}
{1616716800 10800 1 IDT}
- {1631401200 7200 0 IST}
- {1648771200 10800 1 IDT}
+ {1633215600 7200 0 IST}
+ {1648166400 10800 1 IDT}
{1664665200 7200 0 IST}
- {1680220800 10800 1 IDT}
- {1695510000 7200 0 IST}
+ {1679616000 10800 1 IDT}
+ {1696719600 7200 0 IST}
{1711670400 10800 1 IDT}
{1728169200 7200 0 IST}
{1743120000 10800 1 IDT}
- {1759014000 7200 0 IST}
+ {1759618800 7200 0 IST}
{1774569600 10800 1 IDT}
- {1789858800 7200 0 IST}
+ {1791068400 7200 0 IST}
{1806019200 10800 1 IDT}
- {1823122800 7200 0 IST}
- {1838073600 10800 1 IDT}
- {1853362800 7200 0 IST}
- {1869523200 10800 1 IDT}
- {1884207600 7200 0 IST}
+ {1822604400 7200 0 IST}
+ {1837468800 10800 1 IDT}
+ {1854572400 7200 0 IST}
+ {1868918400 10800 1 IDT}
+ {1886022000 7200 0 IST}
{1900972800 10800 1 IDT}
{1917471600 7200 0 IST}
{1932422400 10800 1 IDT}
- {1947711600 7200 0 IST}
+ {1948921200 7200 0 IST}
{1963872000 10800 1 IDT}
- {1978556400 7200 0 IST}
- {1995926400 10800 1 IDT}
+ {1980370800 7200 0 IST}
+ {1995321600 10800 1 IDT}
{2011820400 7200 0 IST}
- {2027376000 10800 1 IDT}
- {2042060400 7200 0 IST}
- {2058825600 10800 1 IDT}
+ {2026771200 10800 1 IDT}
+ {2043874800 7200 0 IST}
+ {2058220800 10800 1 IDT}
{2075324400 7200 0 IST}
{2090275200 10800 1 IDT}
- {2106169200 7200 0 IST}
+ {2106774000 7200 0 IST}
{2121724800 10800 1 IDT}
- {2136409200 7200 0 IST}
+ {2138223600 7200 0 IST}
+ {2153174400 10800 1 IDT}
+ {2169673200 7200 0 IST}
+ {2184624000 10800 1 IDT}
+ {2201122800 7200 0 IST}
+ {2216073600 10800 1 IDT}
+ {2233177200 7200 0 IST}
+ {2248128000 10800 1 IDT}
+ {2264626800 7200 0 IST}
+ {2279577600 10800 1 IDT}
+ {2296076400 7200 0 IST}
+ {2311027200 10800 1 IDT}
+ {2327526000 7200 0 IST}
+ {2342476800 10800 1 IDT}
+ {2358975600 7200 0 IST}
+ {2373926400 10800 1 IDT}
+ {2391030000 7200 0 IST}
+ {2405376000 10800 1 IDT}
+ {2422479600 7200 0 IST}
+ {2437430400 10800 1 IDT}
+ {2453929200 7200 0 IST}
+ {2468880000 10800 1 IDT}
+ {2485378800 7200 0 IST}
+ {2500329600 10800 1 IDT}
+ {2516828400 7200 0 IST}
+ {2531779200 10800 1 IDT}
+ {2548278000 7200 0 IST}
+ {2563228800 10800 1 IDT}
+ {2580332400 7200 0 IST}
+ {2595283200 10800 1 IDT}
+ {2611782000 7200 0 IST}
+ {2626732800 10800 1 IDT}
+ {2643231600 7200 0 IST}
+ {2658182400 10800 1 IDT}
+ {2674681200 7200 0 IST}
+ {2689632000 10800 1 IDT}
+ {2706130800 7200 0 IST}
+ {2721081600 10800 1 IDT}
+ {2738185200 7200 0 IST}
+ {2752531200 10800 1 IDT}
+ {2769634800 7200 0 IST}
+ {2784585600 10800 1 IDT}
+ {2801084400 7200 0 IST}
+ {2816035200 10800 1 IDT}
+ {2832534000 7200 0 IST}
+ {2847484800 10800 1 IDT}
+ {2863983600 7200 0 IST}
+ {2878934400 10800 1 IDT}
+ {2895433200 7200 0 IST}
+ {2910384000 10800 1 IDT}
+ {2927487600 7200 0 IST}
+ {2941833600 10800 1 IDT}
+ {2958937200 7200 0 IST}
+ {2973888000 10800 1 IDT}
+ {2990386800 7200 0 IST}
+ {3005337600 10800 1 IDT}
+ {3021836400 7200 0 IST}
+ {3036787200 10800 1 IDT}
+ {3053286000 7200 0 IST}
+ {3068236800 10800 1 IDT}
+ {3084735600 7200 0 IST}
+ {3099686400 10800 1 IDT}
+ {3116790000 7200 0 IST}
+ {3131740800 10800 1 IDT}
+ {3148239600 7200 0 IST}
+ {3163190400 10800 1 IDT}
+ {3179689200 7200 0 IST}
+ {3194640000 10800 1 IDT}
+ {3211138800 7200 0 IST}
+ {3226089600 10800 1 IDT}
+ {3242588400 7200 0 IST}
+ {3257539200 10800 1 IDT}
+ {3274642800 7200 0 IST}
+ {3288988800 10800 1 IDT}
+ {3306092400 7200 0 IST}
+ {3321043200 10800 1 IDT}
+ {3337542000 7200 0 IST}
+ {3352492800 10800 1 IDT}
+ {3368991600 7200 0 IST}
+ {3383942400 10800 1 IDT}
+ {3400441200 7200 0 IST}
+ {3415392000 10800 1 IDT}
+ {3431890800 7200 0 IST}
+ {3446841600 10800 1 IDT}
+ {3463945200 7200 0 IST}
+ {3478896000 10800 1 IDT}
+ {3495394800 7200 0 IST}
+ {3510345600 10800 1 IDT}
+ {3526844400 7200 0 IST}
+ {3541795200 10800 1 IDT}
+ {3558294000 7200 0 IST}
+ {3573244800 10800 1 IDT}
+ {3589743600 7200 0 IST}
+ {3604694400 10800 1 IDT}
+ {3621798000 7200 0 IST}
+ {3636144000 10800 1 IDT}
+ {3653247600 7200 0 IST}
+ {3668198400 10800 1 IDT}
+ {3684697200 7200 0 IST}
+ {3699648000 10800 1 IDT}
+ {3716146800 7200 0 IST}
+ {3731097600 10800 1 IDT}
+ {3747596400 7200 0 IST}
+ {3762547200 10800 1 IDT}
+ {3779046000 7200 0 IST}
+ {3793996800 10800 1 IDT}
+ {3811100400 7200 0 IST}
+ {3825446400 10800 1 IDT}
+ {3842550000 7200 0 IST}
+ {3857500800 10800 1 IDT}
+ {3873999600 7200 0 IST}
+ {3888950400 10800 1 IDT}
+ {3905449200 7200 0 IST}
+ {3920400000 10800 1 IDT}
+ {3936898800 7200 0 IST}
+ {3951849600 10800 1 IDT}
+ {3968348400 7200 0 IST}
+ {3983299200 10800 1 IDT}
+ {4000402800 7200 0 IST}
+ {4015353600 10800 1 IDT}
+ {4031852400 7200 0 IST}
+ {4046803200 10800 1 IDT}
+ {4063302000 7200 0 IST}
+ {4078252800 10800 1 IDT}
+ {4094751600 7200 0 IST}
}
diff --git a/library/tzdata/Asia/Kamchatka b/library/tzdata/Asia/Kamchatka
index 7a3c908..82abcfa 100644
--- a/library/tzdata/Asia/Kamchatka
+++ b/library/tzdata/Asia/Kamchatka
@@ -67,182 +67,5 @@ set TZData(:Asia/Kamchatka) {
{1269698400 39600 0 PETMMTT}
{1269702000 43200 1 PETST}
{1288450800 39600 0 PETT}
- {1301151600 43200 1 PETST}
- {1319900400 39600 0 PETT}
- {1332601200 43200 1 PETST}
- {1351350000 39600 0 PETT}
- {1364655600 43200 1 PETST}
- {1382799600 39600 0 PETT}
- {1396105200 43200 1 PETST}
- {1414249200 39600 0 PETT}
- {1427554800 43200 1 PETST}
- {1445698800 39600 0 PETT}
- {1459004400 43200 1 PETST}
- {1477753200 39600 0 PETT}
- {1490454000 43200 1 PETST}
- {1509202800 39600 0 PETT}
- {1521903600 43200 1 PETST}
- {1540652400 39600 0 PETT}
- {1553958000 43200 1 PETST}
- {1572102000 39600 0 PETT}
- {1585407600 43200 1 PETST}
- {1603551600 39600 0 PETT}
- {1616857200 43200 1 PETST}
- {1635606000 39600 0 PETT}
- {1648306800 43200 1 PETST}
- {1667055600 39600 0 PETT}
- {1679756400 43200 1 PETST}
- {1698505200 39600 0 PETT}
- {1711810800 43200 1 PETST}
- {1729954800 39600 0 PETT}
- {1743260400 43200 1 PETST}
- {1761404400 39600 0 PETT}
- {1774710000 43200 1 PETST}
- {1792854000 39600 0 PETT}
- {1806159600 43200 1 PETST}
- {1824908400 39600 0 PETT}
- {1837609200 43200 1 PETST}
- {1856358000 39600 0 PETT}
- {1869058800 43200 1 PETST}
- {1887807600 39600 0 PETT}
- {1901113200 43200 1 PETST}
- {1919257200 39600 0 PETT}
- {1932562800 43200 1 PETST}
- {1950706800 39600 0 PETT}
- {1964012400 43200 1 PETST}
- {1982761200 39600 0 PETT}
- {1995462000 43200 1 PETST}
- {2014210800 39600 0 PETT}
- {2026911600 43200 1 PETST}
- {2045660400 39600 0 PETT}
- {2058361200 43200 1 PETST}
- {2077110000 39600 0 PETT}
- {2090415600 43200 1 PETST}
- {2108559600 39600 0 PETT}
- {2121865200 43200 1 PETST}
- {2140009200 39600 0 PETT}
- {2153314800 43200 1 PETST}
- {2172063600 39600 0 PETT}
- {2184764400 43200 1 PETST}
- {2203513200 39600 0 PETT}
- {2216214000 43200 1 PETST}
- {2234962800 39600 0 PETT}
- {2248268400 43200 1 PETST}
- {2266412400 39600 0 PETT}
- {2279718000 43200 1 PETST}
- {2297862000 39600 0 PETT}
- {2311167600 43200 1 PETST}
- {2329311600 39600 0 PETT}
- {2342617200 43200 1 PETST}
- {2361366000 39600 0 PETT}
- {2374066800 43200 1 PETST}
- {2392815600 39600 0 PETT}
- {2405516400 43200 1 PETST}
- {2424265200 39600 0 PETT}
- {2437570800 43200 1 PETST}
- {2455714800 39600 0 PETT}
- {2469020400 43200 1 PETST}
- {2487164400 39600 0 PETT}
- {2500470000 43200 1 PETST}
- {2519218800 39600 0 PETT}
- {2531919600 43200 1 PETST}
- {2550668400 39600 0 PETT}
- {2563369200 43200 1 PETST}
- {2582118000 39600 0 PETT}
- {2595423600 43200 1 PETST}
- {2613567600 39600 0 PETT}
- {2626873200 43200 1 PETST}
- {2645017200 39600 0 PETT}
- {2658322800 43200 1 PETST}
- {2676466800 39600 0 PETT}
- {2689772400 43200 1 PETST}
- {2708521200 39600 0 PETT}
- {2721222000 43200 1 PETST}
- {2739970800 39600 0 PETT}
- {2752671600 43200 1 PETST}
- {2771420400 39600 0 PETT}
- {2784726000 43200 1 PETST}
- {2802870000 39600 0 PETT}
- {2816175600 43200 1 PETST}
- {2834319600 39600 0 PETT}
- {2847625200 43200 1 PETST}
- {2866374000 39600 0 PETT}
- {2879074800 43200 1 PETST}
- {2897823600 39600 0 PETT}
- {2910524400 43200 1 PETST}
- {2929273200 39600 0 PETT}
- {2941974000 43200 1 PETST}
- {2960722800 39600 0 PETT}
- {2974028400 43200 1 PETST}
- {2992172400 39600 0 PETT}
- {3005478000 43200 1 PETST}
- {3023622000 39600 0 PETT}
- {3036927600 43200 1 PETST}
- {3055676400 39600 0 PETT}
- {3068377200 43200 1 PETST}
- {3087126000 39600 0 PETT}
- {3099826800 43200 1 PETST}
- {3118575600 39600 0 PETT}
- {3131881200 43200 1 PETST}
- {3150025200 39600 0 PETT}
- {3163330800 43200 1 PETST}
- {3181474800 39600 0 PETT}
- {3194780400 43200 1 PETST}
- {3212924400 39600 0 PETT}
- {3226230000 43200 1 PETST}
- {3244978800 39600 0 PETT}
- {3257679600 43200 1 PETST}
- {3276428400 39600 0 PETT}
- {3289129200 43200 1 PETST}
- {3307878000 39600 0 PETT}
- {3321183600 43200 1 PETST}
- {3339327600 39600 0 PETT}
- {3352633200 43200 1 PETST}
- {3370777200 39600 0 PETT}
- {3384082800 43200 1 PETST}
- {3402831600 39600 0 PETT}
- {3415532400 43200 1 PETST}
- {3434281200 39600 0 PETT}
- {3446982000 43200 1 PETST}
- {3465730800 39600 0 PETT}
- {3479036400 43200 1 PETST}
- {3497180400 39600 0 PETT}
- {3510486000 43200 1 PETST}
- {3528630000 39600 0 PETT}
- {3541935600 43200 1 PETST}
- {3560079600 39600 0 PETT}
- {3573385200 43200 1 PETST}
- {3592134000 39600 0 PETT}
- {3604834800 43200 1 PETST}
- {3623583600 39600 0 PETT}
- {3636284400 43200 1 PETST}
- {3655033200 39600 0 PETT}
- {3668338800 43200 1 PETST}
- {3686482800 39600 0 PETT}
- {3699788400 43200 1 PETST}
- {3717932400 39600 0 PETT}
- {3731238000 43200 1 PETST}
- {3749986800 39600 0 PETT}
- {3762687600 43200 1 PETST}
- {3781436400 39600 0 PETT}
- {3794137200 43200 1 PETST}
- {3812886000 39600 0 PETT}
- {3825586800 43200 1 PETST}
- {3844335600 39600 0 PETT}
- {3857641200 43200 1 PETST}
- {3875785200 39600 0 PETT}
- {3889090800 43200 1 PETST}
- {3907234800 39600 0 PETT}
- {3920540400 43200 1 PETST}
- {3939289200 39600 0 PETT}
- {3951990000 43200 1 PETST}
- {3970738800 39600 0 PETT}
- {3983439600 43200 1 PETST}
- {4002188400 39600 0 PETT}
- {4015494000 43200 1 PETST}
- {4033638000 39600 0 PETT}
- {4046943600 43200 1 PETST}
- {4065087600 39600 0 PETT}
- {4078393200 43200 1 PETST}
- {4096537200 39600 0 PETT}
+ {1301151600 43200 0 PETT}
}
diff --git a/library/tzdata/Asia/Krasnoyarsk b/library/tzdata/Asia/Krasnoyarsk
index 24046fe..13dfeb5 100644
--- a/library/tzdata/Asia/Krasnoyarsk
+++ b/library/tzdata/Asia/Krasnoyarsk
@@ -66,182 +66,5 @@ set TZData(:Asia/Krasnoyarsk) {
{1256410800 25200 0 KRAT}
{1269716400 28800 1 KRAST}
{1288465200 25200 0 KRAT}
- {1301166000 28800 1 KRAST}
- {1319914800 25200 0 KRAT}
- {1332615600 28800 1 KRAST}
- {1351364400 25200 0 KRAT}
- {1364670000 28800 1 KRAST}
- {1382814000 25200 0 KRAT}
- {1396119600 28800 1 KRAST}
- {1414263600 25200 0 KRAT}
- {1427569200 28800 1 KRAST}
- {1445713200 25200 0 KRAT}
- {1459018800 28800 1 KRAST}
- {1477767600 25200 0 KRAT}
- {1490468400 28800 1 KRAST}
- {1509217200 25200 0 KRAT}
- {1521918000 28800 1 KRAST}
- {1540666800 25200 0 KRAT}
- {1553972400 28800 1 KRAST}
- {1572116400 25200 0 KRAT}
- {1585422000 28800 1 KRAST}
- {1603566000 25200 0 KRAT}
- {1616871600 28800 1 KRAST}
- {1635620400 25200 0 KRAT}
- {1648321200 28800 1 KRAST}
- {1667070000 25200 0 KRAT}
- {1679770800 28800 1 KRAST}
- {1698519600 25200 0 KRAT}
- {1711825200 28800 1 KRAST}
- {1729969200 25200 0 KRAT}
- {1743274800 28800 1 KRAST}
- {1761418800 25200 0 KRAT}
- {1774724400 28800 1 KRAST}
- {1792868400 25200 0 KRAT}
- {1806174000 28800 1 KRAST}
- {1824922800 25200 0 KRAT}
- {1837623600 28800 1 KRAST}
- {1856372400 25200 0 KRAT}
- {1869073200 28800 1 KRAST}
- {1887822000 25200 0 KRAT}
- {1901127600 28800 1 KRAST}
- {1919271600 25200 0 KRAT}
- {1932577200 28800 1 KRAST}
- {1950721200 25200 0 KRAT}
- {1964026800 28800 1 KRAST}
- {1982775600 25200 0 KRAT}
- {1995476400 28800 1 KRAST}
- {2014225200 25200 0 KRAT}
- {2026926000 28800 1 KRAST}
- {2045674800 25200 0 KRAT}
- {2058375600 28800 1 KRAST}
- {2077124400 25200 0 KRAT}
- {2090430000 28800 1 KRAST}
- {2108574000 25200 0 KRAT}
- {2121879600 28800 1 KRAST}
- {2140023600 25200 0 KRAT}
- {2153329200 28800 1 KRAST}
- {2172078000 25200 0 KRAT}
- {2184778800 28800 1 KRAST}
- {2203527600 25200 0 KRAT}
- {2216228400 28800 1 KRAST}
- {2234977200 25200 0 KRAT}
- {2248282800 28800 1 KRAST}
- {2266426800 25200 0 KRAT}
- {2279732400 28800 1 KRAST}
- {2297876400 25200 0 KRAT}
- {2311182000 28800 1 KRAST}
- {2329326000 25200 0 KRAT}
- {2342631600 28800 1 KRAST}
- {2361380400 25200 0 KRAT}
- {2374081200 28800 1 KRAST}
- {2392830000 25200 0 KRAT}
- {2405530800 28800 1 KRAST}
- {2424279600 25200 0 KRAT}
- {2437585200 28800 1 KRAST}
- {2455729200 25200 0 KRAT}
- {2469034800 28800 1 KRAST}
- {2487178800 25200 0 KRAT}
- {2500484400 28800 1 KRAST}
- {2519233200 25200 0 KRAT}
- {2531934000 28800 1 KRAST}
- {2550682800 25200 0 KRAT}
- {2563383600 28800 1 KRAST}
- {2582132400 25200 0 KRAT}
- {2595438000 28800 1 KRAST}
- {2613582000 25200 0 KRAT}
- {2626887600 28800 1 KRAST}
- {2645031600 25200 0 KRAT}
- {2658337200 28800 1 KRAST}
- {2676481200 25200 0 KRAT}
- {2689786800 28800 1 KRAST}
- {2708535600 25200 0 KRAT}
- {2721236400 28800 1 KRAST}
- {2739985200 25200 0 KRAT}
- {2752686000 28800 1 KRAST}
- {2771434800 25200 0 KRAT}
- {2784740400 28800 1 KRAST}
- {2802884400 25200 0 KRAT}
- {2816190000 28800 1 KRAST}
- {2834334000 25200 0 KRAT}
- {2847639600 28800 1 KRAST}
- {2866388400 25200 0 KRAT}
- {2879089200 28800 1 KRAST}
- {2897838000 25200 0 KRAT}
- {2910538800 28800 1 KRAST}
- {2929287600 25200 0 KRAT}
- {2941988400 28800 1 KRAST}
- {2960737200 25200 0 KRAT}
- {2974042800 28800 1 KRAST}
- {2992186800 25200 0 KRAT}
- {3005492400 28800 1 KRAST}
- {3023636400 25200 0 KRAT}
- {3036942000 28800 1 KRAST}
- {3055690800 25200 0 KRAT}
- {3068391600 28800 1 KRAST}
- {3087140400 25200 0 KRAT}
- {3099841200 28800 1 KRAST}
- {3118590000 25200 0 KRAT}
- {3131895600 28800 1 KRAST}
- {3150039600 25200 0 KRAT}
- {3163345200 28800 1 KRAST}
- {3181489200 25200 0 KRAT}
- {3194794800 28800 1 KRAST}
- {3212938800 25200 0 KRAT}
- {3226244400 28800 1 KRAST}
- {3244993200 25200 0 KRAT}
- {3257694000 28800 1 KRAST}
- {3276442800 25200 0 KRAT}
- {3289143600 28800 1 KRAST}
- {3307892400 25200 0 KRAT}
- {3321198000 28800 1 KRAST}
- {3339342000 25200 0 KRAT}
- {3352647600 28800 1 KRAST}
- {3370791600 25200 0 KRAT}
- {3384097200 28800 1 KRAST}
- {3402846000 25200 0 KRAT}
- {3415546800 28800 1 KRAST}
- {3434295600 25200 0 KRAT}
- {3446996400 28800 1 KRAST}
- {3465745200 25200 0 KRAT}
- {3479050800 28800 1 KRAST}
- {3497194800 25200 0 KRAT}
- {3510500400 28800 1 KRAST}
- {3528644400 25200 0 KRAT}
- {3541950000 28800 1 KRAST}
- {3560094000 25200 0 KRAT}
- {3573399600 28800 1 KRAST}
- {3592148400 25200 0 KRAT}
- {3604849200 28800 1 KRAST}
- {3623598000 25200 0 KRAT}
- {3636298800 28800 1 KRAST}
- {3655047600 25200 0 KRAT}
- {3668353200 28800 1 KRAST}
- {3686497200 25200 0 KRAT}
- {3699802800 28800 1 KRAST}
- {3717946800 25200 0 KRAT}
- {3731252400 28800 1 KRAST}
- {3750001200 25200 0 KRAT}
- {3762702000 28800 1 KRAST}
- {3781450800 25200 0 KRAT}
- {3794151600 28800 1 KRAST}
- {3812900400 25200 0 KRAT}
- {3825601200 28800 1 KRAST}
- {3844350000 25200 0 KRAT}
- {3857655600 28800 1 KRAST}
- {3875799600 25200 0 KRAT}
- {3889105200 28800 1 KRAST}
- {3907249200 25200 0 KRAT}
- {3920554800 28800 1 KRAST}
- {3939303600 25200 0 KRAT}
- {3952004400 28800 1 KRAST}
- {3970753200 25200 0 KRAT}
- {3983454000 28800 1 KRAST}
- {4002202800 25200 0 KRAT}
- {4015508400 28800 1 KRAST}
- {4033652400 25200 0 KRAT}
- {4046958000 28800 1 KRAST}
- {4065102000 25200 0 KRAT}
- {4078407600 28800 1 KRAST}
- {4096551600 25200 0 KRAT}
+ {1301166000 28800 0 KRAT}
}
diff --git a/library/tzdata/Asia/Magadan b/library/tzdata/Asia/Magadan
index 28e1f2f..62e01c5 100644
--- a/library/tzdata/Asia/Magadan
+++ b/library/tzdata/Asia/Magadan
@@ -66,182 +66,5 @@ set TZData(:Asia/Magadan) {
{1256396400 39600 0 MAGT}
{1269702000 43200 1 MAGST}
{1288450800 39600 0 MAGT}
- {1301151600 43200 1 MAGST}
- {1319900400 39600 0 MAGT}
- {1332601200 43200 1 MAGST}
- {1351350000 39600 0 MAGT}
- {1364655600 43200 1 MAGST}
- {1382799600 39600 0 MAGT}
- {1396105200 43200 1 MAGST}
- {1414249200 39600 0 MAGT}
- {1427554800 43200 1 MAGST}
- {1445698800 39600 0 MAGT}
- {1459004400 43200 1 MAGST}
- {1477753200 39600 0 MAGT}
- {1490454000 43200 1 MAGST}
- {1509202800 39600 0 MAGT}
- {1521903600 43200 1 MAGST}
- {1540652400 39600 0 MAGT}
- {1553958000 43200 1 MAGST}
- {1572102000 39600 0 MAGT}
- {1585407600 43200 1 MAGST}
- {1603551600 39600 0 MAGT}
- {1616857200 43200 1 MAGST}
- {1635606000 39600 0 MAGT}
- {1648306800 43200 1 MAGST}
- {1667055600 39600 0 MAGT}
- {1679756400 43200 1 MAGST}
- {1698505200 39600 0 MAGT}
- {1711810800 43200 1 MAGST}
- {1729954800 39600 0 MAGT}
- {1743260400 43200 1 MAGST}
- {1761404400 39600 0 MAGT}
- {1774710000 43200 1 MAGST}
- {1792854000 39600 0 MAGT}
- {1806159600 43200 1 MAGST}
- {1824908400 39600 0 MAGT}
- {1837609200 43200 1 MAGST}
- {1856358000 39600 0 MAGT}
- {1869058800 43200 1 MAGST}
- {1887807600 39600 0 MAGT}
- {1901113200 43200 1 MAGST}
- {1919257200 39600 0 MAGT}
- {1932562800 43200 1 MAGST}
- {1950706800 39600 0 MAGT}
- {1964012400 43200 1 MAGST}
- {1982761200 39600 0 MAGT}
- {1995462000 43200 1 MAGST}
- {2014210800 39600 0 MAGT}
- {2026911600 43200 1 MAGST}
- {2045660400 39600 0 MAGT}
- {2058361200 43200 1 MAGST}
- {2077110000 39600 0 MAGT}
- {2090415600 43200 1 MAGST}
- {2108559600 39600 0 MAGT}
- {2121865200 43200 1 MAGST}
- {2140009200 39600 0 MAGT}
- {2153314800 43200 1 MAGST}
- {2172063600 39600 0 MAGT}
- {2184764400 43200 1 MAGST}
- {2203513200 39600 0 MAGT}
- {2216214000 43200 1 MAGST}
- {2234962800 39600 0 MAGT}
- {2248268400 43200 1 MAGST}
- {2266412400 39600 0 MAGT}
- {2279718000 43200 1 MAGST}
- {2297862000 39600 0 MAGT}
- {2311167600 43200 1 MAGST}
- {2329311600 39600 0 MAGT}
- {2342617200 43200 1 MAGST}
- {2361366000 39600 0 MAGT}
- {2374066800 43200 1 MAGST}
- {2392815600 39600 0 MAGT}
- {2405516400 43200 1 MAGST}
- {2424265200 39600 0 MAGT}
- {2437570800 43200 1 MAGST}
- {2455714800 39600 0 MAGT}
- {2469020400 43200 1 MAGST}
- {2487164400 39600 0 MAGT}
- {2500470000 43200 1 MAGST}
- {2519218800 39600 0 MAGT}
- {2531919600 43200 1 MAGST}
- {2550668400 39600 0 MAGT}
- {2563369200 43200 1 MAGST}
- {2582118000 39600 0 MAGT}
- {2595423600 43200 1 MAGST}
- {2613567600 39600 0 MAGT}
- {2626873200 43200 1 MAGST}
- {2645017200 39600 0 MAGT}
- {2658322800 43200 1 MAGST}
- {2676466800 39600 0 MAGT}
- {2689772400 43200 1 MAGST}
- {2708521200 39600 0 MAGT}
- {2721222000 43200 1 MAGST}
- {2739970800 39600 0 MAGT}
- {2752671600 43200 1 MAGST}
- {2771420400 39600 0 MAGT}
- {2784726000 43200 1 MAGST}
- {2802870000 39600 0 MAGT}
- {2816175600 43200 1 MAGST}
- {2834319600 39600 0 MAGT}
- {2847625200 43200 1 MAGST}
- {2866374000 39600 0 MAGT}
- {2879074800 43200 1 MAGST}
- {2897823600 39600 0 MAGT}
- {2910524400 43200 1 MAGST}
- {2929273200 39600 0 MAGT}
- {2941974000 43200 1 MAGST}
- {2960722800 39600 0 MAGT}
- {2974028400 43200 1 MAGST}
- {2992172400 39600 0 MAGT}
- {3005478000 43200 1 MAGST}
- {3023622000 39600 0 MAGT}
- {3036927600 43200 1 MAGST}
- {3055676400 39600 0 MAGT}
- {3068377200 43200 1 MAGST}
- {3087126000 39600 0 MAGT}
- {3099826800 43200 1 MAGST}
- {3118575600 39600 0 MAGT}
- {3131881200 43200 1 MAGST}
- {3150025200 39600 0 MAGT}
- {3163330800 43200 1 MAGST}
- {3181474800 39600 0 MAGT}
- {3194780400 43200 1 MAGST}
- {3212924400 39600 0 MAGT}
- {3226230000 43200 1 MAGST}
- {3244978800 39600 0 MAGT}
- {3257679600 43200 1 MAGST}
- {3276428400 39600 0 MAGT}
- {3289129200 43200 1 MAGST}
- {3307878000 39600 0 MAGT}
- {3321183600 43200 1 MAGST}
- {3339327600 39600 0 MAGT}
- {3352633200 43200 1 MAGST}
- {3370777200 39600 0 MAGT}
- {3384082800 43200 1 MAGST}
- {3402831600 39600 0 MAGT}
- {3415532400 43200 1 MAGST}
- {3434281200 39600 0 MAGT}
- {3446982000 43200 1 MAGST}
- {3465730800 39600 0 MAGT}
- {3479036400 43200 1 MAGST}
- {3497180400 39600 0 MAGT}
- {3510486000 43200 1 MAGST}
- {3528630000 39600 0 MAGT}
- {3541935600 43200 1 MAGST}
- {3560079600 39600 0 MAGT}
- {3573385200 43200 1 MAGST}
- {3592134000 39600 0 MAGT}
- {3604834800 43200 1 MAGST}
- {3623583600 39600 0 MAGT}
- {3636284400 43200 1 MAGST}
- {3655033200 39600 0 MAGT}
- {3668338800 43200 1 MAGST}
- {3686482800 39600 0 MAGT}
- {3699788400 43200 1 MAGST}
- {3717932400 39600 0 MAGT}
- {3731238000 43200 1 MAGST}
- {3749986800 39600 0 MAGT}
- {3762687600 43200 1 MAGST}
- {3781436400 39600 0 MAGT}
- {3794137200 43200 1 MAGST}
- {3812886000 39600 0 MAGT}
- {3825586800 43200 1 MAGST}
- {3844335600 39600 0 MAGT}
- {3857641200 43200 1 MAGST}
- {3875785200 39600 0 MAGT}
- {3889090800 43200 1 MAGST}
- {3907234800 39600 0 MAGT}
- {3920540400 43200 1 MAGST}
- {3939289200 39600 0 MAGT}
- {3951990000 43200 1 MAGST}
- {3970738800 39600 0 MAGT}
- {3983439600 43200 1 MAGST}
- {4002188400 39600 0 MAGT}
- {4015494000 43200 1 MAGST}
- {4033638000 39600 0 MAGT}
- {4046943600 43200 1 MAGST}
- {4065087600 39600 0 MAGT}
- {4078393200 43200 1 MAGST}
- {4096537200 39600 0 MAGT}
+ {1301151600 43200 0 MAGT}
}
diff --git a/library/tzdata/Asia/Novokuznetsk b/library/tzdata/Asia/Novokuznetsk
index d3d611d..9cd45c0 100644
--- a/library/tzdata/Asia/Novokuznetsk
+++ b/library/tzdata/Asia/Novokuznetsk
@@ -67,182 +67,5 @@ set TZData(:Asia/Novokuznetsk) {
{1269716400 21600 0 NOVMMTT}
{1269720000 25200 1 NOVST}
{1288468800 21600 0 NOVT}
- {1301169600 25200 1 NOVST}
- {1319918400 21600 0 NOVT}
- {1332619200 25200 1 NOVST}
- {1351368000 21600 0 NOVT}
- {1364673600 25200 1 NOVST}
- {1382817600 21600 0 NOVT}
- {1396123200 25200 1 NOVST}
- {1414267200 21600 0 NOVT}
- {1427572800 25200 1 NOVST}
- {1445716800 21600 0 NOVT}
- {1459022400 25200 1 NOVST}
- {1477771200 21600 0 NOVT}
- {1490472000 25200 1 NOVST}
- {1509220800 21600 0 NOVT}
- {1521921600 25200 1 NOVST}
- {1540670400 21600 0 NOVT}
- {1553976000 25200 1 NOVST}
- {1572120000 21600 0 NOVT}
- {1585425600 25200 1 NOVST}
- {1603569600 21600 0 NOVT}
- {1616875200 25200 1 NOVST}
- {1635624000 21600 0 NOVT}
- {1648324800 25200 1 NOVST}
- {1667073600 21600 0 NOVT}
- {1679774400 25200 1 NOVST}
- {1698523200 21600 0 NOVT}
- {1711828800 25200 1 NOVST}
- {1729972800 21600 0 NOVT}
- {1743278400 25200 1 NOVST}
- {1761422400 21600 0 NOVT}
- {1774728000 25200 1 NOVST}
- {1792872000 21600 0 NOVT}
- {1806177600 25200 1 NOVST}
- {1824926400 21600 0 NOVT}
- {1837627200 25200 1 NOVST}
- {1856376000 21600 0 NOVT}
- {1869076800 25200 1 NOVST}
- {1887825600 21600 0 NOVT}
- {1901131200 25200 1 NOVST}
- {1919275200 21600 0 NOVT}
- {1932580800 25200 1 NOVST}
- {1950724800 21600 0 NOVT}
- {1964030400 25200 1 NOVST}
- {1982779200 21600 0 NOVT}
- {1995480000 25200 1 NOVST}
- {2014228800 21600 0 NOVT}
- {2026929600 25200 1 NOVST}
- {2045678400 21600 0 NOVT}
- {2058379200 25200 1 NOVST}
- {2077128000 21600 0 NOVT}
- {2090433600 25200 1 NOVST}
- {2108577600 21600 0 NOVT}
- {2121883200 25200 1 NOVST}
- {2140027200 21600 0 NOVT}
- {2153332800 25200 1 NOVST}
- {2172081600 21600 0 NOVT}
- {2184782400 25200 1 NOVST}
- {2203531200 21600 0 NOVT}
- {2216232000 25200 1 NOVST}
- {2234980800 21600 0 NOVT}
- {2248286400 25200 1 NOVST}
- {2266430400 21600 0 NOVT}
- {2279736000 25200 1 NOVST}
- {2297880000 21600 0 NOVT}
- {2311185600 25200 1 NOVST}
- {2329329600 21600 0 NOVT}
- {2342635200 25200 1 NOVST}
- {2361384000 21600 0 NOVT}
- {2374084800 25200 1 NOVST}
- {2392833600 21600 0 NOVT}
- {2405534400 25200 1 NOVST}
- {2424283200 21600 0 NOVT}
- {2437588800 25200 1 NOVST}
- {2455732800 21600 0 NOVT}
- {2469038400 25200 1 NOVST}
- {2487182400 21600 0 NOVT}
- {2500488000 25200 1 NOVST}
- {2519236800 21600 0 NOVT}
- {2531937600 25200 1 NOVST}
- {2550686400 21600 0 NOVT}
- {2563387200 25200 1 NOVST}
- {2582136000 21600 0 NOVT}
- {2595441600 25200 1 NOVST}
- {2613585600 21600 0 NOVT}
- {2626891200 25200 1 NOVST}
- {2645035200 21600 0 NOVT}
- {2658340800 25200 1 NOVST}
- {2676484800 21600 0 NOVT}
- {2689790400 25200 1 NOVST}
- {2708539200 21600 0 NOVT}
- {2721240000 25200 1 NOVST}
- {2739988800 21600 0 NOVT}
- {2752689600 25200 1 NOVST}
- {2771438400 21600 0 NOVT}
- {2784744000 25200 1 NOVST}
- {2802888000 21600 0 NOVT}
- {2816193600 25200 1 NOVST}
- {2834337600 21600 0 NOVT}
- {2847643200 25200 1 NOVST}
- {2866392000 21600 0 NOVT}
- {2879092800 25200 1 NOVST}
- {2897841600 21600 0 NOVT}
- {2910542400 25200 1 NOVST}
- {2929291200 21600 0 NOVT}
- {2941992000 25200 1 NOVST}
- {2960740800 21600 0 NOVT}
- {2974046400 25200 1 NOVST}
- {2992190400 21600 0 NOVT}
- {3005496000 25200 1 NOVST}
- {3023640000 21600 0 NOVT}
- {3036945600 25200 1 NOVST}
- {3055694400 21600 0 NOVT}
- {3068395200 25200 1 NOVST}
- {3087144000 21600 0 NOVT}
- {3099844800 25200 1 NOVST}
- {3118593600 21600 0 NOVT}
- {3131899200 25200 1 NOVST}
- {3150043200 21600 0 NOVT}
- {3163348800 25200 1 NOVST}
- {3181492800 21600 0 NOVT}
- {3194798400 25200 1 NOVST}
- {3212942400 21600 0 NOVT}
- {3226248000 25200 1 NOVST}
- {3244996800 21600 0 NOVT}
- {3257697600 25200 1 NOVST}
- {3276446400 21600 0 NOVT}
- {3289147200 25200 1 NOVST}
- {3307896000 21600 0 NOVT}
- {3321201600 25200 1 NOVST}
- {3339345600 21600 0 NOVT}
- {3352651200 25200 1 NOVST}
- {3370795200 21600 0 NOVT}
- {3384100800 25200 1 NOVST}
- {3402849600 21600 0 NOVT}
- {3415550400 25200 1 NOVST}
- {3434299200 21600 0 NOVT}
- {3447000000 25200 1 NOVST}
- {3465748800 21600 0 NOVT}
- {3479054400 25200 1 NOVST}
- {3497198400 21600 0 NOVT}
- {3510504000 25200 1 NOVST}
- {3528648000 21600 0 NOVT}
- {3541953600 25200 1 NOVST}
- {3560097600 21600 0 NOVT}
- {3573403200 25200 1 NOVST}
- {3592152000 21600 0 NOVT}
- {3604852800 25200 1 NOVST}
- {3623601600 21600 0 NOVT}
- {3636302400 25200 1 NOVST}
- {3655051200 21600 0 NOVT}
- {3668356800 25200 1 NOVST}
- {3686500800 21600 0 NOVT}
- {3699806400 25200 1 NOVST}
- {3717950400 21600 0 NOVT}
- {3731256000 25200 1 NOVST}
- {3750004800 21600 0 NOVT}
- {3762705600 25200 1 NOVST}
- {3781454400 21600 0 NOVT}
- {3794155200 25200 1 NOVST}
- {3812904000 21600 0 NOVT}
- {3825604800 25200 1 NOVST}
- {3844353600 21600 0 NOVT}
- {3857659200 25200 1 NOVST}
- {3875803200 21600 0 NOVT}
- {3889108800 25200 1 NOVST}
- {3907252800 21600 0 NOVT}
- {3920558400 25200 1 NOVST}
- {3939307200 21600 0 NOVT}
- {3952008000 25200 1 NOVST}
- {3970756800 21600 0 NOVT}
- {3983457600 25200 1 NOVST}
- {4002206400 21600 0 NOVT}
- {4015512000 25200 1 NOVST}
- {4033656000 21600 0 NOVT}
- {4046961600 25200 1 NOVST}
- {4065105600 21600 0 NOVT}
- {4078411200 25200 1 NOVST}
- {4096555200 21600 0 NOVT}
+ {1301169600 25200 0 NOVT}
}
diff --git a/library/tzdata/Asia/Novosibirsk b/library/tzdata/Asia/Novosibirsk
index 0b35658..5032eec 100644
--- a/library/tzdata/Asia/Novosibirsk
+++ b/library/tzdata/Asia/Novosibirsk
@@ -67,182 +67,5 @@ set TZData(:Asia/Novosibirsk) {
{1256414400 21600 0 NOVT}
{1269720000 25200 1 NOVST}
{1288468800 21600 0 NOVT}
- {1301169600 25200 1 NOVST}
- {1319918400 21600 0 NOVT}
- {1332619200 25200 1 NOVST}
- {1351368000 21600 0 NOVT}
- {1364673600 25200 1 NOVST}
- {1382817600 21600 0 NOVT}
- {1396123200 25200 1 NOVST}
- {1414267200 21600 0 NOVT}
- {1427572800 25200 1 NOVST}
- {1445716800 21600 0 NOVT}
- {1459022400 25200 1 NOVST}
- {1477771200 21600 0 NOVT}
- {1490472000 25200 1 NOVST}
- {1509220800 21600 0 NOVT}
- {1521921600 25200 1 NOVST}
- {1540670400 21600 0 NOVT}
- {1553976000 25200 1 NOVST}
- {1572120000 21600 0 NOVT}
- {1585425600 25200 1 NOVST}
- {1603569600 21600 0 NOVT}
- {1616875200 25200 1 NOVST}
- {1635624000 21600 0 NOVT}
- {1648324800 25200 1 NOVST}
- {1667073600 21600 0 NOVT}
- {1679774400 25200 1 NOVST}
- {1698523200 21600 0 NOVT}
- {1711828800 25200 1 NOVST}
- {1729972800 21600 0 NOVT}
- {1743278400 25200 1 NOVST}
- {1761422400 21600 0 NOVT}
- {1774728000 25200 1 NOVST}
- {1792872000 21600 0 NOVT}
- {1806177600 25200 1 NOVST}
- {1824926400 21600 0 NOVT}
- {1837627200 25200 1 NOVST}
- {1856376000 21600 0 NOVT}
- {1869076800 25200 1 NOVST}
- {1887825600 21600 0 NOVT}
- {1901131200 25200 1 NOVST}
- {1919275200 21600 0 NOVT}
- {1932580800 25200 1 NOVST}
- {1950724800 21600 0 NOVT}
- {1964030400 25200 1 NOVST}
- {1982779200 21600 0 NOVT}
- {1995480000 25200 1 NOVST}
- {2014228800 21600 0 NOVT}
- {2026929600 25200 1 NOVST}
- {2045678400 21600 0 NOVT}
- {2058379200 25200 1 NOVST}
- {2077128000 21600 0 NOVT}
- {2090433600 25200 1 NOVST}
- {2108577600 21600 0 NOVT}
- {2121883200 25200 1 NOVST}
- {2140027200 21600 0 NOVT}
- {2153332800 25200 1 NOVST}
- {2172081600 21600 0 NOVT}
- {2184782400 25200 1 NOVST}
- {2203531200 21600 0 NOVT}
- {2216232000 25200 1 NOVST}
- {2234980800 21600 0 NOVT}
- {2248286400 25200 1 NOVST}
- {2266430400 21600 0 NOVT}
- {2279736000 25200 1 NOVST}
- {2297880000 21600 0 NOVT}
- {2311185600 25200 1 NOVST}
- {2329329600 21600 0 NOVT}
- {2342635200 25200 1 NOVST}
- {2361384000 21600 0 NOVT}
- {2374084800 25200 1 NOVST}
- {2392833600 21600 0 NOVT}
- {2405534400 25200 1 NOVST}
- {2424283200 21600 0 NOVT}
- {2437588800 25200 1 NOVST}
- {2455732800 21600 0 NOVT}
- {2469038400 25200 1 NOVST}
- {2487182400 21600 0 NOVT}
- {2500488000 25200 1 NOVST}
- {2519236800 21600 0 NOVT}
- {2531937600 25200 1 NOVST}
- {2550686400 21600 0 NOVT}
- {2563387200 25200 1 NOVST}
- {2582136000 21600 0 NOVT}
- {2595441600 25200 1 NOVST}
- {2613585600 21600 0 NOVT}
- {2626891200 25200 1 NOVST}
- {2645035200 21600 0 NOVT}
- {2658340800 25200 1 NOVST}
- {2676484800 21600 0 NOVT}
- {2689790400 25200 1 NOVST}
- {2708539200 21600 0 NOVT}
- {2721240000 25200 1 NOVST}
- {2739988800 21600 0 NOVT}
- {2752689600 25200 1 NOVST}
- {2771438400 21600 0 NOVT}
- {2784744000 25200 1 NOVST}
- {2802888000 21600 0 NOVT}
- {2816193600 25200 1 NOVST}
- {2834337600 21600 0 NOVT}
- {2847643200 25200 1 NOVST}
- {2866392000 21600 0 NOVT}
- {2879092800 25200 1 NOVST}
- {2897841600 21600 0 NOVT}
- {2910542400 25200 1 NOVST}
- {2929291200 21600 0 NOVT}
- {2941992000 25200 1 NOVST}
- {2960740800 21600 0 NOVT}
- {2974046400 25200 1 NOVST}
- {2992190400 21600 0 NOVT}
- {3005496000 25200 1 NOVST}
- {3023640000 21600 0 NOVT}
- {3036945600 25200 1 NOVST}
- {3055694400 21600 0 NOVT}
- {3068395200 25200 1 NOVST}
- {3087144000 21600 0 NOVT}
- {3099844800 25200 1 NOVST}
- {3118593600 21600 0 NOVT}
- {3131899200 25200 1 NOVST}
- {3150043200 21600 0 NOVT}
- {3163348800 25200 1 NOVST}
- {3181492800 21600 0 NOVT}
- {3194798400 25200 1 NOVST}
- {3212942400 21600 0 NOVT}
- {3226248000 25200 1 NOVST}
- {3244996800 21600 0 NOVT}
- {3257697600 25200 1 NOVST}
- {3276446400 21600 0 NOVT}
- {3289147200 25200 1 NOVST}
- {3307896000 21600 0 NOVT}
- {3321201600 25200 1 NOVST}
- {3339345600 21600 0 NOVT}
- {3352651200 25200 1 NOVST}
- {3370795200 21600 0 NOVT}
- {3384100800 25200 1 NOVST}
- {3402849600 21600 0 NOVT}
- {3415550400 25200 1 NOVST}
- {3434299200 21600 0 NOVT}
- {3447000000 25200 1 NOVST}
- {3465748800 21600 0 NOVT}
- {3479054400 25200 1 NOVST}
- {3497198400 21600 0 NOVT}
- {3510504000 25200 1 NOVST}
- {3528648000 21600 0 NOVT}
- {3541953600 25200 1 NOVST}
- {3560097600 21600 0 NOVT}
- {3573403200 25200 1 NOVST}
- {3592152000 21600 0 NOVT}
- {3604852800 25200 1 NOVST}
- {3623601600 21600 0 NOVT}
- {3636302400 25200 1 NOVST}
- {3655051200 21600 0 NOVT}
- {3668356800 25200 1 NOVST}
- {3686500800 21600 0 NOVT}
- {3699806400 25200 1 NOVST}
- {3717950400 21600 0 NOVT}
- {3731256000 25200 1 NOVST}
- {3750004800 21600 0 NOVT}
- {3762705600 25200 1 NOVST}
- {3781454400 21600 0 NOVT}
- {3794155200 25200 1 NOVST}
- {3812904000 21600 0 NOVT}
- {3825604800 25200 1 NOVST}
- {3844353600 21600 0 NOVT}
- {3857659200 25200 1 NOVST}
- {3875803200 21600 0 NOVT}
- {3889108800 25200 1 NOVST}
- {3907252800 21600 0 NOVT}
- {3920558400 25200 1 NOVST}
- {3939307200 21600 0 NOVT}
- {3952008000 25200 1 NOVST}
- {3970756800 21600 0 NOVT}
- {3983457600 25200 1 NOVST}
- {4002206400 21600 0 NOVT}
- {4015512000 25200 1 NOVST}
- {4033656000 21600 0 NOVT}
- {4046961600 25200 1 NOVST}
- {4065105600 21600 0 NOVT}
- {4078411200 25200 1 NOVST}
- {4096555200 21600 0 NOVT}
+ {1301169600 25200 0 NOVT}
}
diff --git a/library/tzdata/Asia/Omsk b/library/tzdata/Asia/Omsk
index 21db9c9..ca90d2e 100644
--- a/library/tzdata/Asia/Omsk
+++ b/library/tzdata/Asia/Omsk
@@ -66,182 +66,5 @@ set TZData(:Asia/Omsk) {
{1256414400 21600 0 OMST}
{1269720000 25200 1 OMSST}
{1288468800 21600 0 OMST}
- {1301169600 25200 1 OMSST}
- {1319918400 21600 0 OMST}
- {1332619200 25200 1 OMSST}
- {1351368000 21600 0 OMST}
- {1364673600 25200 1 OMSST}
- {1382817600 21600 0 OMST}
- {1396123200 25200 1 OMSST}
- {1414267200 21600 0 OMST}
- {1427572800 25200 1 OMSST}
- {1445716800 21600 0 OMST}
- {1459022400 25200 1 OMSST}
- {1477771200 21600 0 OMST}
- {1490472000 25200 1 OMSST}
- {1509220800 21600 0 OMST}
- {1521921600 25200 1 OMSST}
- {1540670400 21600 0 OMST}
- {1553976000 25200 1 OMSST}
- {1572120000 21600 0 OMST}
- {1585425600 25200 1 OMSST}
- {1603569600 21600 0 OMST}
- {1616875200 25200 1 OMSST}
- {1635624000 21600 0 OMST}
- {1648324800 25200 1 OMSST}
- {1667073600 21600 0 OMST}
- {1679774400 25200 1 OMSST}
- {1698523200 21600 0 OMST}
- {1711828800 25200 1 OMSST}
- {1729972800 21600 0 OMST}
- {1743278400 25200 1 OMSST}
- {1761422400 21600 0 OMST}
- {1774728000 25200 1 OMSST}
- {1792872000 21600 0 OMST}
- {1806177600 25200 1 OMSST}
- {1824926400 21600 0 OMST}
- {1837627200 25200 1 OMSST}
- {1856376000 21600 0 OMST}
- {1869076800 25200 1 OMSST}
- {1887825600 21600 0 OMST}
- {1901131200 25200 1 OMSST}
- {1919275200 21600 0 OMST}
- {1932580800 25200 1 OMSST}
- {1950724800 21600 0 OMST}
- {1964030400 25200 1 OMSST}
- {1982779200 21600 0 OMST}
- {1995480000 25200 1 OMSST}
- {2014228800 21600 0 OMST}
- {2026929600 25200 1 OMSST}
- {2045678400 21600 0 OMST}
- {2058379200 25200 1 OMSST}
- {2077128000 21600 0 OMST}
- {2090433600 25200 1 OMSST}
- {2108577600 21600 0 OMST}
- {2121883200 25200 1 OMSST}
- {2140027200 21600 0 OMST}
- {2153332800 25200 1 OMSST}
- {2172081600 21600 0 OMST}
- {2184782400 25200 1 OMSST}
- {2203531200 21600 0 OMST}
- {2216232000 25200 1 OMSST}
- {2234980800 21600 0 OMST}
- {2248286400 25200 1 OMSST}
- {2266430400 21600 0 OMST}
- {2279736000 25200 1 OMSST}
- {2297880000 21600 0 OMST}
- {2311185600 25200 1 OMSST}
- {2329329600 21600 0 OMST}
- {2342635200 25200 1 OMSST}
- {2361384000 21600 0 OMST}
- {2374084800 25200 1 OMSST}
- {2392833600 21600 0 OMST}
- {2405534400 25200 1 OMSST}
- {2424283200 21600 0 OMST}
- {2437588800 25200 1 OMSST}
- {2455732800 21600 0 OMST}
- {2469038400 25200 1 OMSST}
- {2487182400 21600 0 OMST}
- {2500488000 25200 1 OMSST}
- {2519236800 21600 0 OMST}
- {2531937600 25200 1 OMSST}
- {2550686400 21600 0 OMST}
- {2563387200 25200 1 OMSST}
- {2582136000 21600 0 OMST}
- {2595441600 25200 1 OMSST}
- {2613585600 21600 0 OMST}
- {2626891200 25200 1 OMSST}
- {2645035200 21600 0 OMST}
- {2658340800 25200 1 OMSST}
- {2676484800 21600 0 OMST}
- {2689790400 25200 1 OMSST}
- {2708539200 21600 0 OMST}
- {2721240000 25200 1 OMSST}
- {2739988800 21600 0 OMST}
- {2752689600 25200 1 OMSST}
- {2771438400 21600 0 OMST}
- {2784744000 25200 1 OMSST}
- {2802888000 21600 0 OMST}
- {2816193600 25200 1 OMSST}
- {2834337600 21600 0 OMST}
- {2847643200 25200 1 OMSST}
- {2866392000 21600 0 OMST}
- {2879092800 25200 1 OMSST}
- {2897841600 21600 0 OMST}
- {2910542400 25200 1 OMSST}
- {2929291200 21600 0 OMST}
- {2941992000 25200 1 OMSST}
- {2960740800 21600 0 OMST}
- {2974046400 25200 1 OMSST}
- {2992190400 21600 0 OMST}
- {3005496000 25200 1 OMSST}
- {3023640000 21600 0 OMST}
- {3036945600 25200 1 OMSST}
- {3055694400 21600 0 OMST}
- {3068395200 25200 1 OMSST}
- {3087144000 21600 0 OMST}
- {3099844800 25200 1 OMSST}
- {3118593600 21600 0 OMST}
- {3131899200 25200 1 OMSST}
- {3150043200 21600 0 OMST}
- {3163348800 25200 1 OMSST}
- {3181492800 21600 0 OMST}
- {3194798400 25200 1 OMSST}
- {3212942400 21600 0 OMST}
- {3226248000 25200 1 OMSST}
- {3244996800 21600 0 OMST}
- {3257697600 25200 1 OMSST}
- {3276446400 21600 0 OMST}
- {3289147200 25200 1 OMSST}
- {3307896000 21600 0 OMST}
- {3321201600 25200 1 OMSST}
- {3339345600 21600 0 OMST}
- {3352651200 25200 1 OMSST}
- {3370795200 21600 0 OMST}
- {3384100800 25200 1 OMSST}
- {3402849600 21600 0 OMST}
- {3415550400 25200 1 OMSST}
- {3434299200 21600 0 OMST}
- {3447000000 25200 1 OMSST}
- {3465748800 21600 0 OMST}
- {3479054400 25200 1 OMSST}
- {3497198400 21600 0 OMST}
- {3510504000 25200 1 OMSST}
- {3528648000 21600 0 OMST}
- {3541953600 25200 1 OMSST}
- {3560097600 21600 0 OMST}
- {3573403200 25200 1 OMSST}
- {3592152000 21600 0 OMST}
- {3604852800 25200 1 OMSST}
- {3623601600 21600 0 OMST}
- {3636302400 25200 1 OMSST}
- {3655051200 21600 0 OMST}
- {3668356800 25200 1 OMSST}
- {3686500800 21600 0 OMST}
- {3699806400 25200 1 OMSST}
- {3717950400 21600 0 OMST}
- {3731256000 25200 1 OMSST}
- {3750004800 21600 0 OMST}
- {3762705600 25200 1 OMSST}
- {3781454400 21600 0 OMST}
- {3794155200 25200 1 OMSST}
- {3812904000 21600 0 OMST}
- {3825604800 25200 1 OMSST}
- {3844353600 21600 0 OMST}
- {3857659200 25200 1 OMSST}
- {3875803200 21600 0 OMST}
- {3889108800 25200 1 OMSST}
- {3907252800 21600 0 OMST}
- {3920558400 25200 1 OMSST}
- {3939307200 21600 0 OMST}
- {3952008000 25200 1 OMSST}
- {3970756800 21600 0 OMST}
- {3983457600 25200 1 OMSST}
- {4002206400 21600 0 OMST}
- {4015512000 25200 1 OMSST}
- {4033656000 21600 0 OMST}
- {4046961600 25200 1 OMSST}
- {4065105600 21600 0 OMST}
- {4078411200 25200 1 OMSST}
- {4096555200 21600 0 OMST}
+ {1301169600 25200 0 OMST}
}
diff --git a/library/tzdata/Asia/Sakhalin b/library/tzdata/Asia/Sakhalin
index 31395ab..0b29e82 100644
--- a/library/tzdata/Asia/Sakhalin
+++ b/library/tzdata/Asia/Sakhalin
@@ -68,182 +68,5 @@ set TZData(:Asia/Sakhalin) {
{1256400000 36000 0 SAKT}
{1269705600 39600 1 SAKST}
{1288454400 36000 0 SAKT}
- {1301155200 39600 1 SAKST}
- {1319904000 36000 0 SAKT}
- {1332604800 39600 1 SAKST}
- {1351353600 36000 0 SAKT}
- {1364659200 39600 1 SAKST}
- {1382803200 36000 0 SAKT}
- {1396108800 39600 1 SAKST}
- {1414252800 36000 0 SAKT}
- {1427558400 39600 1 SAKST}
- {1445702400 36000 0 SAKT}
- {1459008000 39600 1 SAKST}
- {1477756800 36000 0 SAKT}
- {1490457600 39600 1 SAKST}
- {1509206400 36000 0 SAKT}
- {1521907200 39600 1 SAKST}
- {1540656000 36000 0 SAKT}
- {1553961600 39600 1 SAKST}
- {1572105600 36000 0 SAKT}
- {1585411200 39600 1 SAKST}
- {1603555200 36000 0 SAKT}
- {1616860800 39600 1 SAKST}
- {1635609600 36000 0 SAKT}
- {1648310400 39600 1 SAKST}
- {1667059200 36000 0 SAKT}
- {1679760000 39600 1 SAKST}
- {1698508800 36000 0 SAKT}
- {1711814400 39600 1 SAKST}
- {1729958400 36000 0 SAKT}
- {1743264000 39600 1 SAKST}
- {1761408000 36000 0 SAKT}
- {1774713600 39600 1 SAKST}
- {1792857600 36000 0 SAKT}
- {1806163200 39600 1 SAKST}
- {1824912000 36000 0 SAKT}
- {1837612800 39600 1 SAKST}
- {1856361600 36000 0 SAKT}
- {1869062400 39600 1 SAKST}
- {1887811200 36000 0 SAKT}
- {1901116800 39600 1 SAKST}
- {1919260800 36000 0 SAKT}
- {1932566400 39600 1 SAKST}
- {1950710400 36000 0 SAKT}
- {1964016000 39600 1 SAKST}
- {1982764800 36000 0 SAKT}
- {1995465600 39600 1 SAKST}
- {2014214400 36000 0 SAKT}
- {2026915200 39600 1 SAKST}
- {2045664000 36000 0 SAKT}
- {2058364800 39600 1 SAKST}
- {2077113600 36000 0 SAKT}
- {2090419200 39600 1 SAKST}
- {2108563200 36000 0 SAKT}
- {2121868800 39600 1 SAKST}
- {2140012800 36000 0 SAKT}
- {2153318400 39600 1 SAKST}
- {2172067200 36000 0 SAKT}
- {2184768000 39600 1 SAKST}
- {2203516800 36000 0 SAKT}
- {2216217600 39600 1 SAKST}
- {2234966400 36000 0 SAKT}
- {2248272000 39600 1 SAKST}
- {2266416000 36000 0 SAKT}
- {2279721600 39600 1 SAKST}
- {2297865600 36000 0 SAKT}
- {2311171200 39600 1 SAKST}
- {2329315200 36000 0 SAKT}
- {2342620800 39600 1 SAKST}
- {2361369600 36000 0 SAKT}
- {2374070400 39600 1 SAKST}
- {2392819200 36000 0 SAKT}
- {2405520000 39600 1 SAKST}
- {2424268800 36000 0 SAKT}
- {2437574400 39600 1 SAKST}
- {2455718400 36000 0 SAKT}
- {2469024000 39600 1 SAKST}
- {2487168000 36000 0 SAKT}
- {2500473600 39600 1 SAKST}
- {2519222400 36000 0 SAKT}
- {2531923200 39600 1 SAKST}
- {2550672000 36000 0 SAKT}
- {2563372800 39600 1 SAKST}
- {2582121600 36000 0 SAKT}
- {2595427200 39600 1 SAKST}
- {2613571200 36000 0 SAKT}
- {2626876800 39600 1 SAKST}
- {2645020800 36000 0 SAKT}
- {2658326400 39600 1 SAKST}
- {2676470400 36000 0 SAKT}
- {2689776000 39600 1 SAKST}
- {2708524800 36000 0 SAKT}
- {2721225600 39600 1 SAKST}
- {2739974400 36000 0 SAKT}
- {2752675200 39600 1 SAKST}
- {2771424000 36000 0 SAKT}
- {2784729600 39600 1 SAKST}
- {2802873600 36000 0 SAKT}
- {2816179200 39600 1 SAKST}
- {2834323200 36000 0 SAKT}
- {2847628800 39600 1 SAKST}
- {2866377600 36000 0 SAKT}
- {2879078400 39600 1 SAKST}
- {2897827200 36000 0 SAKT}
- {2910528000 39600 1 SAKST}
- {2929276800 36000 0 SAKT}
- {2941977600 39600 1 SAKST}
- {2960726400 36000 0 SAKT}
- {2974032000 39600 1 SAKST}
- {2992176000 36000 0 SAKT}
- {3005481600 39600 1 SAKST}
- {3023625600 36000 0 SAKT}
- {3036931200 39600 1 SAKST}
- {3055680000 36000 0 SAKT}
- {3068380800 39600 1 SAKST}
- {3087129600 36000 0 SAKT}
- {3099830400 39600 1 SAKST}
- {3118579200 36000 0 SAKT}
- {3131884800 39600 1 SAKST}
- {3150028800 36000 0 SAKT}
- {3163334400 39600 1 SAKST}
- {3181478400 36000 0 SAKT}
- {3194784000 39600 1 SAKST}
- {3212928000 36000 0 SAKT}
- {3226233600 39600 1 SAKST}
- {3244982400 36000 0 SAKT}
- {3257683200 39600 1 SAKST}
- {3276432000 36000 0 SAKT}
- {3289132800 39600 1 SAKST}
- {3307881600 36000 0 SAKT}
- {3321187200 39600 1 SAKST}
- {3339331200 36000 0 SAKT}
- {3352636800 39600 1 SAKST}
- {3370780800 36000 0 SAKT}
- {3384086400 39600 1 SAKST}
- {3402835200 36000 0 SAKT}
- {3415536000 39600 1 SAKST}
- {3434284800 36000 0 SAKT}
- {3446985600 39600 1 SAKST}
- {3465734400 36000 0 SAKT}
- {3479040000 39600 1 SAKST}
- {3497184000 36000 0 SAKT}
- {3510489600 39600 1 SAKST}
- {3528633600 36000 0 SAKT}
- {3541939200 39600 1 SAKST}
- {3560083200 36000 0 SAKT}
- {3573388800 39600 1 SAKST}
- {3592137600 36000 0 SAKT}
- {3604838400 39600 1 SAKST}
- {3623587200 36000 0 SAKT}
- {3636288000 39600 1 SAKST}
- {3655036800 36000 0 SAKT}
- {3668342400 39600 1 SAKST}
- {3686486400 36000 0 SAKT}
- {3699792000 39600 1 SAKST}
- {3717936000 36000 0 SAKT}
- {3731241600 39600 1 SAKST}
- {3749990400 36000 0 SAKT}
- {3762691200 39600 1 SAKST}
- {3781440000 36000 0 SAKT}
- {3794140800 39600 1 SAKST}
- {3812889600 36000 0 SAKT}
- {3825590400 39600 1 SAKST}
- {3844339200 36000 0 SAKT}
- {3857644800 39600 1 SAKST}
- {3875788800 36000 0 SAKT}
- {3889094400 39600 1 SAKST}
- {3907238400 36000 0 SAKT}
- {3920544000 39600 1 SAKST}
- {3939292800 36000 0 SAKT}
- {3951993600 39600 1 SAKST}
- {3970742400 36000 0 SAKT}
- {3983443200 39600 1 SAKST}
- {4002192000 36000 0 SAKT}
- {4015497600 39600 1 SAKST}
- {4033641600 36000 0 SAKT}
- {4046947200 39600 1 SAKST}
- {4065091200 36000 0 SAKT}
- {4078396800 39600 1 SAKST}
- {4096540800 36000 0 SAKT}
+ {1301155200 39600 0 SAKT}
}
diff --git a/library/tzdata/Asia/Vladivostok b/library/tzdata/Asia/Vladivostok
index 29e8f62..54101a5 100644
--- a/library/tzdata/Asia/Vladivostok
+++ b/library/tzdata/Asia/Vladivostok
@@ -66,182 +66,5 @@ set TZData(:Asia/Vladivostok) {
{1256400000 36000 0 VLAT}
{1269705600 39600 1 VLAST}
{1288454400 36000 0 VLAT}
- {1301155200 39600 1 VLAST}
- {1319904000 36000 0 VLAT}
- {1332604800 39600 1 VLAST}
- {1351353600 36000 0 VLAT}
- {1364659200 39600 1 VLAST}
- {1382803200 36000 0 VLAT}
- {1396108800 39600 1 VLAST}
- {1414252800 36000 0 VLAT}
- {1427558400 39600 1 VLAST}
- {1445702400 36000 0 VLAT}
- {1459008000 39600 1 VLAST}
- {1477756800 36000 0 VLAT}
- {1490457600 39600 1 VLAST}
- {1509206400 36000 0 VLAT}
- {1521907200 39600 1 VLAST}
- {1540656000 36000 0 VLAT}
- {1553961600 39600 1 VLAST}
- {1572105600 36000 0 VLAT}
- {1585411200 39600 1 VLAST}
- {1603555200 36000 0 VLAT}
- {1616860800 39600 1 VLAST}
- {1635609600 36000 0 VLAT}
- {1648310400 39600 1 VLAST}
- {1667059200 36000 0 VLAT}
- {1679760000 39600 1 VLAST}
- {1698508800 36000 0 VLAT}
- {1711814400 39600 1 VLAST}
- {1729958400 36000 0 VLAT}
- {1743264000 39600 1 VLAST}
- {1761408000 36000 0 VLAT}
- {1774713600 39600 1 VLAST}
- {1792857600 36000 0 VLAT}
- {1806163200 39600 1 VLAST}
- {1824912000 36000 0 VLAT}
- {1837612800 39600 1 VLAST}
- {1856361600 36000 0 VLAT}
- {1869062400 39600 1 VLAST}
- {1887811200 36000 0 VLAT}
- {1901116800 39600 1 VLAST}
- {1919260800 36000 0 VLAT}
- {1932566400 39600 1 VLAST}
- {1950710400 36000 0 VLAT}
- {1964016000 39600 1 VLAST}
- {1982764800 36000 0 VLAT}
- {1995465600 39600 1 VLAST}
- {2014214400 36000 0 VLAT}
- {2026915200 39600 1 VLAST}
- {2045664000 36000 0 VLAT}
- {2058364800 39600 1 VLAST}
- {2077113600 36000 0 VLAT}
- {2090419200 39600 1 VLAST}
- {2108563200 36000 0 VLAT}
- {2121868800 39600 1 VLAST}
- {2140012800 36000 0 VLAT}
- {2153318400 39600 1 VLAST}
- {2172067200 36000 0 VLAT}
- {2184768000 39600 1 VLAST}
- {2203516800 36000 0 VLAT}
- {2216217600 39600 1 VLAST}
- {2234966400 36000 0 VLAT}
- {2248272000 39600 1 VLAST}
- {2266416000 36000 0 VLAT}
- {2279721600 39600 1 VLAST}
- {2297865600 36000 0 VLAT}
- {2311171200 39600 1 VLAST}
- {2329315200 36000 0 VLAT}
- {2342620800 39600 1 VLAST}
- {2361369600 36000 0 VLAT}
- {2374070400 39600 1 VLAST}
- {2392819200 36000 0 VLAT}
- {2405520000 39600 1 VLAST}
- {2424268800 36000 0 VLAT}
- {2437574400 39600 1 VLAST}
- {2455718400 36000 0 VLAT}
- {2469024000 39600 1 VLAST}
- {2487168000 36000 0 VLAT}
- {2500473600 39600 1 VLAST}
- {2519222400 36000 0 VLAT}
- {2531923200 39600 1 VLAST}
- {2550672000 36000 0 VLAT}
- {2563372800 39600 1 VLAST}
- {2582121600 36000 0 VLAT}
- {2595427200 39600 1 VLAST}
- {2613571200 36000 0 VLAT}
- {2626876800 39600 1 VLAST}
- {2645020800 36000 0 VLAT}
- {2658326400 39600 1 VLAST}
- {2676470400 36000 0 VLAT}
- {2689776000 39600 1 VLAST}
- {2708524800 36000 0 VLAT}
- {2721225600 39600 1 VLAST}
- {2739974400 36000 0 VLAT}
- {2752675200 39600 1 VLAST}
- {2771424000 36000 0 VLAT}
- {2784729600 39600 1 VLAST}
- {2802873600 36000 0 VLAT}
- {2816179200 39600 1 VLAST}
- {2834323200 36000 0 VLAT}
- {2847628800 39600 1 VLAST}
- {2866377600 36000 0 VLAT}
- {2879078400 39600 1 VLAST}
- {2897827200 36000 0 VLAT}
- {2910528000 39600 1 VLAST}
- {2929276800 36000 0 VLAT}
- {2941977600 39600 1 VLAST}
- {2960726400 36000 0 VLAT}
- {2974032000 39600 1 VLAST}
- {2992176000 36000 0 VLAT}
- {3005481600 39600 1 VLAST}
- {3023625600 36000 0 VLAT}
- {3036931200 39600 1 VLAST}
- {3055680000 36000 0 VLAT}
- {3068380800 39600 1 VLAST}
- {3087129600 36000 0 VLAT}
- {3099830400 39600 1 VLAST}
- {3118579200 36000 0 VLAT}
- {3131884800 39600 1 VLAST}
- {3150028800 36000 0 VLAT}
- {3163334400 39600 1 VLAST}
- {3181478400 36000 0 VLAT}
- {3194784000 39600 1 VLAST}
- {3212928000 36000 0 VLAT}
- {3226233600 39600 1 VLAST}
- {3244982400 36000 0 VLAT}
- {3257683200 39600 1 VLAST}
- {3276432000 36000 0 VLAT}
- {3289132800 39600 1 VLAST}
- {3307881600 36000 0 VLAT}
- {3321187200 39600 1 VLAST}
- {3339331200 36000 0 VLAT}
- {3352636800 39600 1 VLAST}
- {3370780800 36000 0 VLAT}
- {3384086400 39600 1 VLAST}
- {3402835200 36000 0 VLAT}
- {3415536000 39600 1 VLAST}
- {3434284800 36000 0 VLAT}
- {3446985600 39600 1 VLAST}
- {3465734400 36000 0 VLAT}
- {3479040000 39600 1 VLAST}
- {3497184000 36000 0 VLAT}
- {3510489600 39600 1 VLAST}
- {3528633600 36000 0 VLAT}
- {3541939200 39600 1 VLAST}
- {3560083200 36000 0 VLAT}
- {3573388800 39600 1 VLAST}
- {3592137600 36000 0 VLAT}
- {3604838400 39600 1 VLAST}
- {3623587200 36000 0 VLAT}
- {3636288000 39600 1 VLAST}
- {3655036800 36000 0 VLAT}
- {3668342400 39600 1 VLAST}
- {3686486400 36000 0 VLAT}
- {3699792000 39600 1 VLAST}
- {3717936000 36000 0 VLAT}
- {3731241600 39600 1 VLAST}
- {3749990400 36000 0 VLAT}
- {3762691200 39600 1 VLAST}
- {3781440000 36000 0 VLAT}
- {3794140800 39600 1 VLAST}
- {3812889600 36000 0 VLAT}
- {3825590400 39600 1 VLAST}
- {3844339200 36000 0 VLAT}
- {3857644800 39600 1 VLAST}
- {3875788800 36000 0 VLAT}
- {3889094400 39600 1 VLAST}
- {3907238400 36000 0 VLAT}
- {3920544000 39600 1 VLAST}
- {3939292800 36000 0 VLAT}
- {3951993600 39600 1 VLAST}
- {3970742400 36000 0 VLAT}
- {3983443200 39600 1 VLAST}
- {4002192000 36000 0 VLAT}
- {4015497600 39600 1 VLAST}
- {4033641600 36000 0 VLAT}
- {4046947200 39600 1 VLAST}
- {4065091200 36000 0 VLAT}
- {4078396800 39600 1 VLAST}
- {4096540800 36000 0 VLAT}
+ {1301155200 39600 0 VLAT}
}
diff --git a/library/tzdata/Asia/Yakutsk b/library/tzdata/Asia/Yakutsk
index acf5d7d..5c32cc9 100644
--- a/library/tzdata/Asia/Yakutsk
+++ b/library/tzdata/Asia/Yakutsk
@@ -66,182 +66,5 @@ set TZData(:Asia/Yakutsk) {
{1256403600 32400 0 YAKT}
{1269709200 36000 1 YAKST}
{1288458000 32400 0 YAKT}
- {1301158800 36000 1 YAKST}
- {1319907600 32400 0 YAKT}
- {1332608400 36000 1 YAKST}
- {1351357200 32400 0 YAKT}
- {1364662800 36000 1 YAKST}
- {1382806800 32400 0 YAKT}
- {1396112400 36000 1 YAKST}
- {1414256400 32400 0 YAKT}
- {1427562000 36000 1 YAKST}
- {1445706000 32400 0 YAKT}
- {1459011600 36000 1 YAKST}
- {1477760400 32400 0 YAKT}
- {1490461200 36000 1 YAKST}
- {1509210000 32400 0 YAKT}
- {1521910800 36000 1 YAKST}
- {1540659600 32400 0 YAKT}
- {1553965200 36000 1 YAKST}
- {1572109200 32400 0 YAKT}
- {1585414800 36000 1 YAKST}
- {1603558800 32400 0 YAKT}
- {1616864400 36000 1 YAKST}
- {1635613200 32400 0 YAKT}
- {1648314000 36000 1 YAKST}
- {1667062800 32400 0 YAKT}
- {1679763600 36000 1 YAKST}
- {1698512400 32400 0 YAKT}
- {1711818000 36000 1 YAKST}
- {1729962000 32400 0 YAKT}
- {1743267600 36000 1 YAKST}
- {1761411600 32400 0 YAKT}
- {1774717200 36000 1 YAKST}
- {1792861200 32400 0 YAKT}
- {1806166800 36000 1 YAKST}
- {1824915600 32400 0 YAKT}
- {1837616400 36000 1 YAKST}
- {1856365200 32400 0 YAKT}
- {1869066000 36000 1 YAKST}
- {1887814800 32400 0 YAKT}
- {1901120400 36000 1 YAKST}
- {1919264400 32400 0 YAKT}
- {1932570000 36000 1 YAKST}
- {1950714000 32400 0 YAKT}
- {1964019600 36000 1 YAKST}
- {1982768400 32400 0 YAKT}
- {1995469200 36000 1 YAKST}
- {2014218000 32400 0 YAKT}
- {2026918800 36000 1 YAKST}
- {2045667600 32400 0 YAKT}
- {2058368400 36000 1 YAKST}
- {2077117200 32400 0 YAKT}
- {2090422800 36000 1 YAKST}
- {2108566800 32400 0 YAKT}
- {2121872400 36000 1 YAKST}
- {2140016400 32400 0 YAKT}
- {2153322000 36000 1 YAKST}
- {2172070800 32400 0 YAKT}
- {2184771600 36000 1 YAKST}
- {2203520400 32400 0 YAKT}
- {2216221200 36000 1 YAKST}
- {2234970000 32400 0 YAKT}
- {2248275600 36000 1 YAKST}
- {2266419600 32400 0 YAKT}
- {2279725200 36000 1 YAKST}
- {2297869200 32400 0 YAKT}
- {2311174800 36000 1 YAKST}
- {2329318800 32400 0 YAKT}
- {2342624400 36000 1 YAKST}
- {2361373200 32400 0 YAKT}
- {2374074000 36000 1 YAKST}
- {2392822800 32400 0 YAKT}
- {2405523600 36000 1 YAKST}
- {2424272400 32400 0 YAKT}
- {2437578000 36000 1 YAKST}
- {2455722000 32400 0 YAKT}
- {2469027600 36000 1 YAKST}
- {2487171600 32400 0 YAKT}
- {2500477200 36000 1 YAKST}
- {2519226000 32400 0 YAKT}
- {2531926800 36000 1 YAKST}
- {2550675600 32400 0 YAKT}
- {2563376400 36000 1 YAKST}
- {2582125200 32400 0 YAKT}
- {2595430800 36000 1 YAKST}
- {2613574800 32400 0 YAKT}
- {2626880400 36000 1 YAKST}
- {2645024400 32400 0 YAKT}
- {2658330000 36000 1 YAKST}
- {2676474000 32400 0 YAKT}
- {2689779600 36000 1 YAKST}
- {2708528400 32400 0 YAKT}
- {2721229200 36000 1 YAKST}
- {2739978000 32400 0 YAKT}
- {2752678800 36000 1 YAKST}
- {2771427600 32400 0 YAKT}
- {2784733200 36000 1 YAKST}
- {2802877200 32400 0 YAKT}
- {2816182800 36000 1 YAKST}
- {2834326800 32400 0 YAKT}
- {2847632400 36000 1 YAKST}
- {2866381200 32400 0 YAKT}
- {2879082000 36000 1 YAKST}
- {2897830800 32400 0 YAKT}
- {2910531600 36000 1 YAKST}
- {2929280400 32400 0 YAKT}
- {2941981200 36000 1 YAKST}
- {2960730000 32400 0 YAKT}
- {2974035600 36000 1 YAKST}
- {2992179600 32400 0 YAKT}
- {3005485200 36000 1 YAKST}
- {3023629200 32400 0 YAKT}
- {3036934800 36000 1 YAKST}
- {3055683600 32400 0 YAKT}
- {3068384400 36000 1 YAKST}
- {3087133200 32400 0 YAKT}
- {3099834000 36000 1 YAKST}
- {3118582800 32400 0 YAKT}
- {3131888400 36000 1 YAKST}
- {3150032400 32400 0 YAKT}
- {3163338000 36000 1 YAKST}
- {3181482000 32400 0 YAKT}
- {3194787600 36000 1 YAKST}
- {3212931600 32400 0 YAKT}
- {3226237200 36000 1 YAKST}
- {3244986000 32400 0 YAKT}
- {3257686800 36000 1 YAKST}
- {3276435600 32400 0 YAKT}
- {3289136400 36000 1 YAKST}
- {3307885200 32400 0 YAKT}
- {3321190800 36000 1 YAKST}
- {3339334800 32400 0 YAKT}
- {3352640400 36000 1 YAKST}
- {3370784400 32400 0 YAKT}
- {3384090000 36000 1 YAKST}
- {3402838800 32400 0 YAKT}
- {3415539600 36000 1 YAKST}
- {3434288400 32400 0 YAKT}
- {3446989200 36000 1 YAKST}
- {3465738000 32400 0 YAKT}
- {3479043600 36000 1 YAKST}
- {3497187600 32400 0 YAKT}
- {3510493200 36000 1 YAKST}
- {3528637200 32400 0 YAKT}
- {3541942800 36000 1 YAKST}
- {3560086800 32400 0 YAKT}
- {3573392400 36000 1 YAKST}
- {3592141200 32400 0 YAKT}
- {3604842000 36000 1 YAKST}
- {3623590800 32400 0 YAKT}
- {3636291600 36000 1 YAKST}
- {3655040400 32400 0 YAKT}
- {3668346000 36000 1 YAKST}
- {3686490000 32400 0 YAKT}
- {3699795600 36000 1 YAKST}
- {3717939600 32400 0 YAKT}
- {3731245200 36000 1 YAKST}
- {3749994000 32400 0 YAKT}
- {3762694800 36000 1 YAKST}
- {3781443600 32400 0 YAKT}
- {3794144400 36000 1 YAKST}
- {3812893200 32400 0 YAKT}
- {3825594000 36000 1 YAKST}
- {3844342800 32400 0 YAKT}
- {3857648400 36000 1 YAKST}
- {3875792400 32400 0 YAKT}
- {3889098000 36000 1 YAKST}
- {3907242000 32400 0 YAKT}
- {3920547600 36000 1 YAKST}
- {3939296400 32400 0 YAKT}
- {3951997200 36000 1 YAKST}
- {3970746000 32400 0 YAKT}
- {3983446800 36000 1 YAKST}
- {4002195600 32400 0 YAKT}
- {4015501200 36000 1 YAKST}
- {4033645200 32400 0 YAKT}
- {4046950800 36000 1 YAKST}
- {4065094800 32400 0 YAKT}
- {4078400400 36000 1 YAKST}
- {4096544400 32400 0 YAKT}
+ {1301158800 36000 0 YAKT}
}
diff --git a/library/tzdata/Asia/Yekaterinburg b/library/tzdata/Asia/Yekaterinburg
index 980f903..2045496 100644
--- a/library/tzdata/Asia/Yekaterinburg
+++ b/library/tzdata/Asia/Yekaterinburg
@@ -66,182 +66,5 @@ set TZData(:Asia/Yekaterinburg) {
{1256418000 18000 0 YEKT}
{1269723600 21600 1 YEKST}
{1288472400 18000 0 YEKT}
- {1301173200 21600 1 YEKST}
- {1319922000 18000 0 YEKT}
- {1332622800 21600 1 YEKST}
- {1351371600 18000 0 YEKT}
- {1364677200 21600 1 YEKST}
- {1382821200 18000 0 YEKT}
- {1396126800 21600 1 YEKST}
- {1414270800 18000 0 YEKT}
- {1427576400 21600 1 YEKST}
- {1445720400 18000 0 YEKT}
- {1459026000 21600 1 YEKST}
- {1477774800 18000 0 YEKT}
- {1490475600 21600 1 YEKST}
- {1509224400 18000 0 YEKT}
- {1521925200 21600 1 YEKST}
- {1540674000 18000 0 YEKT}
- {1553979600 21600 1 YEKST}
- {1572123600 18000 0 YEKT}
- {1585429200 21600 1 YEKST}
- {1603573200 18000 0 YEKT}
- {1616878800 21600 1 YEKST}
- {1635627600 18000 0 YEKT}
- {1648328400 21600 1 YEKST}
- {1667077200 18000 0 YEKT}
- {1679778000 21600 1 YEKST}
- {1698526800 18000 0 YEKT}
- {1711832400 21600 1 YEKST}
- {1729976400 18000 0 YEKT}
- {1743282000 21600 1 YEKST}
- {1761426000 18000 0 YEKT}
- {1774731600 21600 1 YEKST}
- {1792875600 18000 0 YEKT}
- {1806181200 21600 1 YEKST}
- {1824930000 18000 0 YEKT}
- {1837630800 21600 1 YEKST}
- {1856379600 18000 0 YEKT}
- {1869080400 21600 1 YEKST}
- {1887829200 18000 0 YEKT}
- {1901134800 21600 1 YEKST}
- {1919278800 18000 0 YEKT}
- {1932584400 21600 1 YEKST}
- {1950728400 18000 0 YEKT}
- {1964034000 21600 1 YEKST}
- {1982782800 18000 0 YEKT}
- {1995483600 21600 1 YEKST}
- {2014232400 18000 0 YEKT}
- {2026933200 21600 1 YEKST}
- {2045682000 18000 0 YEKT}
- {2058382800 21600 1 YEKST}
- {2077131600 18000 0 YEKT}
- {2090437200 21600 1 YEKST}
- {2108581200 18000 0 YEKT}
- {2121886800 21600 1 YEKST}
- {2140030800 18000 0 YEKT}
- {2153336400 21600 1 YEKST}
- {2172085200 18000 0 YEKT}
- {2184786000 21600 1 YEKST}
- {2203534800 18000 0 YEKT}
- {2216235600 21600 1 YEKST}
- {2234984400 18000 0 YEKT}
- {2248290000 21600 1 YEKST}
- {2266434000 18000 0 YEKT}
- {2279739600 21600 1 YEKST}
- {2297883600 18000 0 YEKT}
- {2311189200 21600 1 YEKST}
- {2329333200 18000 0 YEKT}
- {2342638800 21600 1 YEKST}
- {2361387600 18000 0 YEKT}
- {2374088400 21600 1 YEKST}
- {2392837200 18000 0 YEKT}
- {2405538000 21600 1 YEKST}
- {2424286800 18000 0 YEKT}
- {2437592400 21600 1 YEKST}
- {2455736400 18000 0 YEKT}
- {2469042000 21600 1 YEKST}
- {2487186000 18000 0 YEKT}
- {2500491600 21600 1 YEKST}
- {2519240400 18000 0 YEKT}
- {2531941200 21600 1 YEKST}
- {2550690000 18000 0 YEKT}
- {2563390800 21600 1 YEKST}
- {2582139600 18000 0 YEKT}
- {2595445200 21600 1 YEKST}
- {2613589200 18000 0 YEKT}
- {2626894800 21600 1 YEKST}
- {2645038800 18000 0 YEKT}
- {2658344400 21600 1 YEKST}
- {2676488400 18000 0 YEKT}
- {2689794000 21600 1 YEKST}
- {2708542800 18000 0 YEKT}
- {2721243600 21600 1 YEKST}
- {2739992400 18000 0 YEKT}
- {2752693200 21600 1 YEKST}
- {2771442000 18000 0 YEKT}
- {2784747600 21600 1 YEKST}
- {2802891600 18000 0 YEKT}
- {2816197200 21600 1 YEKST}
- {2834341200 18000 0 YEKT}
- {2847646800 21600 1 YEKST}
- {2866395600 18000 0 YEKT}
- {2879096400 21600 1 YEKST}
- {2897845200 18000 0 YEKT}
- {2910546000 21600 1 YEKST}
- {2929294800 18000 0 YEKT}
- {2941995600 21600 1 YEKST}
- {2960744400 18000 0 YEKT}
- {2974050000 21600 1 YEKST}
- {2992194000 18000 0 YEKT}
- {3005499600 21600 1 YEKST}
- {3023643600 18000 0 YEKT}
- {3036949200 21600 1 YEKST}
- {3055698000 18000 0 YEKT}
- {3068398800 21600 1 YEKST}
- {3087147600 18000 0 YEKT}
- {3099848400 21600 1 YEKST}
- {3118597200 18000 0 YEKT}
- {3131902800 21600 1 YEKST}
- {3150046800 18000 0 YEKT}
- {3163352400 21600 1 YEKST}
- {3181496400 18000 0 YEKT}
- {3194802000 21600 1 YEKST}
- {3212946000 18000 0 YEKT}
- {3226251600 21600 1 YEKST}
- {3245000400 18000 0 YEKT}
- {3257701200 21600 1 YEKST}
- {3276450000 18000 0 YEKT}
- {3289150800 21600 1 YEKST}
- {3307899600 18000 0 YEKT}
- {3321205200 21600 1 YEKST}
- {3339349200 18000 0 YEKT}
- {3352654800 21600 1 YEKST}
- {3370798800 18000 0 YEKT}
- {3384104400 21600 1 YEKST}
- {3402853200 18000 0 YEKT}
- {3415554000 21600 1 YEKST}
- {3434302800 18000 0 YEKT}
- {3447003600 21600 1 YEKST}
- {3465752400 18000 0 YEKT}
- {3479058000 21600 1 YEKST}
- {3497202000 18000 0 YEKT}
- {3510507600 21600 1 YEKST}
- {3528651600 18000 0 YEKT}
- {3541957200 21600 1 YEKST}
- {3560101200 18000 0 YEKT}
- {3573406800 21600 1 YEKST}
- {3592155600 18000 0 YEKT}
- {3604856400 21600 1 YEKST}
- {3623605200 18000 0 YEKT}
- {3636306000 21600 1 YEKST}
- {3655054800 18000 0 YEKT}
- {3668360400 21600 1 YEKST}
- {3686504400 18000 0 YEKT}
- {3699810000 21600 1 YEKST}
- {3717954000 18000 0 YEKT}
- {3731259600 21600 1 YEKST}
- {3750008400 18000 0 YEKT}
- {3762709200 21600 1 YEKST}
- {3781458000 18000 0 YEKT}
- {3794158800 21600 1 YEKST}
- {3812907600 18000 0 YEKT}
- {3825608400 21600 1 YEKST}
- {3844357200 18000 0 YEKT}
- {3857662800 21600 1 YEKST}
- {3875806800 18000 0 YEKT}
- {3889112400 21600 1 YEKST}
- {3907256400 18000 0 YEKT}
- {3920562000 21600 1 YEKST}
- {3939310800 18000 0 YEKT}
- {3952011600 21600 1 YEKST}
- {3970760400 18000 0 YEKT}
- {3983461200 21600 1 YEKST}
- {4002210000 18000 0 YEKT}
- {4015515600 21600 1 YEKST}
- {4033659600 18000 0 YEKT}
- {4046965200 21600 1 YEKST}
- {4065109200 18000 0 YEKT}
- {4078414800 21600 1 YEKST}
- {4096558800 18000 0 YEKT}
+ {1301173200 21600 0 YEKT}
}
diff --git a/library/tzdata/Asia/Yerevan b/library/tzdata/Asia/Yerevan
index cd70b4f..22008ef 100644
--- a/library/tzdata/Asia/Yerevan
+++ b/library/tzdata/Asia/Yerevan
@@ -66,180 +66,5 @@ set TZData(:Asia/Yerevan) {
{1288476000 14400 0 AMT}
{1301176800 18000 1 AMST}
{1319925600 14400 0 AMT}
- {1332626400 18000 1 AMST}
- {1351375200 14400 0 AMT}
- {1364680800 18000 1 AMST}
- {1382824800 14400 0 AMT}
- {1396130400 18000 1 AMST}
- {1414274400 14400 0 AMT}
- {1427580000 18000 1 AMST}
- {1445724000 14400 0 AMT}
- {1459029600 18000 1 AMST}
- {1477778400 14400 0 AMT}
- {1490479200 18000 1 AMST}
- {1509228000 14400 0 AMT}
- {1521928800 18000 1 AMST}
- {1540677600 14400 0 AMT}
- {1553983200 18000 1 AMST}
- {1572127200 14400 0 AMT}
- {1585432800 18000 1 AMST}
- {1603576800 14400 0 AMT}
- {1616882400 18000 1 AMST}
- {1635631200 14400 0 AMT}
- {1648332000 18000 1 AMST}
- {1667080800 14400 0 AMT}
- {1679781600 18000 1 AMST}
- {1698530400 14400 0 AMT}
- {1711836000 18000 1 AMST}
- {1729980000 14400 0 AMT}
- {1743285600 18000 1 AMST}
- {1761429600 14400 0 AMT}
- {1774735200 18000 1 AMST}
- {1792879200 14400 0 AMT}
- {1806184800 18000 1 AMST}
- {1824933600 14400 0 AMT}
- {1837634400 18000 1 AMST}
- {1856383200 14400 0 AMT}
- {1869084000 18000 1 AMST}
- {1887832800 14400 0 AMT}
- {1901138400 18000 1 AMST}
- {1919282400 14400 0 AMT}
- {1932588000 18000 1 AMST}
- {1950732000 14400 0 AMT}
- {1964037600 18000 1 AMST}
- {1982786400 14400 0 AMT}
- {1995487200 18000 1 AMST}
- {2014236000 14400 0 AMT}
- {2026936800 18000 1 AMST}
- {2045685600 14400 0 AMT}
- {2058386400 18000 1 AMST}
- {2077135200 14400 0 AMT}
- {2090440800 18000 1 AMST}
- {2108584800 14400 0 AMT}
- {2121890400 18000 1 AMST}
- {2140034400 14400 0 AMT}
- {2153340000 18000 1 AMST}
- {2172088800 14400 0 AMT}
- {2184789600 18000 1 AMST}
- {2203538400 14400 0 AMT}
- {2216239200 18000 1 AMST}
- {2234988000 14400 0 AMT}
- {2248293600 18000 1 AMST}
- {2266437600 14400 0 AMT}
- {2279743200 18000 1 AMST}
- {2297887200 14400 0 AMT}
- {2311192800 18000 1 AMST}
- {2329336800 14400 0 AMT}
- {2342642400 18000 1 AMST}
- {2361391200 14400 0 AMT}
- {2374092000 18000 1 AMST}
- {2392840800 14400 0 AMT}
- {2405541600 18000 1 AMST}
- {2424290400 14400 0 AMT}
- {2437596000 18000 1 AMST}
- {2455740000 14400 0 AMT}
- {2469045600 18000 1 AMST}
- {2487189600 14400 0 AMT}
- {2500495200 18000 1 AMST}
- {2519244000 14400 0 AMT}
- {2531944800 18000 1 AMST}
- {2550693600 14400 0 AMT}
- {2563394400 18000 1 AMST}
- {2582143200 14400 0 AMT}
- {2595448800 18000 1 AMST}
- {2613592800 14400 0 AMT}
- {2626898400 18000 1 AMST}
- {2645042400 14400 0 AMT}
- {2658348000 18000 1 AMST}
- {2676492000 14400 0 AMT}
- {2689797600 18000 1 AMST}
- {2708546400 14400 0 AMT}
- {2721247200 18000 1 AMST}
- {2739996000 14400 0 AMT}
- {2752696800 18000 1 AMST}
- {2771445600 14400 0 AMT}
- {2784751200 18000 1 AMST}
- {2802895200 14400 0 AMT}
- {2816200800 18000 1 AMST}
- {2834344800 14400 0 AMT}
- {2847650400 18000 1 AMST}
- {2866399200 14400 0 AMT}
- {2879100000 18000 1 AMST}
- {2897848800 14400 0 AMT}
- {2910549600 18000 1 AMST}
- {2929298400 14400 0 AMT}
- {2941999200 18000 1 AMST}
- {2960748000 14400 0 AMT}
- {2974053600 18000 1 AMST}
- {2992197600 14400 0 AMT}
- {3005503200 18000 1 AMST}
- {3023647200 14400 0 AMT}
- {3036952800 18000 1 AMST}
- {3055701600 14400 0 AMT}
- {3068402400 18000 1 AMST}
- {3087151200 14400 0 AMT}
- {3099852000 18000 1 AMST}
- {3118600800 14400 0 AMT}
- {3131906400 18000 1 AMST}
- {3150050400 14400 0 AMT}
- {3163356000 18000 1 AMST}
- {3181500000 14400 0 AMT}
- {3194805600 18000 1 AMST}
- {3212949600 14400 0 AMT}
- {3226255200 18000 1 AMST}
- {3245004000 14400 0 AMT}
- {3257704800 18000 1 AMST}
- {3276453600 14400 0 AMT}
- {3289154400 18000 1 AMST}
- {3307903200 14400 0 AMT}
- {3321208800 18000 1 AMST}
- {3339352800 14400 0 AMT}
- {3352658400 18000 1 AMST}
- {3370802400 14400 0 AMT}
- {3384108000 18000 1 AMST}
- {3402856800 14400 0 AMT}
- {3415557600 18000 1 AMST}
- {3434306400 14400 0 AMT}
- {3447007200 18000 1 AMST}
- {3465756000 14400 0 AMT}
- {3479061600 18000 1 AMST}
- {3497205600 14400 0 AMT}
- {3510511200 18000 1 AMST}
- {3528655200 14400 0 AMT}
- {3541960800 18000 1 AMST}
- {3560104800 14400 0 AMT}
- {3573410400 18000 1 AMST}
- {3592159200 14400 0 AMT}
- {3604860000 18000 1 AMST}
- {3623608800 14400 0 AMT}
- {3636309600 18000 1 AMST}
- {3655058400 14400 0 AMT}
- {3668364000 18000 1 AMST}
- {3686508000 14400 0 AMT}
- {3699813600 18000 1 AMST}
- {3717957600 14400 0 AMT}
- {3731263200 18000 1 AMST}
- {3750012000 14400 0 AMT}
- {3762712800 18000 1 AMST}
- {3781461600 14400 0 AMT}
- {3794162400 18000 1 AMST}
- {3812911200 14400 0 AMT}
- {3825612000 18000 1 AMST}
- {3844360800 14400 0 AMT}
- {3857666400 18000 1 AMST}
- {3875810400 14400 0 AMT}
- {3889116000 18000 1 AMST}
- {3907260000 14400 0 AMT}
- {3920565600 18000 1 AMST}
- {3939314400 14400 0 AMT}
- {3952015200 18000 1 AMST}
- {3970764000 14400 0 AMT}
- {3983464800 18000 1 AMST}
- {4002213600 14400 0 AMT}
- {4015519200 18000 1 AMST}
- {4033663200 14400 0 AMT}
- {4046968800 18000 1 AMST}
- {4065112800 14400 0 AMT}
- {4078418400 18000 1 AMST}
- {4096562400 14400 0 AMT}
+ {1332626400 14400 0 AMT}
}
diff --git a/library/tzdata/Atlantic/Stanley b/library/tzdata/Atlantic/Stanley
index 70dc402..c287238 100644
--- a/library/tzdata/Atlantic/Stanley
+++ b/library/tzdata/Atlantic/Stanley
@@ -71,183 +71,5 @@ set TZData(:Atlantic/Stanley) {
{1240117200 -14400 0 FKT}
{1252216800 -10800 1 FKST}
{1271566800 -14400 0 FKT}
- {1283666400 -10800 1 FKST}
- {1303016400 -14400 0 FKT}
- {1315116000 -10800 1 FKST}
- {1334466000 -14400 0 FKT}
- {1346565600 -10800 1 FKST}
- {1366520400 -14400 0 FKT}
- {1378015200 -10800 1 FKST}
- {1397970000 -14400 0 FKT}
- {1410069600 -10800 1 FKST}
- {1429419600 -14400 0 FKT}
- {1441519200 -10800 1 FKST}
- {1460869200 -14400 0 FKT}
- {1472968800 -10800 1 FKST}
- {1492318800 -14400 0 FKT}
- {1504418400 -10800 1 FKST}
- {1523768400 -14400 0 FKT}
- {1535868000 -10800 1 FKST}
- {1555822800 -14400 0 FKT}
- {1567317600 -10800 1 FKST}
- {1587272400 -14400 0 FKT}
- {1599372000 -10800 1 FKST}
- {1618722000 -14400 0 FKT}
- {1630821600 -10800 1 FKST}
- {1650171600 -14400 0 FKT}
- {1662271200 -10800 1 FKST}
- {1681621200 -14400 0 FKT}
- {1693720800 -10800 1 FKST}
- {1713675600 -14400 0 FKT}
- {1725170400 -10800 1 FKST}
- {1745125200 -14400 0 FKT}
- {1757224800 -10800 1 FKST}
- {1776574800 -14400 0 FKT}
- {1788674400 -10800 1 FKST}
- {1808024400 -14400 0 FKT}
- {1820124000 -10800 1 FKST}
- {1839474000 -14400 0 FKT}
- {1851573600 -10800 1 FKST}
- {1870923600 -14400 0 FKT}
- {1883023200 -10800 1 FKST}
- {1902978000 -14400 0 FKT}
- {1914472800 -10800 1 FKST}
- {1934427600 -14400 0 FKT}
- {1946527200 -10800 1 FKST}
- {1965877200 -14400 0 FKT}
- {1977976800 -10800 1 FKST}
- {1997326800 -14400 0 FKT}
- {2009426400 -10800 1 FKST}
- {2028776400 -14400 0 FKT}
- {2040876000 -10800 1 FKST}
- {2060226000 -14400 0 FKT}
- {2072325600 -10800 1 FKST}
- {2092280400 -14400 0 FKT}
- {2104380000 -10800 1 FKST}
- {2123730000 -14400 0 FKT}
- {2135829600 -10800 1 FKST}
- {2155179600 -14400 0 FKT}
- {2167279200 -10800 1 FKST}
- {2186629200 -14400 0 FKT}
- {2198728800 -10800 1 FKST}
- {2218078800 -14400 0 FKT}
- {2230178400 -10800 1 FKST}
- {2250133200 -14400 0 FKT}
- {2261628000 -10800 1 FKST}
- {2281582800 -14400 0 FKT}
- {2293682400 -10800 1 FKST}
- {2313032400 -14400 0 FKT}
- {2325132000 -10800 1 FKST}
- {2344482000 -14400 0 FKT}
- {2356581600 -10800 1 FKST}
- {2375931600 -14400 0 FKT}
- {2388031200 -10800 1 FKST}
- {2407381200 -14400 0 FKT}
- {2419480800 -10800 1 FKST}
- {2439435600 -14400 0 FKT}
- {2450930400 -10800 1 FKST}
- {2470885200 -14400 0 FKT}
- {2482984800 -10800 1 FKST}
- {2502334800 -14400 0 FKT}
- {2514434400 -10800 1 FKST}
- {2533784400 -14400 0 FKT}
- {2545884000 -10800 1 FKST}
- {2565234000 -14400 0 FKT}
- {2577333600 -10800 1 FKST}
- {2597288400 -14400 0 FKT}
- {2608783200 -10800 1 FKST}
- {2628738000 -14400 0 FKT}
- {2640837600 -10800 1 FKST}
- {2660187600 -14400 0 FKT}
- {2672287200 -10800 1 FKST}
- {2691637200 -14400 0 FKT}
- {2703736800 -10800 1 FKST}
- {2723086800 -14400 0 FKT}
- {2735186400 -10800 1 FKST}
- {2754536400 -14400 0 FKT}
- {2766636000 -10800 1 FKST}
- {2786590800 -14400 0 FKT}
- {2798085600 -10800 1 FKST}
- {2818040400 -14400 0 FKT}
- {2830140000 -10800 1 FKST}
- {2849490000 -14400 0 FKT}
- {2861589600 -10800 1 FKST}
- {2880939600 -14400 0 FKT}
- {2893039200 -10800 1 FKST}
- {2912389200 -14400 0 FKT}
- {2924488800 -10800 1 FKST}
- {2943838800 -14400 0 FKT}
- {2955938400 -10800 1 FKST}
- {2975893200 -14400 0 FKT}
- {2987992800 -10800 1 FKST}
- {3007342800 -14400 0 FKT}
- {3019442400 -10800 1 FKST}
- {3038792400 -14400 0 FKT}
- {3050892000 -10800 1 FKST}
- {3070242000 -14400 0 FKT}
- {3082341600 -10800 1 FKST}
- {3101691600 -14400 0 FKT}
- {3113791200 -10800 1 FKST}
- {3133746000 -14400 0 FKT}
- {3145240800 -10800 1 FKST}
- {3165195600 -14400 0 FKT}
- {3177295200 -10800 1 FKST}
- {3196645200 -14400 0 FKT}
- {3208744800 -10800 1 FKST}
- {3228094800 -14400 0 FKT}
- {3240194400 -10800 1 FKST}
- {3259544400 -14400 0 FKT}
- {3271644000 -10800 1 FKST}
- {3290994000 -14400 0 FKT}
- {3303093600 -10800 1 FKST}
- {3323048400 -14400 0 FKT}
- {3334543200 -10800 1 FKST}
- {3354498000 -14400 0 FKT}
- {3366597600 -10800 1 FKST}
- {3385947600 -14400 0 FKT}
- {3398047200 -10800 1 FKST}
- {3417397200 -14400 0 FKT}
- {3429496800 -10800 1 FKST}
- {3448846800 -14400 0 FKT}
- {3460946400 -10800 1 FKST}
- {3480901200 -14400 0 FKT}
- {3492396000 -10800 1 FKST}
- {3512350800 -14400 0 FKT}
- {3524450400 -10800 1 FKST}
- {3543800400 -14400 0 FKT}
- {3555900000 -10800 1 FKST}
- {3575250000 -14400 0 FKT}
- {3587349600 -10800 1 FKST}
- {3606699600 -14400 0 FKT}
- {3618799200 -10800 1 FKST}
- {3638149200 -14400 0 FKT}
- {3650248800 -10800 1 FKST}
- {3670203600 -14400 0 FKT}
- {3681698400 -10800 1 FKST}
- {3701653200 -14400 0 FKT}
- {3713752800 -10800 1 FKST}
- {3733102800 -14400 0 FKT}
- {3745202400 -10800 1 FKST}
- {3764552400 -14400 0 FKT}
- {3776652000 -10800 1 FKST}
- {3796002000 -14400 0 FKT}
- {3808101600 -10800 1 FKST}
- {3827451600 -14400 0 FKT}
- {3839551200 -10800 1 FKST}
- {3859506000 -14400 0 FKT}
- {3871605600 -10800 1 FKST}
- {3890955600 -14400 0 FKT}
- {3903055200 -10800 1 FKST}
- {3922405200 -14400 0 FKT}
- {3934504800 -10800 1 FKST}
- {3953854800 -14400 0 FKT}
- {3965954400 -10800 1 FKST}
- {3985304400 -14400 0 FKT}
- {3997404000 -10800 1 FKST}
- {4017358800 -14400 0 FKT}
- {4028853600 -10800 1 FKST}
- {4048808400 -14400 0 FKT}
- {4060908000 -10800 1 FKST}
- {4080258000 -14400 0 FKT}
- {4092357600 -10800 1 FKST}
+ {1283662800 -10800 0 FKST}
}
diff --git a/library/tzdata/Europe/Istanbul b/library/tzdata/Europe/Istanbul
index 06b2f88..7737d75 100644
--- a/library/tzdata/Europe/Istanbul
+++ b/library/tzdata/Europe/Istanbul
@@ -122,7 +122,8 @@ set TZData(:Europe/Istanbul) {
{1256432400 7200 0 EET}
{1269738000 10800 1 EEST}
{1288486800 7200 0 EET}
- {1301187600 10800 1 EEST}
+ {1301187600 7200 0 EET}
+ {1301274000 10800 0 EEST}
{1319936400 7200 0 EET}
{1332637200 10800 1 EEST}
{1351386000 7200 0 EET}
diff --git a/library/tzdata/Europe/Kaliningrad b/library/tzdata/Europe/Kaliningrad
index 94ebb12..d5be459 100644
--- a/library/tzdata/Europe/Kaliningrad
+++ b/library/tzdata/Europe/Kaliningrad
@@ -80,182 +80,5 @@ set TZData(:Europe/Kaliningrad) {
{1256428800 7200 0 EET}
{1269734400 10800 1 EEST}
{1288483200 7200 0 EET}
- {1301184000 10800 1 EEST}
- {1319932800 7200 0 EET}
- {1332633600 10800 1 EEST}
- {1351382400 7200 0 EET}
- {1364688000 10800 1 EEST}
- {1382832000 7200 0 EET}
- {1396137600 10800 1 EEST}
- {1414281600 7200 0 EET}
- {1427587200 10800 1 EEST}
- {1445731200 7200 0 EET}
- {1459036800 10800 1 EEST}
- {1477785600 7200 0 EET}
- {1490486400 10800 1 EEST}
- {1509235200 7200 0 EET}
- {1521936000 10800 1 EEST}
- {1540684800 7200 0 EET}
- {1553990400 10800 1 EEST}
- {1572134400 7200 0 EET}
- {1585440000 10800 1 EEST}
- {1603584000 7200 0 EET}
- {1616889600 10800 1 EEST}
- {1635638400 7200 0 EET}
- {1648339200 10800 1 EEST}
- {1667088000 7200 0 EET}
- {1679788800 10800 1 EEST}
- {1698537600 7200 0 EET}
- {1711843200 10800 1 EEST}
- {1729987200 7200 0 EET}
- {1743292800 10800 1 EEST}
- {1761436800 7200 0 EET}
- {1774742400 10800 1 EEST}
- {1792886400 7200 0 EET}
- {1806192000 10800 1 EEST}
- {1824940800 7200 0 EET}
- {1837641600 10800 1 EEST}
- {1856390400 7200 0 EET}
- {1869091200 10800 1 EEST}
- {1887840000 7200 0 EET}
- {1901145600 10800 1 EEST}
- {1919289600 7200 0 EET}
- {1932595200 10800 1 EEST}
- {1950739200 7200 0 EET}
- {1964044800 10800 1 EEST}
- {1982793600 7200 0 EET}
- {1995494400 10800 1 EEST}
- {2014243200 7200 0 EET}
- {2026944000 10800 1 EEST}
- {2045692800 7200 0 EET}
- {2058393600 10800 1 EEST}
- {2077142400 7200 0 EET}
- {2090448000 10800 1 EEST}
- {2108592000 7200 0 EET}
- {2121897600 10800 1 EEST}
- {2140041600 7200 0 EET}
- {2153347200 10800 1 EEST}
- {2172096000 7200 0 EET}
- {2184796800 10800 1 EEST}
- {2203545600 7200 0 EET}
- {2216246400 10800 1 EEST}
- {2234995200 7200 0 EET}
- {2248300800 10800 1 EEST}
- {2266444800 7200 0 EET}
- {2279750400 10800 1 EEST}
- {2297894400 7200 0 EET}
- {2311200000 10800 1 EEST}
- {2329344000 7200 0 EET}
- {2342649600 10800 1 EEST}
- {2361398400 7200 0 EET}
- {2374099200 10800 1 EEST}
- {2392848000 7200 0 EET}
- {2405548800 10800 1 EEST}
- {2424297600 7200 0 EET}
- {2437603200 10800 1 EEST}
- {2455747200 7200 0 EET}
- {2469052800 10800 1 EEST}
- {2487196800 7200 0 EET}
- {2500502400 10800 1 EEST}
- {2519251200 7200 0 EET}
- {2531952000 10800 1 EEST}
- {2550700800 7200 0 EET}
- {2563401600 10800 1 EEST}
- {2582150400 7200 0 EET}
- {2595456000 10800 1 EEST}
- {2613600000 7200 0 EET}
- {2626905600 10800 1 EEST}
- {2645049600 7200 0 EET}
- {2658355200 10800 1 EEST}
- {2676499200 7200 0 EET}
- {2689804800 10800 1 EEST}
- {2708553600 7200 0 EET}
- {2721254400 10800 1 EEST}
- {2740003200 7200 0 EET}
- {2752704000 10800 1 EEST}
- {2771452800 7200 0 EET}
- {2784758400 10800 1 EEST}
- {2802902400 7200 0 EET}
- {2816208000 10800 1 EEST}
- {2834352000 7200 0 EET}
- {2847657600 10800 1 EEST}
- {2866406400 7200 0 EET}
- {2879107200 10800 1 EEST}
- {2897856000 7200 0 EET}
- {2910556800 10800 1 EEST}
- {2929305600 7200 0 EET}
- {2942006400 10800 1 EEST}
- {2960755200 7200 0 EET}
- {2974060800 10800 1 EEST}
- {2992204800 7200 0 EET}
- {3005510400 10800 1 EEST}
- {3023654400 7200 0 EET}
- {3036960000 10800 1 EEST}
- {3055708800 7200 0 EET}
- {3068409600 10800 1 EEST}
- {3087158400 7200 0 EET}
- {3099859200 10800 1 EEST}
- {3118608000 7200 0 EET}
- {3131913600 10800 1 EEST}
- {3150057600 7200 0 EET}
- {3163363200 10800 1 EEST}
- {3181507200 7200 0 EET}
- {3194812800 10800 1 EEST}
- {3212956800 7200 0 EET}
- {3226262400 10800 1 EEST}
- {3245011200 7200 0 EET}
- {3257712000 10800 1 EEST}
- {3276460800 7200 0 EET}
- {3289161600 10800 1 EEST}
- {3307910400 7200 0 EET}
- {3321216000 10800 1 EEST}
- {3339360000 7200 0 EET}
- {3352665600 10800 1 EEST}
- {3370809600 7200 0 EET}
- {3384115200 10800 1 EEST}
- {3402864000 7200 0 EET}
- {3415564800 10800 1 EEST}
- {3434313600 7200 0 EET}
- {3447014400 10800 1 EEST}
- {3465763200 7200 0 EET}
- {3479068800 10800 1 EEST}
- {3497212800 7200 0 EET}
- {3510518400 10800 1 EEST}
- {3528662400 7200 0 EET}
- {3541968000 10800 1 EEST}
- {3560112000 7200 0 EET}
- {3573417600 10800 1 EEST}
- {3592166400 7200 0 EET}
- {3604867200 10800 1 EEST}
- {3623616000 7200 0 EET}
- {3636316800 10800 1 EEST}
- {3655065600 7200 0 EET}
- {3668371200 10800 1 EEST}
- {3686515200 7200 0 EET}
- {3699820800 10800 1 EEST}
- {3717964800 7200 0 EET}
- {3731270400 10800 1 EEST}
- {3750019200 7200 0 EET}
- {3762720000 10800 1 EEST}
- {3781468800 7200 0 EET}
- {3794169600 10800 1 EEST}
- {3812918400 7200 0 EET}
- {3825619200 10800 1 EEST}
- {3844368000 7200 0 EET}
- {3857673600 10800 1 EEST}
- {3875817600 7200 0 EET}
- {3889123200 10800 1 EEST}
- {3907267200 7200 0 EET}
- {3920572800 10800 1 EEST}
- {3939321600 7200 0 EET}
- {3952022400 10800 1 EEST}
- {3970771200 7200 0 EET}
- {3983472000 10800 1 EEST}
- {4002220800 7200 0 EET}
- {4015526400 10800 1 EEST}
- {4033670400 7200 0 EET}
- {4046976000 10800 1 EEST}
- {4065120000 7200 0 EET}
- {4078425600 10800 1 EEST}
- {4096569600 7200 0 EET}
+ {1301184000 10800 0 FET}
}
diff --git a/library/tzdata/Europe/Minsk b/library/tzdata/Europe/Minsk
index d7d9434..1adcff8 100644
--- a/library/tzdata/Europe/Minsk
+++ b/library/tzdata/Europe/Minsk
@@ -70,182 +70,5 @@ set TZData(:Europe/Minsk) {
{1256428800 7200 0 EET}
{1269734400 10800 1 EEST}
{1288483200 7200 0 EET}
- {1301184000 10800 1 EEST}
- {1319932800 7200 0 EET}
- {1332633600 10800 1 EEST}
- {1351382400 7200 0 EET}
- {1364688000 10800 1 EEST}
- {1382832000 7200 0 EET}
- {1396137600 10800 1 EEST}
- {1414281600 7200 0 EET}
- {1427587200 10800 1 EEST}
- {1445731200 7200 0 EET}
- {1459036800 10800 1 EEST}
- {1477785600 7200 0 EET}
- {1490486400 10800 1 EEST}
- {1509235200 7200 0 EET}
- {1521936000 10800 1 EEST}
- {1540684800 7200 0 EET}
- {1553990400 10800 1 EEST}
- {1572134400 7200 0 EET}
- {1585440000 10800 1 EEST}
- {1603584000 7200 0 EET}
- {1616889600 10800 1 EEST}
- {1635638400 7200 0 EET}
- {1648339200 10800 1 EEST}
- {1667088000 7200 0 EET}
- {1679788800 10800 1 EEST}
- {1698537600 7200 0 EET}
- {1711843200 10800 1 EEST}
- {1729987200 7200 0 EET}
- {1743292800 10800 1 EEST}
- {1761436800 7200 0 EET}
- {1774742400 10800 1 EEST}
- {1792886400 7200 0 EET}
- {1806192000 10800 1 EEST}
- {1824940800 7200 0 EET}
- {1837641600 10800 1 EEST}
- {1856390400 7200 0 EET}
- {1869091200 10800 1 EEST}
- {1887840000 7200 0 EET}
- {1901145600 10800 1 EEST}
- {1919289600 7200 0 EET}
- {1932595200 10800 1 EEST}
- {1950739200 7200 0 EET}
- {1964044800 10800 1 EEST}
- {1982793600 7200 0 EET}
- {1995494400 10800 1 EEST}
- {2014243200 7200 0 EET}
- {2026944000 10800 1 EEST}
- {2045692800 7200 0 EET}
- {2058393600 10800 1 EEST}
- {2077142400 7200 0 EET}
- {2090448000 10800 1 EEST}
- {2108592000 7200 0 EET}
- {2121897600 10800 1 EEST}
- {2140041600 7200 0 EET}
- {2153347200 10800 1 EEST}
- {2172096000 7200 0 EET}
- {2184796800 10800 1 EEST}
- {2203545600 7200 0 EET}
- {2216246400 10800 1 EEST}
- {2234995200 7200 0 EET}
- {2248300800 10800 1 EEST}
- {2266444800 7200 0 EET}
- {2279750400 10800 1 EEST}
- {2297894400 7200 0 EET}
- {2311200000 10800 1 EEST}
- {2329344000 7200 0 EET}
- {2342649600 10800 1 EEST}
- {2361398400 7200 0 EET}
- {2374099200 10800 1 EEST}
- {2392848000 7200 0 EET}
- {2405548800 10800 1 EEST}
- {2424297600 7200 0 EET}
- {2437603200 10800 1 EEST}
- {2455747200 7200 0 EET}
- {2469052800 10800 1 EEST}
- {2487196800 7200 0 EET}
- {2500502400 10800 1 EEST}
- {2519251200 7200 0 EET}
- {2531952000 10800 1 EEST}
- {2550700800 7200 0 EET}
- {2563401600 10800 1 EEST}
- {2582150400 7200 0 EET}
- {2595456000 10800 1 EEST}
- {2613600000 7200 0 EET}
- {2626905600 10800 1 EEST}
- {2645049600 7200 0 EET}
- {2658355200 10800 1 EEST}
- {2676499200 7200 0 EET}
- {2689804800 10800 1 EEST}
- {2708553600 7200 0 EET}
- {2721254400 10800 1 EEST}
- {2740003200 7200 0 EET}
- {2752704000 10800 1 EEST}
- {2771452800 7200 0 EET}
- {2784758400 10800 1 EEST}
- {2802902400 7200 0 EET}
- {2816208000 10800 1 EEST}
- {2834352000 7200 0 EET}
- {2847657600 10800 1 EEST}
- {2866406400 7200 0 EET}
- {2879107200 10800 1 EEST}
- {2897856000 7200 0 EET}
- {2910556800 10800 1 EEST}
- {2929305600 7200 0 EET}
- {2942006400 10800 1 EEST}
- {2960755200 7200 0 EET}
- {2974060800 10800 1 EEST}
- {2992204800 7200 0 EET}
- {3005510400 10800 1 EEST}
- {3023654400 7200 0 EET}
- {3036960000 10800 1 EEST}
- {3055708800 7200 0 EET}
- {3068409600 10800 1 EEST}
- {3087158400 7200 0 EET}
- {3099859200 10800 1 EEST}
- {3118608000 7200 0 EET}
- {3131913600 10800 1 EEST}
- {3150057600 7200 0 EET}
- {3163363200 10800 1 EEST}
- {3181507200 7200 0 EET}
- {3194812800 10800 1 EEST}
- {3212956800 7200 0 EET}
- {3226262400 10800 1 EEST}
- {3245011200 7200 0 EET}
- {3257712000 10800 1 EEST}
- {3276460800 7200 0 EET}
- {3289161600 10800 1 EEST}
- {3307910400 7200 0 EET}
- {3321216000 10800 1 EEST}
- {3339360000 7200 0 EET}
- {3352665600 10800 1 EEST}
- {3370809600 7200 0 EET}
- {3384115200 10800 1 EEST}
- {3402864000 7200 0 EET}
- {3415564800 10800 1 EEST}
- {3434313600 7200 0 EET}
- {3447014400 10800 1 EEST}
- {3465763200 7200 0 EET}
- {3479068800 10800 1 EEST}
- {3497212800 7200 0 EET}
- {3510518400 10800 1 EEST}
- {3528662400 7200 0 EET}
- {3541968000 10800 1 EEST}
- {3560112000 7200 0 EET}
- {3573417600 10800 1 EEST}
- {3592166400 7200 0 EET}
- {3604867200 10800 1 EEST}
- {3623616000 7200 0 EET}
- {3636316800 10800 1 EEST}
- {3655065600 7200 0 EET}
- {3668371200 10800 1 EEST}
- {3686515200 7200 0 EET}
- {3699820800 10800 1 EEST}
- {3717964800 7200 0 EET}
- {3731270400 10800 1 EEST}
- {3750019200 7200 0 EET}
- {3762720000 10800 1 EEST}
- {3781468800 7200 0 EET}
- {3794169600 10800 1 EEST}
- {3812918400 7200 0 EET}
- {3825619200 10800 1 EEST}
- {3844368000 7200 0 EET}
- {3857673600 10800 1 EEST}
- {3875817600 7200 0 EET}
- {3889123200 10800 1 EEST}
- {3907267200 7200 0 EET}
- {3920572800 10800 1 EEST}
- {3939321600 7200 0 EET}
- {3952022400 10800 1 EEST}
- {3970771200 7200 0 EET}
- {3983472000 10800 1 EEST}
- {4002220800 7200 0 EET}
- {4015526400 10800 1 EEST}
- {4033670400 7200 0 EET}
- {4046976000 10800 1 EEST}
- {4065120000 7200 0 EET}
- {4078425600 10800 1 EEST}
- {4096569600 7200 0 EET}
+ {1301184000 10800 0 FET}
}
diff --git a/library/tzdata/Europe/Moscow b/library/tzdata/Europe/Moscow
index 9acbd2c..8f40741 100644
--- a/library/tzdata/Europe/Moscow
+++ b/library/tzdata/Europe/Moscow
@@ -79,182 +79,5 @@ set TZData(:Europe/Moscow) {
{1256425200 10800 0 MSK}
{1269730800 14400 1 MSD}
{1288479600 10800 0 MSK}
- {1301180400 14400 1 MSD}
- {1319929200 10800 0 MSK}
- {1332630000 14400 1 MSD}
- {1351378800 10800 0 MSK}
- {1364684400 14400 1 MSD}
- {1382828400 10800 0 MSK}
- {1396134000 14400 1 MSD}
- {1414278000 10800 0 MSK}
- {1427583600 14400 1 MSD}
- {1445727600 10800 0 MSK}
- {1459033200 14400 1 MSD}
- {1477782000 10800 0 MSK}
- {1490482800 14400 1 MSD}
- {1509231600 10800 0 MSK}
- {1521932400 14400 1 MSD}
- {1540681200 10800 0 MSK}
- {1553986800 14400 1 MSD}
- {1572130800 10800 0 MSK}
- {1585436400 14400 1 MSD}
- {1603580400 10800 0 MSK}
- {1616886000 14400 1 MSD}
- {1635634800 10800 0 MSK}
- {1648335600 14400 1 MSD}
- {1667084400 10800 0 MSK}
- {1679785200 14400 1 MSD}
- {1698534000 10800 0 MSK}
- {1711839600 14400 1 MSD}
- {1729983600 10800 0 MSK}
- {1743289200 14400 1 MSD}
- {1761433200 10800 0 MSK}
- {1774738800 14400 1 MSD}
- {1792882800 10800 0 MSK}
- {1806188400 14400 1 MSD}
- {1824937200 10800 0 MSK}
- {1837638000 14400 1 MSD}
- {1856386800 10800 0 MSK}
- {1869087600 14400 1 MSD}
- {1887836400 10800 0 MSK}
- {1901142000 14400 1 MSD}
- {1919286000 10800 0 MSK}
- {1932591600 14400 1 MSD}
- {1950735600 10800 0 MSK}
- {1964041200 14400 1 MSD}
- {1982790000 10800 0 MSK}
- {1995490800 14400 1 MSD}
- {2014239600 10800 0 MSK}
- {2026940400 14400 1 MSD}
- {2045689200 10800 0 MSK}
- {2058390000 14400 1 MSD}
- {2077138800 10800 0 MSK}
- {2090444400 14400 1 MSD}
- {2108588400 10800 0 MSK}
- {2121894000 14400 1 MSD}
- {2140038000 10800 0 MSK}
- {2153343600 14400 1 MSD}
- {2172092400 10800 0 MSK}
- {2184793200 14400 1 MSD}
- {2203542000 10800 0 MSK}
- {2216242800 14400 1 MSD}
- {2234991600 10800 0 MSK}
- {2248297200 14400 1 MSD}
- {2266441200 10800 0 MSK}
- {2279746800 14400 1 MSD}
- {2297890800 10800 0 MSK}
- {2311196400 14400 1 MSD}
- {2329340400 10800 0 MSK}
- {2342646000 14400 1 MSD}
- {2361394800 10800 0 MSK}
- {2374095600 14400 1 MSD}
- {2392844400 10800 0 MSK}
- {2405545200 14400 1 MSD}
- {2424294000 10800 0 MSK}
- {2437599600 14400 1 MSD}
- {2455743600 10800 0 MSK}
- {2469049200 14400 1 MSD}
- {2487193200 10800 0 MSK}
- {2500498800 14400 1 MSD}
- {2519247600 10800 0 MSK}
- {2531948400 14400 1 MSD}
- {2550697200 10800 0 MSK}
- {2563398000 14400 1 MSD}
- {2582146800 10800 0 MSK}
- {2595452400 14400 1 MSD}
- {2613596400 10800 0 MSK}
- {2626902000 14400 1 MSD}
- {2645046000 10800 0 MSK}
- {2658351600 14400 1 MSD}
- {2676495600 10800 0 MSK}
- {2689801200 14400 1 MSD}
- {2708550000 10800 0 MSK}
- {2721250800 14400 1 MSD}
- {2739999600 10800 0 MSK}
- {2752700400 14400 1 MSD}
- {2771449200 10800 0 MSK}
- {2784754800 14400 1 MSD}
- {2802898800 10800 0 MSK}
- {2816204400 14400 1 MSD}
- {2834348400 10800 0 MSK}
- {2847654000 14400 1 MSD}
- {2866402800 10800 0 MSK}
- {2879103600 14400 1 MSD}
- {2897852400 10800 0 MSK}
- {2910553200 14400 1 MSD}
- {2929302000 10800 0 MSK}
- {2942002800 14400 1 MSD}
- {2960751600 10800 0 MSK}
- {2974057200 14400 1 MSD}
- {2992201200 10800 0 MSK}
- {3005506800 14400 1 MSD}
- {3023650800 10800 0 MSK}
- {3036956400 14400 1 MSD}
- {3055705200 10800 0 MSK}
- {3068406000 14400 1 MSD}
- {3087154800 10800 0 MSK}
- {3099855600 14400 1 MSD}
- {3118604400 10800 0 MSK}
- {3131910000 14400 1 MSD}
- {3150054000 10800 0 MSK}
- {3163359600 14400 1 MSD}
- {3181503600 10800 0 MSK}
- {3194809200 14400 1 MSD}
- {3212953200 10800 0 MSK}
- {3226258800 14400 1 MSD}
- {3245007600 10800 0 MSK}
- {3257708400 14400 1 MSD}
- {3276457200 10800 0 MSK}
- {3289158000 14400 1 MSD}
- {3307906800 10800 0 MSK}
- {3321212400 14400 1 MSD}
- {3339356400 10800 0 MSK}
- {3352662000 14400 1 MSD}
- {3370806000 10800 0 MSK}
- {3384111600 14400 1 MSD}
- {3402860400 10800 0 MSK}
- {3415561200 14400 1 MSD}
- {3434310000 10800 0 MSK}
- {3447010800 14400 1 MSD}
- {3465759600 10800 0 MSK}
- {3479065200 14400 1 MSD}
- {3497209200 10800 0 MSK}
- {3510514800 14400 1 MSD}
- {3528658800 10800 0 MSK}
- {3541964400 14400 1 MSD}
- {3560108400 10800 0 MSK}
- {3573414000 14400 1 MSD}
- {3592162800 10800 0 MSK}
- {3604863600 14400 1 MSD}
- {3623612400 10800 0 MSK}
- {3636313200 14400 1 MSD}
- {3655062000 10800 0 MSK}
- {3668367600 14400 1 MSD}
- {3686511600 10800 0 MSK}
- {3699817200 14400 1 MSD}
- {3717961200 10800 0 MSK}
- {3731266800 14400 1 MSD}
- {3750015600 10800 0 MSK}
- {3762716400 14400 1 MSD}
- {3781465200 10800 0 MSK}
- {3794166000 14400 1 MSD}
- {3812914800 10800 0 MSK}
- {3825615600 14400 1 MSD}
- {3844364400 10800 0 MSK}
- {3857670000 14400 1 MSD}
- {3875814000 10800 0 MSK}
- {3889119600 14400 1 MSD}
- {3907263600 10800 0 MSK}
- {3920569200 14400 1 MSD}
- {3939318000 10800 0 MSK}
- {3952018800 14400 1 MSD}
- {3970767600 10800 0 MSK}
- {3983468400 14400 1 MSD}
- {4002217200 10800 0 MSK}
- {4015522800 14400 1 MSD}
- {4033666800 10800 0 MSK}
- {4046972400 14400 1 MSD}
- {4065116400 10800 0 MSK}
- {4078422000 14400 1 MSD}
- {4096566000 10800 0 MSK}
+ {1301180400 14400 0 MSK}
}
diff --git a/library/tzdata/Europe/Samara b/library/tzdata/Europe/Samara
index 80a80f4..f2ac911 100644
--- a/library/tzdata/Europe/Samara
+++ b/library/tzdata/Europe/Samara
@@ -69,182 +69,5 @@ set TZData(:Europe/Samara) {
{1269727200 10800 0 SAMMMTT}
{1269730800 14400 1 SAMST}
{1288479600 10800 0 SAMT}
- {1301180400 14400 1 SAMST}
- {1319929200 10800 0 SAMT}
- {1332630000 14400 1 SAMST}
- {1351378800 10800 0 SAMT}
- {1364684400 14400 1 SAMST}
- {1382828400 10800 0 SAMT}
- {1396134000 14400 1 SAMST}
- {1414278000 10800 0 SAMT}
- {1427583600 14400 1 SAMST}
- {1445727600 10800 0 SAMT}
- {1459033200 14400 1 SAMST}
- {1477782000 10800 0 SAMT}
- {1490482800 14400 1 SAMST}
- {1509231600 10800 0 SAMT}
- {1521932400 14400 1 SAMST}
- {1540681200 10800 0 SAMT}
- {1553986800 14400 1 SAMST}
- {1572130800 10800 0 SAMT}
- {1585436400 14400 1 SAMST}
- {1603580400 10800 0 SAMT}
- {1616886000 14400 1 SAMST}
- {1635634800 10800 0 SAMT}
- {1648335600 14400 1 SAMST}
- {1667084400 10800 0 SAMT}
- {1679785200 14400 1 SAMST}
- {1698534000 10800 0 SAMT}
- {1711839600 14400 1 SAMST}
- {1729983600 10800 0 SAMT}
- {1743289200 14400 1 SAMST}
- {1761433200 10800 0 SAMT}
- {1774738800 14400 1 SAMST}
- {1792882800 10800 0 SAMT}
- {1806188400 14400 1 SAMST}
- {1824937200 10800 0 SAMT}
- {1837638000 14400 1 SAMST}
- {1856386800 10800 0 SAMT}
- {1869087600 14400 1 SAMST}
- {1887836400 10800 0 SAMT}
- {1901142000 14400 1 SAMST}
- {1919286000 10800 0 SAMT}
- {1932591600 14400 1 SAMST}
- {1950735600 10800 0 SAMT}
- {1964041200 14400 1 SAMST}
- {1982790000 10800 0 SAMT}
- {1995490800 14400 1 SAMST}
- {2014239600 10800 0 SAMT}
- {2026940400 14400 1 SAMST}
- {2045689200 10800 0 SAMT}
- {2058390000 14400 1 SAMST}
- {2077138800 10800 0 SAMT}
- {2090444400 14400 1 SAMST}
- {2108588400 10800 0 SAMT}
- {2121894000 14400 1 SAMST}
- {2140038000 10800 0 SAMT}
- {2153343600 14400 1 SAMST}
- {2172092400 10800 0 SAMT}
- {2184793200 14400 1 SAMST}
- {2203542000 10800 0 SAMT}
- {2216242800 14400 1 SAMST}
- {2234991600 10800 0 SAMT}
- {2248297200 14400 1 SAMST}
- {2266441200 10800 0 SAMT}
- {2279746800 14400 1 SAMST}
- {2297890800 10800 0 SAMT}
- {2311196400 14400 1 SAMST}
- {2329340400 10800 0 SAMT}
- {2342646000 14400 1 SAMST}
- {2361394800 10800 0 SAMT}
- {2374095600 14400 1 SAMST}
- {2392844400 10800 0 SAMT}
- {2405545200 14400 1 SAMST}
- {2424294000 10800 0 SAMT}
- {2437599600 14400 1 SAMST}
- {2455743600 10800 0 SAMT}
- {2469049200 14400 1 SAMST}
- {2487193200 10800 0 SAMT}
- {2500498800 14400 1 SAMST}
- {2519247600 10800 0 SAMT}
- {2531948400 14400 1 SAMST}
- {2550697200 10800 0 SAMT}
- {2563398000 14400 1 SAMST}
- {2582146800 10800 0 SAMT}
- {2595452400 14400 1 SAMST}
- {2613596400 10800 0 SAMT}
- {2626902000 14400 1 SAMST}
- {2645046000 10800 0 SAMT}
- {2658351600 14400 1 SAMST}
- {2676495600 10800 0 SAMT}
- {2689801200 14400 1 SAMST}
- {2708550000 10800 0 SAMT}
- {2721250800 14400 1 SAMST}
- {2739999600 10800 0 SAMT}
- {2752700400 14400 1 SAMST}
- {2771449200 10800 0 SAMT}
- {2784754800 14400 1 SAMST}
- {2802898800 10800 0 SAMT}
- {2816204400 14400 1 SAMST}
- {2834348400 10800 0 SAMT}
- {2847654000 14400 1 SAMST}
- {2866402800 10800 0 SAMT}
- {2879103600 14400 1 SAMST}
- {2897852400 10800 0 SAMT}
- {2910553200 14400 1 SAMST}
- {2929302000 10800 0 SAMT}
- {2942002800 14400 1 SAMST}
- {2960751600 10800 0 SAMT}
- {2974057200 14400 1 SAMST}
- {2992201200 10800 0 SAMT}
- {3005506800 14400 1 SAMST}
- {3023650800 10800 0 SAMT}
- {3036956400 14400 1 SAMST}
- {3055705200 10800 0 SAMT}
- {3068406000 14400 1 SAMST}
- {3087154800 10800 0 SAMT}
- {3099855600 14400 1 SAMST}
- {3118604400 10800 0 SAMT}
- {3131910000 14400 1 SAMST}
- {3150054000 10800 0 SAMT}
- {3163359600 14400 1 SAMST}
- {3181503600 10800 0 SAMT}
- {3194809200 14400 1 SAMST}
- {3212953200 10800 0 SAMT}
- {3226258800 14400 1 SAMST}
- {3245007600 10800 0 SAMT}
- {3257708400 14400 1 SAMST}
- {3276457200 10800 0 SAMT}
- {3289158000 14400 1 SAMST}
- {3307906800 10800 0 SAMT}
- {3321212400 14400 1 SAMST}
- {3339356400 10800 0 SAMT}
- {3352662000 14400 1 SAMST}
- {3370806000 10800 0 SAMT}
- {3384111600 14400 1 SAMST}
- {3402860400 10800 0 SAMT}
- {3415561200 14400 1 SAMST}
- {3434310000 10800 0 SAMT}
- {3447010800 14400 1 SAMST}
- {3465759600 10800 0 SAMT}
- {3479065200 14400 1 SAMST}
- {3497209200 10800 0 SAMT}
- {3510514800 14400 1 SAMST}
- {3528658800 10800 0 SAMT}
- {3541964400 14400 1 SAMST}
- {3560108400 10800 0 SAMT}
- {3573414000 14400 1 SAMST}
- {3592162800 10800 0 SAMT}
- {3604863600 14400 1 SAMST}
- {3623612400 10800 0 SAMT}
- {3636313200 14400 1 SAMST}
- {3655062000 10800 0 SAMT}
- {3668367600 14400 1 SAMST}
- {3686511600 10800 0 SAMT}
- {3699817200 14400 1 SAMST}
- {3717961200 10800 0 SAMT}
- {3731266800 14400 1 SAMST}
- {3750015600 10800 0 SAMT}
- {3762716400 14400 1 SAMST}
- {3781465200 10800 0 SAMT}
- {3794166000 14400 1 SAMST}
- {3812914800 10800 0 SAMT}
- {3825615600 14400 1 SAMST}
- {3844364400 10800 0 SAMT}
- {3857670000 14400 1 SAMST}
- {3875814000 10800 0 SAMT}
- {3889119600 14400 1 SAMST}
- {3907263600 10800 0 SAMT}
- {3920569200 14400 1 SAMST}
- {3939318000 10800 0 SAMT}
- {3952018800 14400 1 SAMST}
- {3970767600 10800 0 SAMT}
- {3983468400 14400 1 SAMST}
- {4002217200 10800 0 SAMT}
- {4015522800 14400 1 SAMST}
- {4033666800 10800 0 SAMT}
- {4046972400 14400 1 SAMST}
- {4065116400 10800 0 SAMT}
- {4078422000 14400 1 SAMST}
- {4096566000 10800 0 SAMT}
+ {1301180400 14400 0 SAMT}
}
diff --git a/library/tzdata/Europe/Volgograd b/library/tzdata/Europe/Volgograd
index 49cf1e5..c3f148f 100755
--- a/library/tzdata/Europe/Volgograd
+++ b/library/tzdata/Europe/Volgograd
@@ -66,182 +66,5 @@ set TZData(:Europe/Volgograd) {
{1256425200 10800 0 VOLT}
{1269730800 14400 1 VOLST}
{1288479600 10800 0 VOLT}
- {1301180400 14400 1 VOLST}
- {1319929200 10800 0 VOLT}
- {1332630000 14400 1 VOLST}
- {1351378800 10800 0 VOLT}
- {1364684400 14400 1 VOLST}
- {1382828400 10800 0 VOLT}
- {1396134000 14400 1 VOLST}
- {1414278000 10800 0 VOLT}
- {1427583600 14400 1 VOLST}
- {1445727600 10800 0 VOLT}
- {1459033200 14400 1 VOLST}
- {1477782000 10800 0 VOLT}
- {1490482800 14400 1 VOLST}
- {1509231600 10800 0 VOLT}
- {1521932400 14400 1 VOLST}
- {1540681200 10800 0 VOLT}
- {1553986800 14400 1 VOLST}
- {1572130800 10800 0 VOLT}
- {1585436400 14400 1 VOLST}
- {1603580400 10800 0 VOLT}
- {1616886000 14400 1 VOLST}
- {1635634800 10800 0 VOLT}
- {1648335600 14400 1 VOLST}
- {1667084400 10800 0 VOLT}
- {1679785200 14400 1 VOLST}
- {1698534000 10800 0 VOLT}
- {1711839600 14400 1 VOLST}
- {1729983600 10800 0 VOLT}
- {1743289200 14400 1 VOLST}
- {1761433200 10800 0 VOLT}
- {1774738800 14400 1 VOLST}
- {1792882800 10800 0 VOLT}
- {1806188400 14400 1 VOLST}
- {1824937200 10800 0 VOLT}
- {1837638000 14400 1 VOLST}
- {1856386800 10800 0 VOLT}
- {1869087600 14400 1 VOLST}
- {1887836400 10800 0 VOLT}
- {1901142000 14400 1 VOLST}
- {1919286000 10800 0 VOLT}
- {1932591600 14400 1 VOLST}
- {1950735600 10800 0 VOLT}
- {1964041200 14400 1 VOLST}
- {1982790000 10800 0 VOLT}
- {1995490800 14400 1 VOLST}
- {2014239600 10800 0 VOLT}
- {2026940400 14400 1 VOLST}
- {2045689200 10800 0 VOLT}
- {2058390000 14400 1 VOLST}
- {2077138800 10800 0 VOLT}
- {2090444400 14400 1 VOLST}
- {2108588400 10800 0 VOLT}
- {2121894000 14400 1 VOLST}
- {2140038000 10800 0 VOLT}
- {2153343600 14400 1 VOLST}
- {2172092400 10800 0 VOLT}
- {2184793200 14400 1 VOLST}
- {2203542000 10800 0 VOLT}
- {2216242800 14400 1 VOLST}
- {2234991600 10800 0 VOLT}
- {2248297200 14400 1 VOLST}
- {2266441200 10800 0 VOLT}
- {2279746800 14400 1 VOLST}
- {2297890800 10800 0 VOLT}
- {2311196400 14400 1 VOLST}
- {2329340400 10800 0 VOLT}
- {2342646000 14400 1 VOLST}
- {2361394800 10800 0 VOLT}
- {2374095600 14400 1 VOLST}
- {2392844400 10800 0 VOLT}
- {2405545200 14400 1 VOLST}
- {2424294000 10800 0 VOLT}
- {2437599600 14400 1 VOLST}
- {2455743600 10800 0 VOLT}
- {2469049200 14400 1 VOLST}
- {2487193200 10800 0 VOLT}
- {2500498800 14400 1 VOLST}
- {2519247600 10800 0 VOLT}
- {2531948400 14400 1 VOLST}
- {2550697200 10800 0 VOLT}
- {2563398000 14400 1 VOLST}
- {2582146800 10800 0 VOLT}
- {2595452400 14400 1 VOLST}
- {2613596400 10800 0 VOLT}
- {2626902000 14400 1 VOLST}
- {2645046000 10800 0 VOLT}
- {2658351600 14400 1 VOLST}
- {2676495600 10800 0 VOLT}
- {2689801200 14400 1 VOLST}
- {2708550000 10800 0 VOLT}
- {2721250800 14400 1 VOLST}
- {2739999600 10800 0 VOLT}
- {2752700400 14400 1 VOLST}
- {2771449200 10800 0 VOLT}
- {2784754800 14400 1 VOLST}
- {2802898800 10800 0 VOLT}
- {2816204400 14400 1 VOLST}
- {2834348400 10800 0 VOLT}
- {2847654000 14400 1 VOLST}
- {2866402800 10800 0 VOLT}
- {2879103600 14400 1 VOLST}
- {2897852400 10800 0 VOLT}
- {2910553200 14400 1 VOLST}
- {2929302000 10800 0 VOLT}
- {2942002800 14400 1 VOLST}
- {2960751600 10800 0 VOLT}
- {2974057200 14400 1 VOLST}
- {2992201200 10800 0 VOLT}
- {3005506800 14400 1 VOLST}
- {3023650800 10800 0 VOLT}
- {3036956400 14400 1 VOLST}
- {3055705200 10800 0 VOLT}
- {3068406000 14400 1 VOLST}
- {3087154800 10800 0 VOLT}
- {3099855600 14400 1 VOLST}
- {3118604400 10800 0 VOLT}
- {3131910000 14400 1 VOLST}
- {3150054000 10800 0 VOLT}
- {3163359600 14400 1 VOLST}
- {3181503600 10800 0 VOLT}
- {3194809200 14400 1 VOLST}
- {3212953200 10800 0 VOLT}
- {3226258800 14400 1 VOLST}
- {3245007600 10800 0 VOLT}
- {3257708400 14400 1 VOLST}
- {3276457200 10800 0 VOLT}
- {3289158000 14400 1 VOLST}
- {3307906800 10800 0 VOLT}
- {3321212400 14400 1 VOLST}
- {3339356400 10800 0 VOLT}
- {3352662000 14400 1 VOLST}
- {3370806000 10800 0 VOLT}
- {3384111600 14400 1 VOLST}
- {3402860400 10800 0 VOLT}
- {3415561200 14400 1 VOLST}
- {3434310000 10800 0 VOLT}
- {3447010800 14400 1 VOLST}
- {3465759600 10800 0 VOLT}
- {3479065200 14400 1 VOLST}
- {3497209200 10800 0 VOLT}
- {3510514800 14400 1 VOLST}
- {3528658800 10800 0 VOLT}
- {3541964400 14400 1 VOLST}
- {3560108400 10800 0 VOLT}
- {3573414000 14400 1 VOLST}
- {3592162800 10800 0 VOLT}
- {3604863600 14400 1 VOLST}
- {3623612400 10800 0 VOLT}
- {3636313200 14400 1 VOLST}
- {3655062000 10800 0 VOLT}
- {3668367600 14400 1 VOLST}
- {3686511600 10800 0 VOLT}
- {3699817200 14400 1 VOLST}
- {3717961200 10800 0 VOLT}
- {3731266800 14400 1 VOLST}
- {3750015600 10800 0 VOLT}
- {3762716400 14400 1 VOLST}
- {3781465200 10800 0 VOLT}
- {3794166000 14400 1 VOLST}
- {3812914800 10800 0 VOLT}
- {3825615600 14400 1 VOLST}
- {3844364400 10800 0 VOLT}
- {3857670000 14400 1 VOLST}
- {3875814000 10800 0 VOLT}
- {3889119600 14400 1 VOLST}
- {3907263600 10800 0 VOLT}
- {3920569200 14400 1 VOLST}
- {3939318000 10800 0 VOLT}
- {3952018800 14400 1 VOLST}
- {3970767600 10800 0 VOLT}
- {3983468400 14400 1 VOLST}
- {4002217200 10800 0 VOLT}
- {4015522800 14400 1 VOLST}
- {4033666800 10800 0 VOLT}
- {4046972400 14400 1 VOLST}
- {4065116400 10800 0 VOLT}
- {4078422000 14400 1 VOLST}
- {4096566000 10800 0 VOLT}
+ {1301180400 14400 0 VOLT}
}
diff --git a/library/tzdata/Pacific/Apia b/library/tzdata/Pacific/Apia
index c97a156..e6f33ad 100644
--- a/library/tzdata/Pacific/Apia
+++ b/library/tzdata/Pacific/Apia
@@ -6,5 +6,183 @@ set TZData(:Pacific/Apia) {
{-1861878784 -41400 0 SAMT}
{-631110600 -39600 0 WST}
{1285498800 -36000 1 WSDT}
- {1301824800 -39600 0 WST}
+ {1301752800 -39600 0 WST}
+ {1316872800 -36000 1 WSDT}
+ {1325239200 50400 1 WSDT}
+ {1333202400 46800 0 WST}
+ {1348927200 50400 1 WSDT}
+ {1365256800 46800 0 WST}
+ {1380376800 50400 1 WSDT}
+ {1396706400 46800 0 WST}
+ {1411826400 50400 1 WSDT}
+ {1428156000 46800 0 WST}
+ {1443276000 50400 1 WSDT}
+ {1459605600 46800 0 WST}
+ {1474725600 50400 1 WSDT}
+ {1491055200 46800 0 WST}
+ {1506175200 50400 1 WSDT}
+ {1522504800 46800 0 WST}
+ {1538229600 50400 1 WSDT}
+ {1554559200 46800 0 WST}
+ {1569679200 50400 1 WSDT}
+ {1586008800 46800 0 WST}
+ {1601128800 50400 1 WSDT}
+ {1617458400 46800 0 WST}
+ {1632578400 50400 1 WSDT}
+ {1648908000 46800 0 WST}
+ {1664028000 50400 1 WSDT}
+ {1680357600 46800 0 WST}
+ {1695477600 50400 1 WSDT}
+ {1712412000 46800 0 WST}
+ {1727532000 50400 1 WSDT}
+ {1743861600 46800 0 WST}
+ {1758981600 50400 1 WSDT}
+ {1775311200 46800 0 WST}
+ {1790431200 50400 1 WSDT}
+ {1806760800 46800 0 WST}
+ {1821880800 50400 1 WSDT}
+ {1838210400 46800 0 WST}
+ {1853330400 50400 1 WSDT}
+ {1869660000 46800 0 WST}
+ {1885384800 50400 1 WSDT}
+ {1901714400 46800 0 WST}
+ {1916834400 50400 1 WSDT}
+ {1933164000 46800 0 WST}
+ {1948284000 50400 1 WSDT}
+ {1964613600 46800 0 WST}
+ {1979733600 50400 1 WSDT}
+ {1996063200 46800 0 WST}
+ {2011183200 50400 1 WSDT}
+ {2027512800 46800 0 WST}
+ {2042632800 50400 1 WSDT}
+ {2058962400 46800 0 WST}
+ {2074687200 50400 1 WSDT}
+ {2091016800 46800 0 WST}
+ {2106136800 50400 1 WSDT}
+ {2122466400 46800 0 WST}
+ {2137586400 50400 1 WSDT}
+ {2153916000 46800 0 WST}
+ {2169036000 50400 1 WSDT}
+ {2185365600 46800 0 WST}
+ {2200485600 50400 1 WSDT}
+ {2216815200 46800 0 WST}
+ {2232540000 50400 1 WSDT}
+ {2248869600 46800 0 WST}
+ {2263989600 50400 1 WSDT}
+ {2280319200 46800 0 WST}
+ {2295439200 50400 1 WSDT}
+ {2311768800 46800 0 WST}
+ {2326888800 50400 1 WSDT}
+ {2343218400 46800 0 WST}
+ {2358338400 50400 1 WSDT}
+ {2374668000 46800 0 WST}
+ {2389788000 50400 1 WSDT}
+ {2406117600 46800 0 WST}
+ {2421842400 50400 1 WSDT}
+ {2438172000 46800 0 WST}
+ {2453292000 50400 1 WSDT}
+ {2469621600 46800 0 WST}
+ {2484741600 50400 1 WSDT}
+ {2501071200 46800 0 WST}
+ {2516191200 50400 1 WSDT}
+ {2532520800 46800 0 WST}
+ {2547640800 50400 1 WSDT}
+ {2563970400 46800 0 WST}
+ {2579090400 50400 1 WSDT}
+ {2596024800 46800 0 WST}
+ {2611144800 50400 1 WSDT}
+ {2627474400 46800 0 WST}
+ {2642594400 50400 1 WSDT}
+ {2658924000 46800 0 WST}
+ {2674044000 50400 1 WSDT}
+ {2690373600 46800 0 WST}
+ {2705493600 50400 1 WSDT}
+ {2721823200 46800 0 WST}
+ {2736943200 50400 1 WSDT}
+ {2753272800 46800 0 WST}
+ {2768997600 50400 1 WSDT}
+ {2785327200 46800 0 WST}
+ {2800447200 50400 1 WSDT}
+ {2816776800 46800 0 WST}
+ {2831896800 50400 1 WSDT}
+ {2848226400 46800 0 WST}
+ {2863346400 50400 1 WSDT}
+ {2879676000 46800 0 WST}
+ {2894796000 50400 1 WSDT}
+ {2911125600 46800 0 WST}
+ {2926245600 50400 1 WSDT}
+ {2942575200 46800 0 WST}
+ {2958300000 50400 1 WSDT}
+ {2974629600 46800 0 WST}
+ {2989749600 50400 1 WSDT}
+ {3006079200 46800 0 WST}
+ {3021199200 50400 1 WSDT}
+ {3037528800 46800 0 WST}
+ {3052648800 50400 1 WSDT}
+ {3068978400 46800 0 WST}
+ {3084098400 50400 1 WSDT}
+ {3100428000 46800 0 WST}
+ {3116152800 50400 1 WSDT}
+ {3132482400 46800 0 WST}
+ {3147602400 50400 1 WSDT}
+ {3163932000 46800 0 WST}
+ {3179052000 50400 1 WSDT}
+ {3195381600 46800 0 WST}
+ {3210501600 50400 1 WSDT}
+ {3226831200 46800 0 WST}
+ {3241951200 50400 1 WSDT}
+ {3258280800 46800 0 WST}
+ {3273400800 50400 1 WSDT}
+ {3289730400 46800 0 WST}
+ {3305455200 50400 1 WSDT}
+ {3321784800 46800 0 WST}
+ {3336904800 50400 1 WSDT}
+ {3353234400 46800 0 WST}
+ {3368354400 50400 1 WSDT}
+ {3384684000 46800 0 WST}
+ {3399804000 50400 1 WSDT}
+ {3416133600 46800 0 WST}
+ {3431253600 50400 1 WSDT}
+ {3447583200 46800 0 WST}
+ {3462703200 50400 1 WSDT}
+ {3479637600 46800 0 WST}
+ {3494757600 50400 1 WSDT}
+ {3511087200 46800 0 WST}
+ {3526207200 50400 1 WSDT}
+ {3542536800 46800 0 WST}
+ {3557656800 50400 1 WSDT}
+ {3573986400 46800 0 WST}
+ {3589106400 50400 1 WSDT}
+ {3605436000 46800 0 WST}
+ {3620556000 50400 1 WSDT}
+ {3636885600 46800 0 WST}
+ {3652610400 50400 1 WSDT}
+ {3668940000 46800 0 WST}
+ {3684060000 50400 1 WSDT}
+ {3700389600 46800 0 WST}
+ {3715509600 50400 1 WSDT}
+ {3731839200 46800 0 WST}
+ {3746959200 50400 1 WSDT}
+ {3763288800 46800 0 WST}
+ {3778408800 50400 1 WSDT}
+ {3794738400 46800 0 WST}
+ {3809858400 50400 1 WSDT}
+ {3826188000 46800 0 WST}
+ {3841912800 50400 1 WSDT}
+ {3858242400 46800 0 WST}
+ {3873362400 50400 1 WSDT}
+ {3889692000 46800 0 WST}
+ {3904812000 50400 1 WSDT}
+ {3921141600 46800 0 WST}
+ {3936261600 50400 1 WSDT}
+ {3952591200 46800 0 WST}
+ {3967711200 50400 1 WSDT}
+ {3984040800 46800 0 WST}
+ {3999765600 50400 1 WSDT}
+ {4016095200 46800 0 WST}
+ {4031215200 50400 1 WSDT}
+ {4047544800 46800 0 WST}
+ {4062664800 50400 1 WSDT}
+ {4078994400 46800 0 WST}
+ {4094114400 50400 1 WSDT}
}
diff --git a/library/tzdata/Pacific/Easter b/library/tzdata/Pacific/Easter
index be661fc..38795fb 100644
--- a/library/tzdata/Pacific/Easter
+++ b/library/tzdata/Pacific/Easter
@@ -94,10 +94,10 @@ set TZData(:Pacific/Easter) {
{1255233600 -18000 1 EASST}
{1270350000 -21600 0 EAST}
{1286683200 -18000 1 EASST}
- {1299985200 -21600 0 EAST}
- {1318132800 -18000 1 EASST}
- {1331434800 -21600 0 EAST}
- {1350187200 -18000 1 EASST}
+ {1304823600 -21600 0 EAST}
+ {1313899200 -18000 1 EASST}
+ {1335668400 -21600 0 EAST}
+ {1346558400 -18000 1 EASST}
{1362884400 -21600 0 EAST}
{1381636800 -18000 1 EASST}
{1394334000 -21600 0 EAST}
diff --git a/library/tzdata/Pacific/Fakaofo b/library/tzdata/Pacific/Fakaofo
index 7420639..6ec98eb 100644
--- a/library/tzdata/Pacific/Fakaofo
+++ b/library/tzdata/Pacific/Fakaofo
@@ -2,5 +2,6 @@
set TZData(:Pacific/Fakaofo) {
{-9223372036854775808 -41096 0 LMT}
- {-2177411704 -36000 0 TKT}
+ {-2177411704 -39600 0 TKT}
+ {1325242800 46800 0 TKT}
}
diff --git a/library/tzdata/Pacific/Fiji b/library/tzdata/Pacific/Fiji
index 67f84cb..e067377 100644
--- a/library/tzdata/Pacific/Fiji
+++ b/library/tzdata/Pacific/Fiji
@@ -10,5 +10,182 @@ set TZData(:Pacific/Fiji) {
{1259416800 46800 1 FJST}
{1269698400 43200 0 FJT}
{1287842400 46800 1 FJST}
- {1301148000 43200 0 FJT}
+ {1299333600 43200 0 FJT}
+ {1319292000 46800 1 FJST}
+ {1327154400 43200 0 FJT}
+ {1350741600 46800 1 FJST}
+ {1358604000 43200 0 FJT}
+ {1382191200 46800 1 FJST}
+ {1390053600 43200 0 FJT}
+ {1413640800 46800 1 FJST}
+ {1421503200 43200 0 FJT}
+ {1445090400 46800 1 FJST}
+ {1453557600 43200 0 FJT}
+ {1477144800 46800 1 FJST}
+ {1485007200 43200 0 FJT}
+ {1508594400 46800 1 FJST}
+ {1516456800 43200 0 FJT}
+ {1540044000 46800 1 FJST}
+ {1547906400 43200 0 FJT}
+ {1571493600 46800 1 FJST}
+ {1579356000 43200 0 FJT}
+ {1602943200 46800 1 FJST}
+ {1611410400 43200 0 FJT}
+ {1634997600 46800 1 FJST}
+ {1642860000 43200 0 FJT}
+ {1666447200 46800 1 FJST}
+ {1674309600 43200 0 FJT}
+ {1697896800 46800 1 FJST}
+ {1705759200 43200 0 FJT}
+ {1729346400 46800 1 FJST}
+ {1737208800 43200 0 FJT}
+ {1760796000 46800 1 FJST}
+ {1768658400 43200 0 FJT}
+ {1792245600 46800 1 FJST}
+ {1800712800 43200 0 FJT}
+ {1824300000 46800 1 FJST}
+ {1832162400 43200 0 FJT}
+ {1855749600 46800 1 FJST}
+ {1863612000 43200 0 FJT}
+ {1887199200 46800 1 FJST}
+ {1895061600 43200 0 FJT}
+ {1918648800 46800 1 FJST}
+ {1926511200 43200 0 FJT}
+ {1950098400 46800 1 FJST}
+ {1957960800 43200 0 FJT}
+ {1982152800 46800 1 FJST}
+ {1990015200 43200 0 FJT}
+ {2013602400 46800 1 FJST}
+ {2021464800 43200 0 FJT}
+ {2045052000 46800 1 FJST}
+ {2052914400 43200 0 FJT}
+ {2076501600 46800 1 FJST}
+ {2084364000 43200 0 FJT}
+ {2107951200 46800 1 FJST}
+ {2115813600 43200 0 FJT}
+ {2139400800 46800 1 FJST}
+ {2147868000 43200 0 FJT}
+ {2171455200 46800 1 FJST}
+ {2179317600 43200 0 FJT}
+ {2202904800 46800 1 FJST}
+ {2210767200 43200 0 FJT}
+ {2234354400 46800 1 FJST}
+ {2242216800 43200 0 FJT}
+ {2265804000 46800 1 FJST}
+ {2273666400 43200 0 FJT}
+ {2297253600 46800 1 FJST}
+ {2305116000 43200 0 FJT}
+ {2328703200 46800 1 FJST}
+ {2337170400 43200 0 FJT}
+ {2360757600 46800 1 FJST}
+ {2368620000 43200 0 FJT}
+ {2392207200 46800 1 FJST}
+ {2400069600 43200 0 FJT}
+ {2423656800 46800 1 FJST}
+ {2431519200 43200 0 FJT}
+ {2455106400 46800 1 FJST}
+ {2462968800 43200 0 FJT}
+ {2486556000 46800 1 FJST}
+ {2495023200 43200 0 FJT}
+ {2518610400 46800 1 FJST}
+ {2526472800 43200 0 FJT}
+ {2550060000 46800 1 FJST}
+ {2557922400 43200 0 FJT}
+ {2581509600 46800 1 FJST}
+ {2589372000 43200 0 FJT}
+ {2612959200 46800 1 FJST}
+ {2620821600 43200 0 FJT}
+ {2644408800 46800 1 FJST}
+ {2652271200 43200 0 FJT}
+ {2675858400 46800 1 FJST}
+ {2684325600 43200 0 FJT}
+ {2707912800 46800 1 FJST}
+ {2715775200 43200 0 FJT}
+ {2739362400 46800 1 FJST}
+ {2747224800 43200 0 FJT}
+ {2770812000 46800 1 FJST}
+ {2778674400 43200 0 FJT}
+ {2802261600 46800 1 FJST}
+ {2810124000 43200 0 FJT}
+ {2833711200 46800 1 FJST}
+ {2841573600 43200 0 FJT}
+ {2865765600 46800 1 FJST}
+ {2873628000 43200 0 FJT}
+ {2897215200 46800 1 FJST}
+ {2905077600 43200 0 FJT}
+ {2928664800 46800 1 FJST}
+ {2936527200 43200 0 FJT}
+ {2960114400 46800 1 FJST}
+ {2967976800 43200 0 FJT}
+ {2991564000 46800 1 FJST}
+ {2999426400 43200 0 FJT}
+ {3023013600 46800 1 FJST}
+ {3031480800 43200 0 FJT}
+ {3055068000 46800 1 FJST}
+ {3062930400 43200 0 FJT}
+ {3086517600 46800 1 FJST}
+ {3094380000 43200 0 FJT}
+ {3117967200 46800 1 FJST}
+ {3125829600 43200 0 FJT}
+ {3149416800 46800 1 FJST}
+ {3157279200 43200 0 FJT}
+ {3180866400 46800 1 FJST}
+ {3188728800 43200 0 FJT}
+ {3212316000 46800 1 FJST}
+ {3220783200 43200 0 FJT}
+ {3244370400 46800 1 FJST}
+ {3252232800 43200 0 FJT}
+ {3275820000 46800 1 FJST}
+ {3283682400 43200 0 FJT}
+ {3307269600 46800 1 FJST}
+ {3315132000 43200 0 FJT}
+ {3338719200 46800 1 FJST}
+ {3346581600 43200 0 FJT}
+ {3370168800 46800 1 FJST}
+ {3378636000 43200 0 FJT}
+ {3402223200 46800 1 FJST}
+ {3410085600 43200 0 FJT}
+ {3433672800 46800 1 FJST}
+ {3441535200 43200 0 FJT}
+ {3465122400 46800 1 FJST}
+ {3472984800 43200 0 FJT}
+ {3496572000 46800 1 FJST}
+ {3504434400 43200 0 FJT}
+ {3528021600 46800 1 FJST}
+ {3535884000 43200 0 FJT}
+ {3559471200 46800 1 FJST}
+ {3567938400 43200 0 FJT}
+ {3591525600 46800 1 FJST}
+ {3599388000 43200 0 FJT}
+ {3622975200 46800 1 FJST}
+ {3630837600 43200 0 FJT}
+ {3654424800 46800 1 FJST}
+ {3662287200 43200 0 FJT}
+ {3685874400 46800 1 FJST}
+ {3693736800 43200 0 FJT}
+ {3717324000 46800 1 FJST}
+ {3725186400 43200 0 FJT}
+ {3749378400 46800 1 FJST}
+ {3757240800 43200 0 FJT}
+ {3780828000 46800 1 FJST}
+ {3788690400 43200 0 FJT}
+ {3812277600 46800 1 FJST}
+ {3820140000 43200 0 FJT}
+ {3843727200 46800 1 FJST}
+ {3851589600 43200 0 FJT}
+ {3875176800 46800 1 FJST}
+ {3883039200 43200 0 FJT}
+ {3906626400 46800 1 FJST}
+ {3915093600 43200 0 FJT}
+ {3938680800 46800 1 FJST}
+ {3946543200 43200 0 FJT}
+ {3970130400 46800 1 FJST}
+ {3977992800 43200 0 FJT}
+ {4001580000 46800 1 FJST}
+ {4009442400 43200 0 FJT}
+ {4033029600 46800 1 FJST}
+ {4040892000 43200 0 FJT}
+ {4064479200 46800 1 FJST}
+ {4072341600 43200 0 FJT}
+ {4095928800 46800 1 FJST}
}
diff --git a/library/tzdata/Pacific/Honolulu b/library/tzdata/Pacific/Honolulu
index f441a02..5e70598 100644
--- a/library/tzdata/Pacific/Honolulu
+++ b/library/tzdata/Pacific/Honolulu
@@ -2,11 +2,10 @@
set TZData(:Pacific/Honolulu) {
{-9223372036854775808 -37886 0 LMT}
- {-2208907714 -37800 0 HST}
+ {-2334101314 -37800 0 HST}
{-1157283000 -34200 1 HDT}
- {-1155472200 -34200 0 HST}
- {-880201800 -34200 1 HWT}
- {-769395600 -34200 1 HPT}
+ {-1155436200 -37800 0 HST}
+ {-880198200 -34200 1 HDT}
{-765376200 -37800 0 HST}
{-712150200 -36000 0 HST}
}
diff --git a/library/word.tcl b/library/word.tcl
index b8f7f7d..16a4638 100644
--- a/library/word.tcl
+++ b/library/word.tcl
@@ -7,10 +7,8 @@
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1998 by Scritpics Corporation.
#
-# See the file "license.terms" for information on usage and redistribution of
-# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: word.tcl,v 1.10 2007/12/13 15:26:03 dgp Exp $
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# The following variables are used to determine which characters are
# interpreted as white space.
diff --git a/libtommath/bn_error.c b/libtommath/bn_error.c
index d96ea2a..6393bb0 100644
--- a/libtommath/bn_error.c
+++ b/libtommath/bn_error.c
@@ -41,7 +41,3 @@ char *mp_error_to_string(int code)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_error.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_fast_mp_invmod.c b/libtommath/bn_fast_mp_invmod.c
index 744ae4f..fafd9dc 100644
--- a/libtommath/bn_fast_mp_invmod.c
+++ b/libtommath/bn_fast_mp_invmod.c
@@ -142,7 +142,3 @@ LBL_ERR:mp_clear_multi (&x, &y, &u, &v, &B, &D, NULL);
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_fast_mp_invmod.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_fast_mp_montgomery_reduce.c b/libtommath/bn_fast_mp_montgomery_reduce.c
index 45a4089..e941dc2 100644
--- a/libtommath/bn_fast_mp_montgomery_reduce.c
+++ b/libtommath/bn_fast_mp_montgomery_reduce.c
@@ -166,7 +166,3 @@ int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_fast_mp_montgomery_reduce.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_fast_s_mp_mul_digs.c b/libtommath/bn_fast_s_mp_mul_digs.c
index 86b78b4..ab157b9 100644
--- a/libtommath/bn_fast_s_mp_mul_digs.c
+++ b/libtommath/bn_fast_s_mp_mul_digs.c
@@ -101,7 +101,3 @@ int fast_s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_fast_s_mp_mul_digs.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_fast_s_mp_mul_high_digs.c b/libtommath/bn_fast_s_mp_mul_high_digs.c
index 607630a..ec9f58a 100644
--- a/libtommath/bn_fast_s_mp_mul_high_digs.c
+++ b/libtommath/bn_fast_s_mp_mul_high_digs.c
@@ -92,7 +92,3 @@ int fast_s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_fast_s_mp_mul_high_digs.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_fast_s_mp_sqr.c b/libtommath/bn_fast_s_mp_sqr.c
index 50adf00..1abf24b 100644
--- a/libtommath/bn_fast_s_mp_sqr.c
+++ b/libtommath/bn_fast_s_mp_sqr.c
@@ -108,7 +108,3 @@ int fast_s_mp_sqr (mp_int * a, mp_int * b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_fast_s_mp_sqr.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_2expt.c b/libtommath/bn_mp_2expt.c
index a9d3e9c..a32572d 100644
--- a/libtommath/bn_mp_2expt.c
+++ b/libtommath/bn_mp_2expt.c
@@ -42,7 +42,3 @@ mp_2expt (mp_int * a, int b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_2expt.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_abs.c b/libtommath/bn_mp_abs.c
index 2a7f02c..dc51884 100644
--- a/libtommath/bn_mp_abs.c
+++ b/libtommath/bn_mp_abs.c
@@ -37,7 +37,3 @@ mp_abs (mp_int * a, mp_int * b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_abs.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_add.c b/libtommath/bn_mp_add.c
index ab3bb87..d9b8fa5 100644
--- a/libtommath/bn_mp_add.c
+++ b/libtommath/bn_mp_add.c
@@ -47,7 +47,3 @@ int mp_add (mp_int * a, mp_int * b, mp_int * c)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_add.c,v $ */
-/* $Revision: 1.3 $ */
-/* $Date: 2006/12/01 19:45:38 $ */
diff --git a/libtommath/bn_mp_add_d.c b/libtommath/bn_mp_add_d.c
index 325b067..5281ad4 100644
--- a/libtommath/bn_mp_add_d.c
+++ b/libtommath/bn_mp_add_d.c
@@ -107,8 +107,3 @@ mp_add_d (mp_int * a, mp_digit b, mp_int * c)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_add_d.c,v $ */
-/* Tom's revision is 1.2 */
-/* $Revision: 1.4 $ */
-/* $Date: 2006/12/01 00:31:32 $ */
diff --git a/libtommath/bn_mp_addmod.c b/libtommath/bn_mp_addmod.c
index b0b4d8b..bff193f 100644
--- a/libtommath/bn_mp_addmod.c
+++ b/libtommath/bn_mp_addmod.c
@@ -35,7 +35,3 @@ mp_addmod (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_addmod.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_and.c b/libtommath/bn_mp_and.c
index ff61017..02bef18 100644
--- a/libtommath/bn_mp_and.c
+++ b/libtommath/bn_mp_and.c
@@ -51,7 +51,3 @@ mp_and (mp_int * a, mp_int * b, mp_int * c)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_and.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_clamp.c b/libtommath/bn_mp_clamp.c
index 4f2f8ba..74887bb 100644
--- a/libtommath/bn_mp_clamp.c
+++ b/libtommath/bn_mp_clamp.c
@@ -38,7 +38,3 @@ mp_clamp (mp_int * a)
}
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_clamp.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_clear.c b/libtommath/bn_mp_clear.c
index e1fe10d..bd07e76 100644
--- a/libtommath/bn_mp_clear.c
+++ b/libtommath/bn_mp_clear.c
@@ -38,7 +38,3 @@ mp_clear (mp_int * a)
}
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_clear.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_clear_multi.c b/libtommath/bn_mp_clear_multi.c
index e9910e8..c3ad7a8 100644
--- a/libtommath/bn_mp_clear_multi.c
+++ b/libtommath/bn_mp_clear_multi.c
@@ -28,7 +28,3 @@ void mp_clear_multi(mp_int *mp, ...)
va_end(args);
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_clear_multi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_cmp.c b/libtommath/bn_mp_cmp.c
index 8029633..943249d 100644
--- a/libtommath/bn_mp_cmp.c
+++ b/libtommath/bn_mp_cmp.c
@@ -37,7 +37,3 @@ mp_cmp (const mp_int * a, const mp_int * b)
}
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_cmp.c,v $ */
-/* $Revision: 1.2 $ */
-/* $Date: 2010/05/03 14:36:40 $ */
diff --git a/libtommath/bn_mp_cmp_d.c b/libtommath/bn_mp_cmp_d.c
index 2dded75..ecec091 100644
--- a/libtommath/bn_mp_cmp_d.c
+++ b/libtommath/bn_mp_cmp_d.c
@@ -38,7 +38,3 @@ int mp_cmp_d(const mp_int * a, mp_digit b)
}
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_cmp_d.c,v $ */
-/* $Revision: 1.2 $ */
-/* $Date: 2010/05/03 14:36:40 $ */
diff --git a/libtommath/bn_mp_cmp_mag.c b/libtommath/bn_mp_cmp_mag.c
index 8c6c169..b23a191 100644
--- a/libtommath/bn_mp_cmp_mag.c
+++ b/libtommath/bn_mp_cmp_mag.c
@@ -49,7 +49,3 @@ int mp_cmp_mag (const mp_int * a, const mp_int * b)
return MP_EQ;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_cmp_mag.c,v $ */
-/* $Revision: 1.2 $ */
-/* $Date: 2010/05/03 14:36:40 $ */
diff --git a/libtommath/bn_mp_cnt_lsb.c b/libtommath/bn_mp_cnt_lsb.c
index 4aa68b5..f205e8c 100644
--- a/libtommath/bn_mp_cnt_lsb.c
+++ b/libtommath/bn_mp_cnt_lsb.c
@@ -20,7 +20,7 @@ static const int lnz[16] = {
};
/* Counts the number of lsbs which are zero before the first zero bit */
-int mp_cnt_lsb(mp_int *a)
+int mp_cnt_lsb(const mp_int *a)
{
int x;
mp_digit q, qq;
@@ -47,7 +47,3 @@ int mp_cnt_lsb(mp_int *a)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_cnt_lsb.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_copy.c b/libtommath/bn_mp_copy.c
index 1d6c5cb..ffbc0d4 100644
--- a/libtommath/bn_mp_copy.c
+++ b/libtommath/bn_mp_copy.c
@@ -62,7 +62,3 @@ mp_copy (const mp_int * a, mp_int * b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_copy.c,v $ */
-/* $Revision: 1.2 $ */
-/* $Date: 2010/05/03 14:36:40 $ */
diff --git a/libtommath/bn_mp_count_bits.c b/libtommath/bn_mp_count_bits.c
index 909c153..00d364e 100644
--- a/libtommath/bn_mp_count_bits.c
+++ b/libtommath/bn_mp_count_bits.c
@@ -39,7 +39,3 @@ mp_count_bits (const mp_int * a)
return r;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_count_bits.c,v $ */
-/* $Revision: 1.2 $ */
-/* $Date: 2010/05/03 14:36:40 $ */
diff --git a/libtommath/bn_mp_div.c b/libtommath/bn_mp_div.c
index ce6c255..de4ca04 100644
--- a/libtommath/bn_mp_div.c
+++ b/libtommath/bn_mp_div.c
@@ -286,7 +286,3 @@ LBL_Q:mp_clear (&q);
#endif
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_div.c,v $ */
-/* $Revision: 1.4 $ */
-/* $Date: 2006/12/01 19:45:38 $ */
diff --git a/libtommath/bn_mp_div_2.c b/libtommath/bn_mp_div_2.c
index bcb17c1..186a959 100644
--- a/libtommath/bn_mp_div_2.c
+++ b/libtommath/bn_mp_div_2.c
@@ -62,7 +62,3 @@ int mp_div_2(mp_int * a, mp_int * b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_div_2.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_div_2d.c b/libtommath/bn_mp_div_2d.c
index 2bdbdb5..d7b7e05 100644
--- a/libtommath/bn_mp_div_2d.c
+++ b/libtommath/bn_mp_div_2d.c
@@ -91,7 +91,3 @@ int mp_div_2d (const mp_int * a, int b, mp_int * c, mp_int * d)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_div_2d.c,v $ */
-/* $Revision: 1.2 $ */
-/* $Date: 2010/05/03 14:36:40 $ */
diff --git a/libtommath/bn_mp_div_3.c b/libtommath/bn_mp_div_3.c
index 571991a..79a9816 100644
--- a/libtommath/bn_mp_div_3.c
+++ b/libtommath/bn_mp_div_3.c
@@ -73,7 +73,3 @@ mp_div_3 (mp_int * a, mp_int *c, mp_digit * d)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_div_3.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_div_d.c b/libtommath/bn_mp_div_d.c
index 4289602..af18d0a 100644
--- a/libtommath/bn_mp_div_d.c
+++ b/libtommath/bn_mp_div_d.c
@@ -20,7 +20,7 @@ static int s_is_power_of_two(mp_digit b, int *p)
int x;
/* quick out - if (b & (b-1)) isn't zero, b isn't a power of two */
- if ((b & (b-1)) != 0) {
+ if ((b==0) || (b & (b-1))) {
return 0;
}
for (x = 1; x < DIGIT_BIT; x++) {
@@ -108,7 +108,3 @@ int mp_div_d (mp_int * a, mp_digit b, mp_int * c, mp_digit * d)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_div_d.c,v $ */
-/* $Revision: 1.3 $ */
-/* $Date: 2006/12/01 05:47:47 $ */
diff --git a/libtommath/bn_mp_dr_is_modulus.c b/libtommath/bn_mp_dr_is_modulus.c
index 9532df1..8ad31dc 100644
--- a/libtommath/bn_mp_dr_is_modulus.c
+++ b/libtommath/bn_mp_dr_is_modulus.c
@@ -37,7 +37,3 @@ int mp_dr_is_modulus(mp_int *a)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_dr_is_modulus.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_dr_reduce.c b/libtommath/bn_mp_dr_reduce.c
index 6d63462..8337591 100644
--- a/libtommath/bn_mp_dr_reduce.c
+++ b/libtommath/bn_mp_dr_reduce.c
@@ -88,7 +88,3 @@ top:
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_dr_reduce.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_dr_setup.c b/libtommath/bn_mp_dr_setup.c
index c6f4b2f..de00e2d 100644
--- a/libtommath/bn_mp_dr_setup.c
+++ b/libtommath/bn_mp_dr_setup.c
@@ -26,7 +26,3 @@ void mp_dr_setup(mp_int *a, mp_digit *d)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_dr_setup.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_exch.c b/libtommath/bn_mp_exch.c
index 691d9f6..b7bd186 100644
--- a/libtommath/bn_mp_exch.c
+++ b/libtommath/bn_mp_exch.c
@@ -28,7 +28,3 @@ mp_exch (mp_int * a, mp_int * b)
*b = t;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_exch.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_expt_d.c b/libtommath/bn_mp_expt_d.c
index dfd04eb..132f480 100644
--- a/libtommath/bn_mp_expt_d.c
+++ b/libtommath/bn_mp_expt_d.c
@@ -51,7 +51,3 @@ int mp_expt_d (mp_int * a, mp_digit b, mp_int * c)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_expt_d.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_exptmod.c b/libtommath/bn_mp_exptmod.c
index 714a96f..b7d9fb7 100644
--- a/libtommath/bn_mp_exptmod.c
+++ b/libtommath/bn_mp_exptmod.c
@@ -106,7 +106,3 @@ int mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_exptmod.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_exptmod_fast.c b/libtommath/bn_mp_exptmod_fast.c
index cb8d94a..1902e79 100644
--- a/libtommath/bn_mp_exptmod_fast.c
+++ b/libtommath/bn_mp_exptmod_fast.c
@@ -314,8 +314,3 @@ LBL_M:
return err;
}
#endif
-
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_exptmod_fast.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_exteuclid.c b/libtommath/bn_mp_exteuclid.c
index 9730fa0..2e69ce1 100644
--- a/libtommath/bn_mp_exteuclid.c
+++ b/libtommath/bn_mp_exteuclid.c
@@ -76,7 +76,3 @@ _ERR: mp_clear_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL
return err;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_exteuclid.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_fread.c b/libtommath/bn_mp_fread.c
index c1b0128..44e1ea8 100644
--- a/libtommath/bn_mp_fread.c
+++ b/libtommath/bn_mp_fread.c
@@ -61,7 +61,3 @@ int mp_fread(mp_int *a, int radix, FILE *stream)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_fread.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_fwrite.c b/libtommath/bn_mp_fwrite.c
index 5785c02..b0ec29e 100644
--- a/libtommath/bn_mp_fwrite.c
+++ b/libtommath/bn_mp_fwrite.c
@@ -46,7 +46,3 @@ int mp_fwrite(mp_int *a, int radix, FILE *stream)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_fwrite.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_gcd.c b/libtommath/bn_mp_gcd.c
index bbc5421..68cfa03 100644
--- a/libtommath/bn_mp_gcd.c
+++ b/libtommath/bn_mp_gcd.c
@@ -99,7 +99,3 @@ LBL_U:mp_clear (&v);
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_gcd.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_get_int.c b/libtommath/bn_mp_get_int.c
index 269be79..762cb23 100644
--- a/libtommath/bn_mp_get_int.c
+++ b/libtommath/bn_mp_get_int.c
@@ -39,7 +39,3 @@ unsigned long mp_get_int(mp_int * a)
return res & 0xFFFFFFFFUL;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_get_int.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_grow.c b/libtommath/bn_mp_grow.c
index e77c774..b5b2407 100644
--- a/libtommath/bn_mp_grow.c
+++ b/libtommath/bn_mp_grow.c
@@ -51,7 +51,3 @@ int mp_grow (mp_int * a, int size)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_grow.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_init.c b/libtommath/bn_mp_init.c
index c866e89..ddb2d07 100644
--- a/libtommath/bn_mp_init.c
+++ b/libtommath/bn_mp_init.c
@@ -40,7 +40,3 @@ int mp_init (mp_int * a)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_init.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_init_copy.c b/libtommath/bn_mp_init_copy.c
index 2e1c207..2410a9f 100644
--- a/libtommath/bn_mp_init_copy.c
+++ b/libtommath/bn_mp_init_copy.c
@@ -26,7 +26,3 @@ int mp_init_copy (mp_int * a, mp_int * b)
return mp_copy (b, a);
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_init_copy.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_init_multi.c b/libtommath/bn_mp_init_multi.c
index 70148b8..44e3fe6 100644
--- a/libtommath/bn_mp_init_multi.c
+++ b/libtommath/bn_mp_init_multi.c
@@ -53,7 +53,3 @@ int mp_init_multi(mp_int *mp, ...)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_init_multi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_init_set.c b/libtommath/bn_mp_init_set.c
index cdf1249..dc08867 100644
--- a/libtommath/bn_mp_init_set.c
+++ b/libtommath/bn_mp_init_set.c
@@ -26,7 +26,3 @@ int mp_init_set (mp_int * a, mp_digit b)
return err;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_init_set.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_init_set_int.c b/libtommath/bn_mp_init_set_int.c
index a4e87d5..56b27e0 100644
--- a/libtommath/bn_mp_init_set_int.c
+++ b/libtommath/bn_mp_init_set_int.c
@@ -25,7 +25,3 @@ int mp_init_set_int (mp_int * a, unsigned long b)
return mp_set_int(a, b);
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_init_set_int.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_init_size.c b/libtommath/bn_mp_init_size.c
index 4433b16..8ed2c2a 100644
--- a/libtommath/bn_mp_init_size.c
+++ b/libtommath/bn_mp_init_size.c
@@ -42,7 +42,3 @@ int mp_init_size (mp_int * a, int size)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_init_size.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_invmod.c b/libtommath/bn_mp_invmod.c
index 09e71cd..fdb6c88 100644
--- a/libtommath/bn_mp_invmod.c
+++ b/libtommath/bn_mp_invmod.c
@@ -37,7 +37,3 @@ int mp_invmod (mp_int * a, mp_int * b, mp_int * c)
return MP_VAL;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_invmod.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_invmod_slow.c b/libtommath/bn_mp_invmod_slow.c
index ff9cc96..e079819 100644
--- a/libtommath/bn_mp_invmod_slow.c
+++ b/libtommath/bn_mp_invmod_slow.c
@@ -169,7 +169,3 @@ LBL_ERR:mp_clear_multi (&x, &y, &u, &v, &A, &B, &C, &D, NULL);
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_invmod_slow.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_is_square.c b/libtommath/bn_mp_is_square.c
index 01f07b3..926b449 100644
--- a/libtommath/bn_mp_is_square.c
+++ b/libtommath/bn_mp_is_square.c
@@ -103,7 +103,3 @@ ERR:mp_clear(&t);
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_is_square.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_jacobi.c b/libtommath/bn_mp_jacobi.c
index cb7713d..1644698 100644
--- a/libtommath/bn_mp_jacobi.c
+++ b/libtommath/bn_mp_jacobi.c
@@ -99,7 +99,3 @@ LBL_A1:mp_clear (&a1);
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_jacobi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_karatsuba_mul.c b/libtommath/bn_mp_karatsuba_mul.c
index 53187dd..0d62b9b 100644
--- a/libtommath/bn_mp_karatsuba_mul.c
+++ b/libtommath/bn_mp_karatsuba_mul.c
@@ -161,7 +161,3 @@ ERR:
return err;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_karatsuba_mul.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_karatsuba_sqr.c b/libtommath/bn_mp_karatsuba_sqr.c
index 7f1f253..829405a 100644
--- a/libtommath/bn_mp_karatsuba_sqr.c
+++ b/libtommath/bn_mp_karatsuba_sqr.c
@@ -115,7 +115,3 @@ ERR:
return err;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_karatsuba_sqr.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_lcm.c b/libtommath/bn_mp_lcm.c
index 72a5beb..1d53921 100644
--- a/libtommath/bn_mp_lcm.c
+++ b/libtommath/bn_mp_lcm.c
@@ -54,7 +54,3 @@ LBL_T:
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_lcm.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_lshd.c b/libtommath/bn_mp_lshd.c
index 84dfa81..ce1e63b 100644
--- a/libtommath/bn_mp_lshd.c
+++ b/libtommath/bn_mp_lshd.c
@@ -61,7 +61,3 @@ int mp_lshd (mp_int * a, int b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_lshd.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_mod.c b/libtommath/bn_mp_mod.c
index 16d9d76..98e155e 100644
--- a/libtommath/bn_mp_mod.c
+++ b/libtommath/bn_mp_mod.c
@@ -42,7 +42,3 @@ mp_mod (mp_int * a, mp_int * b, mp_int * c)
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_mod.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_mod_2d.c b/libtommath/bn_mp_mod_2d.c
index e94a819..0170f65 100644
--- a/libtommath/bn_mp_mod_2d.c
+++ b/libtommath/bn_mp_mod_2d.c
@@ -49,7 +49,3 @@ mp_mod_2d (const mp_int * a, int b, mp_int * c)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_mod_2d.c,v $ */
-/* $Revision: 1.2 $ */
-/* $Date: 2010/05/03 14:36:40 $ */
diff --git a/libtommath/bn_mp_mod_d.c b/libtommath/bn_mp_mod_d.c
index 91dcbe1..f642ee8 100644
--- a/libtommath/bn_mp_mod_d.c
+++ b/libtommath/bn_mp_mod_d.c
@@ -21,7 +21,3 @@ mp_mod_d (mp_int * a, mp_digit b, mp_digit * c)
return mp_div_d(a, b, NULL, c);
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_mod_d.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_montgomery_calc_normalization.c b/libtommath/bn_mp_montgomery_calc_normalization.c
index 59dd8ea..0748762 100644
--- a/libtommath/bn_mp_montgomery_calc_normalization.c
+++ b/libtommath/bn_mp_montgomery_calc_normalization.c
@@ -53,7 +53,3 @@ int mp_montgomery_calc_normalization (mp_int * a, mp_int * b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_montgomery_calc_normalization.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_montgomery_reduce.c b/libtommath/bn_mp_montgomery_reduce.c
index f9305d8..bc6abb8 100644
--- a/libtommath/bn_mp_montgomery_reduce.c
+++ b/libtommath/bn_mp_montgomery_reduce.c
@@ -112,7 +112,3 @@ mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_montgomery_reduce.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_montgomery_setup.c b/libtommath/bn_mp_montgomery_setup.c
index cea6778..b8e1887 100644
--- a/libtommath/bn_mp_montgomery_setup.c
+++ b/libtommath/bn_mp_montgomery_setup.c
@@ -48,12 +48,8 @@ mp_montgomery_setup (mp_int * n, mp_digit * rho)
#endif
/* rho = -1/m mod b */
- *rho = (((mp_word)1 << ((mp_word) DIGIT_BIT)) - x) & MP_MASK;
+ *rho = (unsigned long)(((mp_word)1 << ((mp_word) DIGIT_BIT)) - x) & MP_MASK;
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_montgomery_setup.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_mul.c b/libtommath/bn_mp_mul.c
index 6506635..fc024be 100644
--- a/libtommath/bn_mp_mul.c
+++ b/libtommath/bn_mp_mul.c
@@ -60,7 +60,3 @@ int mp_mul (mp_int * a, mp_int * b, mp_int * c)
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_mul.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_mul_2.c b/libtommath/bn_mp_mul_2.c
index 96d5710..2ca6022 100644
--- a/libtommath/bn_mp_mul_2.c
+++ b/libtommath/bn_mp_mul_2.c
@@ -76,7 +76,3 @@ int mp_mul_2(mp_int * a, mp_int * b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_mul_2.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_mul_2d.c b/libtommath/bn_mp_mul_2d.c
index 8672ee3..4ac2e4e 100644
--- a/libtommath/bn_mp_mul_2d.c
+++ b/libtommath/bn_mp_mul_2d.c
@@ -79,7 +79,3 @@ int mp_mul_2d (const mp_int * a, int b, mp_int * c)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_mul_2d.c,v $ */
-/* $Revision: 1.2 $ */
-/* $Date: 2010/05/03 14:36:40 $ */
diff --git a/libtommath/bn_mp_mul_d.c b/libtommath/bn_mp_mul_d.c
index e86d6ab..ba45a0c 100644
--- a/libtommath/bn_mp_mul_d.c
+++ b/libtommath/bn_mp_mul_d.c
@@ -73,7 +73,3 @@ mp_mul_d (mp_int * a, mp_digit b, mp_int * c)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_mul_d.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_mulmod.c b/libtommath/bn_mp_mulmod.c
index d84c555..649b717 100644
--- a/libtommath/bn_mp_mulmod.c
+++ b/libtommath/bn_mp_mulmod.c
@@ -34,7 +34,3 @@ int mp_mulmod (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_mulmod.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_n_root.c b/libtommath/bn_mp_n_root.c
index 734d5ea..b2700a8 100644
--- a/libtommath/bn_mp_n_root.c
+++ b/libtommath/bn_mp_n_root.c
@@ -126,7 +126,3 @@ LBL_T1:mp_clear (&t1);
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_n_root.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_neg.c b/libtommath/bn_mp_neg.c
index 886db3f..07fb148 100644
--- a/libtommath/bn_mp_neg.c
+++ b/libtommath/bn_mp_neg.c
@@ -34,7 +34,3 @@ int mp_neg (const mp_int * a, mp_int * b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_neg.c,v $ */
-/* $Revision: 1.2 $ */
-/* $Date: 2010/05/03 14:36:40 $ */
diff --git a/libtommath/bn_mp_or.c b/libtommath/bn_mp_or.c
index 09df58c..aa5b1bd 100644
--- a/libtommath/bn_mp_or.c
+++ b/libtommath/bn_mp_or.c
@@ -44,7 +44,3 @@ int mp_or (mp_int * a, mp_int * b, mp_int * c)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_or.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_prime_fermat.c b/libtommath/bn_mp_prime_fermat.c
index f6edf9e..7b9b12e 100644
--- a/libtommath/bn_mp_prime_fermat.c
+++ b/libtommath/bn_mp_prime_fermat.c
@@ -56,7 +56,3 @@ LBL_T:mp_clear (&t);
return err;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_prime_fermat.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_prime_is_divisible.c b/libtommath/bn_mp_prime_is_divisible.c
index 897c11b..710c967 100644
--- a/libtommath/bn_mp_prime_is_divisible.c
+++ b/libtommath/bn_mp_prime_is_divisible.c
@@ -44,7 +44,3 @@ int mp_prime_is_divisible (mp_int * a, int *result)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_prime_is_divisible.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_prime_is_prime.c b/libtommath/bn_mp_prime_is_prime.c
index 135f1d9..ce225a3 100644
--- a/libtommath/bn_mp_prime_is_prime.c
+++ b/libtommath/bn_mp_prime_is_prime.c
@@ -77,7 +77,3 @@ LBL_B:mp_clear (&b);
return err;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_prime_is_prime.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_prime_miller_rabin.c b/libtommath/bn_mp_prime_miller_rabin.c
index f2d6c7f..c5185b8 100644
--- a/libtommath/bn_mp_prime_miller_rabin.c
+++ b/libtommath/bn_mp_prime_miller_rabin.c
@@ -97,7 +97,3 @@ LBL_N1:mp_clear (&n1);
return err;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_prime_miller_rabin.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_prime_next_prime.c b/libtommath/bn_mp_prime_next_prime.c
index a875260..2433e8c 100644
--- a/libtommath/bn_mp_prime_next_prime.c
+++ b/libtommath/bn_mp_prime_next_prime.c
@@ -143,7 +143,7 @@ int mp_prime_next_prime(mp_int *a, int t, int bbs_style)
/* is this prime? */
for (x = 0; x < t; x++) {
- mp_set(&b, ltm_prime_tab[t]);
+ mp_set(&b, ltm_prime_tab[x]);
if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) {
goto LBL_ERR;
}
@@ -164,7 +164,3 @@ LBL_ERR:
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_prime_next_prime.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_prime_rabin_miller_trials.c b/libtommath/bn_mp_prime_rabin_miller_trials.c
index 30825a3..e57a43c 100644
--- a/libtommath/bn_mp_prime_rabin_miller_trials.c
+++ b/libtommath/bn_mp_prime_rabin_miller_trials.c
@@ -46,7 +46,3 @@ int mp_prime_rabin_miller_trials(int size)
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_prime_rabin_miller_trials.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_prime_random_ex.c b/libtommath/bn_mp_prime_random_ex.c
index baddd10..a37477e 100644
--- a/libtommath/bn_mp_prime_random_ex.c
+++ b/libtommath/bn_mp_prime_random_ex.c
@@ -119,7 +119,3 @@ error:
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_prime_random_ex.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_radix_size.c b/libtommath/bn_mp_radix_size.c
index 4aa407b..40c4d04 100644
--- a/libtommath/bn_mp_radix_size.c
+++ b/libtommath/bn_mp_radix_size.c
@@ -81,8 +81,3 @@ int mp_radix_size (mp_int * a, int radix, int *size)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_radix_size.c,v $ */
-/* Tom's revision is 1.4 */
-/* $Revision: 1.5 $ */
-/* $Date: 2006/12/01 00:31:32 $ */
diff --git a/libtommath/bn_mp_radix_smap.c b/libtommath/bn_mp_radix_smap.c
index 913acad..7aeb375 100644
--- a/libtommath/bn_mp_radix_smap.c
+++ b/libtommath/bn_mp_radix_smap.c
@@ -18,7 +18,3 @@
/* chars used in radix conversions */
const char *mp_s_rmap = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/";
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_radix_smap.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_rand.c b/libtommath/bn_mp_rand.c
index 6de7447..17c1fbe 100644
--- a/libtommath/bn_mp_rand.c
+++ b/libtommath/bn_mp_rand.c
@@ -49,7 +49,3 @@ mp_rand (mp_int * a, int digits)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_rand.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_read_radix.c b/libtommath/bn_mp_read_radix.c
index 9387bc1..4b92589 100644
--- a/libtommath/bn_mp_read_radix.c
+++ b/libtommath/bn_mp_read_radix.c
@@ -86,9 +86,3 @@ int mp_read_radix (mp_int * a, const char *str, int radix)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_read_radix.c,v $ */
-/* Tom's revision is 1.4. */
-/* $Revision: 1.7 $ */
-/* $Date: 2009/12/11 23:10:47 $ */
-
diff --git a/libtommath/bn_mp_read_signed_bin.c b/libtommath/bn_mp_read_signed_bin.c
index ae9e6a8..3ee8556 100644
--- a/libtommath/bn_mp_read_signed_bin.c
+++ b/libtommath/bn_mp_read_signed_bin.c
@@ -35,7 +35,3 @@ int mp_read_signed_bin (mp_int * a, const unsigned char *b, int c)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_read_signed_bin.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_read_unsigned_bin.c b/libtommath/bn_mp_read_unsigned_bin.c
index b94265f..caf5be0 100644
--- a/libtommath/bn_mp_read_unsigned_bin.c
+++ b/libtommath/bn_mp_read_unsigned_bin.c
@@ -49,7 +49,3 @@ int mp_read_unsigned_bin (mp_int * a, const unsigned char *b, int c)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_read_unsigned_bin.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_reduce.c b/libtommath/bn_mp_reduce.c
index e4c8842..4375e4e 100644
--- a/libtommath/bn_mp_reduce.c
+++ b/libtommath/bn_mp_reduce.c
@@ -94,7 +94,3 @@ CLEANUP:
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_reduce.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_reduce_2k.c b/libtommath/bn_mp_reduce_2k.c
index 0bc9f36..428f2ff 100644
--- a/libtommath/bn_mp_reduce_2k.c
+++ b/libtommath/bn_mp_reduce_2k.c
@@ -55,7 +55,3 @@ ERR:
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_reduce_2k.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_reduce_2k_l.c b/libtommath/bn_mp_reduce_2k_l.c
index ff50948..8e52efa 100644
--- a/libtommath/bn_mp_reduce_2k_l.c
+++ b/libtommath/bn_mp_reduce_2k_l.c
@@ -56,7 +56,3 @@ ERR:
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_reduce_2k_l.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_reduce_2k_setup.c b/libtommath/bn_mp_reduce_2k_setup.c
index 2a97cd0..ac043f6 100644
--- a/libtommath/bn_mp_reduce_2k_setup.c
+++ b/libtommath/bn_mp_reduce_2k_setup.c
@@ -41,7 +41,3 @@ int mp_reduce_2k_setup(mp_int *a, mp_digit *d)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_reduce_2k_setup.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_reduce_2k_setup_l.c b/libtommath/bn_mp_reduce_2k_setup_l.c
index acff733..b59a1ed 100644
--- a/libtommath/bn_mp_reduce_2k_setup_l.c
+++ b/libtommath/bn_mp_reduce_2k_setup_l.c
@@ -38,7 +38,3 @@ ERR:
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_reduce_2k_setup_l.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_reduce_is_2k.c b/libtommath/bn_mp_reduce_is_2k.c
index e398e19..4655fcf 100644
--- a/libtommath/bn_mp_reduce_is_2k.c
+++ b/libtommath/bn_mp_reduce_is_2k.c
@@ -46,7 +46,3 @@ int mp_reduce_is_2k(mp_int *a)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_reduce_is_2k.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_reduce_is_2k_l.c b/libtommath/bn_mp_reduce_is_2k_l.c
index 82e972d..7b57865 100644
--- a/libtommath/bn_mp_reduce_is_2k_l.c
+++ b/libtommath/bn_mp_reduce_is_2k_l.c
@@ -38,7 +38,3 @@ int mp_reduce_is_2k_l(mp_int *a)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_reduce_is_2k_l.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_reduce_setup.c b/libtommath/bn_mp_reduce_setup.c
index 94bd26f..d8cefd9 100644
--- a/libtommath/bn_mp_reduce_setup.c
+++ b/libtommath/bn_mp_reduce_setup.c
@@ -28,7 +28,3 @@ int mp_reduce_setup (mp_int * a, mp_int * b)
return mp_div (a, b, a, NULL);
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_reduce_setup.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_rshd.c b/libtommath/bn_mp_rshd.c
index ebc8d5f..e6095b3 100644
--- a/libtommath/bn_mp_rshd.c
+++ b/libtommath/bn_mp_rshd.c
@@ -66,7 +66,3 @@ void mp_rshd (mp_int * a, int b)
a->used -= b;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_rshd.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_set.c b/libtommath/bn_mp_set.c
index 9cb64c7..c32fc42 100644
--- a/libtommath/bn_mp_set.c
+++ b/libtommath/bn_mp_set.c
@@ -23,7 +23,3 @@ void mp_set (mp_int * a, mp_digit b)
a->used = (a->dp[0] != 0) ? 1 : 0;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_set.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_set_int.c b/libtommath/bn_mp_set_int.c
index 106c4e2..b0fc344 100644
--- a/libtommath/bn_mp_set_int.c
+++ b/libtommath/bn_mp_set_int.c
@@ -42,7 +42,3 @@ int mp_set_int (mp_int * a, unsigned long b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_set_int.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_shrink.c b/libtommath/bn_mp_shrink.c
index ddd72e3..bfdf93a 100644
--- a/libtommath/bn_mp_shrink.c
+++ b/libtommath/bn_mp_shrink.c
@@ -19,17 +19,18 @@
int mp_shrink (mp_int * a)
{
mp_digit *tmp;
- if (a->alloc != a->used && a->used > 0) {
- if ((tmp = OPT_CAST(mp_digit) XREALLOC (a->dp, sizeof (mp_digit) * a->used)) == NULL) {
+ int used = 1;
+
+ if(a->used > 0)
+ used = a->used;
+
+ if (a->alloc != used) {
+ if ((tmp = OPT_CAST(mp_digit) XREALLOC (a->dp, sizeof (mp_digit) * used)) == NULL) {
return MP_MEM;
}
a->dp = tmp;
- a->alloc = a->used;
+ a->alloc = used;
}
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_shrink.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_signed_bin_size.c b/libtommath/bn_mp_signed_bin_size.c
index 97fdb96..8f88e76 100644
--- a/libtommath/bn_mp_signed_bin_size.c
+++ b/libtommath/bn_mp_signed_bin_size.c
@@ -21,7 +21,3 @@ int mp_signed_bin_size (mp_int * a)
return 1 + mp_unsigned_bin_size (a);
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_signed_bin_size.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_sqr.c b/libtommath/bn_mp_sqr.c
index 4e75bdb..3938537 100644
--- a/libtommath/bn_mp_sqr.c
+++ b/libtommath/bn_mp_sqr.c
@@ -52,7 +52,3 @@ if (a->used >= KARATSUBA_SQR_CUTOFF) {
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_sqr.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_sqrmod.c b/libtommath/bn_mp_sqrmod.c
index d0f0a79..6f90772 100644
--- a/libtommath/bn_mp_sqrmod.c
+++ b/libtommath/bn_mp_sqrmod.c
@@ -35,7 +35,3 @@ mp_sqrmod (mp_int * a, mp_int * b, mp_int * c)
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_sqrmod.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_sqrt.c b/libtommath/bn_mp_sqrt.c
index 0bba337..016b8ba 100644
--- a/libtommath/bn_mp_sqrt.c
+++ b/libtommath/bn_mp_sqrt.c
@@ -140,8 +140,3 @@ E2: mp_clear(&t1);
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_sqrt.c,v $ */
-/* Based on Tom's 1.3 */
-/* $Revision: 1.6 $ */
-/* $Date: 2008/10/05 21:27:07 $ */
diff --git a/libtommath/bn_mp_sub.c b/libtommath/bn_mp_sub.c
index c0e2def..13cb43e 100644
--- a/libtommath/bn_mp_sub.c
+++ b/libtommath/bn_mp_sub.c
@@ -53,7 +53,3 @@ mp_sub (mp_int * a, mp_int * b, mp_int * c)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_sub.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_sub_d.c b/libtommath/bn_mp_sub_d.c
index d979f35..b1e4e3f 100644
--- a/libtommath/bn_mp_sub_d.c
+++ b/libtommath/bn_mp_sub_d.c
@@ -87,7 +87,3 @@ mp_sub_d (mp_int * a, mp_digit b, mp_int * c)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_sub_d.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_submod.c b/libtommath/bn_mp_submod.c
index 046e844..7461678 100644
--- a/libtommath/bn_mp_submod.c
+++ b/libtommath/bn_mp_submod.c
@@ -36,7 +36,3 @@ mp_submod (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
return res;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_submod.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_to_signed_bin.c b/libtommath/bn_mp_to_signed_bin.c
index 066eb51..7871921 100644
--- a/libtommath/bn_mp_to_signed_bin.c
+++ b/libtommath/bn_mp_to_signed_bin.c
@@ -27,7 +27,3 @@ int mp_to_signed_bin (mp_int * a, unsigned char *b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_to_signed_bin.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_to_signed_bin_n.c b/libtommath/bn_mp_to_signed_bin_n.c
index b1df632..8da9961 100644
--- a/libtommath/bn_mp_to_signed_bin_n.c
+++ b/libtommath/bn_mp_to_signed_bin_n.c
@@ -25,7 +25,3 @@ int mp_to_signed_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen)
return mp_to_signed_bin(a, b);
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_to_signed_bin_n.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_to_unsigned_bin.c b/libtommath/bn_mp_to_unsigned_bin.c
index d69de35..9496398 100644
--- a/libtommath/bn_mp_to_unsigned_bin.c
+++ b/libtommath/bn_mp_to_unsigned_bin.c
@@ -42,7 +42,3 @@ int mp_to_unsigned_bin (mp_int * a, unsigned char *b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_to_unsigned_bin.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_to_unsigned_bin_n.c b/libtommath/bn_mp_to_unsigned_bin_n.c
index 5621960..4f2a31d 100644
--- a/libtommath/bn_mp_to_unsigned_bin_n.c
+++ b/libtommath/bn_mp_to_unsigned_bin_n.c
@@ -25,7 +25,3 @@ int mp_to_unsigned_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen)
return mp_to_unsigned_bin(a, b);
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_to_unsigned_bin_n.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_toom_mul.c b/libtommath/bn_mp_toom_mul.c
index 14d0705..9daefbd 100644
--- a/libtommath/bn_mp_toom_mul.c
+++ b/libtommath/bn_mp_toom_mul.c
@@ -278,7 +278,3 @@ ERR:
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_toom_mul.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_toom_sqr.c b/libtommath/bn_mp_toom_sqr.c
index 14a235a..9e3f79c 100644
--- a/libtommath/bn_mp_toom_sqr.c
+++ b/libtommath/bn_mp_toom_sqr.c
@@ -220,7 +220,3 @@ ERR:
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_toom_sqr.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_toradix.c b/libtommath/bn_mp_toradix.c
index 1bd8819..132743e 100644
--- a/libtommath/bn_mp_toradix.c
+++ b/libtommath/bn_mp_toradix.c
@@ -69,7 +69,3 @@ int mp_toradix (mp_int * a, char *str, int radix)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_toradix.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_toradix_n.c b/libtommath/bn_mp_toradix_n.c
index 39d5101..dedce71 100644
--- a/libtommath/bn_mp_toradix_n.c
+++ b/libtommath/bn_mp_toradix_n.c
@@ -82,7 +82,3 @@ int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_toradix_n.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_unsigned_bin_size.c b/libtommath/bn_mp_unsigned_bin_size.c
index e79b91a..58c18fb 100644
--- a/libtommath/bn_mp_unsigned_bin_size.c
+++ b/libtommath/bn_mp_unsigned_bin_size.c
@@ -22,7 +22,3 @@ int mp_unsigned_bin_size (mp_int * a)
return (size / 8 + ((size & 7) != 0 ? 1 : 0));
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_unsigned_bin_size.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_xor.c b/libtommath/bn_mp_xor.c
index bf40408..432f42e 100644
--- a/libtommath/bn_mp_xor.c
+++ b/libtommath/bn_mp_xor.c
@@ -45,7 +45,3 @@ mp_xor (mp_int * a, mp_int * b, mp_int * c)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_xor.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_mp_zero.c b/libtommath/bn_mp_zero.c
index 3cbd933..d697a60 100644
--- a/libtommath/bn_mp_zero.c
+++ b/libtommath/bn_mp_zero.c
@@ -30,7 +30,3 @@ void mp_zero (mp_int * a)
}
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_zero.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_prime_tab.c b/libtommath/bn_prime_tab.c
index 38cb592..c47c8bd 100644
--- a/libtommath/bn_prime_tab.c
+++ b/libtommath/bn_prime_tab.c
@@ -55,7 +55,3 @@ const mp_digit ltm_prime_tab[] = {
#endif
};
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_prime_tab.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_reverse.c b/libtommath/bn_reverse.c
index 3132f93..9d7fd29 100644
--- a/libtommath/bn_reverse.c
+++ b/libtommath/bn_reverse.c
@@ -33,7 +33,3 @@ bn_reverse (unsigned char *s, int len)
}
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_reverse.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_s_mp_add.c b/libtommath/bn_s_mp_add.c
index 7023300..7527bf8 100644
--- a/libtommath/bn_s_mp_add.c
+++ b/libtommath/bn_s_mp_add.c
@@ -103,7 +103,3 @@ s_mp_add (mp_int * a, mp_int * b, mp_int * c)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_s_mp_add.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_s_mp_exptmod.c b/libtommath/bn_s_mp_exptmod.c
index 7c6e304..ff6bd54 100644
--- a/libtommath/bn_s_mp_exptmod.c
+++ b/libtommath/bn_s_mp_exptmod.c
@@ -246,7 +246,3 @@ LBL_M:
return err;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_s_mp_exptmod.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_s_mp_mul_digs.c b/libtommath/bn_s_mp_mul_digs.c
index eb99e33..401f32e 100644
--- a/libtommath/bn_s_mp_mul_digs.c
+++ b/libtommath/bn_s_mp_mul_digs.c
@@ -84,7 +84,3 @@ int s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_s_mp_mul_digs.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_s_mp_mul_high_digs.c b/libtommath/bn_s_mp_mul_high_digs.c
index 2ae9ee1..f4dca76 100644
--- a/libtommath/bn_s_mp_mul_high_digs.c
+++ b/libtommath/bn_s_mp_mul_high_digs.c
@@ -75,7 +75,3 @@ s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_s_mp_mul_high_digs.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_s_mp_sqr.c b/libtommath/bn_s_mp_sqr.c
index 0ae2869..464663f 100644
--- a/libtommath/bn_s_mp_sqr.c
+++ b/libtommath/bn_s_mp_sqr.c
@@ -78,7 +78,3 @@ int s_mp_sqr (mp_int * a, mp_int * b)
return MP_OKAY;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_s_mp_sqr.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bn_s_mp_sub.c b/libtommath/bn_s_mp_sub.c
index 94375a0..328c9e5 100644
--- a/libtommath/bn_s_mp_sub.c
+++ b/libtommath/bn_s_mp_sub.c
@@ -83,7 +83,3 @@ s_mp_sub (mp_int * a, mp_int * b, mp_int * c)
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_s_mp_sub.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:11 $ */
diff --git a/libtommath/bncore.c b/libtommath/bncore.c
index ac19aa6..eb95a2e 100644
--- a/libtommath/bncore.c
+++ b/libtommath/bncore.c
@@ -30,7 +30,3 @@ int KARATSUBA_MUL_CUTOFF = 80, /* Min. number of digits before Karatsub
TOOM_MUL_CUTOFF = 350, /* no optimal values of these are known yet so set em high */
TOOM_SQR_CUTOFF = 400;
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bncore.c,v $ */
-/* $Revision: 1.3 $ */
-/* $Date: 2006/12/01 19:45:38 $ */
diff --git a/libtommath/changes.txt b/libtommath/changes.txt
index 9498d36..4fc0913 100644
--- a/libtommath/changes.txt
+++ b/libtommath/changes.txt
@@ -1,3 +1,17 @@
+July 23rd, 2010
+v0.42.0
+ -- Fix for mp_prime_next_prime() bug when checking generated prime
+ -- allow mp_shrink to shrink initialized, but empty MPI's
+ -- Added project and solution files for Visual Studio 2005 and Visual Studio 2008.
+
+March 10th, 2007
+v0.41 -- Wolfgang Ehrhardt suggested a quick fix to mp_div_d() which makes the detection of powers of two quicker.
+ -- [CRI] Added libtommath.dsp for Visual C++ users.
+
+December 24th, 2006
+v0.40 -- Updated makefile to properly support LIBNAME
+ -- Fixed bug in fast_s_mp_mul_high_digs() which overflowed (line 83), thanks Valgrind!
+
April 4th, 2006
v0.39 -- Jim Wigginton pointed out my Montgomery examples in figures 6.4 and 6.6 were off by one, k should be 9 not 8
-- Bruce Guenter suggested I use --tag=CC for libtool builds where the compiler may think it's C++.
diff --git a/libtommath/demo/demo.c b/libtommath/demo/demo.c
index 0555366..e1f8a5e 100644
--- a/libtommath/demo/demo.c
+++ b/libtommath/demo/demo.c
@@ -734,7 +734,3 @@ printf("compare no compare!\n"); exit(EXIT_FAILURE); }
}
return 0;
}
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/demo/demo.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:16 $ */
diff --git a/libtommath/demo/timing.c b/libtommath/demo/timing.c
index cf0f39c..bb3be52 100644
--- a/libtommath/demo/timing.c
+++ b/libtommath/demo/timing.c
@@ -313,7 +313,3 @@ int main(void)
return 0;
}
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/demo/timing.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:16 $ */
diff --git a/libtommath/etc/2kprime.c b/libtommath/etc/2kprime.c
index d8ea97c..67a2777 100644
--- a/libtommath/etc/2kprime.c
+++ b/libtommath/etc/2kprime.c
@@ -73,12 +73,3 @@ int main(void)
return 0;
}
-
-
-
-
-
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/etc/2kprime.c,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:32:16 $ */
diff --git a/libtommath/etc/drprime.c b/libtommath/etc/drprime.c
index eec89ed..0d0fdb9 100644
--- a/libtommath/etc/drprime.c
+++ b/libtommath/etc/drprime.c
@@ -57,8 +57,3 @@ int main(void)
return 0;
}
-
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/etc/drprime.c,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:32:16 $ */
diff --git a/libtommath/etc/drprimes.txt b/libtommath/etc/drprimes.txt
index 2c887ea..7c97f67 100644
--- a/libtommath/etc/drprimes.txt
+++ b/libtommath/etc/drprimes.txt
@@ -1,6 +1,9 @@
-280-bit prime:
-p == 1942668892225729070919461906823518906642406839052139521251812409738904285204940164839
+300-bit prime:
+p == 2037035976334486086268445688409378161051468393665936250636140449354381298610415201576637819
-532-bit prime:
-p == 14059105607947488696282932836518693308967803494693489478439861164411992439598399594747002144074658928593502845729752797260025831423419686528151609940203368691747
+540-bit prime:
+p == 3599131035634557106248430806148785487095757694641533306480604458089470064537190296255232548883112685719936728506816716098566612844395439751206810991770626477344739
+
+780-bit prime:
+p == 6359114106063703798370219984742410466332205126109989319225557147754704702203399726411277962562135973685197744935448875852478791860694279747355800678568677946181447581781401213133886609947027230004277244697462656003655947791725966271167
diff --git a/libtommath/etc/mersenne.c b/libtommath/etc/mersenne.c
index e4891c8..28ac834 100644
--- a/libtommath/etc/mersenne.c
+++ b/libtommath/etc/mersenne.c
@@ -138,7 +138,3 @@ main (void)
}
return 0;
}
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/etc/mersenne.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:28 $ */
diff --git a/libtommath/etc/mont.c b/libtommath/etc/mont.c
index c6a8e32..7839675 100644
--- a/libtommath/etc/mont.c
+++ b/libtommath/etc/mont.c
@@ -39,12 +39,3 @@ int main(void)
return 0;
}
-
-
-
-
-
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/etc/mont.c,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:32:16 $ */
diff --git a/libtommath/etc/pprime.c b/libtommath/etc/pprime.c
index abb3c5a..955f19e 100644
--- a/libtommath/etc/pprime.c
+++ b/libtommath/etc/pprime.c
@@ -394,7 +394,3 @@ main (void)
return 0;
}
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/etc/pprime.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2006/12/01 00:08:28 $ */
diff --git a/libtommath/etc/tune.c b/libtommath/etc/tune.c
index 3088bdb..acb146f 100644
--- a/libtommath/etc/tune.c
+++ b/libtommath/etc/tune.c
@@ -136,7 +136,3 @@ main (void)
return 0;
}
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/etc/tune.c,v $ */
-/* $Revision: 1.1.1.4 $ */
-/* $Date: 2006/12/01 00:08:29 $ */
diff --git a/libtommath/logs/index.html b/libtommath/logs/index.html
index 2b65a0b..8c1ed9d 100644
--- a/libtommath/logs/index.html
+++ b/libtommath/logs/index.html
@@ -22,6 +22,3 @@
</body>
</html>
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/logs/index.html,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:32:16 $ */
diff --git a/libtommath/makefile b/libtommath/makefile
index e08a888..70de306 100644
--- a/libtommath/makefile
+++ b/libtommath/makefile
@@ -3,7 +3,7 @@
#Tom St Denis
#version of library
-VERSION=0.39
+VERSION=0.42.0
CFLAGS += -I./ -Wall -W -Wshadow -Wsign-compare
@@ -40,12 +40,13 @@ else
USER=$(INSTALL_USER)
endif
-default: libtommath.a
-
#default files to install
ifndef LIBNAME
LIBNAME=libtommath.a
endif
+
+default: ${LIBNAME}
+
HEADERS=tommath.h tommath_class.h tommath_superclass.h
#LIBPATH-The directory for libtommath to be installed to.
diff --git a/libtommath/makefile.cygwin_dll b/libtommath/makefile.cygwin_dll
index dae65ae..85b10c7 100644
--- a/libtommath/makefile.cygwin_dll
+++ b/libtommath/makefile.cygwin_dll
@@ -49,7 +49,3 @@ windll: $(OBJECTS)
test: $(OBJECTS) windll
gcc $(CFLAGS) demo/demo.c libtommath.dll.a -Wl,--enable-auto-import -o test -s
cd mtest ; $(CC) -O3 -fomit-frame-pointer -funroll-loops mtest.c -o mtest -s
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/makefile.cygwin_dll,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:31:57 $ */
diff --git a/libtommath/makefile.shared b/libtommath/makefile.shared
index 8522d44..f17bbbd 100644
--- a/libtommath/makefile.shared
+++ b/libtommath/makefile.shared
@@ -1,7 +1,7 @@
#Makefile for GCC
#
#Tom St Denis
-VERSION=0:39
+VERSION=0:41
CC = libtool --mode=compile --tag=CC gcc
diff --git a/libtommath/mtest/logtab.h b/libtommath/mtest/logtab.h
index 4c8774c..addd3ab 100644
--- a/libtommath/mtest/logtab.h
+++ b/libtommath/mtest/logtab.h
@@ -17,8 +17,3 @@ const float s_logv_2[] = {
0.169293808, 0.168613099, 0.167948779, 0.167300179, /* 60 61 62 63 */
0.166666667
};
-
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/mtest/logtab.h,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:32:17 $ */
diff --git a/libtommath/mtest/mpi-config.h b/libtommath/mtest/mpi-config.h
index e6ffbc4..a347263 100644
--- a/libtommath/mtest/mpi-config.h
+++ b/libtommath/mtest/mpi-config.h
@@ -1,5 +1,4 @@
/* Default configuration for MPI library */
-/* $Id: mpi-config.h,v 1.1.1.2 2005/09/26 16:32:17 kennykb Exp $ */
#ifndef MPI_CONFIG_H_
#define MPI_CONFIG_H_
@@ -84,7 +83,3 @@
/* crc==3287762869, version==2, Sat Feb 02 06:43:53 2002 */
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/mtest/mpi-config.h,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:32:17 $ */
diff --git a/libtommath/mtest/mpi-types.h b/libtommath/mtest/mpi-types.h
index 96d5967..42ccfc3 100644
--- a/libtommath/mtest/mpi-types.h
+++ b/libtommath/mtest/mpi-types.h
@@ -13,8 +13,3 @@ typedef int mp_err;
#define MP_DIGIT_SIZE 2
#define DIGIT_FMT "%04X"
#define RADIX (MP_DIGIT_MAX+1)
-
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/mtest/mpi-types.h,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:32:17 $ */
diff --git a/libtommath/mtest/mpi.c b/libtommath/mtest/mpi.c
index 2122389..4566e89 100644
--- a/libtommath/mtest/mpi.c
+++ b/libtommath/mtest/mpi.c
@@ -5,8 +5,6 @@
Copyright (C) 1998 Michael J. Fromberger, All Rights Reserved
Arbitrary precision integer arithmetic library
-
- $Id: mpi.c,v 1.2 2010/03/23 12:58:41 nijtmans Exp $
*/
#include "mpi.h"
@@ -3979,7 +3977,3 @@ int s_mp_outlen(int bits, int r)
/*------------------------------------------------------------------------*/
/* HERE THERE BE DRAGONS */
/* crc==4242132123, version==2, Sat Feb 02 06:43:52 2002 */
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/mtest/mpi.c,v $ */
-/* $Revision: 1.2 $ */
-/* $Date: 2010/03/23 12:58:41 $ */
diff --git a/libtommath/mtest/mpi.h b/libtommath/mtest/mpi.h
index 1bd0680..211421f 100644
--- a/libtommath/mtest/mpi.h
+++ b/libtommath/mtest/mpi.h
@@ -5,8 +5,6 @@
Copyright (C) 1998 Michael J. Fromberger, All Rights Reserved
Arbitrary precision integer arithmetic library
-
- $Id: mpi.h,v 1.1.1.2 2005/09/26 16:32:17 kennykb Exp $
*/
#ifndef _H_MPI_
@@ -225,7 +223,3 @@ int mp_char2value(char ch, int r);
const char *mp_strerror(mp_err ec);
#endif /* end _H_MPI_ */
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/mtest/mpi.h,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:32:17 $ */
diff --git a/libtommath/mtest/mtest.c b/libtommath/mtest/mtest.c
index f18dc00..d46f456 100644
--- a/libtommath/mtest/mtest.c
+++ b/libtommath/mtest/mtest.c
@@ -302,7 +302,3 @@ int main(void)
fclose(rng);
return 0;
}
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/mtest/mtest.c,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:32:17 $ */
diff --git a/libtommath/pre_gen/mpi.c b/libtommath/pre_gen/mpi.c
index 62ec029..d2224c0 100644
--- a/libtommath/pre_gen/mpi.c
+++ b/libtommath/pre_gen/mpi.c
@@ -43,10 +43,6 @@ char *mp_error_to_string(int code)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_error.c */
/* Start: bn_fast_mp_invmod.c */
@@ -195,10 +191,6 @@ LBL_ERR:mp_clear_multi (&x, &y, &u, &v, &B, &D, NULL);
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_fast_mp_invmod.c */
/* Start: bn_fast_mp_montgomery_reduce.c */
@@ -371,10 +363,6 @@ int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_fast_mp_montgomery_reduce.c */
/* Start: bn_fast_s_mp_mul_digs.c */
@@ -482,10 +470,6 @@ int fast_s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_fast_s_mp_mul_digs.c */
/* Start: bn_fast_s_mp_mul_high_digs.c */
@@ -569,7 +553,7 @@ int fast_s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
register mp_digit *tmpc;
tmpc = c->dp + digs;
- for (ix = digs; ix <= pa; ix++) {
+ for (ix = digs; ix < pa; ix++) {
/* now extract the previous digit [below the carry] */
*tmpc++ = W[ix];
}
@@ -584,10 +568,6 @@ int fast_s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_fast_s_mp_mul_high_digs.c */
/* Start: bn_fast_s_mp_sqr.c */
@@ -702,10 +682,6 @@ int fast_s_mp_sqr (mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_fast_s_mp_sqr.c */
/* Start: bn_mp_2expt.c */
@@ -754,10 +730,6 @@ mp_2expt (mp_int * a, int b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_2expt.c */
/* Start: bn_mp_abs.c */
@@ -801,10 +773,6 @@ mp_abs (mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_abs.c */
/* Start: bn_mp_add.c */
@@ -858,10 +826,6 @@ int mp_add (mp_int * a, mp_int * b, mp_int * c)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_add.c */
/* Start: bn_mp_add_d.c */
@@ -974,10 +938,6 @@ mp_add_d (mp_int * a, mp_digit b, mp_int * c)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_add_d.c */
/* Start: bn_mp_addmod.c */
@@ -1019,10 +979,6 @@ mp_addmod (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_addmod.c */
/* Start: bn_mp_and.c */
@@ -1080,10 +1036,6 @@ mp_and (mp_int * a, mp_int * b, mp_int * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_and.c */
/* Start: bn_mp_clamp.c */
@@ -1128,10 +1080,6 @@ mp_clamp (mp_int * a)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_clamp.c */
/* Start: bn_mp_clear.c */
@@ -1176,10 +1124,6 @@ mp_clear (mp_int * a)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_clear.c */
/* Start: bn_mp_clear_multi.c */
@@ -1214,10 +1158,6 @@ void mp_clear_multi(mp_int *mp, ...)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_clear_multi.c */
/* Start: bn_mp_cmp.c */
@@ -1261,10 +1201,6 @@ mp_cmp (mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_cmp.c */
/* Start: bn_mp_cmp_d.c */
@@ -1309,10 +1245,6 @@ int mp_cmp_d(mp_int * a, mp_digit b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_cmp_d.c */
/* Start: bn_mp_cmp_mag.c */
@@ -1368,10 +1300,6 @@ int mp_cmp_mag (mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_cmp_mag.c */
/* Start: bn_mp_cnt_lsb.c */
@@ -1425,10 +1353,6 @@ int mp_cnt_lsb(mp_int *a)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_cnt_lsb.c */
/* Start: bn_mp_copy.c */
@@ -1497,10 +1421,6 @@ mp_copy (mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_copy.c */
/* Start: bn_mp_count_bits.c */
@@ -1546,10 +1466,6 @@ mp_count_bits (mp_int * a)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_count_bits.c */
/* Start: bn_mp_div.c */
@@ -1842,10 +1758,6 @@ LBL_Q:mp_clear (&q);
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_div.c */
/* Start: bn_mp_div_2.c */
@@ -1914,10 +1826,6 @@ int mp_div_2(mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_div_2.c */
/* Start: bn_mp_div_2d.c */
@@ -2015,10 +1923,6 @@ int mp_div_2d (mp_int * a, int b, mp_int * c, mp_int * d)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_div_2d.c */
/* Start: bn_mp_div_3.c */
@@ -2098,10 +2002,6 @@ mp_div_3 (mp_int * a, mp_int *c, mp_digit * d)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_div_3.c */
/* Start: bn_mp_div_d.c */
@@ -2126,7 +2026,12 @@ static int s_is_power_of_two(mp_digit b, int *p)
{
int x;
- for (x = 1; x < DIGIT_BIT; x++) {
+ /* fast return if no power of two */
+ if ((b==0) || (b & (b-1))) {
+ return 0;
+ }
+
+ for (x = 0; x < DIGIT_BIT; x++) {
if (b == (((mp_digit)1)<<x)) {
*p = x;
return 1;
@@ -2212,10 +2117,6 @@ int mp_div_d (mp_int * a, mp_digit b, mp_int * c, mp_digit * d)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_div_d.c */
/* Start: bn_mp_dr_is_modulus.c */
@@ -2259,10 +2160,6 @@ int mp_dr_is_modulus(mp_int *a)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_dr_is_modulus.c */
/* Start: bn_mp_dr_reduce.c */
@@ -2357,10 +2254,6 @@ top:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_dr_reduce.c */
/* Start: bn_mp_dr_setup.c */
@@ -2393,10 +2286,6 @@ void mp_dr_setup(mp_int *a, mp_digit *d)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_dr_setup.c */
/* Start: bn_mp_exch.c */
@@ -2431,10 +2320,6 @@ mp_exch (mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_exch.c */
/* Start: bn_mp_expt_d.c */
@@ -2492,10 +2377,6 @@ int mp_expt_d (mp_int * a, mp_digit b, mp_int * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_expt_d.c */
/* Start: bn_mp_exptmod.c */
@@ -2608,10 +2489,6 @@ int mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_exptmod.c */
/* Start: bn_mp_exptmod_fast.c */
@@ -2932,11 +2809,6 @@ LBL_M:
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_exptmod_fast.c */
/* Start: bn_mp_exteuclid.c */
@@ -3019,10 +2891,6 @@ _ERR: mp_clear_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_exteuclid.c */
/* Start: bn_mp_fread.c */
@@ -3090,10 +2958,6 @@ int mp_fread(mp_int *a, int radix, FILE *stream)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_fread.c */
/* Start: bn_mp_fwrite.c */
@@ -3146,10 +3010,6 @@ int mp_fwrite(mp_int *a, int radix, FILE *stream)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_fwrite.c */
/* Start: bn_mp_gcd.c */
@@ -3255,10 +3115,6 @@ LBL_U:mp_clear (&v);
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_gcd.c */
/* Start: bn_mp_get_int.c */
@@ -3304,10 +3160,6 @@ unsigned long mp_get_int(mp_int * a)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_get_int.c */
/* Start: bn_mp_grow.c */
@@ -3365,10 +3217,6 @@ int mp_grow (mp_int * a, int size)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_grow.c */
/* Start: bn_mp_init.c */
@@ -3415,10 +3263,6 @@ int mp_init (mp_int * a)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_init.c */
/* Start: bn_mp_init_copy.c */
@@ -3451,10 +3295,6 @@ int mp_init_copy (mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_init_copy.c */
/* Start: bn_mp_init_multi.c */
@@ -3514,10 +3354,6 @@ int mp_init_multi(mp_int *mp, ...)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_init_multi.c */
/* Start: bn_mp_init_set.c */
@@ -3550,10 +3386,6 @@ int mp_init_set (mp_int * a, mp_digit b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_init_set.c */
/* Start: bn_mp_init_set_int.c */
@@ -3585,10 +3417,6 @@ int mp_init_set_int (mp_int * a, unsigned long b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_init_set_int.c */
/* Start: bn_mp_init_size.c */
@@ -3637,10 +3465,6 @@ int mp_init_size (mp_int * a, int size)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_init_size.c */
/* Start: bn_mp_invmod.c */
@@ -3684,10 +3508,6 @@ int mp_invmod (mp_int * a, mp_int * b, mp_int * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_invmod.c */
/* Start: bn_mp_invmod_slow.c */
@@ -3863,10 +3683,6 @@ LBL_ERR:mp_clear_multi (&x, &y, &u, &v, &A, &B, &C, &D, NULL);
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_invmod_slow.c */
/* Start: bn_mp_is_square.c */
@@ -3976,10 +3792,6 @@ ERR:mp_clear(&t);
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_is_square.c */
/* Start: bn_mp_jacobi.c */
@@ -4085,10 +3897,6 @@ LBL_A1:mp_clear (&a1);
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_jacobi.c */
/* Start: bn_mp_karatsuba_mul.c */
@@ -4256,10 +4064,6 @@ ERR:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_karatsuba_mul.c */
/* Start: bn_mp_karatsuba_sqr.c */
@@ -4381,10 +4185,6 @@ ERR:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_karatsuba_sqr.c */
/* Start: bn_mp_lcm.c */
@@ -4445,10 +4245,6 @@ LBL_T:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_lcm.c */
/* Start: bn_mp_lshd.c */
@@ -4516,10 +4312,6 @@ int mp_lshd (mp_int * a, int b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_lshd.c */
/* Start: bn_mp_mod.c */
@@ -4568,10 +4360,6 @@ mp_mod (mp_int * a, mp_int * b, mp_int * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_mod.c */
/* Start: bn_mp_mod_2d.c */
@@ -4627,10 +4415,6 @@ mp_mod_2d (mp_int * a, int b, mp_int * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_mod_2d.c */
/* Start: bn_mp_mod_d.c */
@@ -4658,10 +4442,6 @@ mp_mod_d (mp_int * a, mp_digit b, mp_digit * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_mod_d.c */
/* Start: bn_mp_montgomery_calc_normalization.c */
@@ -4721,10 +4501,6 @@ int mp_montgomery_calc_normalization (mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_montgomery_calc_normalization.c */
/* Start: bn_mp_montgomery_reduce.c */
@@ -4843,10 +4619,6 @@ mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_montgomery_reduce.c */
/* Start: bn_mp_montgomery_setup.c */
@@ -4900,16 +4672,12 @@ mp_montgomery_setup (mp_int * n, mp_digit * rho)
#endif
/* rho = -1/m mod b */
- *rho = (((mp_word)1 << ((mp_word) DIGIT_BIT)) - x) & MP_MASK;
+ *rho = (unsigned long)(((mp_word)1 << ((mp_word) DIGIT_BIT)) - x) & MP_MASK;
return MP_OKAY;
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_montgomery_setup.c */
/* Start: bn_mp_mul.c */
@@ -4976,10 +4744,6 @@ int mp_mul (mp_int * a, mp_int * b, mp_int * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_mul.c */
/* Start: bn_mp_mul_2.c */
@@ -5062,10 +4826,6 @@ int mp_mul_2(mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_mul_2.c */
/* Start: bn_mp_mul_2d.c */
@@ -5151,10 +4911,6 @@ int mp_mul_2d (mp_int * a, int b, mp_int * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_mul_2d.c */
/* Start: bn_mp_mul_d.c */
@@ -5234,10 +4990,6 @@ mp_mul_d (mp_int * a, mp_digit b, mp_int * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_mul_d.c */
/* Start: bn_mp_mulmod.c */
@@ -5278,10 +5030,6 @@ int mp_mulmod (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_mulmod.c */
/* Start: bn_mp_n_root.c */
@@ -5414,10 +5162,6 @@ LBL_T1:mp_clear (&t1);
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_n_root.c */
/* Start: bn_mp_neg.c */
@@ -5458,10 +5202,6 @@ int mp_neg (mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_neg.c */
/* Start: bn_mp_or.c */
@@ -5512,10 +5252,6 @@ int mp_or (mp_int * a, mp_int * b, mp_int * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_or.c */
/* Start: bn_mp_prime_fermat.c */
@@ -5578,10 +5314,6 @@ LBL_T:mp_clear (&t);
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_prime_fermat.c */
/* Start: bn_mp_prime_is_divisible.c */
@@ -5632,10 +5364,6 @@ int mp_prime_is_divisible (mp_int * a, int *result)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_prime_is_divisible.c */
/* Start: bn_mp_prime_is_prime.c */
@@ -5719,10 +5447,6 @@ LBL_B:mp_clear (&b);
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_prime_is_prime.c */
/* Start: bn_mp_prime_miller_rabin.c */
@@ -5826,10 +5550,6 @@ LBL_N1:mp_clear (&n1);
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_prime_miller_rabin.c */
/* Start: bn_mp_prime_next_prime.c */
@@ -5978,7 +5698,7 @@ int mp_prime_next_prime(mp_int *a, int t, int bbs_style)
/* is this prime? */
for (x = 0; x < t; x++) {
- mp_set(&b, ltm_prime_tab[t]);
+ mp_set(&b, ltm_prime_tab[x]);
if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) {
goto LBL_ERR;
}
@@ -6000,10 +5720,6 @@ LBL_ERR:
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_prime_next_prime.c */
/* Start: bn_mp_prime_rabin_miller_trials.c */
@@ -6056,10 +5772,6 @@ int mp_prime_rabin_miller_trials(int size)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_prime_rabin_miller_trials.c */
/* Start: bn_mp_prime_random_ex.c */
@@ -6185,10 +5897,6 @@ error:
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_prime_random_ex.c */
/* Start: bn_mp_radix_size.c */
@@ -6267,10 +5975,6 @@ int mp_radix_size (mp_int * a, int radix, int *size)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_radix_size.c */
/* Start: bn_mp_radix_smap.c */
@@ -6295,10 +5999,6 @@ int mp_radix_size (mp_int * a, int radix, int *size)
const char *mp_s_rmap = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/";
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_radix_smap.c */
/* Start: bn_mp_rand.c */
@@ -6354,10 +6054,6 @@ mp_rand (mp_int * a, int digits)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_rand.c */
/* Start: bn_mp_read_radix.c */
@@ -6443,10 +6139,6 @@ int mp_read_radix (mp_int * a, const char *str, int radix)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_read_radix.c */
/* Start: bn_mp_read_signed_bin.c */
@@ -6488,10 +6180,6 @@ int mp_read_signed_bin (mp_int * a, const unsigned char *b, int c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_read_signed_bin.c */
/* Start: bn_mp_read_unsigned_bin.c */
@@ -6547,10 +6235,6 @@ int mp_read_unsigned_bin (mp_int * a, const unsigned char *b, int c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_read_unsigned_bin.c */
/* Start: bn_mp_reduce.c */
@@ -6651,10 +6335,6 @@ CLEANUP:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_reduce.c */
/* Start: bn_mp_reduce_2k.c */
@@ -6716,10 +6396,6 @@ ERR:
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_reduce_2k.c */
/* Start: bn_mp_reduce_2k_l.c */
@@ -6782,10 +6458,6 @@ ERR:
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_reduce_2k_l.c */
/* Start: bn_mp_reduce_2k_setup.c */
@@ -6833,10 +6505,6 @@ int mp_reduce_2k_setup(mp_int *a, mp_digit *d)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_reduce_2k_setup.c */
/* Start: bn_mp_reduce_2k_setup_l.c */
@@ -6881,10 +6549,6 @@ ERR:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_reduce_2k_setup_l.c */
/* Start: bn_mp_reduce_is_2k.c */
@@ -6937,10 +6601,6 @@ int mp_reduce_is_2k(mp_int *a)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_reduce_is_2k.c */
/* Start: bn_mp_reduce_is_2k_l.c */
@@ -6985,10 +6645,6 @@ int mp_reduce_is_2k_l(mp_int *a)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_reduce_is_2k_l.c */
/* Start: bn_mp_reduce_setup.c */
@@ -7023,10 +6679,6 @@ int mp_reduce_setup (mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_reduce_setup.c */
/* Start: bn_mp_rshd.c */
@@ -7099,10 +6751,6 @@ void mp_rshd (mp_int * a, int b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_rshd.c */
/* Start: bn_mp_set.c */
@@ -7132,10 +6780,6 @@ void mp_set (mp_int * a, mp_digit b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_set.c */
/* Start: bn_mp_set_int.c */
@@ -7184,10 +6828,6 @@ int mp_set_int (mp_int * a, unsigned long b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_set_int.c */
/* Start: bn_mp_shrink.c */
@@ -7212,21 +6852,22 @@ int mp_set_int (mp_int * a, unsigned long b)
int mp_shrink (mp_int * a)
{
mp_digit *tmp;
- if (a->alloc != a->used && a->used > 0) {
- if ((tmp = OPT_CAST(mp_digit) XREALLOC (a->dp, sizeof (mp_digit) * a->used)) == NULL) {
+ int used = 1;
+
+ if(a->used > 0)
+ used = a->used;
+
+ if (a->alloc != used) {
+ if ((tmp = OPT_CAST(mp_digit) XREALLOC (a->dp, sizeof (mp_digit) * used)) == NULL) {
return MP_MEM;
}
a->dp = tmp;
- a->alloc = a->used;
+ a->alloc = used;
}
return MP_OKAY;
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_shrink.c */
/* Start: bn_mp_signed_bin_size.c */
@@ -7254,10 +6895,6 @@ int mp_signed_bin_size (mp_int * a)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_signed_bin_size.c */
/* Start: bn_mp_sqr.c */
@@ -7316,10 +6953,6 @@ if (a->used >= KARATSUBA_SQR_CUTOFF) {
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_sqr.c */
/* Start: bn_mp_sqrmod.c */
@@ -7361,14 +6994,11 @@ mp_sqrmod (mp_int * a, mp_int * b, mp_int * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_sqrmod.c */
/* Start: bn_mp_sqrt.c */
#include <tommath.h>
+
#ifdef BN_MP_SQRT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
*
@@ -7446,10 +7076,6 @@ E2: mp_clear(&t1);
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_sqrt.c */
/* Start: bn_mp_sub.c */
@@ -7509,10 +7135,6 @@ mp_sub (mp_int * a, mp_int * b, mp_int * c)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_sub.c */
/* Start: bn_mp_sub_d.c */
@@ -7606,10 +7228,6 @@ mp_sub_d (mp_int * a, mp_digit b, mp_int * c)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_sub_d.c */
/* Start: bn_mp_submod.c */
@@ -7652,10 +7270,6 @@ mp_submod (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_submod.c */
/* Start: bn_mp_to_signed_bin.c */
@@ -7689,10 +7303,6 @@ int mp_to_signed_bin (mp_int * a, unsigned char *b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_to_signed_bin.c */
/* Start: bn_mp_to_signed_bin_n.c */
@@ -7724,10 +7334,6 @@ int mp_to_signed_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_to_signed_bin_n.c */
/* Start: bn_mp_to_unsigned_bin.c */
@@ -7776,10 +7382,6 @@ int mp_to_unsigned_bin (mp_int * a, unsigned char *b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_to_unsigned_bin.c */
/* Start: bn_mp_to_unsigned_bin_n.c */
@@ -7811,10 +7413,6 @@ int mp_to_unsigned_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_to_unsigned_bin_n.c */
/* Start: bn_mp_toom_mul.c */
@@ -8099,10 +7697,6 @@ ERR:
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_toom_mul.c */
/* Start: bn_mp_toom_sqr.c */
@@ -8329,10 +7923,6 @@ ERR:
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_toom_sqr.c */
/* Start: bn_mp_toradix.c */
@@ -8408,10 +7998,6 @@ int mp_toradix (mp_int * a, char *str, int radix)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_toradix.c */
/* Start: bn_mp_toradix_n.c */
@@ -8500,10 +8086,6 @@ int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_toradix_n.c */
/* Start: bn_mp_unsigned_bin_size.c */
@@ -8532,10 +8114,6 @@ int mp_unsigned_bin_size (mp_int * a)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_unsigned_bin_size.c */
/* Start: bn_mp_xor.c */
@@ -8587,10 +8165,6 @@ mp_xor (mp_int * a, mp_int * b, mp_int * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_xor.c */
/* Start: bn_mp_zero.c */
@@ -8627,10 +8201,6 @@ void mp_zero (mp_int * a)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_mp_zero.c */
/* Start: bn_prime_tab.c */
@@ -8692,10 +8262,6 @@ const mp_digit ltm_prime_tab[] = {
};
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_prime_tab.c */
/* Start: bn_reverse.c */
@@ -8735,10 +8301,6 @@ bn_reverse (unsigned char *s, int len)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_reverse.c */
/* Start: bn_s_mp_add.c */
@@ -8848,10 +8410,6 @@ s_mp_add (mp_int * a, mp_int * b, mp_int * c)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_s_mp_add.c */
/* Start: bn_s_mp_exptmod.c */
@@ -9104,10 +8662,6 @@ LBL_M:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_s_mp_exptmod.c */
/* Start: bn_s_mp_mul_digs.c */
@@ -9198,10 +8752,6 @@ int s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_s_mp_mul_digs.c */
/* Start: bn_s_mp_mul_high_digs.c */
@@ -9283,10 +8833,6 @@ s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_s_mp_mul_high_digs.c */
/* Start: bn_s_mp_sqr.c */
@@ -9371,10 +8917,6 @@ int s_mp_sqr (mp_int * a, mp_int * b)
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_s_mp_sqr.c */
/* Start: bn_s_mp_sub.c */
@@ -9464,10 +9006,6 @@ s_mp_sub (mp_int * a, mp_int * b, mp_int * c)
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bn_s_mp_sub.c */
/* Start: bncore.c */
@@ -9504,10 +9042,6 @@ int KARATSUBA_MUL_CUTOFF = 80, /* Min. number of digits before Karatsub
TOOM_SQR_CUTOFF = 400;
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.5 $ */
-/* $Date: 2006/12/01 00:08:34 $ */
-
/* End: bncore.c */
diff --git a/libtommath/tommath.h b/libtommath/tommath.h
index 7cc7d4e..4b3a76f 100644
--- a/libtommath/tommath.h
+++ b/libtommath/tommath.h
@@ -577,9 +577,3 @@ extern const char *mp_s_rmap;
#endif
#endif
-
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/tommath.h,v $ */
-/* Based on Tom's version 1.8 */
-/* $Revision: 1.6 $ */
-/* $Date: 2010/05/03 14:36:40 $ */
diff --git a/libtommath/tommath_class.h b/libtommath/tommath_class.h
index 649e823..b9cc902 100644
--- a/libtommath/tommath_class.h
+++ b/libtommath/tommath_class.h
@@ -993,7 +993,3 @@
#else
#define LTM_LAST
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/tommath_class.h,v $ */
-/* $Revision: 1.3 $ */
-/* $Date: 2006/12/01 19:45:39 $ */
diff --git a/libtommath/tommath_superclass.h b/libtommath/tommath_superclass.h
index ffbb8e1..e3926df 100644
--- a/libtommath/tommath_superclass.h
+++ b/libtommath/tommath_superclass.h
@@ -70,7 +70,3 @@
#endif
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/tommath_superclass.h,v $ */
-/* $Revision: 1.3 $ */
-/* $Date: 2005/09/26 18:27:14 $ */
diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile
index 3298a99..d7b0d1d 100644
--- a/macosx/GNUmakefile
+++ b/macosx/GNUmakefile
@@ -8,9 +8,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: GNUmakefile,v 1.11 2008/12/20 01:11:10 das Exp $
-#
########################################################################################################
#-------------------------------------------------------------------------------------------------------
diff --git a/macosx/README b/macosx/README
index 11a7dcf..6b944ca 100644
--- a/macosx/README
+++ b/macosx/README
@@ -1,8 +1,6 @@
Tcl Mac OS X README
-------------------
-RCS: @(#) $Id: README,v 1.19 2009/06/26 18:14:25 das Exp $
-
This is the README file for the Mac OS X/Darwin version of Tcl.
@@ -19,16 +17,11 @@ before asking on the list, many questions have already been answered).
http://groups.google.com/group/comp.lang.tcl/
- The Tcl'ers Wiki also has many pages dealing with Tcl & Tk on Mac OS X, see
- http://wiki.tcl.tk/references/3753!
- http://wiki.tcl.tk/references/8361!
+ http://wiki.tcl.tk/_/ref?N=3753
+ http://wiki.tcl.tk/_/ref?N=8361
- Please report bugs with Tcl or Tk on Mac OS X to the sourceforge bug trackers:
- Tcl: http://sf.net/tracker/?func=add&group_id=10894&atid=110894
- Tk: http://sf.net/tracker/?func=add&group_id=12997&atid=112997
-please make sure that your report Tk specific bugs to the tktoolkit project bug
-tracker rather than the tcl project bug tracker.
-Mac OS X specific bugs should in general be assigned to user 'das'.
-
+ http://tcl.sourceforge.net/
2. Using Tcl on Mac OS X
------------------------
diff --git a/macosx/Tcl-Common.xcconfig b/macosx/Tcl-Common.xcconfig
index 5c8267e..9c47547 100644
--- a/macosx/Tcl-Common.xcconfig
+++ b/macosx/Tcl-Common.xcconfig
@@ -8,9 +8,6 @@
//
// See the file "license.terms" for information on usage and redistribution
// of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-//
-// RCS: @(#) $Id: Tcl-Common.xcconfig,v 1.13 2009/06/26 18:14:25 das Exp $
-//
HEADER_SEARCH_PATHS = "$(DERIVED_FILE_DIR)/tcl" $(HEADER_SEARCH_PATHS)
OTHER_LDFLAGS = -headerpad_max_install_names -sectcreate __TEXT __info_plist "$(DERIVED_FILE_DIR)/tcl/Tclsh-Info.plist" $(OTHER_LDFLAGS)
diff --git a/macosx/Tcl-Debug.xcconfig b/macosx/Tcl-Debug.xcconfig
index 9496f6f..03d2b2d 100644
--- a/macosx/Tcl-Debug.xcconfig
+++ b/macosx/Tcl-Debug.xcconfig
@@ -8,9 +8,6 @@
//
// See the file "license.terms" for information on usage and redistribution
// of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-//
-// RCS: @(#) $Id: Tcl-Debug.xcconfig,v 1.2 2007/04/23 20:46:13 das Exp $
-//
#include "Tcl-Common.xcconfig"
diff --git a/macosx/Tcl-Info.plist.in b/macosx/Tcl-Info.plist.in
index 431b0a9..f5c6b15 100644
--- a/macosx/Tcl-Info.plist.in
+++ b/macosx/Tcl-Info.plist.in
@@ -5,8 +5,6 @@
See the file "license.terms" for information on usage and redistribution of
this file, and for a DISCLAIMER OF ALL WARRANTIES.
-
- RCS: @(#) $Id: Tcl-Info.plist.in,v 1.3 2009/04/14 00:55:31 das Exp $
-->
<plist version="1.0">
<dict>
diff --git a/macosx/Tcl-Release.xcconfig b/macosx/Tcl-Release.xcconfig
index de68bce..d960a52 100644
--- a/macosx/Tcl-Release.xcconfig
+++ b/macosx/Tcl-Release.xcconfig
@@ -8,9 +8,6 @@
//
// See the file "license.terms" for information on usage and redistribution
// of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-//
-// RCS: @(#) $Id: Tcl-Release.xcconfig,v 1.2 2007/04/23 20:46:13 das Exp $
-//
#include "Tcl-Common.xcconfig"
diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj
index 37bf6c1..a2a703b 100644
--- a/macosx/Tcl.xcode/project.pbxproj
+++ b/macosx/Tcl.xcode/project.pbxproj
@@ -104,6 +104,7 @@
F96D48ED08F272C3004A47F5 /* bn_mp_clear_multi.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */; };
F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427008F272B3004A47F5 /* bn_mp_cmp.c */; };
F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */; };
+ F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427408F272B3004A47F5 /* bn_mp_cnt_lsb.c */; };
F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427408F272B3004A47F5 /* bn_mp_copy.c */; };
F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */; };
F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427608F272B3004A47F5 /* bn_mp_div.c */; };
@@ -786,7 +787,6 @@
F96D443208F272B8004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
F96D443308F272B8004A47F5 /* regexpTestLib.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpTestLib.tcl; sourceTree = "<group>"; };
F96D443508F272B8004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = "<group>"; };
- F96D443608F272B8004A47F5 /* tcl.wse.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.wse.in; sourceTree = "<group>"; };
F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "tcltk-man2html.tcl"; sourceTree = "<group>"; };
F96D443A08F272B9004A47F5 /* tclZIC.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclZIC.tcl; sourceTree = "<group>"; };
F96D443B08F272B9004A47F5 /* uniClass.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniClass.tcl; sourceTree = "<group>"; };
@@ -829,7 +829,6 @@
F96D446708F272B9004A47F5 /* tclUnixSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixSock.c; sourceTree = "<group>"; };
F96D446808F272B9004A47F5 /* tclUnixTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTest.c; sourceTree = "<group>"; };
F96D446908F272B9004A47F5 /* tclUnixThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixThrd.c; sourceTree = "<group>"; };
- F96D446A08F272B9004A47F5 /* tclUnixThrd.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclUnixThrd.h; sourceTree = "<group>"; };
F96D446B08F272B9004A47F5 /* tclUnixTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTime.c; sourceTree = "<group>"; };
F96D446C08F272B9004A47F5 /* tclXtNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtNotify.c; sourceTree = "<group>"; };
F96D446D08F272B9004A47F5 /* tclXtTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtTest.c; sourceTree = "<group>"; };
@@ -921,7 +920,7 @@
F966C06F08F281DC005CB29B /* Frameworks */,
1AB674ADFE9D54B511CA2CBB /* Products */,
);
- comments = "Copyright (c) 2004-2009 Daniel A. Steffen <das@users.sourceforge.net>\nCopyright 2008-2009, Apple Inc.\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.14 2009/06/26 18:14:25 das Exp $\n";
+ comments = "Copyright (c) 2004-2009 Daniel A. Steffen <das@users.sourceforge.net>\nCopyright 2008-2009, Apple Inc.\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\n";
name = Tcl;
path = .;
sourceTree = SOURCE_ROOT;
@@ -1686,7 +1685,6 @@
F96D443208F272B8004A47F5 /* README */,
F96D443308F272B8004A47F5 /* regexpTestLib.tcl */,
F96D443508F272B8004A47F5 /* tcl.hpj.in */,
- F96D443608F272B8004A47F5 /* tcl.wse.in */,
F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */,
F96D443A08F272B9004A47F5 /* tclZIC.tcl */,
F92D7F100DE777240033A13A /* tsdPerf.tcl */,
@@ -1732,7 +1730,6 @@
F96D446708F272B9004A47F5 /* tclUnixSock.c */,
F96D446808F272B9004A47F5 /* tclUnixTest.c */,
F96D446908F272B9004A47F5 /* tclUnixThrd.c */,
- F96D446A08F272B9004A47F5 /* tclUnixThrd.h */,
F96D446B08F272B9004A47F5 /* tclUnixTime.c */,
F96D446C08F272B9004A47F5 /* tclXtNotify.c */,
F96D446D08F272B9004A47F5 /* tclXtTest.c */,
@@ -2070,6 +2067,7 @@
F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */,
F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */,
F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */,
+ F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */,
F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */,
F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */,
F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */,
diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj
index 1882eb8..9c18ac0 100644
--- a/macosx/Tcl.xcodeproj/project.pbxproj
+++ b/macosx/Tcl.xcodeproj/project.pbxproj
@@ -104,6 +104,7 @@
F96D48ED08F272C3004A47F5 /* bn_mp_clear_multi.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */; };
F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427008F272B3004A47F5 /* bn_mp_cmp.c */; };
F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */; };
+ F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427408F272B3004A47F5 /* bn_mp_cnt_lsb.c */; };
F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427408F272B3004A47F5 /* bn_mp_copy.c */; };
F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */; };
F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427608F272B3004A47F5 /* bn_mp_div.c */; };
@@ -786,7 +787,6 @@
F96D443208F272B8004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
F96D443308F272B8004A47F5 /* regexpTestLib.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpTestLib.tcl; sourceTree = "<group>"; };
F96D443508F272B8004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = "<group>"; };
- F96D443608F272B8004A47F5 /* tcl.wse.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.wse.in; sourceTree = "<group>"; };
F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "tcltk-man2html.tcl"; sourceTree = "<group>"; };
F96D443A08F272B9004A47F5 /* tclZIC.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclZIC.tcl; sourceTree = "<group>"; };
F96D443B08F272B9004A47F5 /* uniClass.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniClass.tcl; sourceTree = "<group>"; };
@@ -829,7 +829,6 @@
F96D446708F272B9004A47F5 /* tclUnixSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixSock.c; sourceTree = "<group>"; };
F96D446808F272B9004A47F5 /* tclUnixTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTest.c; sourceTree = "<group>"; };
F96D446908F272B9004A47F5 /* tclUnixThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixThrd.c; sourceTree = "<group>"; };
- F96D446A08F272B9004A47F5 /* tclUnixThrd.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclUnixThrd.h; sourceTree = "<group>"; };
F96D446B08F272B9004A47F5 /* tclUnixTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTime.c; sourceTree = "<group>"; };
F96D446C08F272B9004A47F5 /* tclXtNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtNotify.c; sourceTree = "<group>"; };
F96D446D08F272B9004A47F5 /* tclXtTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtTest.c; sourceTree = "<group>"; };
@@ -921,7 +920,7 @@
F966C06F08F281DC005CB29B /* Frameworks */,
1AB674ADFE9D54B511CA2CBB /* Products */,
);
- comments = "Copyright (c) 2004-2009 Daniel A. Steffen <das@users.sourceforge.net>\nCopyright 2008-2009, Apple Inc.\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.45 2009/08/28 23:04:09 das Exp $\n";
+ comments = "Copyright (c) 2004-2009 Daniel A. Steffen <das@users.sourceforge.net>\nCopyright 2008-2009, Apple Inc.\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\n";
name = Tcl;
path = .;
sourceTree = SOURCE_ROOT;
@@ -1686,7 +1685,6 @@
F96D443208F272B8004A47F5 /* README */,
F96D443308F272B8004A47F5 /* regexpTestLib.tcl */,
F96D443508F272B8004A47F5 /* tcl.hpj.in */,
- F96D443608F272B8004A47F5 /* tcl.wse.in */,
F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */,
F96D443A08F272B9004A47F5 /* tclZIC.tcl */,
F92D7F100DE777240033A13A /* tsdPerf.tcl */,
@@ -1732,7 +1730,6 @@
F96D446708F272B9004A47F5 /* tclUnixSock.c */,
F96D446808F272B9004A47F5 /* tclUnixTest.c */,
F96D446908F272B9004A47F5 /* tclUnixThrd.c */,
- F96D446A08F272B9004A47F5 /* tclUnixThrd.h */,
F96D446B08F272B9004A47F5 /* tclUnixTime.c */,
F96D446C08F272B9004A47F5 /* tclXtNotify.c */,
F96D446D08F272B9004A47F5 /* tclXtTest.c */,
@@ -2070,6 +2067,7 @@
F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */,
F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */,
F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */,
+ F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */,
F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */,
F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */,
F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */,
diff --git a/macosx/Tclsh-Info.plist.in b/macosx/Tclsh-Info.plist.in
index ef2711d..ecc7f21 100644
--- a/macosx/Tclsh-Info.plist.in
+++ b/macosx/Tclsh-Info.plist.in
@@ -5,8 +5,6 @@
See the file "license.terms" for information on usage and redistribution of
this file, and for a DISCLAIMER OF ALL WARRANTIES.
-
- RCS: @(#) $Id: Tclsh-Info.plist.in,v 1.3 2009/04/14 00:55:31 das Exp $
-->
<plist version="1.0">
<dict>
diff --git a/macosx/configure.ac b/macosx/configure.ac
index e330cda..01c3697 100644
--- a/macosx/configure.ac
+++ b/macosx/configure.ac
@@ -2,8 +2,6 @@
dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
-#
-# RCS: @(#) $Id: configure.ac,v 1.1 2005/11/27 02:33:49 das Exp $
dnl Ensure that the config (auto)headers support is used, then just
dnl include the configure sources from ../unix:
diff --git a/macosx/tclMacOSXBundle.c b/macosx/tclMacOSXBundle.c
index d7153fa..dad3733 100644
--- a/macosx/tclMacOSXBundle.c
+++ b/macosx/tclMacOSXBundle.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclMacOSXBundle.c,v 1.18 2010/04/04 11:59:23 dkf Exp $
*/
#include "tclPort.h"
diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c
index 818b91d..f266443 100644
--- a/macosx/tclMacOSXFCmd.c
+++ b/macosx/tclMacOSXFCmd.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclMacOSXFCmd.c,v 1.19 2010/03/25 14:02:11 dkf Exp $
*/
#include "tclInt.h"
@@ -150,8 +148,9 @@ TclMacOSXGetFileAttribute(
result = TclpObjStat(fileName, &statBuf);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -161,8 +160,8 @@ TclMacOSXGetFileAttribute(
*/
errno = EISDIR;
- Tcl_AppendResult(interp, "invalid attribute: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid attribute: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -177,8 +176,9 @@ TclMacOSXGetFileAttribute(
result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read attributes of \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read attributes of \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -201,9 +201,11 @@ TclMacOSXGetFileAttribute(
}
return TCL_OK;
#else
- Tcl_AppendResult(interp, "Mac OS X file attributes not supported", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Mac OS X file attributes not supported", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
return TCL_ERROR;
-#endif
+#endif /* HAVE_GETATTRLIST */
}
/*
@@ -242,8 +244,9 @@ TclMacOSXSetFileAttribute(
result = TclpObjStat(fileName, &statBuf);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -253,8 +256,8 @@ TclMacOSXSetFileAttribute(
*/
errno = EISDIR;
- Tcl_AppendResult(interp, "invalid attribute: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid attribute: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -269,8 +272,9 @@ TclMacOSXSetFileAttribute(
result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read attributes of \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read attributes of \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -307,9 +311,9 @@ TclMacOSXSetFileAttribute(
&finfo.data, sizeof(finfo.data), 0);
if (result != 0) {
- Tcl_AppendResult(interp, "could not set attributes of \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set attributes of \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
} else {
@@ -329,8 +333,9 @@ TclMacOSXSetFileAttribute(
*/
if (newRsrcForkSize != 0) {
- Tcl_AppendResult(interp,
- "setting nonzero rsrclength not supported", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "setting nonzero rsrclength not supported", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
return TCL_ERROR;
}
@@ -360,17 +365,18 @@ TclMacOSXSetFileAttribute(
Tcl_DStringFree(&ds);
if (result != 0) {
- Tcl_AppendResult(interp,
- "could not truncate resource fork of \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not truncate resource fork of \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
}
}
return TCL_OK;
#else
- Tcl_AppendResult(interp, "Mac OS X file attributes not supported", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Mac OS X file attributes not supported", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
return TCL_ERROR;
#endif
}
@@ -638,9 +644,11 @@ SetOSTypeFromAny(
Tcl_UtfToExternalDString(encoding, string, length, &ds);
if (Tcl_DStringLength(&ds) > 4) {
- Tcl_AppendResult(interp, "expected Macintosh OS type but got \"",
- string, "\": ", NULL);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", NULL);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected Macintosh OS type but got \"%s\": ", string));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", NULL);
+ }
result = TCL_ERROR;
} else {
OSType osType;
@@ -688,6 +696,7 @@ UpdateStringOfOSType(
OSType osType = (OSType) objPtr->internalRep.longValue;
Tcl_DString ds;
Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
+ unsigned len;
string[0] = (char) (osType >> 24);
string[1] = (char) (osType >> 16);
@@ -695,8 +704,9 @@ UpdateStringOfOSType(
string[3] = (char) (osType);
string[4] = '\0';
Tcl_ExternalToUtfDString(encoding, string, -1, &ds);
- objPtr->bytes = ckalloc((unsigned) Tcl_DStringLength(&ds) + 1);
- strcpy(objPtr->bytes, Tcl_DStringValue(&ds));
+ len = (unsigned) Tcl_DStringLength(&ds) + 1;
+ objPtr->bytes = ckalloc(len);
+ memcpy(objPtr->bytes, Tcl_DStringValue(&ds), len);
objPtr->length = Tcl_DStringLength(&ds);
Tcl_DStringFree(&ds);
Tcl_FreeEncoding(encoding);
diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c
index f65f6e6..ef80192 100644
--- a/macosx/tclMacOSXNotify.c
+++ b/macosx/tclMacOSXNotify.c
@@ -11,8 +11,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclMacOSXNotify.c,v 1.29 2010/03/25 14:02:12 dkf Exp $
*/
#include "tclInt.h"
@@ -969,7 +967,7 @@ Tcl_CreateFileHandler(
}
}
if (filePtr == NULL) {
- filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
+ filePtr = ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->readyMask = 0;
filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
@@ -1097,7 +1095,7 @@ Tcl_DeleteFileHandler(
} else {
prevPtr->nextPtr = filePtr->nextPtr;
}
- ckfree((char *) filePtr);
+ ckfree(filePtr);
}
/*
@@ -1352,8 +1350,8 @@ QueueFileEvents(
*/
if (filePtr->readyMask == 0) {
- FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
- ckalloc(sizeof(FileHandlerEvent));
+ FileHandlerEvent *fileEvPtr = ckalloc(sizeof(FileHandlerEvent));
+
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
diff --git a/pkgs/README b/pkgs/README
index e2b33f5..01c6f43 100644
--- a/pkgs/README
+++ b/pkgs/README
@@ -1 +1,57 @@
-Add notes here about bundling packages with Tcl.
+
+The 'pkgs' subdirectory of the Tcl source code distribution is meant to be
+a place where the source code distribution of Tcl packages may be placed so
+that they are built, installed, and tested along with Tcl. As originally
+distributed, Tcl re-distributes a number of packages in this location. The
+build systems for Tcl are written so that additional packages may be added,
+or the original packages removed in any number and still have all packages
+present get built, installed, and tested along with Tcl.
+
+In order for a package to work properly under the pkgs subdirectory, it
+needs to conform to the following conventions.
+
+ All files of the package need to be contained in (subdirs of ...) a
+ single subdirectory of the "pkgs" directrory.
+
+ In that subdirectory of "pkgs" there must be an executable file named
+ "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
+ should also accept the --with-tcl= and --with-tclinclude= options in
+ the conventional way.
+
+ The generated "Makefile" must be one suitable for controlling the operations
+ of a `make` program. The following targets must be defined:
+
+ <default>: Perform a build of the runtime components of the
+ package from sources.
+
+ install: Copy the runtime components of the package into their
+ installed location. Must respect the DESTDIR variable
+ for determining the installation location.
+
+ test: Run the test suite of the package. Must respect the
+ TCLSH_PROG, TESTFLAGS variables.
+
+ clean: Delete all files generated by the default build target.
+
+ distclean: Delete all generated files.
+
+ dist: Produce a copy of the package's source code distribution.
+ Must respect the DIST_ROOT variable determing where to
+ write the generated directory.
+
+Packages that are written to make use of the Tcl Extension Architecture (TEA)
+and that make use of the tclconfig collection of support files, should
+conform to these conventions without further efforts.
+
+These conventions are subject to revision and refinement over time to
+better support the needs of the build system. Efforts will be made to
+keep the TEA support scripts consistent with the demands of this system.
+
+In addition, it is requested that packages also support building with
+Microsoft Visual Studio tools. This means the file win/makefile.vc
+should be included, suitable for use by the nmake program, defining the
+targets <default>, install, test, and clean.
+
diff --git a/pkgs/package.list.txt b/pkgs/package.list.txt
new file mode 100644
index 0000000..a13b0fb
--- /dev/null
+++ b/pkgs/package.list.txt
@@ -0,0 +1,26 @@
+# This file contains the mapping of directory names to package names for
+# documentation purposes. Each non-blank non-comment line is a two-element
+# list that says a possible name of directory (multiple lines may be needed
+# because of capitalization issues) and the documentation name of the package
+# to match. Pseudo-numeric suffixes are interpreted as version numbers.
+
+# [incr Tcl]
+itcl {[incr Tcl]}
+Itcl {[incr Tcl]}
+
+# SQLite
+sqlite SQLite
+
+# Thread
+Thread Thread
+thread Thread
+
+# Tcl Database Connectivity
+tdbc TDBC
+Tdbc TDBC
+TDBC TDBC
+# Drivers for TDBC
+tdbcmysql tdbc::mysql
+tdbcodbc tdbc::odbc
+tdbcpostgres tdbc::postgres
+tdbcsqlite3 tdbc::sqlite3
diff --git a/tests/README b/tests/README
index 75a08e7..ce2382e 100644
--- a/tests/README
+++ b/tests/README
@@ -1,7 +1,5 @@
README -- Tcl test suite design document.
-RCS: @(#) $Id: README,v 1.12 2003/04/01 19:17:21 dgp Exp $
-
Contents:
---------
diff --git a/tests/all.tcl b/tests/all.tcl
index 75650a1..05d3024 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -9,11 +9,11 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: all.tcl,v 1.19 2006/11/03 00:34:52 hobbs Exp $
+package prefer latest
package require Tcl 8.5
package require tcltest 2.2
namespace import tcltest::*
configure {*}$argv -testdir [file dir [info script]]
runAllTests
+proc exit args {}
diff --git a/tests/append.test b/tests/append.test
index 3c000df..69c6381 100644
--- a/tests/append.test
+++ b/tests/append.test
@@ -10,17 +10,15 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: append.test,v 1.12 2010/09/01 20:35:33 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-catch {unset x}
-
+unset -nocomplain x
+
test append-1.1 {append command} {
- catch {unset x}
+ unset -nocomplain x
list [append x 1 2 abc "long string"] $x
} {{12abclong string} {12abclong string}}
test append-1.2 {append command} {
@@ -52,12 +50,12 @@ test append-3.2 {append errors} -returnCodes error -body {
append x(0) 44
} -result {can't set "x(0)": variable isn't array}
test append-3.3 {append errors} -returnCodes error -body {
- catch {unset x}
+ unset -nocomplain x
append x
} -result {can't read "x": no such variable}
test append-4.1 {lappend command} {
- catch {unset x}
+ unset -nocomplain x
list [lappend x 1 2 abc "long string"] $x
} {{1 2 abc {long string}} {1 2 abc {long string}}}
test append-4.2 {lappend command} {
@@ -128,19 +126,19 @@ test append-4.16 {lappend command} {
lappend x abc
} "x abc"
test append-4.17 {lappend command} {
- catch {unset x}
+ unset -nocomplain x
lappend x
} {}
test append-4.18 {lappend command} {
- catch {unset x}
+ unset -nocomplain x
lappend x {}
} {{}}
test append-4.19 {lappend command} {
- catch {unset x}
+ unset -nocomplain x
lappend x(0)
} {}
test append-4.20 {lappend command} {
- catch {unset x}
+ unset -nocomplain x
lappend x(0) abc
} {abc}
unset -nocomplain x
@@ -154,7 +152,7 @@ test append-4.22 {lappend command} -returnCodes error -body {
} -result {unmatched open quote in list}
test append-5.1 {long lappends} -setup {
- catch {unset x}
+ unset -nocomplain x
proc check {var size} {
set l [llength $var]
if {$l != $size} {
@@ -188,7 +186,7 @@ test append-6.2 {lappend errors} -returnCodes error -body {
test append-7.1 {lappend-created var and error in trace on that var} -setup {
catch {rename foo ""}
- catch {unset x}
+ unset -nocomplain x
} -body {
trace variable x w foo
proc foo {} {global x; unset x}
@@ -200,8 +198,8 @@ test append-7.1 {lappend-created var and error in trace on that var} -setup {
list [info exists x] [catch {set x} msg] $msg
} -result {0 1 {can't read "x": no such variable}}
test append-7.2 {lappend var triggers read trace} -setup {
- catch {unset myvar}
- catch {unset ::result}
+ unset -nocomplain myvar
+ unset -nocomplain ::result
} -body {
trace variable myvar r foo
proc foo {args} {append ::result $args}
@@ -209,8 +207,8 @@ test append-7.2 {lappend var triggers read trace} -setup {
return $::result
} -result {myvar {} r}
test append-7.3 {lappend var triggers read trace, array var} -setup {
- catch {unset myvar}
- catch {unset ::result}
+ unset -nocomplain myvar
+ unset -nocomplain ::result
} -body {
# The behavior of read triggers on lappend changed in 8.0 to not trigger
# them, and was changed back in 8.4.
@@ -220,8 +218,8 @@ test append-7.3 {lappend var triggers read trace, array var} -setup {
return $::result
} -result {myvar b r}
test append-7.4 {lappend var triggers read trace, array var exists} -setup {
- catch {unset myvar}
- catch {unset ::result}
+ unset -nocomplain myvar
+ unset -nocomplain ::result
} -body {
set myvar(0) 1
trace variable myvar r foo
@@ -230,8 +228,8 @@ test append-7.4 {lappend var triggers read trace, array var exists} -setup {
return $::result
} -result {myvar b r}
test append-7.5 {append var does not trigger read trace} -setup {
- catch {unset myvar}
- catch {unset ::result}
+ unset -nocomplain myvar
+ unset -nocomplain ::result
} -body {
trace variable myvar r foo
proc foo {args} {append ::result $args}
@@ -239,15 +237,16 @@ test append-7.5 {append var does not trigger read trace} -setup {
info exists ::result
} -result {0}
+# THERE ARE NO append-8.* TESTS
+# New tests for bug 3057639 to show off the more consistent behaviour of
+# lappend in both direct-eval and bytecompiled code paths (see appendComp.test
+# for the compiled variants). lappend now behaves like append. 9.0/1 lappend -
+# 9.2/3 append
-# New tests for bug 3057639 to show off the more consistent behaviour
-# of lappend in both direct-eval and bytecompiled code paths (see
-# appendComp.test for the compiled variants). lappend now behaves like
-# append. 9.0/1 lappend - 9.2/3 append
-
-test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing array variable element} {
- catch {unset myvar}
+test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing array variable element} -setup {
+ unset -nocomplain myvar
+} -body {
array set myvar {}
proc nonull {var key val} {
upvar 1 $var lvar
@@ -259,17 +258,19 @@ test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing ar
list [catch {
lappend myvar(key) "new value"
} msg] $msg
-} {0 {{new value}}}
-
-test append-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} {
- catch {unset ::env(__DUMMY__)}
+} -result {0 {{new value}}}
+test append-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup {
+ unset -nocomplain ::env(__DUMMY__)
+} -body {
list [catch {
lappend ::env(__DUMMY__) "new value"
} msg] $msg
-} {0 {{new value}}}
-
-test append-9.2 {bug 3057639, append direct eval, read trace on non-existing array variable element} {
- catch {unset myvar}
+} -cleanup {
+ unset -nocomplain ::env(__DUMMY__)
+} -result {0 {{new value}}}
+test append-9.2 {bug 3057639, append direct eval, read trace on non-existing array variable element} -setup {
+ unset -nocomplain myvar
+} -body {
array set myvar {}
proc nonull {var key val} {
upvar 1 $var lvar
@@ -281,19 +282,25 @@ test append-9.2 {bug 3057639, append direct eval, read trace on non-existing arr
list [catch {
append myvar(key) "new value"
} msg] $msg
-} {0 {new value}}
-
-test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} {
- catch {unset ::env(__DUMMY__)}
+} -result {0 {new value}}
+test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup {
+ unset -nocomplain ::env(__DUMMY__)
+} -body {
list [catch {
append ::env(__DUMMY__) "new value"
} msg] $msg
-} {0 {new value}}
-
-
-catch {unset i x result y}
+} -cleanup {
+ unset -nocomplain ::env(__DUMMY__)
+} -result {0 {new value}}
+
+unset -nocomplain i x result y
catch {rename foo ""}
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/appendComp.test b/tests/appendComp.test
index 9523d2d..f85c3ba 100644
--- a/tests/appendComp.test
+++ b/tests/appendComp.test
@@ -10,20 +10,19 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: appendComp.test,v 1.13 2010/09/01 20:35:33 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
catch {unset x}
-
-test appendComp-1.1 {append command} {
- catch {unset x}
+
+test appendComp-1.1 {append command} -setup {
+ unset -nocomplain x
+} -body {
proc foo {} {append ::x 1 2 abc "long string"}
list [foo] $x
-} {{12abclong string} {12abclong string}}
+} -result {{12abclong string} {12abclong string}}
test appendComp-1.2 {append command} {
proc foo {} {
set x ""
@@ -67,7 +66,7 @@ test appendComp-3.2 {append errors} -returnCodes error -body {
} -result {can't set "x(0)": variable isn't array}
test appendComp-3.3 {append errors} -returnCodes error -body {
proc foo {} {
- catch {unset x}
+ unset -nocomplain x
append x
}
foo
@@ -76,7 +75,7 @@ test appendComp-3.3 {append errors} -returnCodes error -body {
test appendComp-4.1 {lappend command} {
proc foo {} {
global x
- catch {unset x}
+ unset -nocomplain x
lappend x 1 2 abc "long string"
}
list [foo] $x
@@ -207,27 +206,31 @@ test appendComp-4.20 {lappend command} {
foo
} {abc}
-proc check {var size} {
- set l [llength $var]
- if {$l != $size} {
- return "length mismatch: should have been $size, was $l"
- }
- for {set i 0} {$i < $size} {set i [expr $i+1]} {
- set j [lindex $var $i]
- if {$j != "item $i"} {
- return "element $i should have been \"item $i\", was \"$j\""
+test appendComp-5.1 {long lappends} -setup {
+ unset -nocomplain x
+ proc check {var size} {
+ set l [llength $var]
+ if {$l != $size} {
+ return "length mismatch: should have been $size, was $l"
}
+ for {set i 0} {$i < $size} {incr i} {
+ set j [lindex $var $i]
+ if {$j ne "item $i"} {
+ return "element $i should have been \"item $i\", was \"$j\""
+ }
+ }
+ return ok
}
- return ok
-}
-test appendComp-5.1 {long lappends} {
- catch {unset x}
+} -body {
set x ""
for {set i 0} {$i < 300} {set i [expr $i+1]} {
lappend x "item $i"
}
check $x 300
-} ok
+} -cleanup {
+ unset -nocomplain x
+ catch {rename check ""}
+} -result ok
test appendComp-6.1 {lappend errors} -returnCodes error -body {
proc foo {} {lappend}
@@ -243,7 +246,7 @@ test appendComp-6.2 {lappend errors} -returnCodes error -body {
test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup {
catch {rename foo ""}
- catch {unset x}
+ unset -nocomplain x
} -body {
proc bar {} {
global x
@@ -259,7 +262,7 @@ test appendComp-7.1 {lappendComp-created var and error in trace on that var} -se
bar
} -result {0 1 {can't read "x": no such variable}}
test appendComp-7.2 {lappend var triggers read trace, index var} -setup {
- catch {unset ::result}
+ unset -nocomplain ::result
} -body {
proc bar {} {
trace variable myvar r foo
@@ -282,7 +285,7 @@ test appendComp-7.3 {lappend var triggers read trace, stack var} -setup {
bar
} -result {::myvar {} r} -constraints {bug-3057639}
test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
- catch {unset ::result}
+ unset -nocomplain ::result
} -body {
# The behavior of read triggers on lappend changed in 8.0 to not trigger
# them. Maybe not correct, but been there a while.
@@ -295,7 +298,7 @@ test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
bar
} -result {myvar b r} -constraints {bug-3057639}
test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
- catch {unset ::result}
+ unset -nocomplain ::result
} -body {
# The behavior of read triggers on lappend changed in 8.0 to not trigger
# them. Maybe not correct, but been there a while.
@@ -308,7 +311,7 @@ test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
bar
} -result {myvar b r}
test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
- catch {unset ::result}
+ unset -nocomplain ::result
} -body {
proc bar {} {
set myvar(0) 1
@@ -320,8 +323,8 @@ test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
bar
} -result {myvar b r} -constraints {bug-3057639}
test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
- catch {unset ::myvar}
- catch {unset ::result}
+ unset -nocomplain ::myvar
+ unset -nocomplain ::result
} -body {
proc bar {} {
trace variable ::myvar r foo
@@ -332,8 +335,8 @@ test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
bar
} -result {::myvar b r} -constraints {bug-3057639}
test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
- catch {unset ::myvar}
- catch {unset ::result}
+ unset -nocomplain ::myvar
+ unset -nocomplain ::result
} -body {
proc bar {} {
trace variable ::myvar r foo
@@ -344,7 +347,7 @@ test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
bar
} -result {::myvar b r}
test appendComp-7.9 {append var does not trigger read trace} -setup {
- catch {unset ::result}
+ unset -nocomplain ::result
} -body {
proc bar {} {
trace variable myvar r foo
@@ -369,25 +372,24 @@ test appendComp-8.1 {defer error to runtime} -setup {
interp delete slave
} -result {}
+# New tests for bug 3057639 to show off the more consistent behaviour of
+# lappend in both direct-eval and bytecompiled code paths (see append.test for
+# the direct-eval variants). lappend now behaves like append. 9.0/1 lappend -
+# 9.2/3 append.
-# New tests for bug 3057639 to show off the more consistent behaviour
-# of lappend in both direct-eval and bytecompiled code paths (see
-# append.test for the direct-eval variants). lappend now behaves like
-# append. 9.0/1 lappend - 9.2/3 append.
-
-# Note also the tests above now constrained by bug-3057639, these
-# changed behaviour with the triggering of read traces in bc mode
-# gone.
+# Note also the tests above now constrained by bug-3057639, these changed
+# behaviour with the triggering of read traces in bc mode gone.
-# Going back to the tests below. The direct-eval tests are ok before
-# and after patch (no read traces run for lappend, append). The
-# compiled tests are failing for lappend (9.0/1) before the patch,
-# showing how it invokes read traces in the compiled path. The append
-# tests are good (9.2/3). After the patch the failues are gone.
+# Going back to the tests below. The direct-eval tests are ok before and after
+# patch (no read traces run for lappend, append). The compiled tests are
+# failing for lappend (9.0/1) before the patch, showing how it invokes read
+# traces in the compiled path. The append tests are good (9.2/3). After the
+# patch the failues are gone.
-test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} {
- catch {unset myvar}
+test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} -setup {
+ unset -nocomplain myvar
array set myvar {}
+} -body {
proc nonull {var key val} {
upvar 1 $var lvar
if {![info exists lvar($key)]} {
@@ -399,22 +401,21 @@ test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing a
lappend ::myvar(key) "new value"
}
list [catch { foo } msg] $msg
-} {0 {{new value}}}
-
-
-test appendComp-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} {
- catch {unset ::env(__DUMMY__)}
+} -result {0 {{new value}}}
+test appendComp-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup {
+ unset -nocomplain ::env(__DUMMY__)
+} -body {
proc foo {} {
lappend ::env(__DUMMY__) "new value"
}
list [catch { foo } msg] $msg
-} {0 {{new value}}}
-
-
-
-test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing array variable element} {
- catch {unset myvar}
+} -cleanup {
+ unset -nocomplain ::env(__DUMMY__)
+} -result {0 {{new value}}}
+test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing array variable element} -setup {
+ unset -nocomplain myvar
array set myvar {}
+} -body {
proc nonull {var key val} {
upvar 1 $var lvar
if {![info exists lvar($key)]} {
@@ -426,18 +427,18 @@ test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing ar
append ::myvar(key) "new value"
}
list [catch { foo } msg] $msg
-} {0 {new value}}
-
-
-test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} {
- catch {unset ::env(__DUMMY__)}
+} -result {0 {new value}}
+test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup {
+ unset -nocomplain ::env(__DUMMY__)
+} -body {
proc foo {} {
append ::env(__DUMMY__) "new value"
}
list [catch { foo } msg] $msg
-} {0 {new value}}
-
-
+} -cleanup {
+ unset -nocomplain ::env(__DUMMY__)
+} -result {0 {new value}}
+
catch {unset i x result y}
catch {rename foo ""}
catch {rename bar ""}
@@ -447,3 +448,8 @@ catch {rename bar {}}
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/apply.test b/tests/apply.test
index 9bcb50d..ba19b81 100644
--- a/tests/apply.test
+++ b/tests/apply.test
@@ -11,8 +11,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: apply.test,v 1.15 2010/08/15 16:12:27 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.2
diff --git a/tests/assemble.test b/tests/assemble.test
new file mode 100644
index 0000000..7d4e5d1
--- /dev/null
+++ b/tests/assemble.test
@@ -0,0 +1,3293 @@
+# assemble.test --
+#
+# Test suite for the 'tcl::unsupported::assemble' command
+#
+# Copyright (c) 2010 by Ozgur Dogan Ugurlu.
+# Copyright (c) 2010 by Kevin B. Kenny.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#-----------------------------------------------------------------------------
+
+# Commands covered: assemble
+
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.2
+ namespace import -force ::tcltest::*
+}
+namespace eval tcl::unsupported {namespace export assemble}
+namespace import tcl::unsupported::assemble
+
+# Procedure to make code that fills the literal and local variable tables, to
+# force instructions to spill to four bytes.
+
+proc fillTables {} {
+ set s {}
+ set sep {}
+ for {set i 0} {$i < 256} {incr i} {
+ append s $sep [list set v$i literal$i]
+ set sep \n
+ }
+ return $s
+}
+
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+ proc getbytes {} {
+ set lines [split [memory info] \n]
+ return [lindex $lines 3 3]
+ }
+ proc leaktest {script {iterations 3}} {
+ set end [getbytes]
+ for {set i 0} {$i < $iterations} {incr i} {
+ uplevel 1 $script
+ set tmp $end
+ set end [getbytes]
+ }
+ return [expr {$end - $tmp}]
+ }
+}
+
+# assemble-1 - TclNRAssembleObjCmd
+
+test assemble-1.1 {wrong # args, direct eval} {
+ -body {
+ eval [list assemble]
+ }
+ -returnCodes error
+ -result {wrong # args*}
+ -match glob
+}
+test assemble-1.2 {wrong # args, direct eval} {
+ -body {
+ eval [list assemble too many]
+ }
+ -returnCodes error
+ -result {wrong # args*}
+ -match glob
+}
+test assemble-1.3 {error reporting, direct eval} {
+ -body {
+ list [catch {
+ eval [list assemble {
+ # bad opcode
+ rubbish
+ }]
+ } result] $result $errorInfo
+ }
+ -match glob
+ -result {1 {bad instruction "rubbish":*} {bad instruction "rubbish":*
+ while executing
+"rubbish"
+ ("assemble" body, line 3)*}}
+ -cleanup {unset result}
+}
+test assemble-1.4 {simple direct eval} {
+ -body {
+ eval [list assemble {push {this is a test}}]
+ }
+ -result {this is a test}
+}
+
+# assemble-2 - CompileAssembleObj
+
+test assemble-2.1 {bytecode reuse, direct eval} {
+ -body {
+ set x {push "this is a test"}
+ list [eval [list assemble $x]] \
+ [eval [list assemble $x]]
+ }
+ -result {{this is a test} {this is a test}}
+}
+test assemble-2.2 {bytecode discard, direct eval} {
+ -body {
+ set x {load value}
+ proc p1 {x} {
+ set value value1
+ assemble $x
+ }
+ proc p2 {x} {
+ set a b
+ set value value2
+ assemble $x
+ }
+ list [p1 $x] [p2 $x]
+ }
+ -result {value1 value2}
+ -cleanup {
+ unset x
+ rename p1 {}
+ rename p2 {}
+ }
+}
+test assemble-2.3 {null script, direct eval} {
+ -body {
+ set x {}
+ assemble $x
+ }
+ -result {}
+ -cleanup {unset x}
+}
+
+# assemble-3 - TclCompileAssembleCmd
+
+test assemble-3.1 {wrong # args, compiled path} {
+ -body {
+ proc x {} {
+ assemble
+ }
+ x
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args:*}
+}
+test assemble-3.2 {wrong # args, compiled path} {
+ -body {
+ proc x {} {
+ assemble too many
+ }
+ x
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args:*}
+ -cleanup {
+ rename x {}
+ }
+}
+
+# assemble-4 - TclAssembleCode mainline
+
+test assemble-4.1 {syntax error} {
+ -body {
+ proc x {} {
+ assemble {
+ {}extra
+ }
+ }
+ list [catch x result] $result $::errorInfo
+ }
+ -cleanup {
+ rename x {}
+ unset result
+ }
+ -match glob
+ -result {1 {extra characters after close-brace} {extra characters after close-brace
+ while executing
+"{}extra
+ "
+ ("assemble" body, line 2)*}}
+}
+test assemble-4.2 {null command} {
+ -body {
+ proc x {} {
+ assemble {
+ push hello; pop;;push goodbye
+ }
+ }
+ x
+ }
+ -result goodbye
+ -cleanup {
+ rename x {}
+ }
+}
+
+# assemble-5 - GetNextOperand off-nominal cases
+
+test assemble-5.1 {unsupported expansion} {
+ -body {
+ proc x {y} {
+ assemble {
+ {*}$y
+ }
+ }
+ list [catch {x {push hello}} result] $result $::errorCode
+ }
+ -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+ -cleanup {
+ rename x {}
+ unset result
+ }
+}
+test assemble-5.2 {unsupported substitution} {
+ -body {
+ proc x {y} {
+ assemble {
+ $y
+ }
+ }
+ list [catch {x {nop}} result] $result $::errorCode
+ }
+ -cleanup {
+ rename x {}
+ unset result
+ }
+ -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+}
+test assemble-5.3 {unsupported substitution} {
+ -body {
+ proc x {} {
+ assemble {
+ [x]
+ }
+ }
+ list [catch {x} result] $result $::errorCode
+ }
+ -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+}
+test assemble-5.4 {backslash substitution} {
+ -body {
+ proc x {} {
+ assemble {
+ p\x75sh\
+ hello\ world
+ }
+ }
+ x
+ }
+ -cleanup {
+ rename x {}
+ }
+ -result {hello world}
+}
+
+# assemble-6 - ASSEM_PUSH
+
+test assemble-6.1 {push, wrong # args} {
+ -body {
+ assemble push
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-6.2 {push, wrong # args} {
+ -body {
+ assemble {push too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-6.3 {push} {
+ -body {
+ eval [list assemble {push hello}]
+ }
+ -result hello
+}
+test assemble-6.4 {push4} {
+ -body {
+ proc x {} "
+ [fillTables]
+ assemble {push hello}
+ "
+ x
+ }
+ -cleanup {
+ rename x {}
+ }
+ -result hello
+}
+
+# assemble-7 - ASSEM_1BYTE
+
+test assemble-7.1 {add, wrong # args} {
+ -body {
+ assemble {add excess}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-7.2 {add} {
+ -body {
+ assemble {
+ push 2
+ push 2
+ add
+ }
+ }
+ -result {4}
+}
+test assemble-7.3 {appendArrayStk} {
+ -body {
+ set a(b) {hello, }
+ assemble {
+ push a
+ push b
+ push world
+ appendArrayStk
+ }
+ set a(b)
+ }
+ -result {hello, world}
+ -cleanup {unset a}
+}
+test assemble-7.4 {appendStk} {
+ -body {
+ set a {hello, }
+ assemble {
+ push a
+ push world
+ appendStk
+ }
+ set a
+ }
+ -result {hello, world}
+ -cleanup {unset a}
+}
+test assemble-7.5 {bitwise ops} {
+ -body {
+ list \
+ [assemble {push 0b1100; push 0b1010; bitand}] \
+ [assemble {push 0b1100; bitnot}] \
+ [assemble {push 0b1100; push 0b1010; bitor}] \
+ [assemble {push 0b1100; push 0b1010; bitxor}]
+ }
+ -result {8 -13 14 6}
+}
+test assemble-7.6 {div} {
+ -body {
+ assemble {push 999999; push 7; div}
+ }
+ -result 142857
+}
+test assemble-7.7 {dup} {
+ -body {
+ assemble {
+ push 1; dup; dup; add; dup; add; dup; add; add
+ }
+ }
+ -result 9
+}
+test assemble-7.8 {eq} {
+ -body {
+ list \
+ [assemble {push able; push baker; eq}] \
+ [assemble {push able; push able; eq}]
+ }
+ -result {0 1}
+}
+test assemble-7.9 {evalStk} {
+ -body {
+ assemble {
+ push {concat test 7.3}
+ evalStk
+ }
+ }
+ -result {test 7.3}
+}
+test assemble-7.9a {evalStk, syntax} {
+ -body {
+ assemble {
+ push {{}bad}
+ evalStk
+ }
+ }
+ -returnCodes error
+ -result {extra characters after close-brace}
+}
+test assemble-7.9b {evalStk, backtrace} {
+ -body {
+ proc y {z} {
+ error testing
+ }
+ proc x {} {
+ assemble {
+ push {
+ # test error in evalStk
+ y asd
+ }
+ evalStk
+ }
+ }
+ list [catch x result] $result $errorInfo
+ }
+ -result {1 testing {testing
+ while executing
+"error testing"
+ (procedure "y" line 2)
+ invoked from within
+"y asd"*}}
+ -match glob
+ -cleanup {
+ rename y {}
+ rename x {}
+ }
+}
+test assemble-7.10 {existArrayStk} {
+ -body {
+ proc x {name key} {
+ set a(b) c
+ assemble {
+ load name; load key; existArrayStk
+ }
+ }
+ list [x a a] [x a b] [x b a] [x b b]
+ }
+ -result {0 1 0 0}
+ -cleanup {rename x {}}
+}
+test assemble-7.11 {existStk} {
+ -body {
+ proc x {name} {
+ set a b
+ assemble {
+ load name; existStk
+ }
+ }
+ list [x a] [x b]
+ }
+ -result {1 0}
+ -cleanup {rename x {}}
+}
+test assemble-7.12 {expon} {
+ -body {
+ assemble {push 3; push 4; expon}
+ }
+ -result 81
+}
+test assemble-7.13 {exprStk} {
+ -body {
+ assemble {
+ push {acos(-1)}
+ exprStk
+ }
+ }
+ -result 3.141592653589793
+}
+test assemble-7.13a {exprStk, syntax} {
+ -body {
+ assemble {
+ push {2+}
+ exprStk
+ }
+ }
+ -returnCodes error
+ -result {missing operand at _@_
+in expression "2+_@_"}
+}
+test assemble-7.13b {exprStk, backtrace} {
+ -body {
+ proc y {z} {
+ error testing
+ }
+ proc x {} {
+ assemble {
+ push {[y asd]}
+ exprStk
+ }
+ }
+ list [catch x result] $result $errorInfo
+ }
+ -result {1 testing {testing
+ while executing
+"error testing"
+ (procedure "y" line 2)
+ invoked from within
+"y asd"*}}
+ -match glob
+ -cleanup {
+ rename y {}
+ rename x {}
+ }
+}
+test assemble-7.14 {ge gt le lt} {
+ -body {
+ proc x {a b} {
+ list [assemble {load a; load b; ge}] \
+ [assemble {load a; load b; gt}] \
+ [assemble {load a; load b; le}] \
+ [assemble {load a; load b; lt}]
+ }
+ list [x 0 0] [x 0 1] [x 1 0]
+ }
+ -result {{1 0 1 0} {0 0 1 1} {1 1 0 0}}
+ -cleanup {rename x {}}
+}
+test assemble-7.15 {incrArrayStk} {
+ -body {
+ proc x {} {
+ set a(b) 5
+ assemble {
+ push a; push b; push 7; incrArrayStk
+ }
+ }
+ x
+ }
+ -result 12
+ -cleanup {rename x {}}
+}
+test assemble-7.16 {incrStk} {
+ -body {
+ proc x {} {
+ set a 5
+ assemble {
+ push a; push 7; incrStk
+ }
+ }
+ x
+ }
+ -result 12
+ -cleanup {rename x {}}
+}
+test assemble-7.17 {land/lor} {
+ -body {
+ proc x {a b} {
+ list \
+ [assemble {load a; load b; land}] \
+ [assemble {load a; load b; lor}]
+ }
+ list [x 0 0] [x 0 23] [x 35 0] [x 47 59]
+ }
+ -result {{0 0} {0 1} {0 1} {1 1}}
+ -cleanup {rename x {}}
+}
+test assemble-7.18 {lappendArrayStk} {
+ -body {
+ proc x {} {
+ set able(baker) charlie
+ assemble {
+ push able
+ push baker
+ push dog
+ lappendArrayStk
+ }
+ }
+ x
+ }
+ -result {charlie dog}
+ -cleanup {rename x {}}
+}
+test assemble-7.19 {lappendStk} {
+ -body {
+ proc x {} {
+ set able baker
+ assemble {
+ push able
+ push charlie
+ lappendStk
+ }
+ }
+ x
+ }
+ -result {baker charlie}
+ -cleanup {rename x {}}
+}
+test assemble-7.20 {listIndex} {
+ -body {
+ assemble {
+ push {a b c d}
+ push 2
+ listIndex
+ }
+ }
+ -result c
+}
+test assemble-7.21 {listLength} {
+ -body {
+ assemble {
+ push {a b c d}
+ listLength
+ }
+ }
+ -result 4
+}
+test assemble-7.22 {loadArrayStk} {
+ -body {
+ proc x {} {
+ set able(baker) charlie
+ assemble {
+ push able
+ push baker
+ loadArrayStk
+ }
+ }
+ x
+ }
+ -result charlie
+ -cleanup {rename x {}}
+}
+test assemble-7.23 {loadStk} {
+ -body {
+ proc x {} {
+ set able baker
+ assemble {
+ push able
+ loadStk
+ }
+ }
+ x
+ }
+ -result baker
+ -cleanup {rename x {}}
+}
+test assemble-7.24 {lsetList} {
+ -body {
+ proc x {} {
+ set l {{a b} {c d} {e f} {g h}}
+ assemble {
+ push {2 1}; push i; load l; lsetList
+ }
+ }
+ x
+ }
+ -result {{a b} {c d} {e i} {g h}}
+}
+test assemble-7.25 {lshift} {
+ -body {
+ assemble {push 16; push 4; lshift}
+ }
+ -result 256
+}
+test assemble-7.26 {mod} {
+ -body {
+ assemble {push 123456; push 1000; mod}
+ }
+ -result 456
+}
+test assemble-7.27 {mult} {
+ -body {
+ assemble {push 12345679; push 9; mult}
+ }
+ -result 111111111
+}
+test assemble-7.28 {neq} {
+ -body {
+ list \
+ [assemble {push able; push baker; neq}] \
+ [assemble {push able; push able; neq}]
+ }
+ -result {1 0}
+}
+test assemble-7.29 {not} {
+ -body {
+ list \
+ [assemble {push 17; not}] \
+ [assemble {push 0; not}]
+ }
+ -result {0 1}
+}
+test assemble-7.30 {pop} {
+ -body {
+ assemble {push this; pop; push that}
+ }
+ -result that
+}
+test assemble-7.31 {rshift} {
+ -body {
+ assemble {push 257; push 4; rshift}
+ }
+ -result 16
+}
+test assemble-7.32 {storeArrayStk} {
+ -body {
+ proc x {} {
+ assemble {
+ push able; push baker; push charlie; storeArrayStk
+ }
+ array get able
+ }
+ x
+ }
+ -result {baker charlie}
+ -cleanup {rename x {}}
+}
+test assemble-7.33 {storeStk} {
+ -body {
+ proc x {} {
+ assemble {
+ push able; push baker; storeStk
+ }
+ set able
+ }
+ x
+ }
+ -result {baker}
+ -cleanup {rename x {}}
+}
+test assemble-7,34 {strcmp} {
+ -body {
+ proc x {a b} {
+ assemble {
+ load a; load b; strcmp
+ }
+ }
+ list [x able baker] [x baker able] [x baker baker]
+ }
+ -result {-1 1 0}
+ -cleanup {rename x {}}
+}
+test assemble-7.35 {streq/strneq} {
+ -body {
+ proc x {a b} {
+ list \
+ [assemble {load a; load b; streq}] \
+ [assemble {load a; load b; strneq}]
+ }
+ list [x able able] [x able baker]
+ }
+ -result {{1 0} {0 1}}
+ -cleanup {rename x {}}
+}
+test assemble-7.36 {strindex} {
+ -body {
+ assemble {push testing; push 4; strindex}
+ }
+ -result i
+}
+test assemble-7.37 {strlen} {
+ -body {
+ assemble {push testing; strlen}
+ }
+ -result 7
+}
+test assemble-7.38 {sub} {
+ -body {
+ assemble {push 42; push 17; sub}
+ }
+ -result 25
+}
+test assemble-7.39 {tryCvtToNumeric} {
+ -body {
+ assemble {
+ push 42; tryCvtToNumeric
+ }
+ }
+ -result 42
+}
+# assemble-7.40 absent
+test assemble-7.41 {uminus} {
+ -body {
+ assemble {
+ push 42; uminus
+ }
+ }
+ -result -42
+}
+test assemble-7.42 {uplus} {
+ -body {
+ assemble {
+ push 42; uplus
+ }
+ }
+ -result 42
+}
+test assemble-7.43 {uplus} {
+ -body {
+ assemble {
+ push NaN; uplus
+ }
+ }
+ -returnCodes error
+ -result {can't use non-numeric floating-point value as operand of "+"}
+}
+test assemble-7.43.1 {tryCvtToNumeric} {
+ -body {
+ assemble {
+ push NaN; tryCvtToNumeric
+ }
+ }
+ -returnCodes error
+ -result {domain error: argument not in valid range}
+}
+test assemble-7.44 {listIn} {
+ -body {
+ assemble {
+ push b; push {a b c}; listIn
+ }
+ }
+ -result 1
+}
+test assemble-7.45 {listNotIn} {
+ -body {
+ assemble {
+ push d; push {a b c}; listNotIn
+ }
+ }
+ -result 1
+}
+test assemble-7.46 {nop} {
+ -body {
+ assemble { push x; nop; nop; nop}
+ }
+ -result x
+}
+
+# assemble-8 ASSEM_LVT and FindLocalVar
+
+test assemble-8.1 {load, wrong # args} {
+ -body {
+ assemble load
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-8.2 {load, wrong # args} {
+ -body {
+ assemble {load too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-8.3 {nonlocal var} {
+ -body {
+ list [catch {assemble {load ::env}} result] $result $errorCode
+ }
+ -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
+ -cleanup {unset result}
+}
+test assemble-8.4 {bad context} {
+ -body {
+ set x 1
+ list [catch {assemble {load x}} result] $result $errorCode
+ }
+ -result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}}
+ -cleanup {unset result}
+}
+test assemble-8.5 {bad context} {
+ -body {
+ namespace eval assem {
+ set x 1
+ list [catch {assemble {load x}} result] $result $errorCode
+ }
+ }
+ -result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}}
+ -cleanup {namespace delete assem}
+}
+test assemble-8.6 {load1} {
+ -body {
+ proc x {a} {
+ assemble {
+ load a
+ }
+ }
+ x able
+ }
+ -result able
+ -cleanup {rename x {}}
+}
+test assemble-8.7 {load4} {
+ -body {
+ proc x {a} "
+ [fillTables]
+ set b \$a
+ assemble {load b}
+ "
+ x able
+ }
+ -result able
+ -cleanup {rename x {}}
+}
+test assemble-8.8 {loadArray1} {
+ -body {
+ proc x {} {
+ set able(baker) charlie
+ assemble {
+ push baker
+ loadArray able
+ }
+ }
+ x
+ }
+ -result charlie
+ -cleanup {rename x {}}
+}
+test assemble-8.9 {loadArray4} {
+ -body "
+ proc x {} {
+ [fillTables]
+ set able(baker) charlie
+ assemble {
+ push baker
+ loadArray able
+ }
+ }
+ x
+ "
+ -result charlie
+ -cleanup {rename x {}}
+}
+test assemble-8.10 {append1} {
+ -body {
+ proc x {} {
+ set y {hello, }
+ assemble {
+ push world; append y
+ }
+ }
+ x
+ }
+ -result {hello, world}
+ -cleanup {rename x {}}
+}
+test assemble-8.11 {append4} {
+ -body {
+ proc x {} "
+ [fillTables]
+ set y {hello, }
+ assemble {
+ push world; append y
+ }
+ "
+ x
+ }
+ -result {hello, world}
+ -cleanup {rename x {}}
+}
+test assemble-8.12 {appendArray1} {
+ -body {
+ proc x {} {
+ set y(z) {hello, }
+ assemble {
+ push z; push world; appendArray y
+ }
+ }
+ x
+ }
+ -result {hello, world}
+ -cleanup {rename x {}}
+}
+test assemble-8.13 {appendArray4} {
+ -body {
+ proc x {} "
+ [fillTables]
+ set y(z) {hello, }
+ assemble {
+ push z; push world; appendArray y
+ }
+ "
+ x
+ }
+ -result {hello, world}
+ -cleanup {rename x {}}
+}
+test assemble-8.14 {lappend1} {
+ -body {
+ proc x {} {
+ set y {hello,}
+ assemble {
+ push world; lappend y
+ }
+ }
+ x
+ }
+ -result {hello, world}
+ -cleanup {rename x {}}
+}
+test assemble-8.15 {lappend4} {
+ -body {
+ proc x {} "
+ [fillTables]
+ set y {hello,}
+ assemble {
+ push world; lappend y
+ }
+ "
+ x
+ }
+ -result {hello, world}
+ -cleanup {rename x {}}
+}
+test assemble-8.16 {lappendArray1} {
+ -body {
+ proc x {} {
+ set y(z) {hello,}
+ assemble {
+ push z; push world; lappendArray y
+ }
+ }
+ x
+ }
+ -result {hello, world}
+ -cleanup {rename x {}}
+}
+test assemble-8.17 {lappendArray4} {
+ -body {
+ proc x {} "
+ [fillTables]
+ set y(z) {hello,}
+ assemble {
+ push z; push world; lappendArray y
+ }
+ "
+ x
+ }
+ -result {hello, world}
+ -cleanup {rename x {}}
+}
+test assemble-8.18 {store1} {
+ -body {
+ proc x {} {
+ assemble {
+ push test; store y
+ }
+ set y
+ }
+ x
+ }
+ -result {test}
+ -cleanup {rename x {}}
+}
+test assemble-8.19 {store4} {
+ -body {
+ proc x {} "
+ [fillTables]
+ assemble {
+ push test; store y
+ }
+ set y
+ "
+ x
+ }
+ -result test
+ -cleanup {rename x {}}
+}
+test assemble-8.20 {storeArray1} {
+ -body {
+ proc x {} {
+ assemble {
+ push z; push test; storeArray y
+ }
+ set y(z)
+ }
+ x
+ }
+ -result test
+ -cleanup {rename x {}}
+}
+test assemble-8.21 {storeArray4} {
+ -body {
+ proc x {} "
+ [fillTables]
+ assemble {
+ push z; push test; storeArray y
+ }
+ "
+ x
+ }
+ -result test
+ -cleanup {rename x {}}
+}
+
+# assemble-9 - ASSEM_CONCAT1, GetIntegerOperand, CheckOneByte
+
+test assemble-9.1 {wrong # args} {
+ -body {assemble concat}
+ -result {wrong # args*}
+ -match glob
+ -returnCodes error
+}
+test assemble-9.2 {wrong # args} {
+ -body {assemble {concat too many}}
+ -result {wrong # args*}
+ -match glob
+ -returnCodes error
+}
+test assemble-9.3 {not a number} {
+ -body {assemble {concat rubbish}}
+ -result {expected integer but got "rubbish"}
+ -returnCodes error
+}
+test assemble-9.4 {too small} {
+ -body {assemble {concat -1}}
+ -result {operand does not fit in one byte}
+ -returnCodes error
+}
+test assemble-9.5 {too small} {
+ -body {assemble {concat 256}}
+ -result {operand does not fit in one byte}
+ -returnCodes error
+}
+test assemble-9.6 {concat} {
+ -body {
+ assemble {push h; push e; push l; push l; push o; concat 5}
+ }
+ -result hello
+}
+test assemble-9.7 {concat} {
+ -body {
+ list [catch {assemble {concat 0}} result] $result $::errorCode
+ }
+ -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+ -cleanup {unset result}
+}
+
+# assemble-10 -- eval and expr
+
+test assemble-10.1 {eval - wrong # args} {
+ -body {
+ assemble {eval}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-10.2 {eval - wrong # args} {
+ -body {
+ assemble {eval too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-10.3 {eval} {
+ -body {
+ proc x {} {
+ assemble {
+ push 3
+ store n
+ pop
+ eval {expr {3*$n + 1}}
+ push 1
+ add
+ }
+ }
+ x
+ }
+ -result 11
+ -cleanup {rename x {}}
+}
+test assemble-10.4 {expr} {
+ -body {
+ proc x {} {
+ assemble {
+ push 3
+ store n
+ pop
+ expr {3*$n + 1}
+ push 1
+ add
+ }
+ }
+ x
+ }
+ -result 11
+ -cleanup {rename x {}}
+}
+test assemble-10.5 {eval and expr - nonsimple} {
+ -body {
+ proc x {} {
+ assemble {
+ eval "s\x65t n 3"
+ pop
+ expr "\x33*\$n + 1"
+ push 1
+ add
+ }
+ }
+ x
+ }
+ -result 11
+ -cleanup {
+ rename x {}
+ }
+}
+test assemble-10.6 {eval - noncompilable} {
+ -body {
+ list [catch {assemble {eval $x}} result] $result $::errorCode
+ }
+ -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+}
+test assemble-10.7 {expr - noncompilable} {
+ -body {
+ list [catch {assemble {expr $x}} result] $result $::errorCode
+ }
+ -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+}
+
+# assemble-11 - ASSEM_LVT4 (exist, existArray, dictAppend, dictLappend,
+# nsupvar, variable, upvar)
+
+test assemble-11.1 {exist - wrong # args} {
+ -body {
+ assemble {exist}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-11.2 {exist - wrong # args} {
+ -body {
+ assemble {exist too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-11.3 {nonlocal var} {
+ -body {
+ list [catch {assemble {exist ::env}} result] $result $errorCode
+ }
+ -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
+ -cleanup {unset result}
+}
+test assemble-11.4 {exist} {
+ -body {
+ proc x {} {
+ set y z
+ list [assemble {exist y}] \
+ [assemble {exist z}]
+ }
+ x
+ }
+ -result {1 0}
+ -cleanup {rename x {}}
+}
+test assemble-11.5 {existArray} {
+ -body {
+ proc x {} {
+ set a(b) c
+ list [assemble {push b; existArray a}] \
+ [assemble {push c; existArray a}] \
+ [assemble {push a; existArray b}]
+ }
+ x
+ }
+ -result {1 0 0}
+ -cleanup {rename x {}}
+}
+test assemble-11.6 {dictAppend} {
+ -body {
+ proc x {} {
+ set dict {a 1 b 2 c 3}
+ assemble {push b; push 22; dictAppend dict}
+ }
+ x
+ }
+ -result {a 1 b 222 c 3}
+ -cleanup {rename x {}}
+}
+test assemble-11.7 {dictLappend} {
+ -body {
+ proc x {} {
+ set dict {a 1 b 2 c 3}
+ assemble {push b; push 2; dictLappend dict}
+ }
+ x
+ }
+ -result {a 1 b {2 2} c 3}
+ -cleanup {rename x {}}
+}
+test assemble-11.8 {upvar} {
+ -body {
+ proc x {v} {
+ assemble {push 1; load v; upvar w; pop; load w}
+ }
+ proc y {} {
+ set z 123
+ x z
+ }
+ y
+ }
+ -result 123
+ -cleanup {rename x {}; rename y {}}
+}
+test assemble-11.9 {nsupvar} {
+ -body {
+ namespace eval q { variable v 123 }
+ proc x {} {
+ assemble {push q; push v; nsupvar y; pop; load y}
+ }
+ x
+ }
+ -result 123
+ -cleanup {namespace delete q; rename x {}}
+}
+test assemble-11.10 {variable} {
+ -body {
+ namespace eval q { namespace eval r {variable v 123}}
+ proc x {} {
+ assemble {push q::r::v; variable y; load y}
+ }
+ x
+ }
+ -result 123
+ -cleanup {namespace delete q; rename x {}}
+}
+
+# assemble-12 - ASSEM_LVT1 (incr and incrArray)
+
+test assemble-12.1 {incr - wrong # args} {
+ -body {
+ assemble {incr}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-12.2 {incr - wrong # args} {
+ -body {
+ assemble {incr too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-12.3 {incr nonlocal var} {
+ -body {
+ list [catch {assemble {incr ::env}} result] $result $errorCode
+ }
+ -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
+ -cleanup {unset result}
+}
+test assemble-12.4 {incr} {
+ -body {
+ proc x {} {
+ set y 5
+ assemble {push 3; incr y}
+ }
+ x
+ }
+ -result 8
+ -cleanup {rename x {}}
+}
+test assemble-12.5 {incrArray} {
+ -body {
+ proc x {} {
+ set a(b) 5
+ assemble {push b; push 3; incrArray a}
+ }
+ x
+ }
+ -result 8
+ -cleanup {rename x {}}
+}
+test assemble-12.6 {incr, stupid stack restriction} {
+ -body {
+ proc x {} "
+ [fillTables]
+ set y 5
+ assemble {push 3; incr y}
+ "
+ list [catch {x} result] $result $errorCode
+ }
+ -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+ -cleanup {unset result; rename x {}}
+}
+
+# assemble-13 -- ASSEM_LVT1_SINT1 - incrImm and incrArrayImm
+
+test assemble-13.1 {incrImm - wrong # args} {
+ -body {
+ assemble {incrImm x}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-13.2 {incrImm - wrong # args} {
+ -body {
+ assemble {incrImm too many args}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-13.3 {incrImm nonlocal var} {
+ -body {
+ list [catch {assemble {incrImm ::env 2}} result] $result $errorCode
+ }
+ -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
+ -cleanup {unset result}
+}
+test assemble-13.4 {incrImm not a number} {
+ -body {
+ proc x {} {
+ assemble {incrImm x rubbish}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-13.5 {incrImm too big} {
+ -body {
+ proc x {} {
+ assemble {incrImm x 0x80}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-13.6 {incrImm too small} {
+ -body {
+ proc x {} {
+ assemble {incrImm x -0x81}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-13.7 {incrImm} {
+ -body {
+ proc x {} {
+ set y 1
+ list [assemble {incrImm y -0x80}] [assemble {incrImm y 0x7f}]
+ }
+ x
+ }
+ -result {-127 0}
+ -cleanup {rename x {}}
+}
+test assemble-13.8 {incrArrayImm} {
+ -body {
+ proc x {} {
+ set a(b) 5
+ assemble {push b; incrArrayImm a 3}
+ }
+ x
+ }
+ -result 8
+ -cleanup {rename x {}}
+}
+test assemble-13.9 {incrImm, stupid stack restriction} {
+ -body {
+ proc x {} "
+ [fillTables]
+ set y 5
+ assemble {incrImm y 3}
+ "
+ list [catch {x} result] $result $errorCode
+ }
+ -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+ -cleanup {unset result; rename x {}}
+}
+
+# assemble-14 -- ASSEM_SINT1 (incrArrayStkImm and incrStkImm)
+
+test assemble-14.1 {incrStkImm - wrong # args} {
+ -body {
+ assemble {incrStkImm}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-14.2 {incrStkImm - wrong # args} {
+ -body {
+ assemble {incrStkImm too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-14.3 {incrStkImm not a number} {
+ -body {
+ proc x {} {
+ assemble {incrStkImm rubbish}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-14.4 {incrStkImm too big} {
+ -body {
+ proc x {} {
+ assemble {incrStkImm 0x80}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-14.5 {incrStkImm too small} {
+ -body {
+ proc x {} {
+ assemble {incrStkImm -0x81}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-14.6 {incrStkImm} {
+ -body {
+ proc x {} {
+ set y 1
+ list [assemble {push y; incrStkImm -0x80}] \
+ [assemble {push y; incrStkImm 0x7f}]
+ }
+ x
+ }
+ -result {-127 0}
+ -cleanup {rename x {}}
+}
+test assemble-14.7 {incrArrayStkImm} {
+ -body {
+ proc x {} {
+ set a(b) 5
+ assemble {push a; push b; incrArrayStkImm 3}
+ }
+ x
+ }
+ -result 8
+ -cleanup {rename x {}}
+}
+
+# assemble-15 - listIndexImm
+
+test assemble-15.1 {listIndexImm - wrong # args} {
+ -body {
+ assemble {listIndexImm}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-15.2 {listIndexImm - wrong # args} {
+ -body {
+ assemble {listIndexImm too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-15.3 {listIndexImm - bad substitution} {
+ -body {
+ list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode
+ }
+ -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+ -cleanup {unset result}
+}
+test assemble-15.4 {listIndexImm - invalid index} {
+ -body {
+ assemble {listIndexImm rubbish}
+ }
+ -returnCodes error
+ -match glob
+ -result {bad index "rubbish"*}
+}
+test assemble-15.5 {listIndexImm} {
+ -body {
+ assemble {push {a b c}; listIndexImm 2}
+ }
+ -result c
+}
+test assemble-15.6 {listIndexImm} {
+ -body {
+ assemble {push {a b c}; listIndexImm end-1}
+ }
+ -result b
+}
+test assemble-15.7 {listIndexImm} {
+ -body {
+ assemble {push {a b c}; listIndexImm end}
+ }
+ -result c
+}
+
+# assemble-16 - invokeStk
+
+test assemble-16.1 {invokeStk - wrong # args} {
+ -body {
+ assemble {invokeStk}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-16.2 {invokeStk - wrong # args} {
+ -body {
+ assemble {invokeStk too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-16.3 {invokeStk - not a number} {
+ -body {
+ proc x {} {
+ assemble {invokeStk rubbish}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-16.4 {invokeStk - no operands} {
+ -body {
+ proc x {} {
+ assemble {invokeStk 0}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-16.5 {invokeStk1} {
+ -body {
+ tcl::unsupported::assemble {push concat; push 1; push 2; invokeStk 3}
+ }
+ -result {1 2}
+}
+test assemble-16.6 {invokeStk4} {
+ -body {
+ proc x {n} {
+ set code {push concat}
+ set shouldbe {}
+ for {set i 1} {$i < $n} {incr i} {
+ append code \n {push a} $i
+ lappend shouldbe a$i
+ }
+ append code \n {invokeStk} { } $n
+ set is [assemble $code]
+ expr {$is eq $shouldbe}
+ }
+ list [x 254] [x 255] [x 256] [x 257]
+ }
+ -result {1 1 1 1}
+ -cleanup {rename x {}}
+}
+
+# assemble-17 -- jumps and labels
+
+test assemble-17.1 {label, wrong # args} {
+ -body {
+ assemble {label}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-17.2 {label, wrong # args} {
+ -body {
+ assemble {label too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-17.3 {label, bad subst} {
+ -body {
+ list [catch {assemble {label $foo}} result] $result $::errorCode
+ }
+ -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+ -cleanup {unset result}
+}
+test assemble-17.4 {duplicate label} {
+ -body {
+ list [catch {assemble {label foo; label foo}} result] \
+ $result $::errorCode
+ }
+ -result {1 {duplicate definition of label "foo"} {TCL ASSEM DUPLABEL foo}}
+}
+test assemble-17.5 {jump, wrong # args} {
+ -body {
+ assemble {jump}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-17.6 {jump, wrong # args} {
+ -body {
+ assemble {jump too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-17.7 {jump, bad subst} {
+ -body {
+ list [catch {assemble {jump $foo}} result] $result $::errorCode
+ }
+ -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+ -cleanup {unset result}
+}
+test assemble-17.8 {jump - ahead and back} {
+ -body {
+ assemble {
+ jump three
+
+ label one
+ push a
+ jump four
+
+ label two
+ push b
+ jump six
+
+ label three
+ push c
+ jump five
+
+ label four
+ push d
+ jump two
+
+ label five
+ push e
+ jump one
+
+ label six
+ push f
+ concat 6
+ }
+ }
+ -result ceadbf
+}
+test assemble-17.9 {jump - resolve a label multiple times} {
+ -body {
+ proc x {} {
+ set case 0
+ set result {}
+ assemble {
+ jump common
+
+ label zero
+ pop
+ incrImm case 1
+ pop
+ push a
+ append result
+ pop
+ jump common
+
+ label one
+ pop
+ incrImm case 1
+ pop
+ push b
+ append result
+ pop
+ jump common
+
+ label common
+ load case
+ dup
+ push 0
+ eq
+ jumpTrue zero
+ dup
+ push 1
+ eq
+ jumpTrue one
+ dup
+ push 2
+ eq
+ jumpTrue two
+ dup
+ push 3
+ eq
+ jumpTrue three
+
+ label two
+ pop
+ incrImm case 1
+ pop
+ push c
+ append result
+ pop
+ jump common
+
+ label three
+ pop
+ incrImm case 1
+ pop
+ push d
+ append result
+ }
+ }
+ x
+ }
+ -result abcd
+ -cleanup {rename x {}}
+}
+test assemble-17.10 {jump4 needed} {
+ -body {
+ assemble "push x; jump one; label two; [string repeat {dup; pop;} 128]
+ jump three; label one; jump two; label three"
+ }
+ -result x
+}
+test assemble-17.11 {jumpTrue} {
+ -body {
+ proc x {y} {
+ assemble {
+ load y
+ jumpTrue then
+ push no
+ jump else
+ label then
+ push yes
+ label else
+ }
+ }
+ list [x 0] [x 1]
+ }
+ -result {no yes}
+ -cleanup {rename x {}}
+}
+test assemble-17.12 {jumpFalse} {
+ -body {
+ proc x {y} {
+ assemble {
+ load y
+ jumpFalse then
+ push no
+ jump else
+ label then
+ push yes
+ label else
+ }
+ }
+ list [x 0] [x 1]
+ }
+ -result {yes no}
+ -cleanup {rename x {}}
+}
+test assemble-17.13 {jump to undefined label} {
+ -body {
+ list [catch {assemble {jump nowhere}} result] $result $::errorCode
+ }
+ -result {1 {undefined label "nowhere"} {TCL ASSEM NOLABEL nowhere}}
+}
+test assemble-17.14 {jump to undefined label, line number correct?} {
+ -body {
+ catch {assemble {#1
+ #2
+ #3
+ jump nowhere
+ #5
+ #6
+ }}
+ set ::errorInfo
+ }
+ -match glob
+ -result {*"assemble" body, line 4*}
+}
+test assemble-17.15 {multiple passes of code resizing} {
+ -setup {
+ set body {
+ push -
+ }
+ for {set i 0} {$i < 14} {incr i} {
+ append body "label a" $i \
+ "; push a; concat 2; nop; nop; jump b" \
+ $i \n
+ }
+ append body {label a14; push a; concat 2; push 1; jumpTrue b14} \n
+ append body {label a15; push a; concat 2; push 0; jumpFalse b15} \n
+ for {set i 0} {$i < 15} {incr i} {
+ append body "label b" $i \
+ "; push b; concat 2; nop; nop; jump a" \
+ [expr {$i+1}] \n
+ }
+ append body {label c; push -; concat 2; nop; nop; nop; jump d} \n
+ append body {label b15; push b; concat 2; nop; nop; jump c} \n
+ append body {label d}
+ proc x {} [list assemble $body]
+ }
+ -body {
+ x
+ }
+ -cleanup {
+ catch {unset body}
+ catch {rename x {}}
+ }
+ -result -abababababababababababababababab-
+}
+
+# assemble-18 - lindexMulti
+
+test assemble-18.1 {lindexMulti - wrong # args} {
+ -body {
+ assemble {lindexMulti}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-18.2 {lindexMulti - wrong # args} {
+ -body {
+ assemble {lindexMulti too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-18.3 {lindexMulti - bad subst} {
+ -body {
+ assemble {lindexMulti $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-18.4 {lindexMulti - not a number} {
+ -body {
+ proc x {} {
+ assemble {lindexMulti rubbish}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-18.5 {lindexMulti - bad operand count} {
+ -body {
+ proc x {} {
+ assemble {lindexMulti 0}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-18.6 {lindexMulti} {
+ -body {
+ assemble {push {{a b c} {d e f} {g h j}}; lindexMulti 1}
+ }
+ -result {{a b c} {d e f} {g h j}}
+}
+test assemble-18.7 {lindexMulti} {
+ -body {
+ assemble {push {{a b c} {d e f} {g h j}}; push 1; lindexMulti 2}
+ }
+ -result {d e f}
+}
+test assemble-18.8 {lindexMulti} {
+ -body {
+ assemble {push {{a b c} {d e f} {g h j}}; push 2; push 1; lindexMulti 3}
+ }
+ -result h
+}
+
+# assemble-19 - list
+
+test assemble-19.1 {list - wrong # args} {
+ -body {
+ assemble {list}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-19.2 {list - wrong # args} {
+ -body {
+ assemble {list too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-19.3 {list - bad subst} {
+ -body {
+ assemble {list $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-19.4 {list - not a number} {
+ -body {
+ proc x {} {
+ assemble {list rubbish}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-19.5 {list - negative operand count} {
+ -body {
+ proc x {} {
+ assemble {list -1}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-19.6 {list - no args} {
+ -body {
+ assemble {list 0}
+ }
+ -result {}
+}
+test assemble-19.7 {list - 1 arg} {
+ -body {
+ assemble {push hello; list 1}
+ }
+ -result hello
+}
+test assemble-19.8 {list - 2 args} {
+ -body {
+ assemble {push hello; push world; list 2}
+ }
+ -result {hello world}
+}
+
+# assemble-20 - lsetFlat
+
+test assemble-20.1 {lsetFlat - wrong # args} {
+ -body {
+ assemble {lsetFlat}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-20.2 {lsetFlat - wrong # args} {
+ -body {
+ assemble {lsetFlat too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-20.3 {lsetFlat - bad subst} {
+ -body {
+ assemble {lsetFlat $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-20.4 {lsetFlat - not a number} {
+ -body {
+ proc x {} {
+ assemble {lsetFlat rubbish}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-20.5 {lsetFlat - negative operand count} {
+ -body {
+ proc x {} {
+ assemble {lsetFlat 1}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand must be >=2} {TCL ASSEM OPERAND>=2}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-20.6 {lsetFlat} {
+ -body {
+ assemble {push b; push a; lsetFlat 2}
+ }
+ -result b
+}
+test assemble-20.7 {lsetFlat} {
+ -body {
+ assemble {push 1; push d; push {a b c}; lsetFlat 3}
+ }
+ -result {a d c}
+}
+
+# assemble-21 - over
+
+test assemble-21.1 {over - wrong # args} {
+ -body {
+ assemble {over}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-21.2 {over - wrong # args} {
+ -body {
+ assemble {over too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-21.3 {over - bad subst} {
+ -body {
+ assemble {over $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-21.4 {over - not a number} {
+ -body {
+ proc x {} {
+ assemble {over rubbish}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-21.5 {over - negative operand count} {
+ -body {
+ proc x {} {
+ assemble {over -1}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-21.6 {over} {
+ -body {
+ proc x {} {
+ assemble {
+ push 1
+ push 2
+ push 3
+ over 0
+ store x
+ pop
+ pop
+ pop
+ pop
+ load x
+ }
+ }
+ x
+ }
+ -result 3
+ -cleanup {rename x {}}
+}
+test assemble-21.7 {over} {
+ -body {
+ proc x {} {
+ assemble {
+ push 1
+ push 2
+ push 3
+ over 2
+ store x
+ pop
+ pop
+ pop
+ pop
+ load x
+ }
+ }
+ x
+ }
+ -result 1
+ -cleanup {rename x {}}
+}
+
+# assemble-22 - reverse
+
+test assemble-22.1 {reverse - wrong # args} {
+ -body {
+ assemble {reverse}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-22.2 {reverse - wrong # args} {
+ -body {
+ assemble {reverse too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+
+test assemble-22.3 {reverse - bad subst} {
+ -body {
+ assemble {reverse $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+
+test assemble-22.4 {reverse - not a number} {
+ -body {
+ proc x {} {
+ assemble {reverse rubbish}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-22.5 {reverse - negative operand count} {
+ -body {
+ proc x {} {
+ assemble {reverse -1}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-22.6 {reverse - zero operand count} {
+ -body {
+ proc x {} {
+ assemble {push 1; reverse 0}
+ }
+ x
+ }
+ -result 1
+ -cleanup {rename x {}}
+}
+test assemble-22.7 {reverse} {
+ -body {
+ proc x {} {
+ assemble {
+ push 1
+ push 2
+ push 3
+ reverse 1
+ store x
+ pop
+ pop
+ pop
+ load x
+ }
+ }
+ x
+ }
+ -result 3
+ -cleanup {rename x {}}
+}
+test assemble-22.8 {reverse} {
+ -body {
+ proc x {} {
+ assemble {
+ push 1
+ push 2
+ push 3
+ reverse 3
+ store x
+ pop
+ pop
+ pop
+ load x
+ }
+ }
+ x
+ }
+ -result 1
+ -cleanup {rename x {}}
+}
+
+# assemble-23 - ASSEM_BOOL (strmatch, unsetStk, unsetArrayStk)
+
+test assemble-23.1 {strmatch - wrong # args} {
+ -body {
+ assemble {strmatch}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-23.2 {strmatch - wrong # args} {
+ -body {
+ assemble {strmatch too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-23.3 {strmatch - bad subst} {
+ -body {
+ assemble {strmatch $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-23.4 {strmatch - not a boolean} {
+ -body {
+ proc x {} {
+ assemble {strmatch rubbish}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected boolean value but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-23.5 {strmatch} {
+ -body {
+ proc x {a b} {
+ list [assemble {load a; load b; strmatch 0}] \
+ [assemble {load a; load b; strmatch 1}]
+ }
+ list [x foo*.grill fengbar.grill] [x foo*.grill foobar.grill] [x foo*.grill FOOBAR.GRILL]
+ }
+ -result {{0 0} {1 1} {0 1}}
+ -cleanup {rename x {}}
+}
+test assemble-23.6 {unsetStk} {
+ -body {
+ proc x {} {
+ set a {}
+ assemble {push a; unsetStk false}
+ info exists a
+ }
+ x
+ }
+ -result 0
+ -cleanup {rename x {}}
+}
+test assemble-23.7 {unsetStk} {
+ -body {
+ proc x {} {
+ assemble {push a; unsetStk false}
+ info exists a
+ }
+ x
+ }
+ -result 0
+ -cleanup {rename x {}}
+}
+test assemble-23.8 {unsetStk} {
+ -body {
+ proc x {} {
+ assemble {push a; unsetStk true}
+ info exists a
+ }
+ x
+ }
+ -returnCodes error
+ -result {can't unset "a": no such variable}
+ -cleanup {rename x {}}
+}
+test assemble-23.9 {unsetArrayStk} {
+ -body {
+ proc x {} {
+ set a(b) {}
+ assemble {push a; push b; unsetArrayStk false}
+ info exists a(b)
+ }
+ x
+ }
+ -result 0
+ -cleanup {rename x {}}
+}
+test assemble-23.10 {unsetArrayStk} {
+ -body {
+ proc x {} {
+ assemble {push a; push b; unsetArrayStk false}
+ info exists a(b)
+ }
+ x
+ }
+ -result 0
+ -cleanup {rename x {}}
+}
+test assemble-23.11 {unsetArrayStk} {
+ -body {
+ proc x {} {
+ assemble {push a; push b; unsetArrayStk true}
+ info exists a(b)
+ }
+ x
+ }
+ -returnCodes error
+ -result {can't unset "a(b)": no such variable}
+ -cleanup {rename x {}}
+}
+
+# assemble-24 -- ASSEM_BOOL_LVT4 (unset; unsetArray)
+
+test assemble-24.1 {unset - wrong # args} {
+ -body {
+ assemble {unset one}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-24.2 {unset - wrong # args} {
+ -body {
+ assemble {unset too many args}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-24.3 {unset - bad subst -arg 1} {
+ -body {
+ assemble {unset $foo bar}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-24.4 {unset - not a boolean} {
+ -body {
+ proc x {} {
+ assemble {unset rubbish trash}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected boolean value but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-24.5 {unset - bad subst - arg 2} {
+ -body {
+ assemble {unset true $bar}
+ }
+ -returnCodes error
+ -result {assembly code may not contain substitutions}
+}
+test assemble-24.6 {unset - nonlocal var} {
+ -body {
+ assemble {unset true ::foo::bar}
+ }
+ -returnCodes error
+ -result {variable "::foo::bar" is not local}
+}
+test assemble-24.7 {unset} {
+ -body {
+ proc x {} {
+ set a {}
+ assemble {unset false a}
+ info exists a
+ }
+ x
+ }
+ -result 0
+ -cleanup {rename x {}}
+}
+test assemble-24.8 {unset} {
+ -body {
+ proc x {} {
+ assemble {unset false a}
+ info exists a
+ }
+ x
+ }
+ -result 0
+ -cleanup {rename x {}}
+}
+test assemble-24.9 {unset} {
+ -body {
+ proc x {} {
+ assemble {unset true a}
+ info exists a
+ }
+ x
+ }
+ -returnCodes error
+ -result {can't unset "a": no such variable}
+ -cleanup {rename x {}}
+}
+test assemble-24.10 {unsetArray} {
+ -body {
+ proc x {} {
+ set a(b) {}
+ assemble {push b; unsetArray false a}
+ info exists a(b)
+ }
+ x
+ }
+ -result 0
+ -cleanup {rename x {}}
+}
+test assemble-24.11 {unsetArray} {
+ -body {
+ proc x {} {
+ assemble {push b; unsetArray false a}
+ info exists a(b)
+ }
+ x
+ }
+ -result 0
+ -cleanup {rename x {}}
+}
+test assemble-24.12 {unsetArray} {
+ -body {
+ proc x {} {
+ assemble {push b; unsetArray true a}
+ info exists a(b)
+ }
+ x
+ }
+ -returnCodes error
+ -result {can't unset "a(b)": no such variable}
+ -cleanup {rename x {}}
+}
+
+# assemble-25 - dict get
+
+test assemble-25.1 {dict get - wrong # args} {
+ -body {
+ assemble {dictGet}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-25.2 {dict get - wrong # args} {
+ -body {
+ assemble {dictGet too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-25.3 {dictGet - bad subst} {
+ -body {
+ assemble {dictGet $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-25.4 {dict get - not a number} {
+ -body {
+ proc x {} {
+ assemble {dictGet rubbish}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-25.5 {dictGet - negative operand count} {
+ -body {
+ proc x {} {
+ assemble {dictGet 0}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-25.6 {dictGet - 1 index} {
+ -body {
+ assemble {push {a 1 b 2}; push a; dictGet 1}
+ }
+ -result 1
+}
+
+# assemble-26 - dict set
+
+test assemble-26.1 {dict set - wrong # args} {
+ -body {
+ assemble {dictSet 1}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-26.2 {dict get - wrong # args} {
+ -body {
+ assemble {dictSet too many args}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-26.3 {dictSet - bad subst} {
+ -body {
+ assemble {dictSet 1 $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-26.4 {dictSet - not a number} {
+ -body {
+ proc x {} {
+ assemble {dictSet rubbish foo}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-26.5 {dictSet - zero operand count} {
+ -body {
+ proc x {} {
+ assemble {dictSet 0 foo}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-26.6 {dictSet - bad local} {
+ -body {
+ proc x {} {
+ assemble {dictSet 1 ::foo::bar}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-26.7 {dictSet} {
+ -body {
+ proc x {} {
+ set dict {a 1 b 2 c 3}
+ assemble {push b; push 4; dictSet 1 dict}
+ }
+ x
+ }
+ -result {a 1 b 4 c 3}
+ -cleanup {rename x {}}
+}
+
+# assemble-27 - dictUnset
+
+test assemble-27.1 {dictUnset - wrong # args} {
+ -body {
+ assemble {dictUnset 1}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-27.2 {dictUnset - wrong # args} {
+ -body {
+ assemble {dictUnset too many args}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-27.3 {dictUnset - bad subst} {
+ -body {
+ assemble {dictUnset 1 $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-27.4 {dictUnset - not a number} {
+ -body {
+ proc x {} {
+ assemble {dictUnset rubbish foo}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-27.5 {dictUnset - zero operand count} {
+ -body {
+ proc x {} {
+ assemble {dictUnset 0 foo}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-27.6 {dictUnset - bad local} {
+ -body {
+ proc x {} {
+ assemble {dictUnset 1 ::foo::bar}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-27.7 {dictUnset} {
+ -body {
+ proc x {} {
+ set dict {a 1 b 2 c 3}
+ assemble {push b; dictUnset 1 dict}
+ }
+ x
+ }
+ -result {a 1 c 3}
+ -cleanup {rename x {}}
+}
+
+# assemble-28 - dictIncrImm
+
+test assemble-28.1 {dictIncrImm - wrong # args} {
+ -body {
+ assemble {dictIncrImm 1}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-28.2 {dictIncrImm - wrong # args} {
+ -body {
+ assemble {dictIncrImm too many args}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-28.3 {dictIncrImm - bad subst} {
+ -body {
+ assemble {dictIncrImm 1 $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-28.4 {dictIncrImm - not a number} {
+ -body {
+ proc x {} {
+ assemble {dictIncrImm rubbish foo}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-28.5 {dictIncrImm - bad local} {
+ -body {
+ proc x {} {
+ assemble {dictIncrImm 1 ::foo::bar}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
+ -cleanup {rename x {}; unset result}
+}
+test assemble-28.6 {dictIncrImm} {
+ -body {
+ proc x {} {
+ set dict {a 1 b 2 c 3}
+ assemble {push b; dictIncrImm 42 dict}
+ }
+ x
+ }
+ -result {a 1 b 44 c 3}
+ -cleanup {rename x {}}
+}
+
+# assemble-29 - ASSEM_REGEXP
+
+test assemble-29.1 {regexp - wrong # args} {
+ -body {
+ assemble {regexp}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-29.2 {regexp - wrong # args} {
+ -body {
+ assemble {regexp too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-29.3 {regexp - bad subst} {
+ -body {
+ assemble {regexp $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-29.4 {regexp - not a boolean} {
+ -body {
+ proc x {} {
+ assemble {regexp rubbish}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected boolean value but got "rubbish"}
+ -cleanup {rename x {}}
+}
+test assemble-29.5 {regexp} {
+ -body {
+ assemble {push br.*br; push abracadabra; regexp false}
+ }
+ -result 1
+}
+test assemble-29.6 {regexp} {
+ -body {
+ assemble {push br.*br; push aBRacadabra; regexp false}
+ }
+ -result 0
+}
+test assemble-29.7 {regexp} {
+ -body {
+ assemble {push br.*br; push aBRacadabra; regexp true}
+ }
+ -result 1
+}
+
+# assemble-30 - Catches
+
+test assemble-30.1 {simplest possible catch} {
+ -body {
+ proc x {} {
+ assemble {
+ beginCatch @bad
+ push error
+ push testing
+ invokeStk 2
+ pop
+ push 0
+ jump @ok
+ label @bad
+ push 1; # should be pushReturnCode
+ label @ok
+ endCatch
+ }
+ }
+ x
+ }
+ -result 1
+ -cleanup {rename x {}}
+}
+test assemble-30.2 {catch in external catch conntext} {
+ -body {
+ proc x {} {
+ list [catch {
+ assemble {
+ beginCatch @bad
+ push error
+ push testing
+ invokeStk 2
+ pop
+ push 0
+ jump @ok
+ label @bad
+ pushReturnCode
+ label @ok
+ endCatch
+ }
+ } result] $result
+ }
+ x
+ }
+ -result {0 1}
+ -cleanup {rename x {}}
+}
+test assemble-30.3 {embedded catches} {
+ -body {
+ proc x {} {
+ list [catch {
+ assemble {
+ beginCatch @bad
+ push error
+ eval { list [catch {error whatever} result] $result }
+ invokeStk 2
+ push 0
+ reverse 2
+ jump @done
+ label @bad
+ pushReturnCode
+ pushResult
+ label @done
+ endCatch
+ list 2
+ }
+ } result2] $result2
+ }
+ x
+ }
+ -result {0 {1 {1 whatever}}}
+ -cleanup {rename x {}}
+}
+test assemble-30.4 {throw in wrong context} {
+ -body {
+ proc x {} {
+ list [catch {
+ assemble {
+ beginCatch @bad
+ push error
+ eval { list [catch {error whatever} result] $result }
+ invokeStk 2
+ push 0
+ reverse 2
+ jump @done
+
+ label @bad
+ load x
+ pushResult
+
+ label @done
+ endCatch
+ list 2
+ }
+ } result] $result $::errorCode [split $::errorInfo \n]
+ }
+ x
+ }
+ -match glob
+ -result {1 {"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} {TCL ASSEM BADTHROW} {{"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} { in assembly code between lines 10 and 15}*}}
+ -cleanup {rename x {}}
+}
+test assemble-30.5 {unclosed catch} {
+ -body {
+ proc x {} {
+ assemble {
+ beginCatch @error
+ push 0
+ jump @done
+ label @error
+ push 1
+ label @done
+ push ""
+ pop
+ }
+ }
+ list [catch {x} result] $result $::errorCode $::errorInfo
+ }
+ -match glob
+ -result {1 {catch still active on exit from assembly code} {TCL ASSEM UNCLOSEDCATCH} {catch still active on exit from assembly code
+ ("assemble" body, line 2)*}}
+ -cleanup {rename x {}}
+}
+test assemble-30.6 {inconsistent catch contexts} {
+ -body {
+ proc x {y} {
+ assemble {
+ load y
+ jumpTrue @inblock
+ beginCatch @error
+ label @inblock
+ push 0
+ jump @done
+ label @error
+ push 1
+ label @done
+ }
+ }
+ list [catch {x 2} result] $::errorCode $::errorInfo
+ }
+ -match glob
+ -result {1 {TCL ASSEM BADCATCH} {execution reaches an instruction in inconsistent exception contexts
+ ("assemble" body, line 5)*}}
+ -cleanup {rename x {}}
+}
+
+# assemble-31 - Jump tables
+
+test assemble-31.1 {jumpTable, wrong # args} {
+ -body {
+ assemble {jumpTable}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-31.2 {jumpTable, wrong # args} {
+ -body {
+ assemble {jumpTable too many}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+test assemble-31.3 {jumpTable - bad subst} {
+ -body {
+ assemble {jumpTable $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+test assemble-31.4 {jumptable - not a list} {
+ -body {
+ assemble {jumpTable \{rubbish}
+ }
+ -returnCodes error
+ -result {unmatched open brace in list}
+}
+test assemble-31.5 {jumpTable, badly structured} {
+ -body {
+ list [catch {assemble {
+ # line 2
+ jumpTable {one two three};# line 3
+ }} result] \
+ $result $::errorCode $::errorInfo
+ }
+ -match glob
+ -result {1 {jump table must have an even number of list elements} {TCL ASSEM BADJUMPTABLE} {jump table must have an even number of list elements*("assemble" body, line 3)*}}
+}
+test assemble-31.6 {jumpTable, missing symbol} {
+ -body {
+ list [catch {assemble {
+ # line 2
+ jumpTable {1 a};# line 3
+ }} result] \
+ $result $::errorCode $::errorInfo
+ }
+ -match glob
+ -result {1 {undefined label "a"} {TCL ASSEM NOLABEL a} {undefined label "a"*("assemble" body, line 3)*}}
+}
+test assemble-31.7 {jumptable, actual example} {
+ -setup {
+ proc x {} {
+ set result {}
+ for {set i 0} {$i < 5} {incr i} {
+ lappend result [assemble {
+ load i
+ jumpTable {1 @one 2 @two 3 @three}
+ push {none of the above}
+ jump @done
+ label @one
+ push one
+ jump @done
+ label @two
+ push two
+ jump @done
+ label @three
+ push three
+ label @done
+ }]
+ }
+ set tcl_traceCompile 2
+ set result
+ }
+ }
+ -body x
+ -result {{none of the above} one two three {none of the above}}
+ -cleanup {set tcl_traceCompile 0; rename x {}}
+}
+
+test assemble-40.1 {unbalanced stack} {
+ -body {
+ list \
+ [catch {
+ assemble {
+ push 3
+ dup
+ mult
+ push 4
+ dup
+ mult
+ pop
+ expon
+ }
+ } result] $result $::errorInfo
+ }
+ -result {1 {stack underflow} {stack underflow
+ in assembly code between lines 1 and end of assembly code*}}
+ -match glob
+ -returnCodes ok
+}
+test assemble-40.2 {unbalanced stack} {*}{
+ -body {
+ list \
+ [catch {
+ assemble {
+ label a
+ push {}
+ label b
+ pop
+ label c
+ pop
+ label d
+ push {}
+ }
+ } result] $result $::errorInfo
+ }
+ -result {1 {stack underflow} {stack underflow
+ in assembly code between lines 7 and 9*}}
+ -match glob
+ -returnCodes ok
+}
+
+test assemble-41.1 {Inconsistent stack usage} {*}{
+ -body {
+ proc x {y} {
+ assemble {
+ load y
+ jumpFalse else
+ push 0
+ jump then
+ label else
+ push 1
+ push 2
+ label then
+ pop
+ }
+ }
+ catch {x 1}
+ set errorInfo
+ }
+ -match glob
+ -result {inconsistent stack depths on two execution paths
+ ("assemble" body, line 10)*}
+}
+test assemble-41.2 {Inconsistent stack, jumptable and default} {
+ -body {
+ proc x {y} {
+ assemble {
+ load y
+ jumpTable {0 else}
+ push 0
+ label else
+ pop
+ }
+ }
+ catch {x 1}
+ set errorInfo
+ }
+ -match glob
+ -result {inconsistent stack depths on two execution paths
+ ("assemble" body, line 6)*}
+}
+test assemble-41.3 {Inconsistent stack, two legs of jumptable} {
+ -body {
+ proc x {y} {
+ assemble {
+ load y
+ jumpTable {0 no 1 yes}
+ label no
+ push 0
+ label yes
+ pop
+ }
+ }
+ catch {x 1}
+ set errorInfo
+ }
+ -match glob
+ -result {inconsistent stack depths on two execution paths
+ ("assemble" body, line 7)*}
+}
+
+test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
+ -body {
+ proc ulam {n} {
+ assemble {
+ load n; # max
+ dup; # max n
+ jump start; # max n
+
+ label loop; # max n
+ over 1; # max n max
+ over 1; # max in max n
+ ge; # man n max>=n
+ jumpTrue skip; # max n
+
+ reverse 2; # n max
+ pop; # n
+ dup; # n n
+
+ label skip; # max n
+ dup; # max n n
+ push 2; # max n n 2
+ mod; # max n n%2
+ jumpTrue odd; # max n
+
+ push 2; # max n 2
+ div; # max n/2 -> max n
+ jump start; # max n
+
+ label odd; # max n
+ push 3; # max n 3
+ mult; # max 3*n
+ push 1; # max 3*n 1
+ add; # max 3*n+1
+
+ label start; # max n
+ dup; # max n n
+ push 1; # max n n 1
+ neq; # max n n>1
+ jumpTrue loop; # max n
+
+ pop; # max
+ }
+ }
+ set result {}
+ for {set i 1} {$i < 30} {incr i} {
+ lappend result [ulam $i]
+ }
+ set result
+ }
+ -result {1 2 16 4 16 16 52 8 52 16 52 16 40 52 160 16 52 52 88 20 64 52 160 24 88 40 9232 52 88}
+}
+
+test assemble-51.1 {memory leak testing} memory {
+ leaktest {
+ apply {{} {assemble {push hello}}}
+ }
+} 0
+test assemble-51.2 {memory leak testing} memory {
+ leaktest {
+ apply {{{x 0}} {assemble {incrImm x 1}}}
+ }
+} 0
+test assemble-51.3 {memory leak testing} memory {
+ leaktest {
+ apply {{n} {
+ assemble {
+ load n; # max
+ dup; # max n
+ jump start; # max n
+
+ label loop; # max n
+ over 1; # max n max
+ over 1; # max in max n
+ ge; # man n max>=n
+ jumpTrue skip; # max n
+
+ reverse 2; # n max
+ pop; # n
+ dup; # n n
+
+ label skip; # max n
+ dup; # max n n
+ push 2; # max n n 2
+ mod; # max n n%2
+ jumpTrue odd; # max n
+
+ push 2; # max n 2
+ div; # max n/2 -> max n
+ jump start; # max n
+
+ label odd; # max n
+ push 3; # max n 3
+ mult; # max 3*n
+ push 1; # max 3*n 1
+ add; # max 3*n+1
+
+ label start; # max n
+ dup; # max n n
+ push 1; # max n n 1
+ neq; # max n n>1
+ jumpTrue loop; # max n
+
+ pop; # max
+ }
+ }} 1
+ }
+} 0
+test assemble-51.4 {memory leak testing} memory {
+ leaktest {
+ catch {
+ apply {{} {
+ assemble {reverse polish notation}
+ }}
+ }
+ }
+} 0
+
+rename fillTables {}
+rename assemble {}
+
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/assemble1.bench b/tests/assemble1.bench
new file mode 100644
index 0000000..18fd3a9
--- /dev/null
+++ b/tests/assemble1.bench
@@ -0,0 +1,85 @@
+proc ulam1 {n} {
+ set max $n
+ while {$n != 1} {
+ if {$n > $max} {
+ set max $n
+ }
+ if {$n % 2} {
+ set n [expr {3 * $n + 1}]
+ } else {
+ set n [expr {$n / 2}]
+ }
+ }
+ return $max
+}
+
+set tcl_traceCompile 2; ulam1 1; set tcl_traceCompile 0
+
+proc ulam2 {n} {
+ tcl::unsupported::assemble {
+ load n; # max
+ dup; # max n
+ jump start; # max n
+
+ label loop; # max n
+ over 1; # max n max
+ over 1; # max in max n
+ ge; # man n max>=n
+ jumpTrue skip; # max n
+
+ reverse 2; # n max
+ pop; # n
+ dup; # n n
+
+ label skip; # max n
+ dup; # max n n
+ push 2; # max n n 2
+ mod; # max n n%2
+ jumpTrue odd; # max n
+
+ push 2; # max n 2
+ div; # max n/2 -> max n
+ jump start; # max n
+
+ label odd; # max n
+ push 3; # max n 3
+ mult; # max 3*n
+ push 1; # max 3*n 1
+ add; # max 3*n+1
+
+ label start; # max n
+ dup; # max n n
+ push 1; # max n n 1
+ neq; # max n n>1
+ jumpTrue loop; # max n
+
+ pop; # max
+ }
+}
+set tcl_traceCompile 2; ulam2 1; set tcl_traceCompile 0
+
+proc test1 {n} {
+ for {set i 1} {$i <= $n} {incr i} {
+ ulam1 $i
+ }
+}
+proc test2 {n} {
+ for {set i 1} {$i <= $n} {incr i} {
+ ulam2 $i
+ }
+}
+
+for {set j 0} {$j < 10} {incr j} {
+ test1 1
+ set before [clock microseconds]
+ test1 30000
+ set after [clock microseconds]
+ puts "compiled: [expr {1e-6 * ($after - $before)}]"
+
+ test2 1
+ set before [clock microseconds]
+ test2 30000
+ set after [clock microseconds]
+ puts "assembled: [expr {1e-6 * ($after - $before)}]"
+}
+ \ No newline at end of file
diff --git a/tests/assocd.test b/tests/assocd.test
index a677090..d1489b3 100644
--- a/tests/assocd.test
+++ b/tests/assocd.test
@@ -10,14 +10,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: assocd.test,v 1.6 2004/05/19 10:42:00 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testgetassocdata [llength [info commands testgetassocdata]]
testConstraint testsetassocdata [llength [info commands testsetassocdata]]
testConstraint testdelassocdata [llength [info commands testdelassocdata]]
diff --git a/tests/async.test b/tests/async.test
index 654f995..cb67cc2 100644
--- a/tests/async.test
+++ b/tests/async.test
@@ -10,18 +10,17 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: async.test,v 1.10 2010/03/24 10:35:21 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testasync [llength [info commands testasync]]
-testConstraint threaded [expr {
- [info exists ::tcl_platform(threaded)] && $::tcl_platform(threaded)
-}]
+testConstraint threaded [::tcl::pkgconfig get threaded]
proc async1 {result code} {
global aresult acode
@@ -198,7 +197,7 @@ test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
set aresult {Async event not delivered}
testasync marklater $handle
set i 0
- } [string repeat {;incr i;} 1500000] {
+ } "[string repeat {;incr i;} 1500000]after 10;" {
return $aresult
}]] $hm
} -result {test pattern} -cleanup {
diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test
index 56e1ffb..8f29131 100644
--- a/tests/autoMkindex.test
+++ b/tests/autoMkindex.test
@@ -1,17 +1,15 @@
# Commands covered: auto_mkindex auto_import
#
-# This file contains tests related to autoloading and generating
-# the autoloading index.
+# This file contains tests related to autoloading and generating the
+# autoloading index.
#
# Copyright (c) 1998 Lucent Technologies, 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.
-#
-# RCS: @(#) $Id: autoMkindex.test,v 1.15 2004/05/25 17:44:29 dgp Exp $
+# 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
namespace import -force ::tcltest::*
}
@@ -19,10 +17,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
makeFile {# Test file for:
# auto_mkindex
#
-# This file provides example cases for testing the Tcl autoloading
-# facility. Things are much more complicated with namespaces and classes.
-# The "auto_mkindex" facility can no longer be built on top of a simple
-# regular expression parser. It must recognize constructs like this:
+# This file provides example cases for testing the Tcl autoloading facility.
+# Things are much more complicated with namespaces and classes. The
+# "auto_mkindex" facility can no longer be built on top of a simple regular
+# expression parser. It must recognize constructs like this:
#
# namespace eval foo {
# proc test {x y} { ... }
@@ -31,23 +29,23 @@ makeFile {# Test file for:
# }
# }
#
-# Note that procedures and itcl class definitions can be nested inside
-# of namespaces.
+# Note that procedures and itcl class definitions can be nested inside of
+# namespaces.
#
# Copyright (c) 1993-1998 Lucent Technologies, Inc.
# This shouldn't cause any problems
namespace import -force blt::*
-# Should be able to handle "proc" definitions, even if they are
-# preceded by white space.
+# Should be able to handle "proc" definitions, even if they are preceded by
+# white space.
proc normal {x y} {return [expr $x+$y]}
proc indented {x y} {return [expr $x+$y]}
#
-# Should be able to handle proc declarations within namespaces,
-# even if they have explicit namespace paths.
+# Should be able to handle proc declarations within namespaces, even if they
+# have explicit namespace paths.
#
namespace eval buried {
proc inside {args} {return "inside: $args"}
@@ -69,8 +67,8 @@ namespace eval buried {
}
}
-# With proper hooks, we should be able to support other commands
-# that create procedures
+# With proper hooks, we should be able to support other commands that create
+# procedures
proc buried::myproc {name body args} {
::proc $name $body $args
@@ -90,17 +88,15 @@ namespace eval ::buried {
}
{::buried::my proc} mycmd6 args {return "another"}
-# A correctly functioning [auto_import] won't choke when a child
-# namespace [namespace import]s from its parent.
+# A correctly functioning [auto_import] won't choke when a child namespace
+# [namespace import]s from its parent.
#
namespace eval ::parent::child {
namespace import ::parent::*
}
proc ::parent::child::test {} {}
-
} autoMkindex.tcl
-
# Save initial state of auto_mkindex_parser
auto_load auto_mkindex
@@ -120,21 +116,19 @@ set result ""
set origDir [pwd]
cd $::tcltest::temporaryDirectory
-
+
test autoMkindex-1.1 {remove any existing tclIndex file} {
file delete tclIndex
file exists tclIndex
} {0}
-
test autoMkindex-1.2 {build tclIndex based on a test file} {
auto_mkindex . autoMkindex.tcl
file exists tclIndex
} {1}
-
set element "{source [file join . autoMkindex.tcl]}"
-
-test autoMkindex-1.3 {examine tclIndex} {
+test autoMkindex-1.3 {examine tclIndex} -setup {
file delete tclIndex
+} -body {
auto_mkindex . autoMkindex.tcl
namespace eval tcl_autoMkindex_tmp {
set dir "."
@@ -145,33 +139,35 @@ test autoMkindex-1.3 {examine tclIndex} {
lappend ::result [list $elem $auto_index($elem)]
}
}
+ return $result
+} -cleanup {
namespace delete tcl_autoMkindex_tmp
- set ::result
-} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {normal $element} {top $element}"
+} -result "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {normal $element} {top $element}"
-
-test autoMkindex-2.1 {commands on the autoload path can be imported} {
+test autoMkindex-2.1 {commands on the autoload path can be imported} -setup {
file delete tclIndex
+ interp create slave
+} -body {
auto_mkindex . autoMkindex.tcl
- set interp [interp create]
- set final [$interp eval {
+ slave eval {
namespace eval blt {}
set auto_path [linsert $auto_path 0 .]
set info [list [catch {namespace import buried::*} result] $result]
foreach name [lsort [info commands pub_*]] {
lappend info $name [namespace origin $name]
}
- set info
- }]
- interp delete $interp
- set final
-} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"
+ return $info
+ }
+} -cleanup {
+ interp delete slave
+} -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} {
+test autoMkindex-3.1 {slaveHook} -setup {
+ file delete tclIndex
+} -body {
auto_mkindex_parser::slavehook {
_%@namespace eval ::blt {
proc foo {} {}
@@ -179,26 +175,23 @@ test autoMkindex-3.1 {slaveHook} {
}
}
auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* }
- file delete tclIndex
auto_mkindex . autoMkindex.tcl
-
+ file exists tclIndex
+} -cleanup {
# Reset initCommands to avoid trashing other tests
-
AutoMkindexTestReset
- file exists tclIndex
-} 1
-
-# The auto_mkindex_parser::command is used to register commands
-# that create new commands.
-
-test autoMkindex-3.2 {auto_mkindex_parser::command} {
+} -result 1
+# The auto_mkindex_parser::command is used to register commands that create
+# new commands.
+test autoMkindex-3.2 {auto_mkindex_parser::command} -setup {
+ file delete tclIndex
+} -body {
auto_mkindex_parser::command buried::myproc {name args} {
variable index
variable scriptFile
append index [list set auto_index([fullname $name])] \
" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
}
- file delete tclIndex
auto_mkindex . autoMkindex.tcl
namespace eval tcl_autoMkindex_tmp {
set dir "."
@@ -208,17 +201,16 @@ test autoMkindex-3.2 {auto_mkindex_parser::command} {
foreach elem [lsort [array names auto_index]] {
lappend ::result [list $elem $auto_index($elem)]
}
+ return $::result
}
+} -cleanup {
namespace delete tcl_autoMkindex_tmp
-
# Reset initCommands to avoid trashing other tests
-
AutoMkindexTestReset
- set ::result
-} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}"
-
-
-test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
+} -result "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}"
+test autoMkindex-3.3 {auto_mkindex_parser::command} -setup {
+ file delete tclIndex
+} -constraints {knownBug} -body {
auto_mkindex_parser::command {buried::my proc} {name args} {
variable index
variable scriptFile
@@ -226,7 +218,6 @@ test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
append index [list set auto_index([fullname $name])] \
" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
}
- file delete tclIndex
auto_mkindex . autoMkindex.tcl
namespace eval tcl_autoMkindex_tmp {
set dir "."
@@ -237,109 +228,93 @@ test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
lappend ::result [list $elem $auto_index($elem)]
}
}
+ list [lsearch -inline $::result *mycmd4*] \
+ [lsearch -inline $::result *mycmd5*] \
+ [lsearch -inline $::result *mycmd6*]
+} -cleanup {
namespace delete tcl_autoMkindex_tmp
-
# Reset initCommands to avoid trashing other tests
-
AutoMkindexTestReset
- proc lvalue {list pattern} {
- set ix [lsearch $list $pattern]
- if {$ix >= 0} {
- return [lindex $list $ix]
- } else {
- return {}
- }
- }
- list [lvalue $::result *mycmd4*] [lvalue $::result *mycmd5*] [lvalue $::result *mycmd6*]
-} "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"
-
-
-makeDirectory pkg
-makeFile {
-package provide football 1.0
-
-namespace eval ::pro:: {
- #
- # export only public functions.
- #
- namespace export {[a-z]*}
-}
-namespace eval ::college:: {
- #
- # export only public functions.
- #
- namespace export {[a-z]*}
-}
-
-proc ::pro::team {} {
- puts "go packers!"
- return true
-}
+} -result "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"
-proc ::college::team {} {
- puts "go badgers!"
- return true
-}
-
-} [file join pkg samename.tcl]
-
-
-test autoMkindex-4.1 {platform indenpendant source commands} {
+test autoMkindex-4.1 {platform independent source commands} -setup {
file delete tclIndex
+ makeDirectory pkg
+ makeFile {
+ package provide football 1.0
+ namespace eval ::pro:: {
+ #
+ # export only public functions.
+ #
+ namespace export {[a-z]*}
+ }
+ namespace eval ::college:: {
+ #
+ # export only public functions.
+ #
+ namespace export {[a-z]*}
+ }
+ proc ::pro::team {} {
+ puts "go packers!"
+ return true
+ }
+ proc ::college::team {} {
+ puts "go badgers!"
+ return true
+ }
+ } [file join pkg samename.tcl]
+} -body {
auto_mkindex . pkg/samename.tcl
set f [open tclIndex r]
- set dat [split [string trim [read $f]] "\n"]
- set len [llength $dat]
- set result [lsort [lrange $dat [expr {$len-2}] [expr {$len-1}]]]
- close $f
- set result
-} {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}}
-
-removeFile [file join pkg samename.tcl]
-
-makeFile {
-set dollar1 "this string contains an unescaped dollar sign -> \\$foo"
-set dollar2 "this string contains an escaped dollar sign -> \$foo \\\$foo"
-set bracket1 "this contains an unescaped bracket [NoSuchProc]"
-set bracket2 "this contains an escaped bracket \[NoSuchProc\]"
-set bracket3 "this contains nested unescaped brackets [[NoSuchProc]]"
-proc testProc {} {}
-} [file join pkg magicchar.tcl]
-
-test autoMkindex-5.1 {escape magic tcl chars in general code} {
+ lsort [lrange [split [string trim [read $f]] "\n"] end-1 end]
+} -cleanup {
+ catch {close $f}
+ removeFile [file join pkg samename.tcl]
+ removeDirectory pkg
+} -result {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}}
+
+test autoMkindex-5.1 {escape magic tcl chars in general code} -setup {
file delete tclIndex
+ makeDirectory pkg
+ makeFile {
+ set dollar1 "this string contains an unescaped dollar sign -> \\$foo"
+ set dollar2 \
+ "this string contains an escaped dollar sign -> \$foo \\\$foo"
+ set bracket1 "this contains an unescaped bracket [NoSuchProc]"
+ set bracket2 "this contains an escaped bracket \[NoSuchProc\]"
+ set bracket3 \
+ "this contains nested unescaped brackets [[NoSuchProc]]"
+ proc testProc {} {}
+ } [file join pkg magicchar.tcl]
set result {}
- if { ![catch {auto_mkindex . pkg/magicchar.tcl}] } {
- set f [open tclIndex r]
- set dat [split [string trim [read $f]] "\n"]
- set result [lindex $dat end]
- close $f
- }
- set result
-} {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]}
-
-removeFile [file join pkg magicchar.tcl]
-
-makeFile {
-proc {[magic mojo proc]} {} {}
-} [file join pkg magicchar2.tcl]
-
-test autoMkindex-5.2 {correctly locate auto loaded procs with []} {
+} -body {
+ auto_mkindex . pkg/magicchar.tcl
+ set f [open tclIndex r]
+ lindex [split [string trim [read $f]] "\n"] end
+} -cleanup {
+ catch {close $f}
+ removeFile [file join pkg magicchar.tcl]
+ removeDirectory pkg
+} -result {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]}
+test autoMkindex-5.2 {correctly locate auto loaded procs with []} -setup {
file delete tclIndex
+ makeDirectory pkg
+ makeFile {
+ proc {[magic mojo proc]} {} {}
+ } [file join pkg magicchar2.tcl]
set result {}
- if { ![catch {auto_mkindex . pkg/magicchar2.tcl}] } {
- # Make a slave interp to test the autoloading
- set c [interp create]
- $c eval {lappend auto_path [pwd]}
- set result [$c eval {catch {{[magic mojo proc]}}}]
- interp delete $c
- }
- set result
-} 0
-
-removeFile [file join pkg magicchar2.tcl]
-removeDirectory pkg
-
+ interp create slave
+} -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]}}}
+} -cleanup {
+ interp delete slave
+ removeFile [file join pkg magicchar2.tcl]
+ removeDirectory pkg
+} -result 0
+
# Clean up.
unset result
@@ -357,3 +332,9 @@ if {[file exists tclIndex]} {
cd $origDir
::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/basic.test b/tests/basic.test
index c07d805..7435571 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -14,13 +14,13 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: basic.test,v 1.46 2009/09/17 17:58:10 dgp Exp $
-#
package require tcltest 2
namespace import -force ::tcltest::*
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testevalex [llength [info commands testevalex]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]
testConstraint testcreatecommand [llength [info commands testcreatecommand]]
diff --git a/tests/binary.test b/tests/binary.test
index 79fdb92..ccd0f29 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -9,8 +9,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: binary.test,v 1.41 2010/09/15 22:12:00 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -2383,6 +2381,23 @@ test binary-63.4 {NaN} ieeeFloatingPoint {
format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
} 0x7ff3123456789abc
+# Make sure TclParseNumber() rejects invalid nan-hex formats [Bug 3402540]
+test binary-63.5 {NaN} -constraints ieeeFloatingPoint -body {
+ binary format q Nan(
+} -returnCodes error -match glob -result {expected floating-point number*}
+test binary-63.6 {NaN} -constraints ieeeFloatingPoint -body {
+ binary format q Nan()
+} -returnCodes error -match glob -result {expected floating-point number*}
+test binary-63.7 {NaN} -constraints ieeeFloatingPoint -body {
+ binary format q Nan(g)
+} -returnCodes error -match glob -result {expected floating-point number*}
+test binary-63.8 {NaN} -constraints ieeeFloatingPoint -body {
+ binary format q Nan(1,2)
+} -returnCodes error -match glob -result {expected floating-point number*}
+test binary-63.9 {NaN} -constraints ieeeFloatingPoint -body {
+ binary format q Nan(1234567890abcd)
+} -returnCodes error -match glob -result {expected floating-point number*}
+
test binary-64.1 {NaN} -constraints ieeeFloatingPoint -body {
binary scan [binary format w 0x7ff8000000000000] q d
set d
@@ -2627,6 +2642,27 @@ test binary-73.23 {binary decode base64} -body {
test binary-73.24 {binary decode base64} -body {
string length [binary decode base64 " "]
} -result 0
+test binary-73.25 {binary decode base64} -body {
+ list [string length [set r [binary decode base64 WA==\n]]] $r
+} -result {1 X}
+test binary-73.26 {binary decode base64} -body {
+ list [string length [set r [binary decode base64 WFk=\n]]] $r
+} -result {2 XY}
+test binary-73.27 {binary decode base64} -body {
+ list [string length [set r [binary decode base64 WFla\n]]] $r
+} -result {3 XYZ}
+test binary-73.28 {binary decode base64} -body {
+ list [string length [set r [binary decode base64 -strict WA==\n]]] $r
+} -returnCodes error -match glob -result {invalid base64 character *}
+test binary-73.29 {binary decode base64} -body {
+ list [string length [set r [binary decode base64 -strict WFk=\n]]] $r
+} -returnCodes error -match glob -result {invalid base64 character *}
+test binary-73.30 {binary decode base64} -body {
+ list [string length [set r [binary decode base64 -strict WFla\n]]] $r
+} -returnCodes error -match glob -result {invalid base64 character *}
+test binary-73.31 {binary decode base64} -body {
+ list [string length [set r [binary decode base64 WA==WFla]]] $r
+} -returnCodes error -match glob -result {invalid base64 character *}
test binary-74.1 {binary encode uuencode} -body {
binary encode uuencode
diff --git a/tests/case.test b/tests/case.test
index a9bec93..6d63cea 100644
--- a/tests/case.test
+++ b/tests/case.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: case.test,v 1.8 2008/07/21 22:22:28 nijtmans Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/chan.test b/tests/chan.test
index 7dccda7..d8390e2 100644
--- a/tests/chan.test
+++ b/tests/chan.test
@@ -6,8 +6,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: chan.test,v 1.16 2008/12/18 01:14:17 ferrieux Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -63,7 +61,7 @@ test chan-4.5 {chan command: check valid inValue, invalid outValue} -body {
} -returnCodes error -match glob -result {bad value for -eofchar:*}
test chan-4.6 {chan command: check no inValue, valid outValue} -body {
chan configure stdout -eofchar [list {} \x27]
-} -returnCodes ok -result {}
+} -returnCodes ok -result {} -cleanup {chan configure stdout -eofchar [list {} {}]}
test chan-5.1 {chan command: copy subcommand} -body {
chan copy foo
diff --git a/tests/chanio.test b/tests/chanio.test
index c1dba49..665df50 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -12,8 +12,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: chanio.test,v 1.23 2010/02/07 08:03:11 dkf Exp $
if {[catch {package require tcltest 2}]} {
chan puts stderr "Skipping tests in [info script]. tcltest 2 required."
@@ -31,6 +29,9 @@ namespace eval ::tcl::test::io {
variable msg
variable expected
+ ::tcltest::loadTestedCommands
+ catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testchannel [llength [info commands testchannel]]
testConstraint exec [llength [info commands exec]]
testConstraint openpipe 1
@@ -39,14 +40,14 @@ namespace eval ::tcl::test::io {
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
- testConstraint testthread [llength [info commands testthread]]
+ testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
- # You need a *very* special environment to do some tests. In
- # particular, many file systems do not support large-files...
+ # You need a *very* special environment to do some tests. In particular,
+ # many file systems do not support large-files...
testConstraint largefileSupport 0
- # some tests can only be run is umask is 2
- # if "umask" cannot be run, the tests will be skipped.
+ # some tests can only be run is umask is 2 if "umask" cannot be run, the
+ # tests will be skipped.
set umaskValue 0
testConstraint umask [expr {![catch {set umaskValue [scan [exec /bin/sh -c umask] %o]}]}]
@@ -92,6 +93,11 @@ namespace eval ::tcl::test::io {
chan close $f
return $a
}
+
+ # Wrapper round butt-ugly pipe syntax
+ proc openpipe {{mode r+} args} {
+ open "|[list [interpreter] {*}$args]" $mode
+ }
test chan-io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
# no test, need to cause an async error.
@@ -183,17 +189,17 @@ test chan-io-2.2 {WriteBytes: savedLF > 0} {
chan close $f
lappend x [contents $path(test1)]
} [list "123456789012345\r" "123456789012345\r\n12"]
-test chan-io-2.3 {WriteBytes: flush on line} {
- # Tcl "line" buffering has weird behavior: if current buffer contains
- # a \n, entire buffer gets flushed. Logical behavior would be to flush
- # only up to the \n.
+test chan-io-2.3 {WriteBytes: flush on line} -body {
+ # Tcl "line" buffering has weird behavior: if current buffer contains a
+ # \n, entire buffer gets flushed. Logical behavior would be to flush only
+ # up to the \n.
set f [open $path(test1) w]
chan configure $f -encoding binary -buffering line -translation crlf
chan puts -nonewline $f "\n12"
- set x [contents $path(test1)]
+ contents $path(test1)
+} -cleanup {
chan close $f
- set x
-} "\r\n12"
+} -result "\r\n12"
test chan-io-2.4 {WriteBytes: reset sawLF after each buffer} {
set f [open $path(test1) w]
chan configure $f -encoding binary -buffering line -translation lf \
@@ -222,17 +228,17 @@ test chan-io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} {
chan close $f
lappend x [contents $path(test1)]
} [list "123456789012345\r" "123456789012345\r\n12"]
-test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
- # Tcl "line" buffering has weird behavior: if current buffer contains
- # a \n, entire buffer gets flushed. Logical behavior would be to flush
- # only up to the \n.
+test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -body {
+ # Tcl "line" buffering has weird behavior: if current buffer contains a
+ # \n, entire buffer gets flushed. Logical behavior would be to flush only
+ # up to the \n.
set f [open $path(test1) w]
chan configure $f -encoding ascii -buffering line -translation crlf
chan puts -nonewline $f "\n12"
- set x [contents $path(test1)]
+ contents $path(test1)
+} -cleanup {
chan close $f
- set x
-} "\r\n12"
+} -result "\r\n12"
test chan-io-3.4 {WriteChars: loop over stage buffer} {
# stage buffer maps to more than can be queued at once.
set f [open $path(test1) w]
@@ -380,118 +386,118 @@ test chan-io-5.5 {CheckFlush: none} {
lappend x [contents $path(test1)]
} [list "1234567890" "1234567890"]
-test chan-io-6.1 {Tcl_GetsObj: working} {
+test chan-io-6.1 {Tcl_GetsObj: working} -body {
set f [open $path(test1) w]
chan puts $f "foo\nboo"
chan close $f
set f [open $path(test1)]
- set x [chan gets $f]
+ chan gets $f
+} -cleanup {
chan close $f
- set x
-} {foo}
+} -result {foo}
test chan-io-6.2 {Tcl_GetsObj: CheckChannelErrors() != 0} emptyTest {
# no test, need to cause an async error.
} {}
-test chan-io-6.3 {Tcl_GetsObj: how many have we used?} {
+test chan-io-6.3 {Tcl_GetsObj: how many have we used?} -body {
# if (bufPtr != NULL) {oldRemoved = bufPtr->nextRemoved}
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts $f "abc\ndefg"
chan close $f
set f [open $path(test1)]
- set x [list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line]
+ list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {0 3 5 4 defg}
-test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} {
+} -result {0 3 5 4 defg}
+test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body {
set f [open $path(test1) w]
chan configure $f -translation binary
chan puts $f "\x81\u1234\0"
chan close $f
set f [open $path(test1)]
chan configure $f -translation binary
- set x [list [chan gets $f line] $line]
+ list [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 3 "\x81\x34\x00"]
-test chan-io-6.5 {Tcl_GetsObj: encoding != NULL} {
+} -result [list 3 "\x81\x34\x00"]
+test chan-io-6.5 {Tcl_GetsObj: encoding != NULL} -body {
set f [open $path(test1) w]
chan configure $f -translation binary
chan puts $f "\x88\xea\x92\x9a"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis
- set x [list [chan gets $f line] $line]
+ list [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 2 "\u4e00\u4e01"]
+} -result [list 2 "\u4e00\u4e01"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
-test chan-io-6.6 {Tcl_GetsObj: loop test} {
+test chan-io-6.6 {Tcl_GetsObj: loop test} -body {
# if (dst >= dstEnd)
set f [open $path(test1) w]
chan puts $f $a
chan puts $f hi
chan close $f
set f [open $path(test1)]
- set x [list [chan gets $f line] $line]
+ list [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 256 $a]
-test chan-io-6.7 {Tcl_GetsObj: error in input} {stdio openpipe} {
+} -result [list 256 $a]
+test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints {stdio openpipe} -body {
# if (FilterInputBytes(chanPtr, &gs) != 0)
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan puts -nonewline $f "hi\nwould"
chan flush $f
chan gets $f
chan configure $f -blocking 0
- set x [chan gets $f line]
+ chan gets $f line
+} -cleanup {
chan close $f
- set x
-} {-1}
-test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} {
+} -result {-1}
+test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} -body {
set f [open $path(test1) w]
chan puts $f "abcdef\x1aghijk\nwombat"
chan close $f
set f [open $path(test1)]
chan configure $f -eofchar \x1a
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {6 abcdef -1 {}}
-test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} {
+} -result {6 abcdef -1 {}}
+test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} -body {
set f [open $path(test1) w]
chan puts $f "abcdefghijk\nwom\u001abat"
chan close $f
set f [open $path(test1)]
chan configure $f -eofchar \x1a
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {11 abcdefghijk 3 wom}
+} -result {11 abcdefghijk 3 wom}
# Comprehensive tests
-test chan-io-6.10 {Tcl_GetsObj: lf mode: no chars} {
+test chan-io-6.10 {Tcl_GetsObj: lf mode: no chars} -body {
set f [open $path(test1) w]
chan close $f
set f [open $path(test1)]
chan configure $f -translation lf
- set x [list [chan gets $f line] $line]
+ list [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {-1 {}}
-test chan-io-6.11 {Tcl_GetsObj: lf mode: lone \n} {
+} -result {-1 {}}
+test chan-io-6.11 {Tcl_GetsObj: lf mode: lone \n} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\n"
chan close $f
set f [open $path(test1)]
chan configure $f -translation lf
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {0 {} -1 {}}
-test chan-io-6.12 {Tcl_GetsObj: lf mode: lone \r} {
+} -result {0 {} -1 {}}
+test chan-io-6.12 {Tcl_GetsObj: lf mode: lone \r} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\r"
@@ -499,193 +505,194 @@ test chan-io-6.12 {Tcl_GetsObj: lf mode: lone \r} {
set f [open $path(test1)]
chan configure $f -translation lf
set x [list [chan gets $f line] $line [chan gets $f line] $line]
+} -cleanup {
chan close $f
- set x
-} [list 1 "\r" -1 ""]
-test chan-io-6.13 {Tcl_GetsObj: lf mode: 1 char} {
+} -result [list 1 "\r" -1 ""]
+test chan-io-6.13 {Tcl_GetsObj: lf mode: 1 char} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f a
chan close $f
set f [open $path(test1)]
chan configure $f -translation lf
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {1 a -1 {}}
-test chan-io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} {
+} -result {1 a -1 {}}
+test chan-io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "a\n"
chan close $f
set f [open $path(test1)]
chan configure $f -translation lf
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {1 a -1 {}}
-test chan-io-6.15 {Tcl_GetsObj: lf mode: several chars} {
+} -result {1 a -1 {}}
+test chan-io-6.15 {Tcl_GetsObj: lf mode: several chars} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
chan close $f
set f [open $path(test1)]
chan configure $f -translation lf
- set x [list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line \
+ [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""]
-test chan-io-6.16 {Tcl_GetsObj: cr mode: no chars} {
+} -result [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""]
+test chan-io-6.16 {Tcl_GetsObj: cr mode: no chars} -body {
set f [open $path(test1) w]
chan close $f
set f [open $path(test1)]
chan configure $f -translation cr
- set x [list [chan gets $f line] $line]
+ list [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {-1 {}}
-test chan-io-6.17 {Tcl_GetsObj: cr mode: lone \n} {
+} -result {-1 {}}
+test chan-io-6.17 {Tcl_GetsObj: cr mode: lone \n} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\n"
chan close $f
set f [open $path(test1)]
chan configure $f -translation cr
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 1 "\n" -1 ""]
-test chan-io-6.18 {Tcl_GetsObj: cr mode: lone \r} {
+} -result [list 1 "\n" -1 ""]
+test chan-io-6.18 {Tcl_GetsObj: cr mode: lone \r} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\r"
chan close $f
set f [open $path(test1)]
chan configure $f -translation cr
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {0 {} -1 {}}
-test chan-io-6.19 {Tcl_GetsObj: cr mode: 1 char} {
+} -result {0 {} -1 {}}
+test chan-io-6.19 {Tcl_GetsObj: cr mode: 1 char} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f a
chan close $f
set f [open $path(test1)]
chan configure $f -translation cr
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {1 a -1 {}}
-test chan-io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} {
+} -result {1 a -1 {}}
+test chan-io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "a\r"
chan close $f
set f [open $path(test1)]
chan configure $f -translation cr
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {1 a -1 {}}
-test chan-io-6.21 {Tcl_GetsObj: cr mode: several chars} {
+} -result {1 a -1 {}}
+test chan-io-6.21 {Tcl_GetsObj: cr mode: several chars} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
chan close $f
set f [open $path(test1)]
chan configure $f -translation cr
- set x [list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""]
-test chan-io-6.22 {Tcl_GetsObj: crlf mode: no chars} {
+} -result [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""]
+test chan-io-6.22 {Tcl_GetsObj: crlf mode: no chars} -body {
set f [open $path(test1) w]
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf
- set x [list [chan gets $f line] $line]
+ list [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {-1 {}}
-test chan-io-6.23 {Tcl_GetsObj: crlf mode: lone \n} {
+} -result {-1 {}}
+test chan-io-6.23 {Tcl_GetsObj: crlf mode: lone \n} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\n"
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 1 "\n" -1 ""]
-test chan-io-6.24 {Tcl_GetsObj: crlf mode: lone \r} {
+} -result [list 1 "\n" -1 ""]
+test chan-io-6.24 {Tcl_GetsObj: crlf mode: lone \r} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\r"
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 1 "\r" -1 ""]
-test chan-io-6.25 {Tcl_GetsObj: crlf mode: \r\r} {
+} -result [list 1 "\r" -1 ""]
+test chan-io-6.25 {Tcl_GetsObj: crlf mode: \r\r} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\r\r"
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 2 "\r\r" -1 ""]
-test chan-io-6.26 {Tcl_GetsObj: crlf mode: \r\n} {
+} -result [list 2 "\r\r" -1 ""]
+test chan-io-6.26 {Tcl_GetsObj: crlf mode: \r\n} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\r\n"
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 0 "" -1 ""]
-test chan-io-6.27 {Tcl_GetsObj: crlf mode: 1 char} {
+} -result {0 {} -1 {}}
+test chan-io-6.27 {Tcl_GetsObj: crlf mode: 1 char} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f a
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {1 a -1 {}}
-test chan-io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} {
+} -result {1 a -1 {}}
+test chan-io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "a\r\n"
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {1 a -1 {}}
-test chan-io-6.29 {Tcl_GetsObj: crlf mode: several chars} {
+} -result {1 a -1 {}}
+test chan-io-6.29 {Tcl_GetsObj: crlf mode: several chars} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf
- set x [list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""]
-test chan-io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} {
+} -result [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""]
+test chan-io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} -constraints {testchannel} -body {
# if (eol >= dstEnd)
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -693,23 +700,26 @@ test chan-io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} {
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf -buffersize 16
- set x [list [chan gets $f line] $line [testchannel inputbuffered $f]]
+ list [chan gets $f line] $line [testchannel inputbuffered $f]
+} -cleanup {
chan close $f
- set x
-} [list 15 "123456789012345" 15]
-test chan-io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel openpipe fileevent} {
+} -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 {
# (FilterInputBytes() != 0)
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan configure $f -translation {crlf lf} -buffering none
chan puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r"
chan configure $f -buffersize 16
- set x [chan gets $f]
+ lappend x [chan gets $f]
chan configure $f -blocking 0
- lappend x [chan gets $f line] $line [chan blocked $f] [testchannel inputbuffered $f]
+ lappend x [chan gets $f line] $line [chan blocked $f] \
+ [testchannel inputbuffered $f]
+} -cleanup {
chan close $f
- set x
-} [list "bbbbbbbbbbbbbb" -1 "" 1 16]
-test chan-io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel} {
+} -result {bbbbbbbbbbbbbb -1 {} 1 16}
+test chan-io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} -constraints {testchannel} -body {
# not (FilterInputBytes() != 0)
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -717,11 +727,11 @@ test chan-io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testcha
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf -buffersize 16
- set x [list [chan gets $f line] $line [chan tell $f] [testchannel inputbuffered $f]]
+ list [chan gets $f line] $line [chan tell $f] [testchannel inputbuffered $f]
+} -cleanup {
chan close $f
- set x
-} [list 15 "123456789012345" 17 3]
-test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
+} -result {15 123456789012345 17 3}
+test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} -body {
# eol still equals dstEnd
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -729,11 +739,11 @@ test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf -buffersize 16
- set x [list [chan gets $f line] $line [chan eof $f]]
+ list [chan gets $f line] $line [chan eof $f]
+} -cleanup {
chan close $f
- set x
-} [list 16 "123456789012345\r" 1]
-test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
+} -result [list 16 "123456789012345\r" 1]
+test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} -body {
# not (*eol == '\n')
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -741,161 +751,171 @@ test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n}
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf -buffersize 16
- set x [list [chan gets $f line] $line [chan tell $f]]
+ list [chan gets $f line] $line [chan tell $f]
+} -cleanup {
chan close $f
- set x
-} [list 20 "123456789012345\rabcd" 22]
-test chan-io-6.35 {Tcl_GetsObj: auto mode: no chars} {
+} -result [list 20 "123456789012345\rabcd" 22]
+test chan-io-6.35 {Tcl_GetsObj: auto mode: no chars} -body {
set f [open $path(test1) w]
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto
- set x [list [chan gets $f line] $line]
+ list [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {-1 {}}
-test chan-io-6.36 {Tcl_GetsObj: auto mode: lone \n} {
+} -result {-1 {}}
+test chan-io-6.36 {Tcl_GetsObj: auto mode: lone \n} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\n"
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 0 "" -1 ""]
-test chan-io-6.37 {Tcl_GetsObj: auto mode: lone \r} {
+} -result {0 {} -1 {}}
+test chan-io-6.37 {Tcl_GetsObj: auto mode: lone \r} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\r"
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 0 "" -1 ""]
-test chan-io-6.38 {Tcl_GetsObj: auto mode: \r\r} {
+} -result {0 {} -1 {}}
+test chan-io-6.38 {Tcl_GetsObj: auto mode: \r\r} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\r\r"
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto
- set x [list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 0 "" 0 "" -1 ""]
-test chan-io-6.39 {Tcl_GetsObj: auto mode: \r\n} {
+} -result {0 {} 0 {} -1 {}}
+test chan-io-6.39 {Tcl_GetsObj: auto mode: \r\n} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\r\n"
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 0 "" -1 ""]
-test chan-io-6.40 {Tcl_GetsObj: auto mode: 1 char} {
+} -result {0 {} -1 {}}
+test chan-io-6.40 {Tcl_GetsObj: auto mode: 1 char} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f a
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {1 a -1 {}}
-test chan-io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} {
+} -result {1 a -1 {}}
+test chan-io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "a\r\n"
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {1 a -1 {}}
-test chan-io-6.42 {Tcl_GetsObj: auto mode: several chars} {
+} -result {1 a -1 {}}
+test chan-io-6.42 {Tcl_GetsObj: auto mode: several chars} -setup {
+ set x ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto
- set x [list [chan gets $f line] $line [chan gets $f line] $line]
+ lappend x [chan gets $f line] $line [chan gets $f line] $line
lappend x [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""]
-test chan-io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent} {
+} -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 {
# if (chanPtr->flags & INPUT_SAW_CR)
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
chan configure $f -buffersize 16
- set x [list [chan gets $f]]
+ lappend x [chan gets $f]
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "\nabcd\refg\x1a"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
lappend x [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
-test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
+} -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 {
# not (*eol == '\n')
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
chan configure $f -buffersize 16
- set x [list [chan gets $f]]
+ lappend x [chan gets $f]
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "abcd\refg\x1a"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
lappend x [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
-test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel openpipe fileevent} {
+} -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 {
# Tcl_ExternalToUtf()
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
chan configure $f -encoding unicode
chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
chan configure $f -buffersize 16
chan gets $f
chan configure $f -blocking 0
- set x [list [chan gets $f line] $line [testchannel queuedcr $f]]
+ lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "\nabcd\refg"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
chan close $f
- set x
-} [list 15 "123456789abcdef" 1 4 "abcd" 0]
-test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel openpipe fileevent} {
+} -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 {
# memmove()
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
chan configure $f -buffersize 16
chan gets $f
chan configure $f -blocking 0
- set x [list [chan gets $f line] $line [testchannel queuedcr $f]]
+ lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "\n\x1a"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
chan close $f
- set x
-} [list 15 "123456789abcdef" 1 -1 "" 0]
-test chan-io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testchannel} {
+} -result {15 123456789abcdef 1 -1 {} 0}
+test chan-io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} -constraints {testchannel} -body {
# (eol == dstEnd)
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -903,11 +923,11 @@ test chan-io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {te
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto -buffersize 16
- set x [list [chan gets $f] [testchannel inputbuffered $f]]
+ list [chan gets $f] [testchannel inputbuffered $f]
+} -cleanup {
chan close $f
- set x
-} [list "123456789012345" 15]
-test chan-io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} {
+} -result {123456789012345 15}
+test chan-io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} -constraints {testchannel} -body {
# PeekAhead() did not get any, so (eol >= dstEnd)
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -915,44 +935,44 @@ test chan-io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto -buffersize 16
- set x [list [chan gets $f] [testchannel queuedcr $f]]
+ list [chan gets $f] [testchannel queuedcr $f]
+} -cleanup {
chan close $f
- set x
-} [list "123456789012345" 1]
-test chan-io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
+} -result {123456789012345 1}
+test chan-io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} -constraints {testchannel} -body {
# if (*eol == '\n') {skip++}
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "123456\r\n78901"
chan close $f
set f [open $path(test1)]
- set x [list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]]
+ list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
+} -cleanup {
chan close $f
- set x
-} [list "123456" 0 8 "78901"]
-test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
+} -result {123456 0 8 78901}
+test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} -constraints {testchannel} -body {
# not (*eol == '\n')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "123456\r78901"
chan close $f
set f [open $path(test1)]
- set x [list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]]
+ list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
+} -cleanup {
chan close $f
- set x
-} [list "123456" 0 7 "78901"]
-test chan-io-6.51 {Tcl_GetsObj: auto mode: \n} {
+} -result {123456 0 7 78901}
+test chan-io-6.51 {Tcl_GetsObj: auto mode: \n} -body {
# else if (*eol == '\n') {goto gotoeol;}
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "123456\n78901"
chan close $f
set f [open $path(test1)]
- set x [list [chan gets $f] [chan tell $f] [chan gets $f]]
+ list [chan gets $f] [chan tell $f] [chan gets $f]
+} -cleanup {
chan close $f
- set x
-} [list "123456" 7 "78901"]
-test chan-io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} {
+} -result {123456 7 78901}
+test chan-io-6.52 {Tcl_GetsObj: saw EOF character} -constraints {testchannel} -body {
# if (eof != NULL)
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -960,30 +980,30 @@ test chan-io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} {
chan close $f
set f [open $path(test1)]
chan configure $f -eofchar \x1a
- set x [list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]]
+ list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
+} -cleanup {
chan close $f
- set x
-} [list "123456" 0 6 ""]
-test chan-io-6.53 {Tcl_GetsObj: device EOF} {
+} -result {123456 0 6 {}}
+test chan-io-6.53 {Tcl_GetsObj: device EOF} -body {
# didn't produce any bytes
set f [open $path(test1) w]
chan close $f
set f [open $path(test1)]
- set x [list [chan gets $f line] $line [chan eof $f]]
+ list [chan gets $f line] $line [chan eof $f]
+} -cleanup {
chan close $f
- set x
-} {-1 {} 1}
-test chan-io-6.54 {Tcl_GetsObj: device EOF} {
+} -result {-1 {} 1}
+test chan-io-6.54 {Tcl_GetsObj: device EOF} -body {
# got some bytes before EOF.
set f [open $path(test1) w]
chan puts -nonewline $f abc
chan close $f
set f [open $path(test1)]
- set x [list [chan gets $f line] $line [chan eof $f]]
+ list [chan gets $f line] $line [chan eof $f]
+} -cleanup {
chan close $f
- set x
-} {3 abc 1}
-test chan-io-6.55 {Tcl_GetsObj: overconverted} {
+} -result {3 abc 1}
+test chan-io-6.55 {Tcl_GetsObj: overconverted} -body {
# Tcl_ExternalToUtf(), make sure state updated
set f [open $path(test1) w]
chan configure $f -encoding iso2022-jp
@@ -991,32 +1011,40 @@ test chan-io-6.55 {Tcl_GetsObj: overconverted} {
chan close $f
set f [open $path(test1)]
chan configure $f -encoding iso2022-jp
- set x [list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line]
+ list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
-test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio openpipe fileevent} {
+} -result [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
+test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup {
update
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ variable x {}
+} -constraints {stdio openpipe fileevent} -body {
+ set f [openpipe w+ $path(cat)]
chan configure $f -buffering none
chan puts -nonewline $f "foobar"
chan configure $f -blocking 0
- variable x {}
- after 500 [namespace code { lappend x timeout }]
- chan event $f readable [namespace code { lappend x [chan gets $f] }]
+ after 500 [namespace code {
+ lappend x timeout
+ }]
+ chan event $f readable [namespace code {
+ lappend x [chan gets $f]
+ }]
vwait [namespace which -variable x]
vwait [namespace which -variable x]
chan configure $f -blocking 1
chan puts -nonewline $f "baz\n"
- after 500 [namespace code { lappend x timeout }]
+ after 500 [namespace code {
+ lappend x timeout
+ }]
chan configure $f -blocking 0
vwait [namespace which -variable x]
vwait [namespace which -variable x]
+ return $x
+} -cleanup {
chan close $f
- set x
-} {{} timeout foobarbaz timeout}
+} -result {{} timeout foobarbaz timeout}
-test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} {
+test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} -body {
# (result == TCL_CONVERT_MULTIBYTE)
set f [open $path(test1) w]
chan configure $f -encoding shiftjis
@@ -1024,11 +1052,11 @@ test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} {
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis -buffersize 16
- set x [chan gets $f]
+ chan gets $f
+} -cleanup {
chan close $f
- set x
-} "1234567890123\uff10\uff11\uff12\uff13\uff14"
-test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} {
+} -result "1234567890123\uff10\uff11\uff12\uff13\uff14"
+test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} -body {
# (bufPtr->nextAdded < bufPtr->bufLength)
set f [open $path(test1) w]
chan configure $f -encoding binary
@@ -1036,44 +1064,46 @@ test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} {
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis
- set x [list [chan gets $f line] $line [chan eof $f]]
+ list [chan gets $f line] $line [chan eof $f]
+} -cleanup {
chan close $f
- set x
-} [list 10 "1234567890" 0]
-test chan-io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
+} -result {10 1234567890 0}
+test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
+ set x ""
+} -constraints {testchannel} -body {
set f [open $path(test1) w]
chan configure $f -encoding binary
chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis
- set x [list [chan gets $f line] $line]
+ lappend x [chan gets $f line] $line
lappend x [chan tell $f] [testchannel inputbuffered $f] [chan eof $f]
lappend x [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
-test chan-io-7.4 {FilterInputBytes: recover from split up character} {stdio openpipe fileevent} {
- set f [open "|[list [interpreter] $path(cat)]" w+]
+} -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 {
+ set f [openpipe w+ $path(cat)]
chan configure $f -encoding binary -buffering none
chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
chan configure $f -encoding shiftjis -blocking 0
- chan event $f read [namespace code "ready $f"]
- variable x {}
- proc ready {f} {
- variable x
+ chan event $f read [namespace code {
lappend x [chan gets $f line] $line [chan blocked $f]
- }
+ }]
vwait [namespace which -variable x]
chan configure $f -encoding binary -blocking 1
chan puts $f "\x51\x82\x52"
chan configure $f -encoding shiftjis
vwait [namespace which -variable x]
+ return $x
+} -cleanup {
chan close $f
- set x
-} [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]
+} -result [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]
-test chan-io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} {
+test chan-io-8.1 {PeekAhead: only go to device if no more cached data} -constraints {testchannel} -body {
# (bufPtr->nextPtr == NULL)
set f [open $path(test1) w]
chan configure $f -encoding ascii -translation lf
@@ -1083,43 +1113,43 @@ test chan-io-8.1 {PeekAhead: only go to device if no more cached data} {testchan
chan configure $f -encoding ascii -translation auto -buffersize 16
# here
chan gets $f
- set x [testchannel inputbuffered $f]
+ testchannel inputbuffered $f
+} -cleanup {
chan close $f
- set x
-} "7"
-test chan-io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel openpipe fileevent} {
+} -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 {
# not (bufPtr->nextPtr == NULL)
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan configure $f -translation lf -encoding ascii -buffering none
chan puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz"
- variable x {}
- chan event $f read [namespace code "ready $f"]
- proc ready {f} {
- variable x
+ chan event $f read [namespace code {
lappend x [chan gets $f line] $line [testchannel inputbuffered $f]
- }
+ }]
chan configure $f -encoding unicode -buffersize 16 -blocking 0
vwait [namespace which -variable x]
chan configure $f -translation auto -encoding ascii -blocking 1
# here
vwait [namespace which -variable x]
+ return $x
+} -cleanup {
chan close $f
- set x
-} [list -1 "" 42 15 "123456789012345" 25]
-test chan-io-8.3 {PeekAhead: no cached data available} {stdio testchannel openpipe fileevent} {
+} -result {-1 {} 42 15 123456789012345 25}
+test chan-io-8.3 {PeekAhead: no cached data available} -constraints {stdio testchannel openpipe fileevent} -body {
# (bytesLeft == 0)
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary}
chan puts -nonewline $f "abcdefghijklmno\r"
chan flush $f
- set x [list [chan gets $f line] $line [testchannel queuedcr $f]]
+ list [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
chan close $f
- set x
-} [list 15 "abcdefghijklmno" 1]
+} -result {15 abcdefghijklmno 1}
set a "123456789012345678901234567890"
append a "123456789012345678901234567890"
append a "1234567890123456789012345678901"
-test chan-io-8.4 {PeekAhead: cached data available in this buffer} {
+test chan-io-8.4 {PeekAhead: cached data available in this buffer} -body {
# not (bytesLeft == 0)
set f [open $path(test1) w+]
chan configure $f -translation binary
@@ -1130,45 +1160,47 @@ test chan-io-8.4 {PeekAhead: cached data available in this buffer} {
# "${a}\r" was converted in one operation (because ENCODING_LINESIZE is
# 30). To check if "\n" follows, calls PeekAhead and determines that
# cached data is available in buffer w/o having to call driver.
- set x [chan gets $f]
+ chan gets $f
+} -cleanup {
chan close $f
- set x
-} $a
+} -result $a
unset a
-test chan-io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
+test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {stdio testchannel openpipe fileevent} -body {
# (bufPtr->nextAdded < bufPtr->length)
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary}
chan puts -nonewline $f "abcdefghijklmno\r"
chan flush $f
# here
- set x [list [chan gets $f line] $line [testchannel queuedcr $f]]
+ list [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
chan close $f
- set x
-} {15 abcdefghijklmno 1}
-test chan-io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
+} -result {15 abcdefghijklmno 1}
+test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel openpipe fileevent} -body {
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary} -buffersize 16
chan puts -nonewline $f "abcdefghijklmno\r"
chan flush $f
# here
- set x [list [chan gets $f line] $line [testchannel queuedcr $f]]
+ list [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
chan close $f
- set x
-} {15 abcdefghijklmno 1}
-test chan-io-8.7 {PeekAhead: cleanup} {stdio testchannel openpipe fileevent} {
+} -result {15 abcdefghijklmno 1}
+test chan-io-8.7 {PeekAhead: cleanup} -setup {
+ set x ""
+} -constraints {stdio testchannel openpipe fileevent} -body {
# Make sure bytes are removed from buffer.
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary} -buffering none
chan puts -nonewline $f "abcdefghijklmno\r"
# here
- set x [list [chan gets $f line] $line [testchannel queuedcr $f]]
+ lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan puts -nonewline $f "\x1a"
lappend x [chan gets $f line] $line
+} -cleanup {
chan close $f
- set x
-} {15 abcdefghijklmno 1 -1 {}}
+} -result {15 abcdefghijklmno 1 -1 {}}
test chan-io-9.1 {CommonGetsCleanup} emptyTest {
} {}
@@ -1176,18 +1208,18 @@ test chan-io-9.1 {CommonGetsCleanup} emptyTest {
test chan-io-10.1 {Tcl_ReadChars: CheckChannelErrors} emptyTest {
# no test, need to cause an async error.
} {}
-test chan-io-10.2 {Tcl_ReadChars: loop until enough copied} {
+test chan-io-10.2 {Tcl_ReadChars: loop until enough copied} -body {
# one time
# for (copied = 0; (unsigned) toRead > 0; )
set f [open $path(test1) w]
chan puts $f abcdefghijklmnop
chan close $f
set f [open $path(test1)]
- set x [chan read $f 5]
+ chan read $f 5
+} -cleanup {
chan close $f
- set x
-} {abcde}
-test chan-io-10.3 {Tcl_ReadChars: loop until enough copied} {
+} -result {abcde}
+test chan-io-10.3 {Tcl_ReadChars: loop until enough copied} -body {
# multiple times
# for (copied = 0; (unsigned) toRead > 0; )
set f [open $path(test1) w]
@@ -1196,34 +1228,34 @@ test chan-io-10.3 {Tcl_ReadChars: loop until enough copied} {
set f [open $path(test1)]
chan configure $f -buffersize 16
# here
- set x [chan read $f 19]
+ chan read $f 19
+} -cleanup {
chan close $f
- set x
-} {abcdefghijklmnopqrs}
-test chan-io-10.4 {Tcl_ReadChars: no more in channel buffer} {
+} -result {abcdefghijklmnopqrs}
+test chan-io-10.4 {Tcl_ReadChars: no more in channel buffer} -body {
# (copiedNow < 0)
set f [open $path(test1) w]
chan puts -nonewline $f abcdefghijkl
chan close $f
set f [open $path(test1)]
# here
- set x [chan read $f 1000]
+ chan read $f 1000
+} -cleanup {
chan close $f
- set x
-} {abcdefghijkl}
-test chan-io-10.5 {Tcl_ReadChars: stop on EOF} {
+} -result {abcdefghijkl}
+test chan-io-10.5 {Tcl_ReadChars: stop on EOF} -body {
# (chanPtr->flags & CHANNEL_EOF)
set f [open $path(test1) w]
chan puts -nonewline $f abcdefghijkl
chan close $f
set f [open $path(test1)]
# here
- set x [chan read $f 1000]
+ chan read $f 1000
+} -cleanup {
chan close $f
- set x
-} {abcdefghijkl}
+} -result {abcdefghijkl}
-test chan-io-11.1 {ReadBytes: want to read a lot} {
+test chan-io-11.1 {ReadBytes: want to read a lot} -body {
# ((unsigned) toRead > (unsigned) srcLen)
set f [open $path(test1) w]
chan puts -nonewline $f abcdefghijkl
@@ -1231,11 +1263,11 @@ test chan-io-11.1 {ReadBytes: want to read a lot} {
set f [open $path(test1)]
chan configure $f -encoding binary
# here
- set x [chan read $f 1000]
+ chan read $f 1000
+} -cleanup {
chan close $f
- set x
-} {abcdefghijkl}
-test chan-io-11.2 {ReadBytes: want to read all} {
+} -result {abcdefghijkl}
+test chan-io-11.2 {ReadBytes: want to read all} -body {
# ((unsigned) toRead > (unsigned) srcLen)
set f [open $path(test1) w]
chan puts -nonewline $f abcdefghijkl
@@ -1243,11 +1275,11 @@ test chan-io-11.2 {ReadBytes: want to read all} {
set f [open $path(test1)]
chan configure $f -encoding binary
# here
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} {abcdefghijkl}
-test chan-io-11.3 {ReadBytes: allocate more space} {
+} -result {abcdefghijkl}
+test chan-io-11.3 {ReadBytes: allocate more space} -body {
# (toRead > length - offset - 1)
set f [open $path(test1) w]
chan puts -nonewline $f abcdefghijklmnopqrstuvwxyz
@@ -1255,11 +1287,11 @@ test chan-io-11.3 {ReadBytes: allocate more space} {
set f [open $path(test1)]
chan configure $f -buffersize 16 -encoding binary
# here
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} {abcdefghijklmnopqrstuvwxyz}
-test chan-io-11.4 {ReadBytes: EOF char found} {
+} -result {abcdefghijklmnopqrstuvwxyz}
+test chan-io-11.4 {ReadBytes: EOF char found} -body {
# (TranslateInputEOL() != 0)
set f [open $path(test1) w]
chan puts $f abcdefghijklmnopqrstuvwxyz
@@ -1267,34 +1299,34 @@ test chan-io-11.4 {ReadBytes: EOF char found} {
set f [open $path(test1)]
chan configure $f -eofchar m -encoding binary
# here
- set x [list [chan read $f] [chan eof $f] [chan read $f] [chan eof $f]]
+ list [chan read $f] [chan eof $f] [chan read $f] [chan eof $f]
+} -cleanup {
chan close $f
- set x
-} [list "abcdefghijkl" 1 "" 1]
+} -result {abcdefghijkl 1 {} 1}
-test chan-io-12.1 {ReadChars: want to read a lot} {
+test chan-io-12.1 {ReadChars: want to read a lot} -body {
# ((unsigned) toRead > (unsigned) srcLen)
set f [open $path(test1) w]
chan puts -nonewline $f abcdefghijkl
chan close $f
set f [open $path(test1)]
# here
- set x [chan read $f 1000]
+ chan read $f 1000
+} -cleanup {
chan close $f
- set x
-} {abcdefghijkl}
-test chan-io-12.2 {ReadChars: want to read all} {
+} -result {abcdefghijkl}
+test chan-io-12.2 {ReadChars: want to read all} -body {
# ((unsigned) toRead > (unsigned) srcLen)
set f [open $path(test1) w]
chan puts -nonewline $f abcdefghijkl
chan close $f
set f [open $path(test1)]
# here
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} {abcdefghijkl}
-test chan-io-12.3 {ReadChars: allocate more space} {
+} -result {abcdefghijkl}
+test chan-io-12.3 {ReadChars: allocate more space} -body {
# (toRead > length - offset - 1)
set f [open $path(test1) w]
chan puts -nonewline $f abcdefghijklmnopqrstuvwxyz
@@ -1302,22 +1334,21 @@ test chan-io-12.3 {ReadChars: allocate more space} {
set f [open $path(test1)]
chan configure $f -buffersize 16
# here
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} {abcdefghijklmnopqrstuvwxyz}
-test chan-io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} {
+} -result {abcdefghijklmnopqrstuvwxyz}
+test chan-io-12.4 {ReadChars: split-up char} -setup {
+ variable x {}
+} -constraints {stdio testchannel openpipe fileevent} -body {
# (srcRead == 0)
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan configure $f -encoding binary -buffering none -buffersize 16
chan puts -nonewline $f "123456789012345\x96"
chan configure $f -encoding shiftjis -blocking 0
- chan event $f read [namespace code "ready $f"]
- proc ready {f} {
- variable x
+ chan event $f read [namespace code {
lappend x [chan read $f] [testchannel inputbuffered $f]
- }
- variable x {}
+ }]
chan configure $f -encoding shiftjis
vwait [namespace which -variable x]
chan configure $f -encoding binary -blocking 1
@@ -1325,17 +1356,20 @@ test chan-io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileeve
after 500 ;# Give the cat process time to catch up
chan configure $f -encoding shiftjis -blocking 0
vwait [namespace which -variable x]
+ return $x
+} -cleanup {
chan close $f
- set x
-} [list "123456789012345" 1 "\u672c" 0]
-test chan-io-12.5 {ReadChars: chan events on partial characters} {stdio openpipe fileevent} {
+} -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 {
set path(test1) [makeFile {
chan configure stdout -encoding binary -buffering none
chan gets stdin; chan puts -nonewline "\xe7"
chan gets stdin; chan puts -nonewline "\x89"
chan gets stdin; chan puts -nonewline "\xa6"
} test1]
- set f [open "|[list [interpreter] $path(test1)]" r+]
+ set f [openpipe r+ $path(test1)]
chan event $f readable [namespace code {
lappend x [chan read $f]
if {[chan eof $f]} {
@@ -1345,7 +1379,6 @@ test chan-io-12.5 {ReadChars: chan events on partial characters} {stdio openpipe
chan puts $f "go1"
chan flush $f
chan configure $f -blocking 0 -encoding utf-8
- variable x {}
vwait [namespace which -variable x]
after 500 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
@@ -1359,32 +1392,31 @@ test chan-io-12.5 {ReadChars: chan events on partial characters} {stdio openpipe
vwait [namespace which -variable x]
vwait [namespace which -variable x]
lappend x [catch {chan close $f} msg] $msg
- set x
-} "{} timeout {} timeout \u7266 {} eof 0 {}"
+} -result "{} timeout {} timeout \u7266 {} eof 0 {}"
-test chan-io-13.1 {TranslateInputEOL: cr mode} {} {
+test chan-io-13.1 {TranslateInputEOL: cr mode} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\rdef\r"
chan close $f
set f [open $path(test1)]
chan configure $f -translation cr
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "abcd\ndef\n"
-test chan-io-13.2 {TranslateInputEOL: crlf mode} {
+} -result "abcd\ndef\n"
+test chan-io-13.2 {TranslateInputEOL: crlf mode} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\r\ndef\r\n"
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "abcd\ndef\n"
-test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
+} -result "abcd\ndef\n"
+test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} -body {
# (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -1392,11 +1424,11 @@ test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "abcd\ndef\r"
-test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
+} -result "abcd\ndef\r"
+test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} -body {
# (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -1404,11 +1436,11 @@ test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "abcd\ndef\rfgh"
-test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
+} -result "abcd\ndef\rfgh"
+test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} -body {
# (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -1416,32 +1448,32 @@ test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
chan close $f
set f [open $path(test1)]
chan configure $f -translation crlf
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "abcd\ndef\nfgh"
-test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel openpipe fileevent} {
+} -result "abcd\ndef\nfgh"
+test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup {
+ variable x {}
+ variable y {}
+} -constraints {stdio testchannel openpipe fileevent} -body {
# (chanPtr->flags & INPUT_SAW_CR)
# This test may fail on slower machines.
- set f [open "|[list [interpreter] $path(cat)]" w+]
+ set f [openpipe w+ $path(cat)]
chan configure $f -blocking 0 -buffering none -translation {auto lf}
- chan event $f read [namespace code "ready $f"]
- proc ready {f} {
- variable x
+ chan event $f read [namespace code {
lappend x [chan read $f] [testchannel queuedcr $f]
- }
- variable x {}
- variable y {}
+ }]
chan puts -nonewline $f "abcdefghj\r"
after 500 [namespace code {set y ok}]
vwait [namespace which -variable y]
chan puts -nonewline $f "\n01234"
after 500 [namespace code {set y ok}]
vwait [namespace which -variable y]
+ return $x
+} -cleanup {
chan close $f
- set x
-} [list "abcdefghj\n" 1 "01234" 0]
-test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe} {
+} -result [list "abcdefghj\n" 1 "01234" 0]
+test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} -constraints {testchannel openpipe} -body {
# (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -1449,11 +1481,11 @@ test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto
- set x [list [chan read $f] [testchannel queuedcr $f]]
+ list [chan read $f] [testchannel queuedcr $f]
+} -cleanup {
chan close $f
- set x
-} [list "abcd\n" 1]
-test chan-io-13.8 {TranslateInputEOL: auto mode: \r\n} {
+} -result [list "abcd\n" 1]
+test chan-io-13.8 {TranslateInputEOL: auto mode: \r\n} -body {
# (*src == '\n')
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -1461,22 +1493,22 @@ test chan-io-13.8 {TranslateInputEOL: auto mode: \r\n} {
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "abcd\ndef"
-test chan-io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
+} -result "abcd\ndef"
+test chan-io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\rdef"
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "abcd\ndef"
-test chan-io-13.10 {TranslateInputEOL: auto mode: \n} {
+} -result "abcd\ndef"
+test chan-io-13.10 {TranslateInputEOL: auto mode: \n} -body {
# not (*src == '\r')
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -1484,11 +1516,11 @@ test chan-io-13.10 {TranslateInputEOL: auto mode: \n} {
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "abcd\ndef"
-test chan-io-13.11 {TranslateInputEOL: EOF char} {
+} -result "abcd\ndef"
+test chan-io-13.11 {TranslateInputEOL: EOF char} -body {
# (*chanPtr->inEofChar != '\0')
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -1496,11 +1528,11 @@ test chan-io-13.11 {TranslateInputEOL: EOF char} {
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto -eofchar e
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "abcd\nd"
-test chan-io-13.12 {TranslateInputEOL: find EOF char in src} {
+} -result "abcd\nd"
+test chan-io-13.12 {TranslateInputEOL: find EOF char in src} -body {
# (*chanPtr->inEofChar != '\0')
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -1508,16 +1540,16 @@ test chan-io-13.12 {TranslateInputEOL: find EOF char in src} {
chan close $f
set f [open $path(test1)]
chan configure $f -translation auto -eofchar e
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "\n\n\nab\n\nd"
+} -result "\n\n\nab\n\nd"
# Test standard handle management. The functions tested are Tcl_SetStdChannel
# and Tcl_GetStdChannel. Incidentally we are also testing channel table
# management.
-if {[info commands testchannel] ne ""} {
+if {[testConstraint testchannel]} {
set consoleFileNames [lsort [testchannel open]]
} else {
# just to avoid an error
@@ -1525,24 +1557,24 @@ if {[info commands testchannel] ne ""} {
}
test chan-io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {testchannel} {
- set l ""
- lappend l [chan configure stdin -buffering]
- lappend l [chan configure stdout -buffering]
- lappend l [chan configure stderr -buffering]
- lappend l [lsort [testchannel open]]
- set l
+ set result ""
+ lappend result [chan configure stdin -buffering]
+ lappend result [chan configure stdout -buffering]
+ lappend result [chan configure stderr -buffering]
+ lappend result [lsort [testchannel open]]
} [list line line none $consoleFileNames]
-test chan-io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
+test chan-io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} -setup {
interp create x
- set l ""
- lappend l [x eval {chan configure stdin -buffering}]
- lappend l [x eval {chan configure stdout -buffering}]
- lappend l [x eval {chan configure stderr -buffering}]
+ set result ""
+} -body {
+ lappend result [x eval {chan configure stdin -buffering}]
+ lappend result [x eval {chan configure stdout -buffering}]
+ lappend result [x eval {chan configure stderr -buffering}]
+} -cleanup {
interp delete x
- set l
-} {line line none}
+} -result {line line none}
set path(test3) [makeFile {} test3]
-test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} {
+test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints {exec openpipe} -body {
set f [open $path(test1) w]
chan puts -nonewline $f {
chan close stdin
@@ -1564,15 +1596,15 @@ test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} {
set f [open $path(test2) r]
set f2 [open $path(test3) r]
lappend result [chan read $f] [chan read $f2]
+} -cleanup {
chan close $f
chan close $f2
- set result
-} {{
+} -result {{
out
} {err
}}
# This test relies on the fact that stdout is used before stderr.
-test chan-io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec} {
+test chan-io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints {exec} -body {
set f [open $path(test1) w]
chan puts -nonewline $f { chan close stdin
chan close stdout
@@ -1581,7 +1613,8 @@ test chan-io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec} {
chan puts $f [list open $path(test1) r]]
chan puts $f "set f2 \[[list open $path(test2) w]]"
chan puts $f "set f3 \[[list open $path(test3) w]]"
- chan puts $f { chan puts stdout [chan gets stdin]
+ chan puts $f {
+ chan puts stdout [chan gets stdin]
chan puts stdout $f2
chan puts stderr $f3
chan close $f
@@ -1593,10 +1626,10 @@ test chan-io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec} {
set f [open $path(test2) r]
set f2 [open $path(test3) r]
lappend result [chan read $f] [chan read $f2]
+} -cleanup {
chan close $f
chan close $f2
- set result
-} {{ chan close stdin
+} -result {{ chan close stdin
stdout
} {stderr
}}
@@ -1653,10 +1686,10 @@ test chan-io-14.8 {reuse of stdio special channels} -setup {
chan puts [chan gets $f]
}
chan close $f
- set f [open "|[list [interpreter] $path(script)]" r]
- set c [chan gets $f]
+ set f [openpipe r $path(script)]
+ chan gets $f
+} -cleanup {
chan close $f
- set c
} -result hello
test chan-io-14.9 {reuse of stdio special channels} -setup {
file delete $path(script)
@@ -1673,15 +1706,14 @@ test chan-io-14.9 {reuse of stdio special channels} -setup {
chan puts [chan gets $f]
}
chan close $f
- set f [open "|[list [interpreter] $path(script) [array get path]]" r]
- set c [chan gets $f]
- chan close $f
- set c
+ set f [openpipe r $path(script) [array get path]]
+ chan gets $f
} -cleanup {
+ chan close $f
# Added delay to give Windows time to stop the spawned process and clean
# up its grip on the file test1. Added delete as proper test cleanup.
# The failing tests were 18.1 and 18.2 as first re-users of file "test1".
- after 10000
+ after [expr {[testConstraint win] ? 10000 : 500}]
file delete $path(script)
file delete $path(test1)
} -result hello
@@ -1699,39 +1731,42 @@ test chan-io-16.1 {Tcl_DeleteChan CloseHandler} emptyTest {
# These functions use "eof stdin" to ensure that the standard channels are
# added to the channel table of the interpreter.
-test chan-io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
+test chan-io-17.1 {GetChannelTable, DeleteChannelTable on std handles} -setup {
+ set l ""
+} -constraints {testchannel} -body {
set l1 [testchannel refcount stdin]
chan eof stdin
interp create x
- set l ""
- lappend l [expr [testchannel refcount stdin] - $l1]
+ lappend l [expr {[testchannel refcount stdin] - $l1}]
x eval {chan eof stdin}
- lappend l [expr [testchannel refcount stdin] - $l1]
+ lappend l [expr {[testchannel refcount stdin] - $l1}]
interp delete x
- lappend l [expr [testchannel refcount stdin] - $l1]
-} {0 1 0}
-test chan-io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
+ lappend l [expr {[testchannel refcount stdin] - $l1}]
+} -result {0 1 0}
+test chan-io-17.2 {GetChannelTable, DeleteChannelTable on std handles} -setup {
+ set l ""
+} -constraints {testchannel} -body {
set l1 [testchannel refcount stdout]
chan eof stdin
interp create x
- set l ""
- lappend l [expr [testchannel refcount stdout] - $l1]
+ lappend l [expr {[testchannel refcount stdout] - $l1}]
x eval {chan eof stdout}
- lappend l [expr [testchannel refcount stdout] - $l1]
+ lappend l [expr {[testchannel refcount stdout] - $l1}]
interp delete x
- lappend l [expr [testchannel refcount stdout] - $l1]
-} {0 1 0}
-test chan-io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
+ lappend l [expr {[testchannel refcount stdout] - $l1}]
+} -result {0 1 0}
+test chan-io-17.3 {GetChannelTable, DeleteChannelTable on std handles} -setup {
+ set l ""
+} -constraints {testchannel} -body {
set l1 [testchannel refcount stderr]
chan eof stdin
interp create x
- set l ""
- lappend l [expr [testchannel refcount stderr] - $l1]
+ lappend l [expr {[testchannel refcount stderr] - $l1}]
x eval {chan eof stderr}
- lappend l [expr [testchannel refcount stderr] - $l1]
+ lappend l [expr {[testchannel refcount stderr] - $l1}]
interp delete x
- lappend l [expr [testchannel refcount stderr] - $l1]
-} {0 1 0}
+ lappend l [expr {[testchannel refcount stderr] - $l1}]
+} -result {0 1 0}
test chan-io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
file delete -force $path(test1)
@@ -1745,8 +1780,7 @@ test chan-io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
} else {
lappend l "very broken: $f found after being chan closed"
}
- string equal [string tolower $l] \
- [list 1 "can not find channel named \"$f\""]
+ string equal $l [list 1 "can not find channel named \"$f\""]
} -result 1
test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
file delete -force $path(test1)
@@ -1767,8 +1801,7 @@ test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
} else {
lappend l "very broken: $f found after being chan closed"
}
- string equal [string tolower $l] \
- [list 1 2 1 1 "can not find channel named \"$f\""]
+ string equal $l [list 1 2 1 1 "can not find channel named \"$f\""]
} -result 1
test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
file delete $path(test1)
@@ -1787,20 +1820,20 @@ test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
} else {
lappend l "very broken: $f found after being chan closed"
}
- string equal [string tolower $l] \
- [list 1 2 1 "can not find channel named \"$f\""]
+ string equal $l [list 1 2 1 "can not find channel named \"$f\""]
} -result 1
test chan-io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
chan eof stdin
} 0
-test chan-io-19.2 {testing Tcl_GetChannel, user opened handle} {
+test chan-io-19.2 {testing Tcl_GetChannel, user opened handle} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
- set x [chan eof $f]
+ chan eof $f
+} -cleanup {
chan close $f
- set x
-} 0
+} -result 0
test chan-io-19.3 {Tcl_GetChannel, channel not found} -body {
chan eof file34
} -returnCodes error -result {can not find channel named "file34"}
@@ -1816,35 +1849,36 @@ test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} -setup {
} else {
lappend l "very broken: $f found after being chan closed"
}
- string equal [string tolower $l] \
- [list 0 "can not find channel named \"$f\""]
+ string equal $l [list 0 "can not find channel named \"$f\""]
} -result 1
-test chan-io-20.1 {Tcl_CreateChannel: initial settings} {
- set a [open $path(test2) w]
+test chan-io-20.1 {Tcl_CreateChannel: initial settings} -setup {
set old [encoding system]
+} -body {
+ set a [open $path(test2) w]
encoding system ascii
set f [open $path(test1) w]
- set x [chan configure $f -encoding]
- chan close $f
+ chan configure $f -encoding
+} -cleanup {
encoding system $old
+ chan close $f
chan close $a
- set x
-} {ascii}
-test chan-io-20.2 {Tcl_CreateChannel: initial settings} {win} {
+} -result {ascii}
+test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body {
set f [open $path(test1) w+]
- set x [list [chan configure $f -eofchar] [chan configure $f -translation]]
+ list [chan configure $f -eofchar] [chan configure $f -translation]
+} -cleanup {
chan close $f
- set x
-} [list [list \x1a ""] {auto crlf}]
-test chan-io-20.3 {Tcl_CreateChannel: initial settings} {unix} {
+} -result [list [list \x1a ""] {auto crlf}]
+test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -body {
set f [open $path(test1) w+]
- set x [list [chan configure $f -eofchar] [chan configure $f -translation]]
+ list [chan configure $f -eofchar] [chan configure $f -translation]
+} -cleanup {
chan close $f
- set x
-} {{{} {}} {auto lf}}
-set path(stdout) [makeFile {} stdout]
-test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio openpipe} {
+} -result {{{} {}} {auto lf}}
+test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
+ set path(stdout) [makeFile {} stdout]
+} -constraints {stdio openpipe} -body {
set f [open $path(script) w]
chan puts -nonewline $f {
chan close stdout
@@ -1855,10 +1889,11 @@ test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio open
chan puts stderr [chan configure stdout -buffersize]
}
chan close $f
- set f [open "|[list [interpreter] $path(script)]"]
- catch {chan close $f} msg
- set msg
-} {777}
+ set f [openpipe r $path(script)]
+ chan close $f
+} -cleanup {
+ removeFile $path(stdout)
+} -returnCodes error -result {777}
test chan-io-21.1 {Chan CloseChannelsOnExit} emptyTest {
} {}
@@ -1873,99 +1908,107 @@ test chan-io-22.1 {Tcl_GetChannelMode} emptyTest {
# Not used anywhere in Tcl.
} {}
-test chan-io-23.1 {Tcl_GetChannelName} {testchannel} {
+test chan-io-23.1 {Tcl_GetChannelName} -constraints {testchannel} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
set n [testchannel name $f]
+ expr {$n eq $f ? "ok" : "$n != $f"}
+} -cleanup {
chan close $f
- string compare $n $f
-} 0
+} -result ok
-test chan-io-24.1 {Tcl_GetChannelType} {testchannel} {
+test chan-io-24.1 {Tcl_GetChannelType} -constraints {testchannel} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
- set t [testchannel type $f]
+ testchannel type $f
+} -cleanup {
chan close $f
- string compare $t file
-} 0
+} -result "file"
-test chan-io-25.1 {Tcl_GetChannelHandle, input} {testchannel} {
+test chan-io-25.1 {Tcl_GetChannelHandle, input} -setup {
+ set l ""
+} -constraints {testchannel} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
chan puts $f "1234567890\n098765432"
chan close $f
set f [open $path(test1) r]
chan gets $f
- set l ""
lappend l [testchannel inputbuffered $f]
lappend l [chan tell $f]
+} -cleanup {
chan close $f
- set l
-} {10 11}
-test chan-io-25.2 {Tcl_GetChannelHandle, output} {testchannel} {
+} -result {10 11}
+test chan-io-25.2 {Tcl_GetChannelHandle, output} -setup {
file delete $path(test1)
+ set l ""
+} -constraints {testchannel} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f hello
- set l ""
lappend l [testchannel outputbuffered $f]
lappend l [chan tell $f]
chan flush $f
lappend l [testchannel outputbuffered $f]
lappend l [chan tell $f]
+} -cleanup {
chan close $f
file delete $path(test1)
- set l
-} {6 6 0 6}
+} -result {6 6 0 6}
-test chan-io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
+test chan-io-26.1 {Tcl_GetChannelInstanceData} -body {
# "pid" command uses Tcl_GetChannelInstanceData
# Don't care what pid is (but must be a number), just want to exercise it.
- set f [open "|[list [interpreter] << exit]"]
- expr [pid $f]
+ set f [openpipe r << exit]
+ pid $f
+} -constraints {stdio openpipe} -cleanup {
chan close $f
-} {}
+} -match regexp -result {^\d+$}
# Test flushing. The functions tested here are FlushChannel.
-test chan-io-27.1 {FlushChannel, no output buffered} {
+test chan-io-27.1 {FlushChannel, no output buffered} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan flush $f
- set s [file size $path(test1)]
+ file size $path(test1)
+} -cleanup {
chan close $f
- set s
-} 0
-test chan-io-27.2 {FlushChannel, some output buffered} {
+} -result 0
+test chan-io-27.2 {FlushChannel, some output buffered} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
- set l ""
chan puts $f hello
lappend l [file size $path(test1)]
chan flush $f
lappend l [file size $path(test1)]
chan close $f
lappend l [file size $path(test1)]
- set l
-} {0 6 6}
-test chan-io-27.3 {FlushChannel, implicit flush on chan close} {
+} -result {0 6 6}
+test chan-io-27.3 {FlushChannel, implicit flush on chan close} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
- set l ""
chan puts $f hello
lappend l [file size $path(test1)]
chan close $f
lappend l [file size $path(test1)]
- set l
-} {0 6}
-test chan-io-27.4 {FlushChannel, implicit flush when buffer fills} {
+} -result {0 6}
+test chan-io-27.4 {FlushChannel, implicit flush when buffer fills} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
chan configure $f -buffersize 60
- set l ""
lappend l [file size $path(test1)]
for {set i 0} {$i < 12} {incr i} {
chan puts $f hello
@@ -1973,15 +2016,15 @@ test chan-io-27.4 {FlushChannel, implicit flush when buffer fills} {
lappend l [file size $path(test1)]
chan flush $f
lappend l [file size $path(test1)]
+} -cleanup {
chan close $f
- set l
-} {0 60 72}
-test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} \
- {unixOrPc} {
+} -result {0 60 72}
+test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} -setup {
file delete $path(test1)
+ set l ""
+} -constraints {unixOrPc} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -buffersize 60 -eofchar {}
- set l ""
lappend l [file size $path(test1)]
for {set i 0} {$i < 12} {incr i} {
chan puts $f hello
@@ -1989,14 +2032,13 @@ test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan cl
lappend l [file size $path(test1)]
chan close $f
lappend l [file size $path(test1)]
- set l
-} {0 60 72}
+} -result {0 60 72}
set path(pipe) [makeFile {} pipe]
set path(output) [makeFile {} output]
-test chan-io-27.6 {FlushChannel, async flushing, async chan close} \
- {stdio asyncPipeChan Close openpipe} {
+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 {
set f [open $path(pipe) w]
chan puts $f "set f \[[list open $path(output) w]]"
chan puts $f {
@@ -2014,7 +2056,7 @@ test chan-io-27.6 {FlushChannel, async flushing, async chan close} \
}
set f [open $path(output) w]
chan close $f
- set f [open "|[list [interpreter] $path(pipe)]" w]
+ set f [openpipe w $path(pipe)]
chan configure $f -blocking off
chan puts -nonewline $f $x
chan close $f
@@ -2028,26 +2070,28 @@ test chan-io-27.6 {FlushChannel, async flushing, async chan close} \
} else {
set result ok
}
-} ok
+} -result ok
# Tests closing a channel. The functions tested are Chan CloseChannel and
# Tcl_Chan Close.
-test chan-io-28.1 {Chan CloseChannel called when all references are dropped} {testchannel} {
+test chan-io-28.1 {Chan CloseChannel called when all references are dropped} -setup {
file delete $path(test1)
+ set l ""
+} -constraints {testchannel} -body {
set f [open $path(test1) w]
interp create x
interp share "" $f x
- set l ""
lappend l [testchannel refcount $f]
x eval chan close $f
interp delete x
lappend l [testchannel refcount $f]
+} -cleanup {
chan close $f
- set l
-} {2 1}
-test chan-io-28.2 {Chan CloseChannel called when all references are dropped} {
+} -result {2 1}
+test chan-io-28.2 {Chan CloseChannel called when all references are dropped} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
interp create x
interp share "" $f x
@@ -2057,14 +2101,14 @@ test chan-io-28.2 {Chan CloseChannel called when all references are dropped} {
x eval chan close $f
interp delete x
set f [open $path(test1) r]
- set l [chan gets $f]
+ chan gets $f
+} -cleanup {
chan close $f
- set l
-} abcdef
-test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} \
- {stdio asyncPipeChan Close nonPortable openpipe} {
+} -result abcdef
+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 {
set f [open $path(pipe) w]
chan puts $f {
# Need to not have eof char appended on chan close, because the other
@@ -2087,7 +2131,7 @@ test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} \
}
set f [open $path(output) w]
chan close $f
- set f [open "|[list [interpreter] pipe]" r+]
+ set f [openpipe r+ $path(pipe)]
chan configure $f -blocking off -eofchar {}
chan puts -nonewline $f $x
chan close $f
@@ -2101,10 +2145,11 @@ test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} \
} else {
set result ok
}
-} ok
-test chan-io-28.4 {Tcl_Chan Close} {testchannel} {
+} -result ok
+test chan-io-28.4 {Tcl_Chan Close} -constraints {testchannel} -setup {
file delete $path(test1)
set l ""
+} -body {
lappend l [lsort [testchannel open]]
set f [open $path(test1) w]
lappend l [lsort [testchannel open]]
@@ -2113,8 +2158,8 @@ test chan-io-28.4 {Tcl_Chan Close} {testchannel} {
set x [list $consoleFileNames \
[lsort [list {*}$consoleFileNames $f]] \
$consoleFileNames]
- string compare $l $x
-} 0
+ expr {$l eq $x ? "ok" : "{$l} != {$x}"}
+} -result ok
test chan-io-28.5 {Tcl_Chan Close vs standard handles} -setup {
file delete $path(script)
} -constraints {stdio unix testchannel openpipe} -body {
@@ -2124,7 +2169,7 @@ test chan-io-28.5 {Tcl_Chan Close vs standard handles} -setup {
chan puts [testchannel open]
}
chan close $f
- set f [open "|[list [interpreter] $path(script)]" r]
+ set f [openpipe r $path(script)]
set l [chan gets $f]
chan close $f
lsort $l
@@ -2132,27 +2177,28 @@ test chan-io-28.5 {Tcl_Chan Close vs standard handles} -setup {
test chan-io-28.6 {Tcl_CloseEx (half-close) pipe} -setup {
set cat [makeFile {
fconfigure stdout -buffering line
- while {[gets stdin line]>=0} {puts $line}
+ while {[gets stdin line] >= 0} {puts $line}
puts DONE
exit 0
} cat.tcl]
+ variable done
} -body {
- set ::ff [open "|[list [interpreter] $cat]" r+]
- puts $::ff Hey
- close $::ff w
- set timer [after 1000 {set ::done Failed}]
- set ::acc {}
- fileevent $::ff readable {
- if {[gets $::ff line]<0} {
- set ::done Succeeded
+ set ff [openpipe r+ $cat]
+ puts $ff Hey
+ close $ff w
+ set timer [after 1000 [namespace code {set done Failed}]]
+ set acc {}
+ fileevent $ff readable [namespace code {
+ if {[gets $ff line] < 0} {
+ set done Succeeded
} else {
- lappend ::acc $line
+ lappend acc $line
}
- }
- vwait ::done
+ }]
+ vwait [namespace which -variable done]
after cancel $timer
- close $::ff r
- list $::done $::acc
+ close $ff r
+ list $done $acc
} -cleanup {
removeFile cat.tcl
} -result {Succeeded {Hey DONE}}
@@ -2163,102 +2209,108 @@ test chan-io-28.7 {Tcl_CloseEx (half-close) socket} -setup {
puts [lindex [fconfigure $s -sockname] 2]
flush stdout
vwait ::sok
- fconfigure $::sok -buffering line
- while {[gets $::sok line]>=0} {puts $::sok $line}
- puts $::sok DONE
+ fconfigure $sok -buffering line
+ while {[gets $sok line]>=0} {puts $sok $line}
+ puts $sok DONE
exit 0
} echo.tcl]
} -body {
- set ::ff [open "|[list [interpreter] $echo]" r]
- gets $::ff port
- set ::s [socket 127.0.0.1 $port]
- puts $::s Hey
- close $::s w
- set timer [after 1000 {set ::done Failed}]
- set ::acc {}
- fileevent $::s readable {
- if {[gets $::s line]<0} {
- set ::done Succeeded
+ set ff [openpipe r $echo]
+ gets $ff port
+ set s [socket 127.0.0.1 $port]
+ puts $s Hey
+ close $s w
+ set timer [after 1000 [namespace code {set ::done Failed}]]
+ set acc {}
+ fileevent $s readable [namespace code {
+ if {[gets $s line]<0} {
+ set done Succeeded
} else {
- lappend ::acc $line
+ lappend acc $line
}
- }
- vwait ::done
+ }]
+ vwait [namespace which -variable done]
after cancel $timer
- close $::s r
- close $::ff
- list $::done $::acc
+ close $s r
+ close $ff
+ list $done $acc
} -cleanup {
removeFile echo.tcl
} -result {Succeeded {Hey DONE}}
-test chan-io-29.1 {Tcl_WriteChars, channel not writable} {
- list [catch {chan puts stdin hello} msg] $msg
-} {1 {channel "stdin" wasn't opened for writing}}
-test chan-io-29.2 {Tcl_WriteChars, empty string} {
+test chan-io-29.1 {Tcl_WriteChars, channel not writable} -body {
+ chan puts stdin hello
+} -returnCodes error -result {channel "stdin" wasn't opened for writing}
+test chan-io-29.2 {Tcl_WriteChars, empty string} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -eofchar {}
chan puts -nonewline $f ""
chan close $f
file size $path(test1)
-} 0
-test chan-io-29.3 {Tcl_WriteChars, nonempty string} {
+} -result 0
+test chan-io-29.3 {Tcl_WriteChars, nonempty string} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -eofchar {}
chan puts -nonewline $f hello
chan close $f
file size $path(test1)
-} 5
-test chan-io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {testchannel} {
+} -result 5
+test chan-io-29.4 {Tcl_WriteChars, buffering in full buffering mode} -setup {
file delete $path(test1)
+ set l ""
+} -constraints {testchannel} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -buffering full -eofchar {}
chan puts $f hello
- set l ""
lappend l [testchannel outputbuffered $f]
lappend l [file size $path(test1)]
chan flush $f
lappend l [testchannel outputbuffered $f]
lappend l [file size $path(test1)]
+} -cleanup {
chan close $f
- set l
-} {6 0 0 6}
-test chan-io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {testchannel} {
+} -result {6 0 0 6}
+test chan-io-29.5 {Tcl_WriteChars, buffering in line buffering mode} -setup {
file delete $path(test1)
+ set l ""
+} -constraints {testchannel} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -buffering line -eofchar {}
chan puts -nonewline $f hello
- set l ""
lappend l [testchannel outputbuffered $f]
lappend l [file size $path(test1)]
chan puts $f hello
lappend l [testchannel outputbuffered $f]
lappend l [file size $path(test1)]
+} -cleanup {
chan close $f
- set l
-} {5 0 0 11}
-test chan-io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {testchannel} {
+} -result {5 0 0 11}
+test chan-io-29.6 {Tcl_WriteChars, buffering in no buffering mode} -setup {
file delete $path(test1)
+ set l ""
+} -constraints {testchannel} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -buffering none -eofchar {}
chan puts -nonewline $f hello
- set l ""
lappend l [testchannel outputbuffered $f]
lappend l [file size $path(test1)]
chan puts $f hello
lappend l [testchannel outputbuffered $f]
lappend l [file size $path(test1)]
+} -cleanup {
chan close $f
- set l
-} {0 5 0 11}
-test chan-io-29.7 {Tcl_Flush, full buffering} {testchannel} {
+} -result {0 5 0 11}
+test chan-io-29.7 {Tcl_Flush, full buffering} -setup {
file delete $path(test1)
+ set l ""
+} -constraints {testchannel} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -buffering full -eofchar {}
chan puts -nonewline $f hello
- set l ""
lappend l [testchannel outputbuffered $f]
lappend l [file size $path(test1)]
chan puts $f hello
@@ -2267,15 +2319,16 @@ test chan-io-29.7 {Tcl_Flush, full buffering} {testchannel} {
chan flush $f
lappend l [testchannel outputbuffered $f]
lappend l [file size $path(test1)]
+} -cleanup {
chan close $f
- set l
-} {5 0 11 0 0 11}
-test chan-io-29.8 {Tcl_Flush, full buffering} {testchannel} {
+} -result {5 0 11 0 0 11}
+test chan-io-29.8 {Tcl_Flush, full buffering} -setup {
file delete $path(test1)
+ set l ""
+} -constraints {testchannel} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -buffering line
chan puts -nonewline $f hello
- set l ""
lappend l [testchannel outputbuffered $f]
lappend l [file size $path(test1)]
chan flush $f
@@ -2287,14 +2340,15 @@ test chan-io-29.8 {Tcl_Flush, full buffering} {testchannel} {
chan flush $f
lappend l [testchannel outputbuffered $f]
lappend l [file size $path(test1)]
+} -cleanup {
chan close $f
- set l
-} {5 0 0 5 0 11 0 11}
-test chan-io-29.9 {Tcl_Flush, channel not writable} {
- list [catch {chan flush stdin} msg] $msg
-} {1 {channel "stdin" wasn't opened for writing}}
-test chan-io-29.10 {Tcl_WriteChars, looping and buffering} {
+} -result {5 0 0 5 0 11 0 11}
+test chan-io-29.9 {Tcl_Flush, channel not writable} -body {
+ chan flush stdin
+} -returnCodes error -result {channel "stdin" wasn't opened for writing}
+test chan-io-29.10 {Tcl_WriteChars, looping and buffering} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf -eofchar {}
set f2 [open $path(longfile) r]
@@ -2304,9 +2358,10 @@ test chan-io-29.10 {Tcl_WriteChars, looping and buffering} {
chan close $f2
chan close $f1
file size $path(test1)
-} 387
-test chan-io-29.11 {Tcl_WriteChars, no newline, implicit flush} {
+} -result 387
+test chan-io-29.11 {Tcl_WriteChars, no newline, implicit flush} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -eofchar {}
set f2 [open $path(longfile) r]
@@ -2316,10 +2371,11 @@ test chan-io-29.11 {Tcl_WriteChars, no newline, implicit flush} {
chan close $f1
chan close $f2
file size $path(test1)
-} 377
-test chan-io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} {
+} -result 377
+test chan-io-29.12 {Tcl_WriteChars on a pipe} -setup {
file delete $path(test1)
file delete $path(pipe)
+} -constraints {stdio openpipe} -body {
set f1 [open $path(pipe) w]
chan puts $f1 "set f1 \[[list open $path(longfile) r]]"
chan puts $f1 {
@@ -2328,23 +2384,25 @@ test chan-io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} {
}
}
chan close $f1
- set f1 [open "|[list [interpreter] $path(pipe)]" r]
+ set f1 [openpipe r $path(pipe)]
set f2 [open $path(longfile) r]
set y ok
for {set x 0} {$x < 10} {incr x} {
set l1 [chan gets $f1]
set l2 [chan gets $f2]
- if {"$l1" != "$l2"} {
- set y broken
+ if {$l1 ne $l2} {
+ set y broken:$x
}
}
+ return $y
+} -cleanup {
chan close $f1
chan close $f2
- set y
-} ok
-test chan-io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio openpipe} {
+} -result ok
+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 {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan puts [chan gets stdin]
@@ -2352,70 +2410,74 @@ test chan-io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio openpipe} {
}
chan close $f1
set y ok
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
chan configure $f1 -buffering line
set f2 [open $path(longfile) r]
set line [chan gets $f2]
chan puts $f1 $line
set backline [chan gets $f1]
- if {"$line" != "$backline"} {
- set y broken
+ if {$line ne $backline} {
+ set y broken1
}
set line [chan gets $f2]
chan puts $f1 $line
set backline [chan gets $f1]
- if {"$line" != "$backline"} {
- set y broken
+ if {$line ne $backline} {
+ set y broken2
}
+ return $y
+} -cleanup {
chan close $f1
chan close $f2
- set y
-} ok
-test chan-io-29.14 {Tcl_WriteChars, buffering and implicit flush at chan close} {
+} -result ok
+test chan-io-29.14 {Tcl_WriteChars, buffering and implicit flush at chan close} -setup {
file delete $path(test3)
+} -body {
set f [open $path(test3) w]
chan puts -nonewline $f "Text1"
chan puts -nonewline $f " Text 2"
chan puts $f " Text 3"
chan close $f
set f [open $path(test3) r]
- set x [chan gets $f]
+ chan gets $f
+} -cleanup {
chan close $f
- set x
-} {Text1 Text 2 Text 3}
-test chan-io-29.15 {Tcl_Flush, channel not open for writing} {
+} -result {Text1 Text 2 Text 3}
+test chan-io-29.15 {Tcl_Flush, channel not open for writing} -setup {
file delete $path(test1)
set fd [open $path(test1) w]
chan close $fd
+} -body {
set fd [open $path(test1) r]
- set x [list [catch {chan flush $fd} msg] $msg]
- chan close $fd
- string compare $x \
- [list 1 "channel \"$fd\" wasn't opened for writing"]
-} 0
-test chan-io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio openpipe} {
- set fd [open "|[list [interpreter] cat longfile]" r]
- set x [list [catch {chan flush $fd} msg] $msg]
+ chan flush $fd
+} -returnCodes error -cleanup {
catch {chan close $fd}
- string compare $x \
- [list 1 "channel \"$fd\" wasn't opened for writing"]
-} 0
-test chan-io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} {
+} -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 {
+ chan flush $fd
+} -returnCodes error -cleanup {
+ catch {chan close $fd}
+} -match glob -result {channel "*" wasn't opened for writing}
+test chan-io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf
chan puts $f1 hello
chan puts $f1 hello
chan puts $f1 hello
chan flush $f1
- set x [file size $path(test1)]
+ file size $path(test1)
+} -cleanup {
chan close $f1
- set x
-} 18
-test chan-io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} {
+} -result 18
+test chan-io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} -setup {
file delete $path(test1)
set x ""
set f1 [open $path(test1) w]
+} -body {
chan configure $f1 -translation lf
chan puts $f1 hello
chan puts $f1 hello
@@ -2428,11 +2490,12 @@ test chan-io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} {
chan puts $f1 hello
chan flush $f1
lappend x [file size $path(test1)]
+} -cleanup {
chan close $f1
- set x
-} {18 24 30}
-test chan-io-29.19 {Explicit and implicit flushes} {
+} -result {18 24 30}
+test chan-io-29.19 {Explicit and implicit flushes} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf -eofchar {}
set x ""
@@ -2447,10 +2510,10 @@ test chan-io-29.19 {Explicit and implicit flushes} {
chan puts $f1 hello
chan close $f1
lappend x [file size $path(test1)]
- set x
-} {18 24 30}
-test chan-io-29.20 {Implicit flush when buffer is full} {
+} -result {18 24 30}
+test chan-io-29.20 {Implicit flush when buffer is full} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf -eofchar {}
set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
@@ -2465,24 +2528,25 @@ test chan-io-29.20 {Implicit flush when buffer is full} {
lappend z [file size $path(test1)]
chan close $f1
lappend z [file size $path(test1)]
- set z
-} {4096 12288 12600}
-test chan-io-29.21 {Tcl_Flush to pipe} {stdio openpipe} {
+} -result {4096 12288 12600}
+test chan-io-29.21 {Tcl_Flush to pipe} -setup {
file delete $path(pipe)
+} -constraints {stdio openpipe} -body {
set f1 [open $path(pipe) w]
chan puts $f1 {set x [chan read stdin 6]}
chan puts $f1 {set cnt [string length $x]}
chan puts $f1 {chan puts "read $cnt characters"}
chan close $f1
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
chan puts $f1 hello
chan flush $f1
- set x [chan gets $f1]
+ chan gets $f1
+} -cleanup {
catch {chan close $f1}
- set x
-} "read 6 characters"
-test chan-io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} {
+} -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 {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan configure stdout -buffering full
@@ -2494,18 +2558,19 @@ test chan-io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} {
chan flush stdout
}
chan close $f1
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
set x ""
lappend x [chan gets $f1]
lappend x [chan gets $f1]
chan puts $f1 hello
chan flush $f1
lappend x [chan gets $f1]
+} -cleanup {
chan close $f1
- set x
-} {hello hello bye}
-test chan-io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio openpipe} {
+} -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 {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan puts hello
@@ -2514,108 +2579,112 @@ test chan-io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio openpipe
chan puts bye
}
chan close $f1
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
set x ""
lappend x [chan gets $f1]
lappend x [chan gets $f1]
chan puts $f1 hello
chan flush $f1
lappend x [chan gets $f1]
+} -cleanup {
chan close $f1
- set x
-} {hello hello bye}
-test chan-io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} {
+} -result {hello hello bye}
+test chan-io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} -setup {
+ variable x {}
+} -body {
set f [open $path(test3) w]
chan puts $f "Line 1"
chan puts $f "Line 2"
set f2 [open $path(test3)]
- set x {}
lappend x [chan read -nonewline $f2]
chan close $f2
chan flush $f
set f2 [open $path(test3)]
lappend x [chan read -nonewline $f2]
+} -cleanup {
chan close $f2
chan close $f
- set x
-} "{} {Line 1\nLine 2}"
-test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio openpipe fileevent} {
+} -result "{} {Line 1\nLine 2}"
+test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} -setup {
file delete $path(test3)
- set f [open "|[list [interpreter] $path(cat) | [interpreter] $path(cat) > $path(test3)]" w]
+} -constraints {stdio openpipe fileevent} -body {
+ set f [openpipe w $path(cat) | [interpreter] $path(cat) > $path(test3)]
chan puts $f "Line 1"
chan puts $f "Line 2"
chan close $f
after 100
set f [open $path(test3) r]
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "Line 1\nLine 2\n"
-test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs openpipe} {
+} -result "Line 1\nLine 2\n"
+test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} -constraints {stdio unixExecs openpipe} -body {
set f [open "|[list cat -u]" r+]
chan puts $f "Line1"
chan flush $f
- set x [chan gets $f]
+ chan gets $f
+} -cleanup {
chan close $f
- set x
-} {Line1}
-test chan-io-29.27 {Tcl_Flush on chan closed pipeline} {stdio openpipe} {
+} -result {Line1}
+test chan-io-29.27 {Tcl_Flush on chan closed pipeline} -setup {
file delete $path(pipe)
set f [open $path(pipe) w]
chan puts $f {exit}
chan close $f
- set f [open "|[list [interpreter] $path(pipe)]" r+]
+} -constraints {stdio openpipe} -body {
+ set f [openpipe r+ $path(pipe)]
chan gets $f
chan puts $f output
after 50
#
- # The flush below will get a SIGPIPE. This is an expected part of
- # test and indicates that the test operates correctly. If you run
- # this test under a debugger, the signal will by intercepted unless
- # you disable the debugger's signal interception.
+ # The flush below will get a SIGPIPE. This is an expected part of the test
+ # and indicates that the test operates correctly. If you run this test
+ # under a debugger, the signal will by intercepted unless you disable the
+ # debugger's signal interception.
#
if {[catch {chan flush $f} msg]} {
set x [list 1 $msg $::errorCode]
catch {chan close $f}
+ } elseif {[catch {chan close $f} msg]} {
+ set x [list 1 $msg $::errorCode]
} else {
- if {[catch {chan close $f} msg]} {
- set x [list 1 $msg $::errorCode]
- } else {
- set x {this was supposed to fail and did not}
- }
+ set x {this was supposed to fail and did not}
}
- regsub {".*":} $x {"":} x
string tolower $x
-} {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}}
-test chan-io-29.28 {Tcl_WriteChars, lf mode} {
+} -match glob -result {1 {error flushing "*": broken pipe} {posix epipe {broken pipe}}}
+test chan-io-29.28 {Tcl_WriteChars, lf mode} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
chan puts $f hello\nthere\nand\nhere
chan flush $f
- set s [file size $path(test1)]
+ file size $path(test1)
+} -cleanup {
chan close $f
- set s
-} 21
-test chan-io-29.29 {Tcl_WriteChars, cr mode} {
+} -result 21
+test chan-io-29.29 {Tcl_WriteChars, cr mode} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar {}
chan puts $f hello\nthere\nand\nhere
chan close $f
file size $path(test1)
-} 21
-test chan-io-29.30 {Tcl_WriteChars, crlf mode} {
+} -result 21
+test chan-io-29.30 {Tcl_WriteChars, crlf mode} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar {}
chan puts $f hello\nthere\nand\nhere
chan close $f
file size $path(test1)
-} 25
-test chan-io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
+} -result 25
+test chan-io-29.31 {Tcl_WriteChars, background flush} -setup {
file delete $path(pipe)
file delete $path(output)
+} -constraints {stdio openpipe} -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}
@@ -2633,7 +2702,7 @@ test chan-io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
}
set f [open $path(output) w]
chan close $f
- set f [open "|[list [interpreter] $path(pipe)]" r+]
+ set f [openpipe r+ $path(pipe)]
chan configure $f -blocking off
chan puts -nonewline $f $x
chan close $f
@@ -2651,12 +2720,12 @@ test chan-io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
# 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 chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} \
- {stdio asyncPipeChan Close openpipe} {
+ return $result
+} -result ok
+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 {
set f [open $path(pipe) w]
chan puts $f "set f \[[list open $path(output) w]]"
chan puts $f {chan configure $f -translation lf}
@@ -2675,7 +2744,7 @@ test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} \
}
set f [open $path(output) w]
chan close $f
- set f [open "|[list [interpreter] $path(pipe)]" r+]
+ set f [openpipe r+ $path(pipe)]
chan configure $f -blocking off
chan puts -nonewline $f $x
chan close $f
@@ -2689,8 +2758,8 @@ test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} \
} else {
set result ok
}
-} ok
-test chan-io-29.33 {Tcl_Flush, implicit flush on exit} {exec} {
+} -result ok
+test chan-io-29.33 {Tcl_Flush, implicit flush on exit} -setup {
set f [open $path(script) w]
chan puts $f "set f \[[list open $path(test1) w]]"
chan puts $f {chan configure $f -translation lf
@@ -2699,13 +2768,14 @@ test chan-io-29.33 {Tcl_Flush, implicit flush on exit} {exec} {
chan puts $f strange
}
chan close $f
+} -constraints exec -body {
exec [interpreter] $path(script)
set f [open $path(test1) r]
- set r [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set r
-} "hello\nbye\nstrange\n"
-test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {socket tempNotMac fileevent} {
+} -result "hello\nbye\nstrange\n"
+test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} -setup {
variable c 0
variable x running
set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
@@ -2714,6 +2784,7 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {s
chan puts $s $l
}
}
+} -constraints {socket tempNotMac fileevent} -body {
proc accept {s a p} {
variable x
chan event $s readable [namespace code [list readit $s]]
@@ -2739,13 +2810,14 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {s
chan close $cs
chan close $ss
vwait [namespace which -variable x]
- set c
-} 2000
-test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} {socket tempNotMac fileevent} {
- # On Mac, this test screws up sockets such that subsequent tests using
- # port 2828 either cause errors or panic().
+ return $c
+} -result 2000
+test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} -setup {
catch {interp delete x}
catch {interp delete y}
+} -constraints {socket tempNotMac fileevent} -body {
+ # On Mac, this test screws up sockets such that subsequent tests using
+ # port 2828 either cause errors or panic().
interp create x
interp create y
set s [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
@@ -2777,171 +2849,182 @@ test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} {sock
y eval "chan event $c readable \{readit $c\}"
y eval [list chan close $c]
update
+} -cleanup {
chan close $s
interp delete x
interp delete y
-} ""
+} -result ""
# Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read.
-test chan-io-30.1 {Tcl_Write lf, Tcl_Read lf} {
+test chan-io-30.1 {Tcl_Write lf, Tcl_Read lf} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "hello\nthere\nand\nhere\n"
-test chan-io-30.2 {Tcl_Write lf, Tcl_Read cr} {
+} -result "hello\nthere\nand\nhere\n"
+test chan-io-30.2 {Tcl_Write lf, Tcl_Read cr} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "hello\nthere\nand\nhere\n"
-test chan-io-30.3 {Tcl_Write lf, Tcl_Read crlf} {
+} -result "hello\nthere\nand\nhere\n"
+test chan-io-30.3 {Tcl_Write lf, Tcl_Read crlf} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "hello\nthere\nand\nhere\n"
-test chan-io-30.4 {Tcl_Write cr, Tcl_Read cr} {
+} -result "hello\nthere\nand\nhere\n"
+test chan-io-30.4 {Tcl_Write cr, Tcl_Read cr} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "hello\nthere\nand\nhere\n"
-test chan-io-30.5 {Tcl_Write cr, Tcl_Read lf} {
+} -result "hello\nthere\nand\nhere\n"
+test chan-io-30.5 {Tcl_Write cr, Tcl_Read lf} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "hello\rthere\rand\rhere\r"
-test chan-io-30.6 {Tcl_Write cr, Tcl_Read crlf} {
+} -result "hello\rthere\rand\rhere\r"
+test chan-io-30.6 {Tcl_Write cr, Tcl_Read crlf} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "hello\rthere\rand\rhere\r"
-test chan-io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
+} -result "hello\rthere\rand\rhere\r"
+test chan-io-30.7 {Tcl_Write crlf, Tcl_Read crlf} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "hello\nthere\nand\nhere\n"
-test chan-io-30.8 {Tcl_Write crlf, Tcl_Read lf} {
+} -result "hello\nthere\nand\nhere\n"
+test chan-io-30.8 {Tcl_Write crlf, Tcl_Read lf} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "hello\r\nthere\r\nand\r\nhere\r\n"
-test chan-io-30.9 {Tcl_Write crlf, Tcl_Read cr} {
+} -result "hello\r\nthere\r\nand\r\nhere\r\n"
+test chan-io-30.9 {Tcl_Write crlf, Tcl_Read cr} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} "hello\n\nthere\n\nand\n\nhere\n\n"
-test chan-io-30.10 {Tcl_Write lf, Tcl_Read auto} {
+} -result "hello\n\nthere\n\nand\n\nhere\n\n"
+test chan-io-30.10 {Tcl_Write lf, Tcl_Read auto} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
- set c [chan read $f]
- set x [chan configure $f -translation]
+ list [chan read $f] [chan configure $f -translation]
+} -cleanup {
chan close $f
- list $c $x
-} {{hello
+} -result {{hello
there
and
here
} auto}
-test chan-io-30.11 {Tcl_Write cr, Tcl_Read auto} {
+test chan-io-30.11 {Tcl_Write cr, Tcl_Read auto} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
- set c [chan read $f]
- set x [chan configure $f -translation]
+ list [chan read $f] [chan configure $f -translation]
+} -cleanup {
chan close $f
- list $c $x
-} {{hello
+} -result {{hello
there
and
here
} auto}
-test chan-io-30.12 {Tcl_Write crlf, Tcl_Read auto} {
+test chan-io-30.12 {Tcl_Write crlf, Tcl_Read auto} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
- set c [chan read $f]
- set x [chan configure $f -translation]
+ list [chan read $f] [chan configure $f -translation]
+} -cleanup {
chan close $f
- list $c $x
-} {{hello
+} -result {{hello
there
and
here
} auto}
-test chan-io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
+test chan-io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
set line "123456789ABCDE" ;# 14 char plus crlf
@@ -2952,12 +3035,13 @@ test chan-io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto
- set c [chan read $f]
+ string length [chan read $f]
+} -cleanup {
chan close $f
- string length $c
-} [expr 700*15+1]
-test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
+} -result [expr 700*15+1]
+test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
set line "123456789ABCDE" ;# 14 char plus crlf
@@ -2968,60 +3052,64 @@ test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf
- set c [chan read $f]
+ string length [chan read $f]
+} -cleanup {
chan close $f
- string length $c
-} [expr 700*15+1]
-test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} {
+} -result [expr 700*15+1]
+test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f hello\nthere\nand\rhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto
- set c [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set c
-} {hello
+} -result {hello
there
and
here
}
-test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
+test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f hello\nthere\nand\rhere\n\x1a
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
- set c [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set c
-} {hello
+} -result {hello
there
and
here
}
-test chan-io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {win} {
+test chan-io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} -setup {
file delete $path(test1)
+} -constraints {win} -body {
set f [open $path(test1) w]
chan configure $f -eofchar \x1a -translation lf
chan puts $f hello\nthere\nand\rhere
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
- set c [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set c
-} {hello
+} -result {hello
there
and
here
}
-test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
+test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
set s [format "abc\ndef\n%cghi\nqrs" 26]
@@ -3037,11 +3125,12 @@ test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {abc def 0 {} 1 {} 1}
-test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
+} -result {abc def 0 {} 1 {} 1}
+test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
set s [format "abc\ndef\n%cghi\nqrs" 26]
@@ -3057,19 +3146,19 @@ test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {abc def 0 {} 1 {} 1}
-test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
+} -result {abc def 0 {} 1 {} 1}
+test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
- set s [format "abc\ndef\n%cghi\nqrs" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar {}
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3079,61 +3168,61 @@ test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} "abc def 0 \x1aghi 0 qrs 0 {} 1"
-test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
+} -result "abc def 0 \x1aghi 0 qrs 0 {} 1"
+test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
- set s [format "abc\ndef\n%cghi\nqrs" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar {}
- set l ""
set x [chan gets $f]
- lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"]
+ lappend l [string equal $x "abc\ndef\n\x1aghi\nqrs\n"]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {0 1 {} 1}
-test chan-io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
+} -result {1 1 {} 1}
+test chan-io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
- set s [format "abc\ndef\n%cghi\nqrs" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar {}
- set l ""
set x [chan gets $f]
- lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"]
+ lappend l [string equal $x "abc\ndef\n\x1aghi\nqrs\n"]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {0 1 {} 1}
-test chan-io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
+} -result {1 1 {} 1}
+test chan-io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
- set c [format abc\ndef\n%cqrs\ntuv 26]
- chan puts $f $c
+ chan puts $f [format abc\ndef\n%cqrs\ntuv 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
- set c [string length [chan read $f]]
- set e [chan eof $f]
+ list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $c $e
-} {8 1}
-test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
+} -result {8 1}
+test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
set c [format abc\ndef\n%cqrs\ntuv 26]
@@ -3141,13 +3230,13 @@ test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1a
- set c [string length [chan read $f]]
- set e [chan eof $f]
+ list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $c $e
-} {8 1}
-test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
+} -result {8 1}
+test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
set c [format abc\ndef\n%cqrs\ntuv 26]
@@ -3155,13 +3244,13 @@ test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
- set c [string length [chan read $f]]
- set e [chan eof $f]
+ list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $c $e
-} {8 1}
-test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
+} -result {8 1}
+test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
set c [format abc\ndef\n%cqrs\ntuv 26]
@@ -3169,13 +3258,13 @@ test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1a
- set c [string length [chan read $f]]
- set e [chan eof $f]
+ list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $c $e
-} {8 1}
-test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
+} -result {8 1}
+test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
set c [format abc\ndef\n%cqrs\ntuv 26]
@@ -3183,13 +3272,13 @@ test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
- set c [string length [chan read $f]]
- set e [chan eof $f]
+ list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $c $e
-} {8 1}
-test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
+} -result {8 1}
+test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
set c [format abc\ndef\n%cqrs\ntuv 26]
@@ -3197,92 +3286,97 @@ test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1a
- set c [string length [chan read $f]]
- set e [chan eof $f]
+ list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $c $e
-} {8 1}
+} -result {8 1}
-# Test end of line translations. Functions tested are Tcl_Write and Tcl_Gets.
+# Test end of line translations. Functions tested are Tcl_Write and
+# Tcl_Gets.
-test chan-io-31.1 {Tcl_Write lf, Tcl_Gets auto} {
+test chan-io-31.1 {Tcl_Write lf, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
- set l ""
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
+} -cleanup {
chan close $f
- set l
-} {hello 6 auto there 12 auto}
-test chan-io-31.2 {Tcl_Write cr, Tcl_Gets auto} {
+} -result {hello 6 auto there 12 auto}
+test chan-io-31.2 {Tcl_Write cr, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
- set l ""
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
+} -cleanup {
chan close $f
- set l
-} {hello 6 auto there 12 auto}
-test chan-io-31.3 {Tcl_Write crlf, Tcl_Gets auto} {
+} -result {hello 6 auto there 12 auto}
+test chan-io-31.3 {Tcl_Write crlf, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
- set l ""
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
+} -cleanup {
chan close $f
- set l
-} {hello 7 auto there 14 auto}
-test chan-io-31.4 {Tcl_Write lf, Tcl_Gets lf} {
+} -result {hello 7 auto there 14 auto}
+test chan-io-31.4 {Tcl_Write lf, Tcl_Gets lf} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf
- set l ""
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
+} -cleanup {
chan close $f
- set l
-} {hello 6 lf there 12 lf}
-test chan-io-31.5 {Tcl_Write lf, Tcl_Gets cr} {
+} -result {hello 6 lf there 12 lf}
+test chan-io-31.5 {Tcl_Write lf, Tcl_Gets cr} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr
- set l ""
lappend l [string length [chan gets $f]]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
@@ -3291,18 +3385,19 @@ test chan-io-31.5 {Tcl_Write lf, Tcl_Gets cr} {
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {21 21 cr 1 {} 21 cr 1}
-test chan-io-31.6 {Tcl_Write lf, Tcl_Gets crlf} {
+} -result {21 21 cr 1 {} 21 cr 1}
+test chan-io-31.6 {Tcl_Write lf, Tcl_Gets crlf} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf
- set l ""
lappend l [string length [chan gets $f]]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
@@ -3311,18 +3406,19 @@ test chan-io-31.6 {Tcl_Write lf, Tcl_Gets crlf} {
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {21 21 crlf 1 {} 21 crlf 1}
-test chan-io-31.7 {Tcl_Write cr, Tcl_Gets cr} {
+} -result {21 21 crlf 1 {} 21 crlf 1}
+test chan-io-31.7 {Tcl_Write cr, Tcl_Gets cr} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr
- set l ""
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
@@ -3331,18 +3427,19 @@ test chan-io-31.7 {Tcl_Write cr, Tcl_Gets cr} {
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {hello 6 cr 0 there 12 cr 0}
-test chan-io-31.8 {Tcl_Write cr, Tcl_Gets lf} {
+} -result {hello 6 cr 0 there 12 cr 0}
+test chan-io-31.8 {Tcl_Write cr, Tcl_Gets lf} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf
- set l ""
lappend l [string length [chan gets $f]]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
@@ -3351,18 +3448,19 @@ test chan-io-31.8 {Tcl_Write cr, Tcl_Gets lf} {
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {21 21 lf 1 {} 21 lf 1}
-test chan-io-31.9 {Tcl_Write cr, Tcl_Gets crlf} {
+} -result {21 21 lf 1 {} 21 lf 1}
+test chan-io-31.9 {Tcl_Write cr, Tcl_Gets crlf} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf
- set l ""
lappend l [string length [chan gets $f]]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
@@ -3371,18 +3469,19 @@ test chan-io-31.9 {Tcl_Write cr, Tcl_Gets crlf} {
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {21 21 crlf 1 {} 21 crlf 1}
-test chan-io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} {
+} -result {21 21 crlf 1 {} 21 crlf 1}
+test chan-io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf
- set l ""
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
@@ -3391,18 +3490,19 @@ test chan-io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} {
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {hello 7 crlf 0 there 14 crlf 0}
-test chan-io-31.11 {Tcl_Write crlf, Tcl_Gets cr} {
+} -result {hello 7 crlf 0 there 14 crlf 0}
+test chan-io-31.11 {Tcl_Write crlf, Tcl_Gets cr} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr
- set l ""
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
@@ -3411,18 +3511,19 @@ test chan-io-31.11 {Tcl_Write crlf, Tcl_Gets cr} {
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {hello 6 cr 0 6 13 cr 0}
-test chan-io-31.12 {Tcl_Write crlf, Tcl_Gets lf} {
+} -result {hello 6 cr 0 6 13 cr 0}
+test chan-io-31.12 {Tcl_Write crlf, Tcl_Gets lf} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
chan puts $f hello\nthere\nand\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf
- set l ""
lappend l [string length [chan gets $f]]
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
@@ -3431,30 +3532,32 @@ test chan-io-31.12 {Tcl_Write crlf, Tcl_Gets lf} {
lappend l [chan tell $f]
lappend l [chan configure $f -translation]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {6 7 lf 0 6 14 lf 0}
-test chan-io-31.13 {binary mode is synonym of lf mode} {
+} -result {6 7 lf 0 6 14 lf 0}
+test chan-io-31.13 {binary mode is synonym of lf mode} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation binary
- set x [chan configure $f -translation]
+ chan configure $f -translation
+} -cleanup {
chan close $f
- set x
-} lf
+} -result lf
#
# Test chan-io-9.14 has been removed because "auto" output translation mode is
# not supoprted.
#
-test chan-io-31.14 {Tcl_Write mixed, Tcl_Gets auto} {
+test chan-io-31.14 {Tcl_Write mixed, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts $f hello\nthere\rand\r\nhere
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3462,18 +3565,19 @@ test chan-io-31.14 {Tcl_Write mixed, Tcl_Gets auto} {
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {hello there and here 0 {} 1}
-test chan-io-31.15 {Tcl_Write mixed, Tcl_Gets auto} {
+} -result {hello there and here 0 {} 1}
+test chan-io-31.15 {Tcl_Write mixed, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f hello\nthere\rand\r\nhere\r
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3481,17 +3585,18 @@ test chan-io-31.15 {Tcl_Write mixed, Tcl_Gets auto} {
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {hello there and here 0 {} 1}
-test chan-io-31.16 {Tcl_Write mixed, Tcl_Gets auto} {
+} -result {hello there and here 0 {} 1}
+test chan-io-31.16 {Tcl_Write mixed, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f hello\nthere\rand\r\nhere\n
chan close $f
set f [open $path(test1) r]
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3499,18 +3604,19 @@ test chan-io-31.16 {Tcl_Write mixed, Tcl_Gets auto} {
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {hello there and here 0 {} 1}
-test chan-io-31.17 {Tcl_Write mixed, Tcl_Gets auto} {
+} -result {hello there and here 0 {} 1}
+test chan-io-31.17 {Tcl_Write mixed, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f hello\nthere\rand\r\nhere\r\n
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3518,19 +3624,19 @@ test chan-io-31.17 {Tcl_Write mixed, Tcl_Gets auto} {
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {hello there and here 0 {} 1}
-test chan-io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
+} -result {hello there and here 0 {} 1}
+test chan-io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
- set s [format "hello\nthere\nand\rhere\n\%c" 26]
- chan puts $f $s
+ chan puts $f [format "hello\nthere\nand\rhere\n\%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3538,18 +3644,19 @@ test chan-io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {hello there and here 0 {} 1}
-test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
+} -result {hello there and here 0 {} 1}
+test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -eofchar \x1a -translation lf
chan puts $f hello\nthere\nand\rhere
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3557,56 +3664,56 @@ test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {hello there and here 0 {} 1}
-test chan-io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
+} -result {hello there and here 0 {} 1}
+test chan-io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
- set s [format "abc\ndef\n%cqrs\ntuv" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a
chan configure $f -translation auto
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {abc def 0 {} 1}
-test chan-io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
+} -result {abc def 0 {} 1}
+test chan-io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
- set s [format "abc\ndef\n%cqrs\ntuv" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {abc def 0 {} 1}
-test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
+} -result {abc def 0 {} 1}
+test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
- set s [format "abc\ndef\n%cqrs\ntuv" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar {}
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3616,19 +3723,19 @@ test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
-test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
+} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
+test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar {}
- set s [format "abc\ndef\n%cqrs\ntuv" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar {}
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3638,19 +3745,19 @@ test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
-test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
+} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
+test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar {}
- set s [format "abc\ndef\n%cqrs\ntuv" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar {}
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3660,119 +3767,121 @@ test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
-test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
+} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
+test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
- set s [format "abc\ndef\n%cqrs\ntuv" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {abc def 0 {} 1}
-test chan-io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
+} -result {abc def 0 {} 1}
+test chan-io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
- set s [format "abc\ndef\n%cqrs\ntuv" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1a
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {abc def 0 {} 1}
-test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
+} -result {abc def 0 {} 1}
+test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar {}
- set s [format "abc\ndef\n%cqrs\ntuv" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {abc def 0 {} 1}
-test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
+} -result {abc def 0 {} 1}
+test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar {}
- set s [format "abc\ndef\n%cqrs\ntuv" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1a
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {abc def 0 {} 1}
-test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
+} -result {abc def 0 {} 1}
+test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar {}
- set s [format "abc\ndef\n%cqrs\ntuv" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {abc def 0 {} 1}
-test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
+} -result {abc def 0 {} 1}
+test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar {}
- set s [format "abc\ndef\n%cqrs\ntuv" 26]
- chan puts $f $s
+ chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1a
- set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {abc def 0 {} 1}
-test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
+} -result {abc def 0 {} 1}
+test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} -setup {
file delete $path(test1)
+ set c ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
set line "123456789ABCDE" ;# 14 char plus crlf
@@ -3783,15 +3892,16 @@ test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf
- set c ""
while {[chan gets $f line] >= 0} {
append c $line\n
}
chan close $f
string length $c
-} [expr 700*15+1]
-test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
+} -result [expr 700*15+1]
+test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup {
file delete $path(test1)
+ set c ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
set line "123456789ABCDE" ;# 14 char plus crlf
@@ -3802,45 +3912,41 @@ test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto
- set c ""
while {[chan gets $f line] >= 0} {
append c $line\n
}
chan close $f
string length $c
-} [expr 700*15+1]
+} -result [expr 700*15+1]
# Test Tcl_Read and buffering.
-test chan-io-32.1 {Tcl_Read, channel not readable} {
- list [catch {read stdout} msg] $msg
-} {1 {channel "stdout" wasn't opened for reading}}
+test chan-io-32.1 {Tcl_Read, channel not readable} -body {
+ read stdout
+} -returnCodes error -result {channel "stdout" wasn't opened for reading}
test chan-io-32.2 {Tcl_Read, zero byte count} {
chan read stdin 0
} ""
-test chan-io-32.3 {Tcl_Read, negative byte count} {
+test chan-io-32.3 {Tcl_Read, negative byte count} -setup {
set f [open $path(longfile) r]
- set l [list [catch {chan read $f -1} msg] $msg]
+} -body {
+ chan read $f -1
+} -returnCodes error -cleanup {
chan close $f
- set l
-} {1 {bad argument "-1": should be "nonewline"}}
-test chan-io-32.4 {Tcl_Read, positive byte count} {
+} -result {expected non-negative integer but got "-1"}
+test chan-io-32.4 {Tcl_Read, positive byte count} -body {
set f [open $path(longfile) r]
- set x [chan read $f 1024]
- set s [string length $x]
- unset x
+ string length [chan read $f 1024]
+} -cleanup {
chan close $f
- set s
-} 1024
-test chan-io-32.5 {Tcl_Read, multiple buffers} {
+} -result 1024
+test chan-io-32.5 {Tcl_Read, multiple buffers} -body {
set f [open $path(longfile) r]
chan configure $f -buffersize 100
- set x [chan read $f 1024]
- set s [string length $x]
- unset x
+ string length [chan read $f 1024]
+} -cleanup {
chan close $f
- set s
-} 1024
+} -result 1024
test chan-io-32.6 {Tcl_Read, very large read} {
set f1 [open $path(longfile) r]
set z [chan read $f1 1000000]
@@ -3849,7 +3955,7 @@ test chan-io-32.6 {Tcl_Read, very large read} {
set x ok
set z [file size $path(longfile)]
if {$z != $l} {
- set x broken
+ set x "$z != $l"
}
set x
} ok
@@ -3861,7 +3967,7 @@ test chan-io-32.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
set l [string length $z]
set x ok
if {$l != 20} {
- set x broken
+ set x "$l != 20"
}
set x
} ok
@@ -3874,7 +3980,7 @@ test chan-io-32.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
set l [string length $z]
set z [file size $path(longfile)]
if {$z != $l} {
- set x broken
+ set x "$z != $l"
}
set x
} ok
@@ -3886,121 +3992,125 @@ test chan-io-32.9 {Tcl_Read, read to end of file} {
set x ok
set z [file size $path(longfile)]
if {$z != $l} {
- set x broken
+ set x "$z != $l"
}
set x
} ok
-test chan-io-32.10 {Tcl_Read from a pipe} {stdio openpipe} {
+test chan-io-32.10 {Tcl_Read from a pipe} -setup {
file delete $path(pipe)
+} -constraints {stdio openpipe} -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan puts [chan gets stdin]}
chan close $f1
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
chan puts $f1 hello
chan flush $f1
- set x [chan read $f1]
+ chan read $f1
+} -cleanup {
chan close $f1
- set x
-} "hello\n"
-test chan-io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
+} -result "hello\n"
+test chan-io-32.11 {Tcl_Read from a pipe} -setup {
file delete $path(pipe)
+ set x ""
+} -constraints {stdio openpipe} -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan puts [chan gets stdin]}
chan puts $f1 {chan puts [chan gets stdin]}
chan close $f1
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
chan puts $f1 hello
chan flush $f1
- set x ""
lappend x [chan read $f1 6]
chan puts $f1 hello
chan flush $f1
lappend x [chan read $f1]
+} -cleanup {
chan close $f1
- set x
-} {{hello
+} -result {{hello
} {hello
}}
-test chan-io-32.12 {Tcl_Read, -nonewline} {
+test chan-io-32.12 {Tcl_Read, -nonewline} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan puts $f1 hello
chan puts $f1 bye
chan close $f1
set f1 [open $path(test1) r]
- set c [chan read -nonewline $f1]
+ chan read -nonewline $f1
+} -cleanup {
chan close $f1
- set c
-} {hello
+} -result {hello
bye}
-test chan-io-32.13 {Tcl_Read, -nonewline} {
+test chan-io-32.13 {Tcl_Read, -nonewline} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan puts $f1 hello
chan puts $f1 bye
chan close $f1
set f1 [open $path(test1) r]
set c [chan read -nonewline $f1]
- chan close $f1
list [string length $c] $c
-} {9 {hello
+} -cleanup {
+ chan close $f1
+} -result {9 {hello
bye}}
-test chan-io-32.14 {Tcl_Read, reading in small chunks} {
+test chan-io-32.14 {Tcl_Read, reading in small chunks} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan puts $f "Two lines: this one"
chan puts $f "and this one"
chan close $f
set f [open $path(test1)]
- set x [list [chan read $f 1] [chan read $f 2] [chan read $f]]
+ list [chan read $f 1] [chan read $f 2] [chan read $f]
+} -cleanup {
chan close $f
- set x
-} {T wo { lines: this one
+} -result {T wo { lines: this one
and this one
}}
-test chan-io-32.15 {Tcl_Read, asking for more input than available} {
+test chan-io-32.15 {Tcl_Read, asking for more input than available} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan puts $f "Two lines: this one"
chan puts $f "and this one"
chan close $f
set f [open $path(test1)]
- set x [chan read $f 100]
+ chan read $f 100
+} -cleanup {
chan close $f
- set x
-} {Two lines: this one
+} -result {Two lines: this one
and this one
}
-test chan-io-32.16 {Tcl_Read, read to end of file with -nonewline} {
+test chan-io-32.16 {Tcl_Read, read to end of file with -nonewline} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan puts $f "Two lines: this one"
chan puts $f "and this one"
chan close $f
set f [open $path(test1)]
- set x [chan read -nonewline $f]
+ chan read -nonewline $f
+} -cleanup {
chan close $f
- set x
-} {Two lines: this one
+} -result {Two lines: this one
and this one}
# Test Tcl_Gets.
-test chan-io-33.1 {Tcl_Gets, reading what was written} {
+test chan-io-33.1 {Tcl_Gets, reading what was written} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
- set y "first line"
- chan puts $f1 $y
+ chan puts $f1 "first line"
chan close $f1
set f1 [open $path(test1) r]
- set x [chan gets $f1]
- set z ok
- if {"$x" != "$y"} {
- set z broken
- }
+ chan gets $f1
+} -cleanup {
chan close $f1
- set z
-} ok
+} -result {first line}
test chan-io-33.2 {Tcl_Gets into variable} {
set f1 [open $path(longfile) r]
set c [chan gets $f1 x]
@@ -4012,24 +4122,22 @@ test chan-io-33.2 {Tcl_Gets into variable} {
chan close $f1
set z
} ok
-test chan-io-33.3 {Tcl_Gets from pipe} {stdio openpipe} {
+test chan-io-33.3 {Tcl_Gets from pipe} -setup {
file delete $path(pipe)
+} -constraints {stdio openpipe} -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan puts [chan gets stdin]}
chan close $f1
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
chan puts $f1 hello
chan flush $f1
- set x [chan gets $f1]
+ chan gets $f1
+} -cleanup {
chan close $f1
- set z ok
- if {"$x" != "hello"} {
- set z broken
- }
- set z
-} ok
-test chan-io-33.4 {Tcl_Gets with long line} {
+} -result hello
+test chan-io-33.4 {Tcl_Gets with long line} -setup {
file delete $path(test3)
+} -body {
set f [open $path(test3) w]
chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
@@ -4038,44 +4146,46 @@ test chan-io-33.4 {Tcl_Gets with long line} {
chan puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
chan close $f
set f [open $path(test3)]
- set x [chan gets $f]
+ chan gets $f
+} -cleanup {
chan close $f
- set x
-} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
+} -result {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test chan-io-33.5 {Tcl_Gets with long line} {
set f [open $path(test3)]
set x [chan gets $f y]
chan close $f
list $x $y
} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
-test chan-io-33.6 {Tcl_Gets and end of file} {
+test chan-io-33.6 {Tcl_Gets and end of file} -setup {
file delete $path(test3)
+ set x {}
+} -body {
set f [open $path(test3) w]
chan puts -nonewline $f "Test1\nTest2"
chan close $f
set f [open $path(test3)]
- set x {}
set y {}
lappend x [chan gets $f y] $y
set y {}
lappend x [chan gets $f y] $y
set y {}
lappend x [chan gets $f y] $y
+} -cleanup {
chan close $f
- set x
-} {5 Test1 5 Test2 -1 {}}
-test chan-io-33.7 {Tcl_Gets and bad variable} {
+} -result {5 Test1 5 Test2 -1 {}}
+test chan-io-33.7 {Tcl_Gets and bad variable} -setup {
set f [open $path(test3) w]
chan puts $f "Line 1"
chan puts $f "Line 2"
chan close $f
catch {unset x}
- set x 24
set f [open $path(test3) r]
- set result [list [catch {chan gets $f x(0)} msg] $msg]
+} -body {
+ set x 24
+ chan gets $f x(0)
+} -returnCodes error -cleanup {
chan close $f
- set result
-} {1 {can't set "x(0)": variable isn't array}}
+} -result {can't set "x(0)": variable isn't array}
test chan-io-33.8 {Tcl_Gets, exercising double buffering} {
set f [open $path(test3) w]
chan configure $f -translation lf -eofchar {}
@@ -4118,15 +4228,16 @@ test chan-io-33.10 {Tcl_Gets, exercising double buffering} {
# Test Tcl_Seek and Tcl_Tell.
-test chan-io-34.1 {Tcl_Seek to current position at start of file} {
+test chan-io-34.1 {Tcl_Seek to current position at start of file} -body {
set f1 [open $path(longfile) r]
chan seek $f1 0 current
- set c [chan tell $f1]
+ chan tell $f1
+} -cleanup {
chan close $f1
- set c
-} 0
-test chan-io-34.2 {Tcl_Seek to offset from start} {
+} -result 0
+test chan-io-34.2 {Tcl_Seek to offset from start} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf -eofchar {}
chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
@@ -4134,12 +4245,13 @@ test chan-io-34.2 {Tcl_Seek to offset from start} {
chan close $f1
set f1 [open $path(test1) r]
chan seek $f1 10 start
- set c [chan tell $f1]
+ chan tell $f1
+} -cleanup {
chan close $f1
- set c
-} 10
-test chan-io-34.3 {Tcl_Seek to end of file} {
+} -result 10
+test chan-io-34.3 {Tcl_Seek to end of file} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf -eofchar {}
chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
@@ -4147,12 +4259,13 @@ test chan-io-34.3 {Tcl_Seek to end of file} {
chan close $f1
set f1 [open $path(test1) r]
chan seek $f1 0 end
- set c [chan tell $f1]
+ chan tell $f1
+} -cleanup {
chan close $f1
- set c
-} 54
-test chan-io-34.4 {Tcl_Seek to offset from end of file} {
+} -result 54
+test chan-io-34.4 {Tcl_Seek to offset from end of file} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf -eofchar {}
chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
@@ -4160,12 +4273,13 @@ test chan-io-34.4 {Tcl_Seek to offset from end of file} {
chan close $f1
set f1 [open $path(test1) r]
chan seek $f1 -10 end
- set c [chan tell $f1]
+ chan tell $f1
+} -cleanup {
chan close $f1
- set c
-} 44
-test chan-io-34.5 {Tcl_Seek to offset from current position} {
+} -result 44
+test chan-io-34.5 {Tcl_Seek to offset from current position} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf -eofchar {}
chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
@@ -4174,12 +4288,13 @@ test chan-io-34.5 {Tcl_Seek to offset from current position} {
set f1 [open $path(test1) r]
chan seek $f1 10 current
chan seek $f1 10 current
- set c [chan tell $f1]
+ chan tell $f1
+} -cleanup {
chan close $f1
- set c
-} 20
-test chan-io-34.6 {Tcl_Seek to offset from end of file} {
+} -result 20
+test chan-io-34.6 {Tcl_Seek to offset from end of file} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf -eofchar {}
chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
@@ -4187,14 +4302,14 @@ test chan-io-34.6 {Tcl_Seek to offset from end of file} {
chan close $f1
set f1 [open $path(test1) r]
chan seek $f1 -10 end
- set c [chan tell $f1]
- set r [chan read $f1]
+ list [chan tell $f1] [chan read $f1]
+} -cleanup {
chan close $f1
- list $c $r
-} {44 {rstuvwxyz
+} -result {44 {rstuvwxyz
}}
-test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position} {
+test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf -eofchar {}
chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
@@ -4205,19 +4320,20 @@ test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position
set c1 [chan tell $f1]
set r1 [chan read $f1 5]
chan seek $f1 0 current
- set c2 [chan tell $f1]
- chan close $f1
- list $c1 $r1 $c2
-} {44 rstuv 49}
-test chan-io-34.8 {Tcl_Seek on pipes: not supported} {stdio openpipe} {
- set f1 [open "|[list [interpreter]]" r+]
- set x [list [catch {chan seek $f1 0 current} msg] $msg]
+ list $c1 $r1 [chan tell $f1]
+} -cleanup {
chan close $f1
- regsub {".*":} $x {"":} x
- string tolower $x
-} {1 {error during seek on "": invalid argument}}
-test chan-io-34.9 {Tcl_Seek, testing buffered input flushing} {
+} -result {44 rstuv 49}
+test chan-io-34.8 {Tcl_Seek on pipes: not supported} -setup {
+ set pipe [openpipe]
+} -constraints {stdio openpipe} -body {
+ chan seek $pipe 0 current
+} -returnCodes error -cleanup {
+ chan close $pipe
+} -match glob -result {error during seek on "*": invalid argument}
+test chan-io-34.9 {Tcl_Seek, testing buffered input flushing} -setup {
file delete $path(test3)
+} -body {
set f [open $path(test3) w]
chan configure $f -eofchar {}
chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
@@ -4236,9 +4352,9 @@ test chan-io-34.9 {Tcl_Seek, testing buffered input flushing} {
lappend x [chan read $f 1]
chan seek $f 1
lappend x [chan read $f 1]
+} -cleanup {
chan close $f
- set x
-} {a d a l Y {} b}
+} -result {a d a l Y {} b}
set path(test3) [makeFile {} test3]
test chan-io-34.10 {Tcl_Seek testing flushing of buffered input} {
set f [open $path(test3) w]
@@ -4282,15 +4398,17 @@ test chan-io-34.12 {Tcl_Seek testing combination of write, seek back and read} {
} {14 {xyz
123
xyzzy} zzy}
-test chan-io-34.13 {Tcl_Tell at start of file} {
+test chan-io-34.13 {Tcl_Tell at start of file} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
- set p [chan tell $f1]
+ chan tell $f1
+} -cleanup {
chan close $f1
- set p
-} 0
-test chan-io-34.14 {Tcl_Tell after seek to end of file} {
+} -result 0
+test chan-io-34.14 {Tcl_Tell after seek to end of file} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf -eofchar {}
chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
@@ -4298,12 +4416,13 @@ test chan-io-34.14 {Tcl_Tell after seek to end of file} {
chan close $f1
set f1 [open $path(test1) r]
chan seek $f1 0 end
- set c1 [chan tell $f1]
+ chan tell $f1
+} -cleanup {
chan close $f1
- set c1
-} 54
-test chan-io-34.15 {Tcl_Tell combined with seeking} {
+} -result 54
+test chan-io-34.15 {Tcl_Tell combined with seeking} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf -eofchar {}
chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
@@ -4313,18 +4432,18 @@ test chan-io-34.15 {Tcl_Tell combined with seeking} {
chan seek $f1 10 start
set c1 [chan tell $f1]
chan seek $f1 10 current
- set c2 [chan tell $f1]
+ list $c1 [chan tell $f1]
+} -cleanup {
chan close $f1
- list $c1 $c2
-} {10 20}
-test chan-io-34.16 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
- set f1 [open "|[list [interpreter]]" r+]
- set c [chan tell $f1]
+} -result {10 20}
+test chan-io-34.16 {Tcl_Tell on pipe: always -1} -constraints {stdio openpipe} -body {
+ set f1 [openpipe]
+ chan tell $f1
+} -cleanup {
chan close $f1
- set c
-} -1
+} -result -1
test chan-io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
- set f1 [open "|[list [interpreter]]" r+]
+ set f1 [openpipe]
chan puts $f1 {chan puts hello}
chan flush $f1
set c [chan tell $f1]
@@ -4332,8 +4451,9 @@ test chan-io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
chan close $f1
set c
} -1
-test chan-io-34.18 {Tcl_Tell combined with seeking and reading} {
+test chan-io-34.18 {Tcl_Tell combined with seeking and reading} -setup {
file delete $path(test2)
+} -body {
set f [open $path(test2) w]
chan configure $f -translation lf -eofchar {}
chan puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n"
@@ -4349,23 +4469,24 @@ test chan-io-34.18 {Tcl_Tell combined with seeking and reading} {
lappend x [chan tell $f]
chan seek $f 0 end
lappend x [chan tell $f]
+} -cleanup {
chan close $f
- set x
-} {0 3 2 12 30}
-test chan-io-34.19 {Tcl_Tell combined with opening in append mode} {
+} -result {0 3 2 12 30}
+test chan-io-34.19 {Tcl_Tell combined with opening in append mode} -body {
set f [open $path(test3) w]
chan configure $f -translation lf -eofchar {}
chan puts $f "abcdefghijklmnopqrstuvwxyz"
chan puts $f "abcdefghijklmnopqrstuvwxyz"
chan close $f
set f [open $path(test3) a]
- set c [chan tell $f]
+ chan tell $f
+} -cleanup {
chan close $f
- set c
-} 54
-test chan-io-34.20 {Tcl_Tell combined with writing} {
- set f [open $path(test3) w]
+} -result 54
+test chan-io-34.20 {Tcl_Tell combined with writing} -setup {
set l ""
+} -body {
+ set f [open $path(test3) w]
chan seek $f 29 start
lappend l [chan tell $f]
chan puts -nonewline $f a
@@ -4375,14 +4496,15 @@ test chan-io-34.20 {Tcl_Tell combined with writing} {
lappend l [chan tell $f]
chan seek $f 407 end
lappend l [chan tell $f]
+} -cleanup {
chan close $f
- set l
-} {29 39 40 447}
-test chan-io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} {
+} -result {29 39 40 447}
+test chan-io-34.21 {Tcl_Seek and Tcl_Tell on large files} -setup {
file delete $path(test3)
+ set l ""
+} -constraints {largefileSupport} -body {
set f [open $path(test3) w]
chan configure $f -encoding binary
- set l ""
lappend l [chan tell $f]
chan puts -nonewline $f abcdef
lappend l [chan tell $f]
@@ -4398,13 +4520,13 @@ test chan-io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} {
# truncate...
chan close [open $path(test3) w]
lappend l [file size $f]
- set l
-} {0 6 6 4294967296 4294967302 4294967302 0}
+} -result {0 6 6 4294967296 4294967302 4294967302 0}
# Test Tcl_Eof
-test chan-io-35.1 {Tcl_Eof} {
+test chan-io-35.1 {Tcl_Eof} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan puts $f hello
chan puts $f hello
@@ -4419,16 +4541,17 @@ test chan-io-35.1 {Tcl_Eof} {
chan gets $f
lappend x [chan eof $f]
lappend x [chan eof $f]
+} -cleanup {
chan close $f
- set x
-} {0 0 0 0 1 1}
-test chan-io-35.2 {Tcl_Eof with pipe} {stdio openpipe} {
+} -result {0 0 0 0 1 1}
+test chan-io-35.2 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
file delete $path(pipe)
+} -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan gets stdin}
chan puts $f1 {chan puts hello}
chan close $f1
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
chan puts $f1 hello
set x [chan eof $f1]
chan flush $f1
@@ -4437,16 +4560,17 @@ test chan-io-35.2 {Tcl_Eof with pipe} {stdio openpipe} {
lappend x [chan eof $f1]
chan gets $f1
lappend x [chan eof $f1]
+} -cleanup {
chan close $f1
- set x
-} {0 0 0 1}
-test chan-io-35.3 {Tcl_Eof with pipe} {stdio openpipe} {
+} -result {0 0 0 1}
+test chan-io-35.3 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
file delete $path(pipe)
+} -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan gets stdin}
chan puts $f1 {chan puts hello}
chan close $f1
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
chan puts $f1 hello
set x [chan eof $f1]
chan flush $f1
@@ -4459,37 +4583,39 @@ test chan-io-35.3 {Tcl_Eof with pipe} {stdio openpipe} {
lappend x [chan eof $f1]
chan gets $f1
lappend x [chan eof $f1]
+} -cleanup {
chan close $f1
- set x
-} {0 0 0 1 1 1}
-test chan-io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
+} -result {0 0 0 1 1 1}
+test chan-io-35.4 {Tcl_Eof, eof detection on nonblocking file} -setup {
file delete $path(test1)
- set f [open $path(test1) w]
- chan close $f
+ set l ""
+} -constraints {nonBlockFiles} -body {
+ chan close [open $path(test1) w]
set f [open $path(test1) r]
chan configure $f -blocking off
- set l ""
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {{} 1}
-test chan-io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio openpipe} {
+} -result {{} 1}
+test chan-io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} -setup {
file delete $path(pipe)
+ set l ""
+} -constraints {stdio openpipe} -body {
set f [open $path(pipe) w]
chan puts $f {
exit
}
chan close $f
- set f [open "|[list [interpreter] $path(pipe)]" r]
- set l ""
+ set f [openpipe r $path(pipe)]
lappend l [chan gets $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {{} 1}
-test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} {
+} -result {{} 1}
+test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar \x1a
chan puts $f abc\ndef
@@ -4497,13 +4623,13 @@ test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} {
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
- set l [string length [chan read $f]]
- set e [chan eof $f]
+ list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $s $l $e
-} {9 8 1}
-test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} {
+} -result {9 8 1}
+test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar \x1a
chan puts $f abc\ndef
@@ -4511,13 +4637,13 @@ test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} {
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1a
- set l [string length [chan read $f]]
- set e [chan eof $f]
+ list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $s $l $e
-} {9 8 1}
-test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} {
+} -result {9 8 1}
+test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar \x1a
chan puts $f abc\ndef
@@ -4525,13 +4651,13 @@ test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} {
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
- set l [string length [chan read $f]]
- set e [chan eof $f]
+ list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $s $l $e
-} {9 8 1}
-test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} {
+} -result {9 8 1}
+test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar \x1a
chan puts $f abc\ndef
@@ -4539,13 +4665,13 @@ test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} {
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1a
- set l [string length [chan read $f]]
- set e [chan eof $f]
+ list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $s $l $e
-} {9 8 1}
-test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} {
+} -result {9 8 1}
+test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar \x1a
chan puts $f abc\ndef
@@ -4553,13 +4679,13 @@ test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} {
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
- set l [string length [chan read $f]]
- set e [chan eof $f]
+ list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $s $l $e
-} {11 8 1}
-test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} {
+} -result {11 8 1}
+test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar \x1a
chan puts $f abc\ndef
@@ -4567,112 +4693,106 @@ test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} {
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1a
- set l [string length [chan read $f]]
- set e [chan eof $f]
+ list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $s $l $e
-} {11 8 1}
-test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
+} -result {11 8 1}
+test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
- set i [format abc\ndef\n%cqrs\nuvw 26]
- chan puts $f $i
+ chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
- set l [string length [chan read $f]]
- set e [chan eof $f]
+ list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $c $l $e
-} {17 8 1}
-test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
+} -result {17 8 1}
+test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
- set i [format abc\ndef\n%cqrs\nuvw 26]
- chan puts $f $i
+ chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1a
- set l [string length [chan read $f]]
- set e [chan eof $f]
+ list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $c $l $e
-} {17 8 1}
-test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
+} -result {17 8 1}
+test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar {}
- set i [format abc\ndef\n%cqrs\nuvw 26]
- chan puts $f $i
+ chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
- set l [string length [chan read $f]]
- set e [chan eof $f]
+ list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $c $l $e
-} {17 8 1}
-test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
+} -result {17 8 1}
+test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar {}
- set i [format abc\ndef\n%cqrs\nuvw 26]
- chan puts $f $i
+ chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1a
- set l [string length [chan read $f]]
- set e [chan eof $f]
+ list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $c $l $e
-} {17 8 1}
-test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
+} -result {17 8 1}
+test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar {}
- set i [format abc\ndef\n%cqrs\nuvw 26]
- chan puts $f $i
+ chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
- set l [string length [chan read $f]]
- set e [chan eof $f]
+ list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $c $l $e
-} {21 8 1}
-test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
+} -result {21 8 1}
+test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar {}
- set i [format abc\ndef\n%cqrs\nuvw 26]
- chan puts $f $i
+ chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1a
- set l [string length [chan read $f]]
- set e [chan eof $f]
+ list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
chan close $f
- list $c $l $e
-} {21 8 1}
+} -result {21 8 1}
# Test Tcl_InputBlocked
-test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} {
- set f1 [open "|[list [interpreter]]" r+]
+test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} -setup {
+ set x ""
+} -constraints {stdio openpipe} -body {
+ set f1 [openpipe]
chan puts $f1 {chan puts hello_from_pipe}
chan flush $f1
chan gets $f1
chan configure $f1 -blocking off -buffering full
chan puts $f1 {chan puts hello}
- set x ""
lappend x [chan gets $f1]
lappend x [chan blocked $f1]
chan flush $f1
@@ -4681,133 +4801,135 @@ test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} {
lappend x [chan blocked $f1]
lappend x [chan gets $f1]
lappend x [chan blocked $f1]
+} -cleanup {
chan close $f1
- set x
-} {{} 1 hello 0 {} 1}
-test chan-io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio openpipe} {
- set f1 [open "|[list [interpreter]]" r+]
+} -result {{} 1 hello 0 {} 1}
+test chan-io-36.2 {Tcl_InputBlocked on blocking pipe} -setup {
+ set x ""
+} -constraints {stdio openpipe} -body {
+ set f1 [openpipe]
chan configure $f1 -buffering line
chan puts $f1 {chan puts hello_from_pipe}
- set x ""
lappend x [chan gets $f1]
lappend x [chan blocked $f1]
chan puts $f1 {exit}
lappend x [chan gets $f1]
lappend x [chan blocked $f1]
lappend x [chan eof $f1]
+} -cleanup {
chan close $f1
- set x
-} {hello_from_pipe 0 {} 0 1}
-test chan-io-36.3 {Tcl_InputBlocked vs files, short read} {
+} -result {hello_from_pipe 0 {} 0 1}
+test chan-io-36.3 {Tcl_InputBlocked vs files, short read} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan puts $f abcdefghijklmnop
chan close $f
set f [open $path(test1) r]
- set l ""
lappend l [chan blocked $f]
lappend l [chan read $f 3]
lappend l [chan blocked $f]
lappend l [chan read -nonewline $f]
lappend l [chan blocked $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {0 abc 0 defghijklmnop 0 1}
-test chan-io-36.4 {Tcl_InputBlocked vs files, event driven read} {fileevent} {
- proc in {f} {
- variable l
- variable x
- lappend l [chan read $f 3]
- if {[chan eof $f]} {lappend l eof; chan close $f; set x done}
- }
+} -result {0 abc 0 defghijklmnop 0 1}
+test chan-io-36.4 {Tcl_InputBlocked vs files, event driven read} -setup {
file delete $path(test1)
+ set l ""
+ variable x
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan puts $f abcdefghijklmnop
chan close $f
set f [open $path(test1) r]
- set l ""
- chan event $f readable [namespace code [list in $f]]
- variable x
+ chan event $f readable [namespace code {
+ lappend l [chan read $f 3]
+ if {[chan eof $f]} {lappend l eof; chan close $f; set x done}
+ }]
vwait [namespace which -variable x]
- set l
-} {abc def ghi jkl mno {p
+ return $l
+} -result {abc def ghi jkl mno {p
} eof}
-test chan-io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles} {
+test chan-io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} -setup {
file delete $path(test1)
+ set l ""
+} -constraints {nonBlockFiles} -body {
set f [open $path(test1) w]
chan puts $f abcdefghijklmnop
chan close $f
set f [open $path(test1) r]
chan configure $f -blocking off
- set l ""
lappend l [chan blocked $f]
lappend l [chan read $f 3]
lappend l [chan blocked $f]
lappend l [chan read -nonewline $f]
lappend l [chan blocked $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} {0 abc 0 defghijklmnop 0 1}
-test chan-io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles fileevent} {
- proc in {f} {
- variable l
- variable x
- lappend l [chan read $f 3]
- if {[chan eof $f]} {lappend l eof; chan close $f; set x done}
- }
+} -result {0 abc 0 defghijklmnop 0 1}
+test chan-io-36.6 {Tcl_InputBlocked vs files, event driven read} -setup {
file delete $path(test1)
+ set l ""
+ variable x
+} -constraints {nonBlockFiles fileevent} -body {
set f [open $path(test1) w]
chan puts $f abcdefghijklmnop
chan close $f
set f [open $path(test1) r]
chan configure $f -blocking off
- set l ""
- chan event $f readable [namespace code [list in $f]]
- variable x
+ chan event $f readable [namespace code {
+ lappend l [chan read $f 3]
+ if {[chan eof $f]} {lappend l eof; chan close $f; set x done}
+ }]
vwait [namespace which -variable x]
- set l
-} {abc def ghi jkl mno {p
+ return $l
+} -result {abc def ghi jkl mno {p
} eof}
# Test Tcl_InputBuffered
-test chan-io-37.1 {Tcl_InputBuffered} {testchannel} {
+test chan-io-37.1 {Tcl_InputBuffered} -setup {
+ set l ""
+} -constraints {testchannel} -body {
set f [open $path(longfile) r]
chan configure $f -buffersize 4096
chan read $f 3
- set l ""
lappend l [testchannel inputbuffered $f]
lappend l [chan tell $f]
+} -cleanup {
chan close $f
- set l
-} {4093 3}
-test chan-io-37.2 {Tcl_InputBuffered, test input flushing on seek} {testchannel} {
+} -result {4093 3}
+test chan-io-37.2 {Tcl_InputBuffered, test input flushing on seek} -setup {
+ set l ""
+} -constraints {testchannel} -body {
set f [open $path(longfile) r]
chan configure $f -buffersize 4096
chan read $f 3
- set l ""
lappend l [testchannel inputbuffered $f]
lappend l [chan tell $f]
chan seek $f 0 current
lappend l [testchannel inputbuffered $f]
lappend l [chan tell $f]
+} -cleanup {
chan close $f
- set l
-} {4093 3 0 3}
+} -result {4093 3 0 3}
# Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize
-test chan-io-38.1 {Tcl_GetChannelBufferSize, default buffer size} {
+test chan-io-38.1 {Tcl_GetChannelBufferSize, default buffer size} -body {
set f [open $path(longfile) r]
- set s [chan configure $f -buffersize]
+ chan configure $f -buffersize
+} -cleanup {
chan close $f
- set s
-} 4096
-test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
- set f [open $path(longfile) r]
+} -result 4096
+test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} -setup {
set l ""
+} -body {
+ set f [open $path(longfile) r]
lappend l [chan configure $f -buffersize]
chan configure $f -buffersize 10000
lappend l [chan configure $f -buffersize]
@@ -4821,9 +4943,9 @@ test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
lappend l [chan configure $f -buffersize]
chan configure $f -buffersize 10000000
lappend l [chan configure $f -buffersize]
+} -cleanup {
chan close $f
- set l
-} {4096 10000 1 1 1 100000 1048576}
+} -result {4096 10000 1 1 1 100000 1048576}
test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
# This test crashes the interp if Bug #427196 is not fixed
set chan [open [info script] r]
@@ -4836,35 +4958,39 @@ test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads}
# Test Tcl_SetChannelOption, Tcl_GetChannelOption
-test chan-io-39.1 {Tcl_GetChannelOption} {
+test chan-io-39.1 {Tcl_GetChannelOption} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
- set x [chan configure $f1 -blocking]
+ chan configure $f1 -blocking
+} -cleanup {
chan close $f1
- set x
-} 1
+} -result 1
#
# Test 17.2 was removed.
#
-test chan-io-39.2 {Tcl_GetChannelOption} {
+test chan-io-39.2 {Tcl_GetChannelOption} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
- set x [chan configure $f1 -buffering]
+ chan configure $f1 -buffering
+} -cleanup {
chan close $f1
- set x
-} full
-test chan-io-39.3 {Tcl_GetChannelOption} {
+} -result full
+test chan-io-39.3 {Tcl_GetChannelOption} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -buffering line
- set x [chan configure $f1 -buffering]
+ chan configure $f1 -buffering
+} -cleanup {
chan close $f1
- set x
-} line
-test chan-io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
+} -result line
+test chan-io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} -setup {
file delete $path(test1)
- set f1 [open $path(test1) w]
set l ""
+} -body {
+ set f1 [open $path(test1) w]
lappend l [chan configure $f1 -buffering]
chan configure $f1 -buffering line
lappend l [chan configure $f1 -buffering]
@@ -4874,47 +5000,51 @@ test chan-io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
lappend l [chan configure $f1 -buffering]
chan configure $f1 -buffering full
lappend l [chan configure $f1 -buffering]
+} -cleanup {
chan close $f1
- set l
-} {full line none line full}
-test chan-io-39.5 {Tcl_GetChannelOption, invariance} {
+} -result {full line none line full}
+test chan-io-39.5 {Tcl_GetChannelOption, invariance} -setup {
file delete $path(test1)
- set f1 [open $path(test1) w]
set l ""
+} -body {
+ set f1 [open $path(test1) w]
lappend l [chan configure $f1 -buffering]
lappend l [list [catch {chan configure $f1 -buffering green} msg] $msg]
lappend l [chan configure $f1 -buffering]
+} -cleanup {
chan close $f1
- set l
-} {full {1 {bad value for -buffering: must be one of full, line, or none}} full}
-test chan-io-39.6 {Tcl_SetChannelOption, multiple options} {
+} -result {full {1 {bad value for -buffering: must be one of full, line, or none}} full}
+test chan-io-39.6 {Tcl_SetChannelOption, multiple options} -setup {
file delete $path(test1)
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf -buffering line
chan puts $f1 hello
chan puts $f1 bye
- set x [file size $path(test1)]
+ file size $path(test1)
+} -cleanup {
chan close $f1
- set x
-} 10
-test chan-io-39.7 {Tcl_SetChannelOption, buffering, translation} {
+} -result 10
+test chan-io-39.7 {Tcl_SetChannelOption, buffering, translation} -setup {
file delete $path(test1)
+ set x ""
+} -body {
set f1 [open $path(test1) w]
chan configure $f1 -translation lf
chan puts $f1 hello
chan puts $f1 bye
- set x ""
chan configure $f1 -buffering line
lappend x [file size $path(test1)]
chan puts $f1 really_bye
lappend x [file size $path(test1)]
+} -cleanup {
chan close $f1
- set x
-} {0 21}
-test chan-io-39.8 {Tcl_SetChannelOption, different buffering options} {
+} -result {0 21}
+test chan-io-39.8 {Tcl_SetChannelOption, different buffering options} -setup {
file delete $path(test1)
- set f1 [open $path(test1) w]
set l ""
+} -body {
+ set f1 [open $path(test1) w]
chan configure $f1 -translation lf -buffering none -eofchar {}
chan puts -nonewline $f1 hello
lappend l [file size $path(test1)]
@@ -4929,14 +5059,14 @@ test chan-io-39.8 {Tcl_SetChannelOption, different buffering options} {
lappend l [file size $path(test1)]
chan close $f1
lappend l [file size $path(test1)]
- set l
-} {5 10 10 10 20 20}
-test chan-io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
+} -result {5 10 10 10 20 20}
+test chan-io-39.9 {Tcl_SetChannelOption, blocking mode} -setup {
file delete $path(test1)
+ set x ""
+} -constraints {nonBlockFiles} -body {
set f1 [open $path(test1) w]
chan close $f1
set f1 [open $path(test1) r]
- set x ""
lappend x [chan configure $f1 -blocking]
chan configure $f1 -blocking off
lappend x [chan configure $f1 -blocking]
@@ -4944,11 +5074,13 @@ test chan-io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
lappend x [chan read $f1 1000]
lappend x [chan blocked $f1]
lappend x [chan eof $f1]
+} -cleanup {
chan close $f1
- set x
-} {1 0 {} {} 0 1}
-test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} {
+} -result {1 0 {} {} 0 1}
+test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} -setup {
file delete $path(pipe)
+ set x ""
+} -constraints {stdio openpipe} -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan gets stdin
@@ -4957,8 +5089,7 @@ test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} {
chan gets stdin
}
chan close $f1
- set x ""
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
chan configure $f1 -blocking off -buffering line
lappend x [chan configure $f1 -blocking]
lappend x [chan gets $f1]
@@ -4980,71 +5111,78 @@ test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} {
lappend x [chan eof $f1]
lappend x [chan gets $f1]
lappend x [chan eof $f1]
+} -cleanup {
chan close $f1
- set x
-} {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
-test chan-io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} {
+} -result {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
+test chan-io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -buffersize -10
- set x [chan configure $f -buffersize]
+ chan configure $f -buffersize
+} -cleanup {
chan close $f
- set x
-} 1
-test chan-io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} {
+} -result 1
+test chan-io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -buffersize 10000000
- set x [chan configure $f -buffersize]
+ chan configure $f -buffersize
+} -cleanup {
chan close $f
- set x
-} 1048576
-test chan-io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
+} -result 1048576
+test chan-io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -buffersize 40000
- set x [chan configure $f -buffersize]
+ chan configure $f -buffersize
+} -cleanup {
chan close $f
- set x
-} 40000
-test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
+} -result 40000
+test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -encoding {}
chan puts -nonewline $f \xe7\x89\xa6
chan close $f
set f [open $path(test1) r]
chan configure $f -encoding utf-8
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} \u7266
-test chan-io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
+} -result \u7266
+test chan-io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
chan configure $f -encoding binary
chan puts -nonewline $f \xe7\x89\xa6
chan close $f
set f [open $path(test1) r]
chan configure $f -encoding utf-8
- set x [chan read $f]
+ chan read $f
+} -cleanup {
chan close $f
- set x
-} \u7266
-test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
+} -result \u7266
+test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup {
file delete $path(test1)
set f [open $path(test1) w]
- set result [list [catch {chan configure $f -encoding foobar} msg] $msg]
+} -body {
+ chan configure $f -encoding foobar
+} -returnCodes error -cleanup {
chan close $f
- set result
-} {1 {unknown encoding "foobar"}}
-test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio openpipe fileevent} {
- set f [open "|[list [interpreter] $path(cat)]" r+]
+} -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 {
+ set f [openpipe r+ $path(cat)]
chan configure $f -encoding binary
chan puts -nonewline $f "\xe7"
chan flush $f
chan configure $f -encoding utf-8 -blocking 0
- variable x {}
chan event $f readable [namespace code { lappend x [chan read $f] }]
vwait [namespace which -variable x]
after 300 [namespace code { lappend x timeout }]
@@ -5057,105 +5195,113 @@ test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_
vwait [namespace which -variable x]
after 300 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
+ return $x
+} -cleanup {
chan close $f
- set x
-} "{} timeout {} timeout \xe7 timeout"
+} -result "{} timeout {} timeout \xe7 timeout"
test chan-io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
- {socket} {
+ -constraints {socket} -body {
proc accept {s a p} {chan close $s}
set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set port [lindex [chan configure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
chan configure $s2 -translation {auto lf}
- set modes [chan configure $s2 -translation]
+ chan configure $s2 -translation
+} -cleanup {
chan close $s1
chan close $s2
- set modes
-} {auto lf}
+} -result {auto lf}
test chan-io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
- {socket} {
+ -constraints {socket} -body {
proc accept {s a p} {chan close $s}
set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set port [lindex [chan configure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
chan configure $s2 -translation {auto crlf}
- set modes [chan configure $s2 -translation]
+ chan configure $s2 -translation
+} -cleanup {
chan close $s1
chan close $s2
- set modes
-} {auto crlf}
+} -result {auto crlf}
test chan-io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
- {socket} {
+ -constraints {socket} -body {
proc accept {s a p} {chan close $s}
set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set port [lindex [chan configure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
chan configure $s2 -translation {auto cr}
- set modes [chan configure $s2 -translation]
+ chan configure $s2 -translation
+} -cleanup {
chan close $s1
chan close $s2
- set modes
-} {auto cr}
+} -result {auto cr}
test chan-io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
- {socket} {
+ -constraints {socket} -body {
proc accept {s a p} {chan close $s}
set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set port [lindex [chan configure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
chan configure $s2 -translation {auto auto}
- set modes [chan configure $s2 -translation]
+ chan configure $s2 -translation
+} -cleanup {
chan close $s1
chan close $s2
- set modes
-} {auto crlf}
-test chan-io-39.22 {Tcl_SetChannelOption, invariance} {unix} {
+} -result {auto crlf}
+test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup {
file delete $path(test1)
- set f1 [open $path(test1) w+]
set l ""
+} -constraints {unix} -body {
+ set f1 [open $path(test1) w+]
lappend l [chan configure $f1 -eofchar]
chan configure $f1 -eofchar {ON GO}
lappend l [chan configure $f1 -eofchar]
chan configure $f1 -eofchar D
lappend l [chan configure $f1 -eofchar]
+} -cleanup {
chan close $f1
- set l
-} {{{} {}} {O G} {D D}}
-test chan-io-39.22a {Tcl_SetChannelOption, invariance} {
+} -result {{{} {}} {O G} {D D}}
+test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup {
file delete $path(test1)
- set f1 [open $path(test1) w+]
set l [list]
+} -body {
+ set f1 [open $path(test1) w+]
chan configure $f1 -eofchar {ON GO}
lappend l [chan configure $f1 -eofchar]
chan configure $f1 -eofchar D
lappend l [chan configure $f1 -eofchar]
lappend l [list [catch {chan configure $f1 -eofchar {1 2 3}} msg] $msg]
+} -cleanup {
chan close $f1
- set l
-} {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}}
-test chan-io-39.23 {Tcl_GetChannelOption, server socket is not readable or
- writeable, it should still have valid -eofchar and -translation options } {
+} -result {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}}
+test chan-io-39.23 {Tcl_GetChannelOption, server socket is not readable or\
+ writeable, it should still have valid -eofchar and -translation options} -setup {
set l [list]
+} -body {
set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
- lappend l [chan configure $sock -eofchar] [chan configure $sock -translation]
+ lappend l [chan configure $sock -eofchar] \
+ [chan configure $sock -translation]
+} -cleanup {
chan close $sock
- set l
-} {{{}} auto}
-test chan-io-39.24 {Tcl_SetChannelOption, server socket is not readable or
- writable so we can't change -eofchar or -translation } {
+} -result {{{}} auto}
+test chan-io-39.24 {Tcl_SetChannelOption, server socket is not readable or\
+ writable so we can't change -eofchar or -translation} -setup {
set l [list]
+} -body {
set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
chan configure $sock -eofchar D -translation lf
- lappend l [chan configure $sock -eofchar] [chan configure $sock -translation]
+ lappend l [chan configure $sock -eofchar] \
+ [chan configure $sock -translation]
+} -cleanup {
chan close $sock
- set l
-} {{{}} auto}
+} -result {{{}} auto}
-test chan-io-40.1 {POSIX open access modes: RDWR} {
+test chan-io-40.1 {POSIX open access modes: RDWR} -setup {
file delete $path(test3)
+} -body {
set f [open $path(test3) w]
chan puts $f xyzzy
chan close $f
@@ -5166,11 +5312,12 @@ test chan-io-40.1 {POSIX open access modes: RDWR} {
chan close $f
set f [open $path(test3) r]
lappend x [chan gets $f]
+} -cleanup {
chan close $f
- set x
-} {zzy abzzy}
-test chan-io-40.2 {POSIX open access modes: CREAT} {unix} {
+} -result {zzy abzzy}
+test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
file delete $path(test3)
+} -constraints {unix} -body {
set f [open $path(test3) {WRONLY CREAT} 0600]
file stat $path(test3) stats
set x [format "0%o" [expr $stats(mode)&0o777]]
@@ -5178,19 +5325,20 @@ test chan-io-40.2 {POSIX open access modes: CREAT} {unix} {
chan close $f
set f [open $path(test3) r]
lappend x [chan gets $f]
+} -cleanup {
chan close $f
- set x
-} {0600 {line 1}}
-test chan-io-40.3 {POSIX open access modes: CREAT} {unix umask} {
- # This test only works if your umask is 2, like ouster's.
+} -result {0600 {line 1}}
+test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
file delete $path(test3)
- set f [open $path(test3) {WRONLY CREAT}]
- chan close $f
+} -constraints {unix umask} -body {
+ # This test only works if your umask is 2, like ouster's.
+ chan close [open $path(test3) {WRONLY CREAT}]
file stat $path(test3) stats
format "0%o" [expr $stats(mode)&0o777]
-} [format %04o [expr {0o666 & ~ $umaskValue}]]
-test chan-io-40.4 {POSIX open access modes: CREAT} {
+} -result [format %04o [expr {0o666 & ~ $umaskValue}]]
+test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
file delete $path(test3)
+} -body {
set f [open $path(test3) w]
chan configure $f -eofchar {}
chan puts $f xyzzy
@@ -5200,12 +5348,14 @@ test chan-io-40.4 {POSIX open access modes: CREAT} {
chan puts -nonewline $f "ab"
chan close $f
set f [open $path(test3) r]
- set x [chan gets $f]
+ chan gets $f
+} -cleanup {
chan close $f
- set x
-} abzzy
-test chan-io-40.5 {POSIX open access modes: APPEND} {
+} -result abzzy
+test chan-io-40.5 {POSIX open access modes: APPEND} -setup {
file delete $path(test3)
+ set x ""
+} -body {
set f [open $path(test3) w]
chan configure $f -translation lf -eofchar {}
chan puts $f xyzzy
@@ -5218,30 +5368,32 @@ test chan-io-40.5 {POSIX open access modes: APPEND} {
chan close $f
set f [open $path(test3) r]
chan configure $f -translation lf
- set x ""
chan seek $f 6 current
lappend x [chan gets $f]
lappend x [chan gets $f]
+} -cleanup {
chan close $f
- set x
-} {{new line} abc}
-test chan-io-40.6 {POSIX open access modes: EXCL} -match regexp -body {
+} -result {{new line} abc}
+test chan-io-40.6 {POSIX open access modes: EXCL} -match regexp -setup {
file delete $path(test3)
+} -body {
set f [open $path(test3) w]
chan puts $f xyzzy
chan close $f
open $path(test3) {WRONLY CREAT EXCL}
} -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists}
-test chan-io-40.7 {POSIX open access modes: EXCL} {
+test chan-io-40.7 {POSIX open access modes: EXCL} -setup {
file delete $path(test3)
+} -body {
set f [open $path(test3) {WRONLY CREAT EXCL}]
chan configure $f -eofchar {}
chan puts $f "A test line"
chan close $f
viewFile test3
-} {A test line}
-test chan-io-40.8 {POSIX open access modes: TRUNC} {
+} -result {A test line}
+test chan-io-40.8 {POSIX open access modes: TRUNC} -setup {
file delete $path(test3)
+} -body {
set f [open $path(test3) w]
chan puts $f xyzzy
chan close $f
@@ -5249,32 +5401,31 @@ test chan-io-40.8 {POSIX open access modes: TRUNC} {
chan puts $f abc
chan close $f
set f [open $path(test3) r]
- set x [chan gets $f]
+ chan gets $f
+} -cleanup {
chan close $f
- set x
-} abc
-test chan-io-40.9 {POSIX open access modes: NONBLOCK} {nonPortable unix} {
+} -result abc
+test chan-io-40.9 {POSIX open access modes: NONBLOCK} -setup {
file delete $path(test3)
+} -constraints {nonPortable unix} -body {
set f [open $path(test3) {WRONLY NONBLOCK CREAT}]
chan puts $f "NONBLOCK test"
chan close $f
set f [open $path(test3) r]
- set x [chan gets $f]
+ chan gets $f
+} -cleanup {
chan close $f
- set x
-} {NONBLOCK test}
-test chan-io-40.10 {POSIX open access modes: RDONLY} {
+} -result {NONBLOCK test}
+test chan-io-40.10 {POSIX open access modes: RDONLY} -body {
set f [open $path(test1) w]
chan puts $f "two lines: this one"
chan puts $f "and this"
chan close $f
set f [open $path(test1) RDONLY]
- set x [list [chan gets $f] [catch {chan puts $f Test} msg] $msg]
+ list [chan gets $f] [catch {chan puts $f Test} msg] $msg
+} -cleanup {
chan close $f
- string compare [string tolower $x] \
- [list {two lines: this one} 1 \
- [format "channel \"%s\" wasn't opened for writing" $f]]
-} 0
+} -match glob -result {{two lines: this one} 1 {channel "*" wasn't opened for writing}}
test chan-io-40.11 {POSIX open access modes: RDONLY} -match regexp -body {
file delete $path(test3)
open $path(test3) RDONLY
@@ -5283,7 +5434,7 @@ test chan-io-40.12 {POSIX open access modes: WRONLY} -match regexp -body {
file delete $path(test3)
open $path(test3) WRONLY
} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
-test chan-io-40.13 {POSIX open access modes: WRONLY} {
+test chan-io-40.13 {POSIX open access modes: WRONLY} -body {
makeFile xyzzy test3
set f [open $path(test3) WRONLY]
chan configure $f -eofchar {}
@@ -5292,9 +5443,7 @@ test chan-io-40.13 {POSIX open access modes: WRONLY} {
set x [list [catch {chan gets $f} msg] $msg]
chan close $f
lappend x [viewFile test3]
- string compare [string tolower $x] \
- [list 1 "channel \"$f\" wasn't opened for reading" abzzy]
-} 0
+} -match glob -result {1 {channel "*" wasn't opened for reading} abzzy}
test chan-io-40.14 {POSIX open access modes: RDWR} -match regexp -body {
file delete $path(test3)
open $path(test3) RDWR
@@ -5315,29 +5464,30 @@ test chan-io-40.16 {tilde substitution in open} -constraints makeFileInHome -set
} -cleanup {
removeFile _test_ ~
} -result 1
-test chan-io-40.17 {tilde substitution in open} {
+test chan-io-40.17 {tilde substitution in open} -setup {
set home $::env(HOME)
+} -body {
unset ::env(HOME)
- set x [list [catch {open ~/foo} msg] $msg]
+ open ~/foo
+} -returnCodes error -cleanup {
set ::env(HOME) $home
- set x
-} {1 {couldn't find HOME environment variable to expand path}}
+} -result {couldn't find HOME environment variable to expand path}
-test chan-io-41.1 {Tcl_FileeventCmd: errors} {fileevent} {
- list [catch {chan event foo} msg] $msg
-} {1 {wrong # args: should be "chan event channelId event ?script?"}}
-test chan-io-41.2 {Tcl_FileeventCmd: errors} {fileevent} {
- list [catch {chan event foo bar baz q} msg] $msg
-} {1 {wrong # args: should be "chan event channelId event ?script?"}}
-test chan-io-41.3 {Tcl_FileeventCmd: errors} {fileevent} {
- list [catch {chan event gorp readable} msg] $msg
-} {1 {can not find channel named "gorp"}}
-test chan-io-41.4 {Tcl_FileeventCmd: errors} {fileevent} {
- list [catch {chan event gorp writable} msg] $msg
-} {1 {can not find channel named "gorp"}}
-test chan-io-41.5 {Tcl_FileeventCmd: errors} {fileevent} {
- list [catch {chan event gorp who-knows} msg] $msg
-} {1 {bad event name "who-knows": must be readable or writable}}
+test chan-io-41.1 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
+ chan event foo
+} -returnCodes error -result {wrong # args: should be "chan event channelId event ?script?"}
+test chan-io-41.2 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
+ chan event foo bar baz q
+} -returnCodes error -result {wrong # args: should be "chan event channelId event ?script?"}
+test chan-io-41.3 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
+ chan event gorp readable
+} -returnCodes error -result {can not find channel named "gorp"}
+test chan-io-41.4 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
+ chan event gorp writable
+} -returnCodes error -result {can not find channel named "gorp"}
+test chan-io-41.5 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
+ chan event gorp who-knows
+} -returnCodes error -result {bad event name "who-knows": must be readable or writable}
#
# Test chan event on a file
@@ -5372,7 +5522,6 @@ test chan-io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {file
lappend result [chan event $f readable]
} {13 11 12 {}}
-
test chan-io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs fileevent} {
set result {}
chan event $f readable "script 1"
@@ -5387,8 +5536,8 @@ test chan-io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixEx
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+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
set result {}
+} -constraints {stdio unixExecs fileevent openpipe} -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"
@@ -5415,14 +5564,12 @@ test chan-io-44.1 {FileEventProc procedure: normal read event} -setup {
chan puts $f2 text; chan flush $f2
variable x initial
vwait [namespace which -variable x]
- set x
+ return $x
} -cleanup {
catch {chan close $f2}
catch {chan close $f3}
} -result {text}
-test chan-io-44.2 {FileEventProc procedure: error in read event} -constraints {
- stdio unixExecs fileevent openpipe
-} -setup {
+test chan-io-44.2 {FileEventProc procedure: error in read event} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
proc myHandler {msg options} {
@@ -5430,7 +5577,7 @@ test chan-io-44.2 {FileEventProc procedure: error in read event} -constraints {
}
set handler [interp bgerror {}]
interp bgerror {} [namespace which myHandler]
-} -body {
+} -constraints {stdio unixExecs fileevent openpipe} -body {
chan event $f2 readable {error bogus}
chan puts $f2 text; chan flush $f2
variable x initial
@@ -5457,14 +5604,12 @@ test chan-io-44.3 {FileEventProc procedure: normal write event} -setup {
vwait [namespace which -variable x]
vwait [namespace which -variable x]
vwait [namespace which -variable x]
- set x
+ return $x
} -cleanup {
catch {chan close $f2}
catch {chan close $f3}
} -result {initial triggered triggered triggered}
-test chan-io-44.4 {FileEventProc procedure: eror in write event} -constraints {
- stdio unixExecs fileevent openpipe
-} -setup {
+test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
proc myHandler {msg options} {
@@ -5472,7 +5617,7 @@ test chan-io-44.4 {FileEventProc procedure: eror in write event} -constraints {
}
set handler [interp bgerror {}]
interp bgerror {} [namespace which myHandler]
-} -body {
+} -constraints {stdio unixExecs fileevent openpipe} -body {
chan event $f2 writable {error bad-write}
variable x initial
vwait [namespace which -variable x]
@@ -5483,7 +5628,7 @@ test chan-io-44.4 {FileEventProc procedure: eror in write event} -constraints {
catch {chan close $f3}
} -result {bad-write {}}
test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
- set f4 [open "|[list [interpreter] $path(cat) << foo]" r]
+ set f4 [openpipe r $path(cat) << foo]
chan event $f4 readable [namespace code {
if {[chan gets $f4 line] < 0} {
lappend x eof
@@ -5510,7 +5655,9 @@ test chan-io-45.1 {DeleteFileEvent, cleanup on chan close} {fileevent} {
}]
chan close $f
set x initial
- after 100 [namespace code { set y done }]
+ after 100 [namespace code {
+ set y done
+ }]
variable y
vwait [namespace which -variable y]
set x
@@ -5519,9 +5666,9 @@ test chan-io-45.2 {DeleteFileEvent, cleanup on chan close} {fileevent} {
set f [open $path(foo) r]
set f2 [open $path(foo) r]
chan event $f readable [namespace code {
- lappend x "f triggered: \"[chan gets $f]\""
- chan event $f readable {}
- }]
+ lappend x "f triggered: \"[chan gets $f]\""
+ chan event $f readable {}
+ }]
chan event $f2 readable [namespace code {
lappend x "f2 triggered: \"[chan gets $f2]\""
chan event $f2 readable {}
@@ -5595,30 +5742,32 @@ test chan-io-46.3 {Tcl event loop vs multiple interpreters} testfevent {
}
} {0 0 {0 timer}}
-test chan-io-47.1 {chan event vs multiple interpreters} {testfevent fileevent} {
+test chan-io-47.1 {chan event vs multiple interpreters} -setup {
set f [open $path(foo) r]
set f2 [open $path(foo) r]
set f3 [open $path(foo) r]
+ set x {}
+} -constraints {testfevent fileevent} -body {
chan event $f readable {script 1}
testfevent create
testfevent share $f2
testfevent cmd "chan event $f2 readable {script 2}"
chan event $f3 readable {sript 3}
- set x {}
lappend x [chan event $f2 readable]
testfevent delete
lappend x [chan event $f readable] [chan event $f2 readable] \
[chan event $f3 readable]
+} -cleanup {
chan close $f
chan close $f2
chan close $f3
- set x
-} {{} {script 1} {} {sript 3}}
-test chan-io-47.2 {deleting chan event on interpreter delete} {testfevent fileevent} {
+} -result {{} {script 1} {} {sript 3}}
+test chan-io-47.2 {deleting chan event on interpreter delete} -setup {
set f [open $path(foo) r]
set f2 [open $path(foo) r]
set f3 [open $path(foo) r]
set f4 [open $path(foo) r]
+} -constraints {testfevent fileevent} -body {
chan event $f readable {script 1}
testfevent create
testfevent share $f2
@@ -5627,19 +5776,20 @@ test chan-io-47.2 {deleting chan event on interpreter delete} {testfevent fileev
chan event $f3 readable {script 3}"
chan event $f4 readable {script 4}
testfevent delete
- set x [list [chan event $f readable] [chan event $f2 readable] \
- [chan event $f3 readable] [chan event $f4 readable]]
+ list [chan event $f readable] [chan event $f2 readable] \
+ [chan event $f3 readable] [chan event $f4 readable]
+} -cleanup {
chan close $f
chan close $f2
chan close $f3
chan close $f4
- set x
-} {{script 1} {} {} {script 4}}
-test chan-io-47.3 {deleting chan event on interpreter delete} {testfevent fileevent} {
+} -result {{script 1} {} {} {script 4}}
+test chan-io-47.3 {deleting chan event on interpreter delete} -setup {
set f [open $path(foo) r]
set f2 [open $path(foo) r]
set f3 [open $path(foo) r]
set f4 [open $path(foo) r]
+} -constraints {testfevent fileevent} -body {
testfevent create
testfevent share $f3
testfevent share $f4
@@ -5648,56 +5798,56 @@ test chan-io-47.3 {deleting chan event on interpreter delete} {testfevent fileev
testfevent cmd "chan event $f3 readable {script 3}
chan event $f4 readable {script 4}"
testfevent delete
- set x [list [chan event $f readable] [chan event $f2 readable] \
- [chan event $f3 readable] [chan event $f4 readable]]
+ list [chan event $f readable] [chan event $f2 readable] \
+ [chan event $f3 readable] [chan event $f4 readable]
+} -cleanup {
chan close $f
chan close $f2
chan close $f3
chan close $f4
- set x
-} {{script 1} {script 2} {} {}}
-test chan-io-47.4 {file events on shared files and multiple interpreters} {testfevent fileevent} {
+} -result {{script 1} {script 2} {} {}}
+test chan-io-47.4 {file events on shared files and multiple interpreters} -setup {
set f [open $path(foo) r]
set f2 [open $path(foo) r]
+} -constraints {testfevent fileevent} -body {
testfevent create
testfevent share $f
testfevent cmd "chan event $f readable {script 1}"
chan event $f readable {script 2}
chan event $f2 readable {script 3}
- set x [list [chan event $f2 readable] \
- [testfevent cmd "chan event $f readable"] \
- [chan event $f readable]]
+ list [chan event $f2 readable] [testfevent cmd "chan event $f readable"] \
+ [chan event $f readable]
+} -cleanup {
testfevent delete
chan close $f
chan close $f2
- set x
-} {{script 3} {script 1} {script 2}}
-test chan-io-47.5 {file events on shared files, deleting file events} {testfevent fileevent} {
+} -result {{script 3} {script 1} {script 2}}
+test chan-io-47.5 {file events on shared files, deleting file events} -setup {
set f [open $path(foo) r]
+} -body {
testfevent create
testfevent share $f
testfevent cmd "chan event $f readable {script 1}"
chan event $f readable {script 2}
testfevent cmd "chan event $f readable {}"
- set x [list [testfevent cmd "chan event $f readable"] \
- [chan event $f readable]]
+ list [testfevent cmd "chan event $f readable"] [chan event $f readable]
+} -constraints {testfevent fileevent} -cleanup {
testfevent delete
chan close $f
- set x
-} {{} {script 2}}
-test chan-io-47.6 {file events on shared files, deleting file events} {testfevent fileevent} {
+} -result {{} {script 2}}
+test chan-io-47.6 {file events on shared files, deleting file events} -setup {
set f [open $path(foo) r]
+} -body {
testfevent create
testfevent share $f
testfevent cmd "chan event $f readable {script 1}"
chan event $f readable {script 2}
chan event $f readable {}
- set x [list [testfevent cmd "chan event $f readable"] \
- [chan event $f readable]]
+ list [testfevent cmd "chan event $f readable"] [chan event $f readable]
+} -constraints {testfevent fileevent} -cleanup {
testfevent delete
chan close $f
- set x
-} {{script 1} {}}
+} -result {{script 1} {}}
set path(bar) [makeFile {} bar]
@@ -5710,10 +5860,7 @@ test chan-io-48.1 {testing readability conditions} {fileevent} {
chan puts $f abcdefg
chan close $f
set f [open $path(bar) r]
- chan event $f readable [namespace code [list consume $f]]
- proc consume {f} {
- variable l
- variable x
+ chan event $f readable [namespace code {
lappend l called
if {[chan eof $f]} {
chan close $f
@@ -5721,7 +5868,7 @@ test chan-io-48.1 {testing readability conditions} {fileevent} {
} else {
chan gets $f
}
- }
+ }]
set l ""
variable x not_done
vwait [namespace which -variable x]
@@ -5736,11 +5883,7 @@ test chan-io-48.2 {testing readability conditions} {nonBlockFiles fileevent} {
chan puts $f abcdefg
chan close $f
set f [open $path(bar) r]
- chan event $f readable [namespace code [list consume $f]]
- chan configure $f -blocking off
- proc consume {f} {
- variable x
- variable l
+ chan event $f readable [namespace code {
lappend l called
if {[chan eof $f]} {
chan close $f
@@ -5748,14 +5891,17 @@ test chan-io-48.2 {testing readability conditions} {nonBlockFiles fileevent} {
} else {
chan gets $f
}
- }
+ }]
+ chan configure $f -blocking off
set l ""
variable x not_done
vwait [namespace which -variable x]
list $x $l
} {done {called called called called called called called}}
set path(my_script) [makeFile {} my_script]
-test chan-io-48.3 {testing readability conditions} {stdio unix nonBlockFiles openpipe fileevent} {
+test chan-io-48.3 {testing readability conditions} -setup {
+ set l ""
+} -constraints {stdio unix nonBlockFiles openpipe fileevent} -body {
set f [open $path(bar) w]
chan puts $f abcdefg
chan puts $f abcdefg
@@ -5774,13 +5920,8 @@ test chan-io-48.3 {testing readability conditions} {stdio unix nonBlockFiles ope
}
}
chan close $f
- set f [open "|[list [interpreter]]" r+]
- chan event $f readable [namespace code [list consume $f]]
- chan configure $f -buffering line
- chan configure $f -blocking off
- proc consume {f} {
- variable l
- variable x
+ set f [openpipe]
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
} else {
@@ -5789,28 +5930,31 @@ test chan-io-48.3 {testing readability conditions} {stdio unix nonBlockFiles ope
chan gets $f
lappend l [chan blocked $f]
}
- }
- set l ""
+ }]
+ chan configure $f -buffering line
+ chan configure $f -blocking off
variable x not_done
chan puts $f [list source $path(my_script)]
chan puts $f "set f \[[list open $path(bar) r]]"
chan puts $f {copy_slowly $f}
chan puts $f {exit}
vwait [namespace which -variable x]
- chan close $f
list $x $l
-} {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
-test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fileevent} {
+} -cleanup {
+ chan close $f
+} -result {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
+test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} -setup {
file delete $path(test1)
+ set c 0
+ set l ""
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
- variable c [format "abc\ndef\n%c" 26]
- chan puts -nonewline $f $c
+ chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
- proc consume {f} {
- variable l
- variable c
- variable x
+ set f [open $path(test1) r]
+ chan configure $f -translation auto -eofchar \x1a
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
@@ -5818,27 +5962,23 @@ test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode
lappend l [chan gets $f]
incr c
}
- }
- set c 0
- set l ""
- set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
- chan event $f readable [namespace code [list consume $f]]
+ }]
variable x
vwait [namespace which -variable x]
list $c $l
-} {3 {abc def {}}}
-test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {fileevent} {
+} -result {3 {abc def {}}}
+test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} -setup {
file delete $path(test1)
+ set c 0
+ set l ""
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
- set c [format "abc\ndef\n%cfoo\nbar\n" 26]
- chan puts -nonewline $f $c
+ chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
- proc consume {f} {
- variable l
- variable x
- variable c
+ set f [open $path(test1) r]
+ chan configure $f -eofchar \x1a -translation auto
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
@@ -5846,27 +5986,23 @@ test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode}
lappend l [chan gets $f]
incr c
}
- }
- set c 0
- set l ""
- set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
- chan event $f readable [namespace code [list consume $f]]
+ }]
variable x
vwait [namespace which -variable x]
list $c $l
-} {3 {abc def {}}}
-test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {fileevent} {
+} -result {3 {abc def {}}}
+test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode} -setup {
file delete $path(test1)
+ set c 0
+ set l ""
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
- set c [format "abc\ndef\n%c" 26]
- chan puts -nonewline $f $c
+ chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
- proc consume {f} {
- variable l
- variable x
- variable c
+ set f [open $path(test1) r]
+ chan configure $f -translation auto -eofchar \x1a
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
@@ -5874,27 +6010,23 @@ test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode
lappend l [chan gets $f]
incr c
}
- }
- set c 0
- set l ""
- set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
- chan event $f readable [namespace code [list consume $f]]
+ }]
variable x
vwait [namespace which -variable x]
list $c $l
-} {3 {abc def {}}}
-test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {fileevent} {
+} -result {3 {abc def {}}}
+test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} -setup {
file delete $path(test1)
+ set c 0
+ set l ""
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
- set c [format "abc\ndef\n%cfoo\nbar\n" 26]
- chan puts -nonewline $f $c
+ chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
- proc consume {f} {
- variable l
- variable c
- variable x
+ set f [open $path(test1) r]
+ chan configure $f -eofchar \x1a -translation auto
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
@@ -5902,27 +6034,23 @@ test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode}
lappend l [chan gets $f]
incr c
}
- }
- set c 0
- set l ""
- set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
- chan event $f readable [namespace code [list consume $f]]
+ }]
variable x
vwait [namespace which -variable x]
list $c $l
-} {3 {abc def {}}}
-test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {fileevent} {
+} -result {3 {abc def {}}}
+test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} -setup {
file delete $path(test1)
+ set c 0
+ set l ""
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
- set c [format "abc\ndef\n%c" 26]
- chan puts -nonewline $f $c
+ chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
- proc consume {f} {
- variable l
- variable x
- variable c
+ set f [open $path(test1) r]
+ chan configure $f -translation auto -eofchar \x1a
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
@@ -5930,27 +6058,23 @@ test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mo
lappend l [chan gets $f]
incr c
}
- }
- set c 0
- set l ""
- set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
- chan event $f readable [namespace code [list consume $f]]
+ }]
variable x
vwait [namespace which -variable x]
list $c $l
-} {3 {abc def {}}}
-test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {fileevent} {
+} -result {3 {abc def {}}}
+test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} -setup {
file delete $path(test1)
+ set c 0
+ set l ""
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
- set c [format "abc\ndef\n%cfoo\nbar\n" 26]
- chan puts -nonewline $f $c
+ chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
- proc consume {f} {
- variable l
- variable c
- variable x
+ set f [open $path(test1) r]
+ chan configure $f -eofchar \x1a -translation auto
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
@@ -5958,27 +6082,23 @@ test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode
lappend l [chan gets $f]
incr c
}
- }
- set c 0
- set l ""
- set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
- chan event $f readable [namespace code [list consume $f]]
+ }]
variable x
vwait [namespace which -variable x]
list $c $l
-} {3 {abc def {}}}
-test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {fileevent} {
+} -result {3 {abc def {}}}
+test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} -setup {
file delete $path(test1)
+ set c 0
+ set l ""
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
- set c [format "abc\ndef\n%cfoo\nbar\n" 26]
- chan puts -nonewline $f $c
+ chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
- proc consume {f} {
- variable l
- variable c
- variable x
+ set f [open $path(test1) r]
+ chan configure $f -eofchar \x1a -translation lf
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
@@ -5986,27 +6106,23 @@ test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {
lappend l [chan gets $f]
incr c
}
- }
- set c 0
- set l ""
- set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation lf
- chan event $f readable [namespace code [list consume $f]]
+ }]
variable x
vwait [namespace which -variable x]
list $c $l
-} {3 {abc def {}}}
-test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {fileevent} {
+} -result {3 {abc def {}}}
+test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode} -setup {
file delete $path(test1)
+ set c 0
+ set l ""
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
- set c [format "abc\ndef\n%c" 26]
- chan puts -nonewline $f $c
+ chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
- proc consume {f} {
- variable l
- variable x
- variable c
+ set f [open $path(test1) r]
+ chan configure $f -translation lf -eofchar \x1a
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
@@ -6014,27 +6130,23 @@ test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode}
lappend l [chan gets $f]
incr c
}
- }
- set c 0
- set l ""
- set f [open $path(test1) r]
- chan configure $f -translation lf -eofchar \x1a
- chan event $f readable [namespace code [list consume $f]]
+ }]
variable x
vwait [namespace which -variable x]
list $c $l
-} {3 {abc def {}}}
-test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {fileevent} {
+} -result {3 {abc def {}}}
+test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} -setup {
file delete $path(test1)
+ set c 0
+ set l ""
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
- set c [format "abc\ndef\n%cfoo\nbar\n" 26]
- chan puts -nonewline $f $c
+ chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
- proc consume {f} {
- variable l
- variable x
- variable c
+ set f [open $path(test1) r]
+ chan configure $f -eofchar \x1a -translation cr
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
@@ -6042,27 +6154,23 @@ test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {
lappend l [chan gets $f]
incr c
}
- }
- set c 0
- set l ""
- set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation cr
- chan event $f readable [namespace code [list consume $f]]
+ }]
variable x
vwait [namespace which -variable x]
list $c $l
-} {3 {abc def {}}}
-test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {fileevent} {
+} -result {3 {abc def {}}}
+test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode} -setup {
file delete $path(test1)
+ set c 0
+ set l ""
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation cr
- set c [format "abc\ndef\n%c" 26]
- chan puts -nonewline $f $c
+ chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
- proc consume {f} {
- variable c
- variable x
- variable l
+ set f [open $path(test1) r]
+ chan configure $f -translation cr -eofchar \x1a
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
@@ -6070,27 +6178,23 @@ test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode}
lappend l [chan gets $f]
incr c
}
- }
- set c 0
- set l ""
- set f [open $path(test1) r]
- chan configure $f -translation cr -eofchar \x1a
- chan event $f readable [namespace code [list consume $f]]
+ }]
variable x
vwait [namespace which -variable x]
list $c $l
-} {3 {abc def {}}}
-test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {fileevent} {
+} -result {3 {abc def {}}}
+test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} -setup {
file delete $path(test1)
+ set c 0
+ set l ""
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
- set c [format "abc\ndef\n%cfoo\nbar\n" 26]
- chan puts -nonewline $f $c
+ chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
- proc consume {f} {
- variable c
- variable x
- variable l
+ set f [open $path(test1) r]
+ chan configure $f -eofchar \x1a -translation crlf
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
@@ -6098,27 +6202,23 @@ test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mod
lappend l [chan gets $f]
incr c
}
- }
- set c 0
- set l ""
- set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation crlf
- chan event $f readable [namespace code [list consume $f]]
+ }]
variable x
vwait [namespace which -variable x]
list $c $l
-} {3 {abc def {}}}
-test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {fileevent} {
+} -result {3 {abc def {}}}
+test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} -setup {
file delete $path(test1)
+ set c 0
+ set l ""
+} -constraints {fileevent} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf
- set c [format "abc\ndef\n%c" 26]
- chan puts -nonewline $f $c
+ chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
- proc consume {f} {
- variable c
- variable x
- variable l
+ set f [open $path(test1) r]
+ chan configure $f -translation crlf -eofchar \x1a
+ chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
chan close $f
@@ -6126,25 +6226,21 @@ test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
lappend l [chan gets $f]
incr c
}
- }
- set c 0
- set l ""
- set f [open $path(test1) r]
- chan configure $f -translation crlf -eofchar \x1a
- chan event $f readable [namespace code [list consume $f]]
+ }]
variable x
vwait [namespace which -variable x]
list $c $l
-} {3 {abc def {}}}
+} -result {3 {abc def {}}}
-test chan-io-49.1 {testing crlf reading, leftover cr disgorgment} {
+test chan-io-49.1 {testing crlf reading, leftover cr disgorgment} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "a\rb\rc\r\n"
chan close $f
set f [open $path(test1) r]
- set l ""
lappend l [file size $path(test1)]
chan configure $f -translation crlf
lappend l [chan read $f 1]
@@ -6162,18 +6258,19 @@ test chan-io-49.1 {testing crlf reading, leftover cr disgorgment} {
lappend l [chan eof $f]
lappend l [chan read $f 1]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} "7 a 1 [list \r] 2 b 3 [list \r] 4 c 5 {
+} -result "7 a 1 [list \r] 2 b 3 [list \r] 4 c 5 {
} 7 0 {} 1"
-test chan-io-49.2 {testing crlf reading, leftover cr disgorgment} {
+test chan-io-49.2 {testing crlf reading, leftover cr disgorgment} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "a\rb\rc\r\n"
chan close $f
set f [open $path(test1) r]
- set l ""
lappend l [file size $path(test1)]
chan configure $f -translation crlf
lappend l [chan read $f 2]
@@ -6186,17 +6283,18 @@ test chan-io-49.2 {testing crlf reading, leftover cr disgorgment} {
lappend l [chan read $f 2]
lappend l [chan tell $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1"
-test chan-io-49.3 {testing crlf reading, leftover cr disgorgment} {
+} -result "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1"
+test chan-io-49.3 {testing crlf reading, leftover cr disgorgment} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "a\rb\rc\r\n"
chan close $f
set f [open $path(test1) r]
- set l ""
lappend l [file size $path(test1)]
chan configure $f -translation crlf
lappend l [chan read $f 3]
@@ -6207,17 +6305,18 @@ test chan-io-49.3 {testing crlf reading, leftover cr disgorgment} {
lappend l [chan read $f 3]
lappend l [chan tell $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1"
-test chan-io-49.4 {testing crlf reading, leftover cr disgorgment} {
+} -result "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1"
+test chan-io-49.4 {testing crlf reading, leftover cr disgorgment} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "a\rb\rc\r\n"
chan close $f
set f [open $path(test1) r]
- set l ""
lappend l [file size $path(test1)]
chan configure $f -translation crlf
lappend l [chan read $f 3]
@@ -6228,17 +6327,18 @@ test chan-io-49.4 {testing crlf reading, leftover cr disgorgment} {
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1"
-test chan-io-49.5 {testing crlf reading, leftover cr disgorgment} {
+} -result "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1"
+test chan-io-49.5 {testing crlf reading, leftover cr disgorgment} -setup {
file delete $path(test1)
+ set l ""
+} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "a\rb\rc\r\n"
chan close $f
set f [open $path(test1) r]
- set l ""
lappend l [file size $path(test1)]
chan configure $f -translation crlf
lappend l [set x [chan gets $f]]
@@ -6246,30 +6346,31 @@ test chan-io-49.5 {testing crlf reading, leftover cr disgorgment} {
lappend l [chan gets $f]
lappend l [chan tell $f]
lappend l [chan eof $f]
+} -cleanup {
chan close $f
- set l
-} [list 7 a\rb\rc 7 {} 7 1]
+} -result [list 7 a\rb\rc 7 {} 7 1]
-test chan-io-50.1 {testing handler deletion} {testchannelevent} {
+test chan-io-50.1 {testing handler deletion} -setup {
file delete $path(test1)
+} -constraints {testchannelevent} -body {
set f [open $path(test1) w]
chan close $f
set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delhandler $f]]
- proc delhandler {f} {
- variable z
- set z called
+ testchannelevent $f add readable [namespace code {
+ variable z called
testchannelevent $f delete 0
- }
- set z not_called
+ }]
+ variable z not_called
update
+ return $z
+} -cleanup {
chan close $f
- set z
-} called
-test chan-io-50.2 {testing handler deletion with multiple handlers} {testchannelevent} {
+} -result called
+test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
- set f [open $path(test1) w]
- chan close $f
+ 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]]
@@ -6278,20 +6379,20 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} {testchannel
lappend z "called delhandler $f $i"
testchannelevent $f delete 0
}
- set z ""
update
- chan close $f
- string compare [string tolower $z] \
+ string equal $z \
[list [list called delhandler $f 0] [list called delhandler $f 1]]
-} 0
-test chan-io-50.3 {testing handler deletion with multiple handlers} {testchannelevent} {
- file delete $path(test1)
- set f [open $path(test1) w]
+} -cleanup {
chan close $f
+} -result 1
+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]]
- set z ""
proc notcalled {f i} {
variable z
lappend z "notcalled was called!! $f $i"
@@ -6303,23 +6404,21 @@ test chan-io-50.3 {testing handler deletion with multiple handlers} {testchannel
testchannelevent $f delete 0
lappend z "delhandler $f $i deleted myself"
}
- set z ""
update
- chan close $f
- string compare [string tolower $z] \
+ string equal $z \
[list [list delhandler $f 0 called] \
[list delhandler $f 0 deleted myself]]
-} 0
-test chan-io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} {
+} -cleanup {
+ chan close $f
+} -result 1
+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 {
set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delrecursive $f]]
- proc delrecursive {f} {
- variable z
- variable u
- if {"$u" == "recursive"} {
+ testchannelevent $f add readable [namespace code {
+ if {$u eq "recursive"} {
testchannelevent $f delete 0
lappend z "delrecursive deleting recursive"
} else {
@@ -6327,18 +6426,19 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} {testchanneleven
set u recursive
update
}
- }
+ }]
variable u toplevel
variable z ""
update
+ return $z
+} -cleanup {
chan close $f
- string compare [string tolower $z] \
- {{delrecursive calling recursive} {delrecursive deleting recursive}}
-} 0
-test chan-io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} {
+} -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]]
@@ -6349,7 +6449,7 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} {testchanneleven
proc del {f} {
variable u
variable z
- if {"$u" == "recursive"} {
+ if {$u eq "recursive"} {
testchannelevent $f delete 1
testchannelevent $f delete 0
lappend z "del deleted notcalled"
@@ -6364,22 +6464,23 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} {testchanneleven
set z ""
set u toplevel
update
+ return $z
+} -cleanup {
chan close $f
- string compare [string tolower $z] \
- [list {del calling recursive} {del deleted notcalled} \
- {del deleted myself} {del after update}]
-} 0
-test chan-io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} {
+} -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]]
proc first {f} {
variable u
variable z
- if {"$u" == "toplevel"} {
+ if {$u eq "toplevel"} {
lappend z "first called"
set u first
update
@@ -6391,11 +6492,11 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} {testchanneleven
proc second {f} {
variable u
variable z
- if {"$u" == "first"} {
+ if {$u eq "first"} {
lappend z "second called, first time"
set u second
testchannelevent $f delete 0
- } elseif {"$u" == "second"} {
+ } elseif {$u eq "second"} {
lappend z "second called, second time"
testchannelevent $f delete 0
} else {
@@ -6406,74 +6507,74 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} {testchanneleven
set z ""
set u toplevel
update
+ return $z
+} -cleanup {
chan 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 update}]
-test chan-io-51.1 {Test old socket deletion on Macintosh} {socket} {
+test chan-io-51.1 {Test old socket deletion on Macintosh} -setup {
set x 0
set result ""
+ variable wait ""
+} -constraints {socket} -body {
proc accept {s a p} {
variable x
- variable wait
chan configure $s -blocking off
chan puts $s "sock[incr x]"
chan close $s
- set wait done
+ variable wait done
}
set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set port [lindex [chan configure $ss -sockname] 2]
- variable wait ""
set cs [socket 127.0.0.1 $port]
vwait [namespace which -variable wait]
lappend result [chan gets $cs]
chan close $cs
- set wait ""
set cs [socket 127.0.0.1 $port]
vwait [namespace which -variable wait]
lappend result [chan gets $cs]
chan close $cs
- set wait ""
set cs [socket 127.0.0.1 $port]
vwait [namespace which -variable wait]
lappend result [chan gets $cs]
chan close $cs
- set wait ""
set cs [socket 127.0.0.1 $port]
vwait [namespace which -variable wait]
lappend result [chan gets $cs]
+} -cleanup {
chan close $cs
chan close $ss
- set result
-} {sock1 sock2 sock3 sock4}
+} -result {sock1 sock2 sock3 sock4}
-test chan-io-52.1 {TclCopyChannel} {fcopy} {
+test chan-io-52.1 {TclCopyChannel} -constraints {fcopy} -setup {
file delete $path(test1)
+} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan copy $f1 $f2 -command { # }
- catch { chan copy $f1 $f2 } msg
+ chan copy $f1 $f2 -command " # "
+ chan copy $f1 $f2
+} -returnCodes error -cleanup {
chan close $f1
chan close $f2
- string compare $msg "channel \"$f1\" is busy"
-} {0}
-test chan-io-52.2 {TclCopyChannel} {fcopy} {
+} -match glob -result {channel "*" is busy}
+test chan-io-52.2 {TclCopyChannel} -constraints {fcopy} -setup {
file delete $path(test1)
+} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
set f3 [open $thisScript]
- chan copy $f1 $f2 -command { # }
- catch { chan copy $f3 $f2 } msg
+ chan copy $f1 $f2 -command " # "
+ chan copy $f3 $f2
+} -returnCodes error -cleanup {
chan close $f1
chan close $f2
chan close $f3
- string compare $msg "channel \"$f2\" is busy"
-} {0}
-test chan-io-52.3 {TclCopyChannel} {fcopy} {
+} -match glob -result {channel "*" is busy}
+test chan-io-52.3 {TclCopyChannel} -constraints {fcopy} -setup {
file delete $path(test1)
+} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
chan configure $f1 -translation lf -blocking 0
@@ -6484,13 +6585,14 @@ test chan-io-52.3 {TclCopyChannel} {fcopy} {
chan close $f2
set s1 [file size $thisScript]
set s2 [file size $path(test1)]
- if {("$s1" == "$s2") && ($s0 == $s1)} {
+ if {($s1 == $s2) && ($s0 == $s1)} {
lappend result ok
}
- set result
-} {0 0 ok}
-test chan-io-52.4 {TclCopyChannel} {fcopy} {
+ return $result
+} -result {0 0 ok}
+test chan-io-52.4 {TclCopyChannel} -constraints {fcopy} -setup {
file delete $path(test1)
+} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
chan configure $f1 -translation lf -blocking 0
@@ -6500,9 +6602,10 @@ test chan-io-52.4 {TclCopyChannel} {fcopy} {
chan close $f1
chan close $f2
lappend result [file size $path(test1)]
-} {0 0 40}
-test chan-io-52.5 {TclCopyChannel, all} {fcopy} {
+} -result {0 0 40}
+test chan-io-52.5 {TclCopyChannel, all} -constraints {fcopy} -setup {
file delete $path(test1)
+} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
chan configure $f1 -translation lf -blocking 0
@@ -6511,15 +6614,14 @@ test chan-io-52.5 {TclCopyChannel, all} {fcopy} {
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
chan close $f2
- set s1 [file size $thisScript]
- set s2 [file size $path(test1)]
- if {"$s1" == "$s2"} {
+ if {[file size $thisScript] == [file size $path(test1)]} {
lappend result ok
}
- set result
-} {0 0 ok}
-test chan-io-52.5a {TclCopyChannel, all, other negative value} {fcopy} {
+ return $result
+} -result {0 0 ok}
+test chan-io-52.5a {TclCopyChannel, all, other negative value} -setup {
file delete $path(test1)
+} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
chan configure $f1 -translation lf -blocking 0
@@ -6528,15 +6630,14 @@ test chan-io-52.5a {TclCopyChannel, all, other negative value} {fcopy} {
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
chan close $f2
- set s1 [file size $thisScript]
- set s2 [file size $path(test1)]
- if {"$s1" == "$s2"} {
+ if {[file size $thisScript] == [file size $path(test1)]} {
lappend result ok
}
- set result
-} {0 0 ok}
-test chan-io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} {
+ return $result
+} -result {0 0 ok}
+test chan-io-52.5b {TclCopyChannel, all, wrap to negative value} -setup {
file delete $path(test1)
+} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
chan configure $f1 -translation lf -blocking 0
@@ -6545,15 +6646,14 @@ test chan-io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} {
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
chan close $f2
- set s1 [file size $thisScript]
- set s2 [file size $path(test1)]
- if {"$s1" == "$s2"} {
+ if {[file size $thisScript] == [file size $path(test1)]} {
lappend result ok
}
- set result
-} {0 0 ok}
-test chan-io-52.6 {TclCopyChannel} {fcopy} {
+ return $result
+} -result {0 0 ok}
+test chan-io-52.6 {TclCopyChannel} -setup {
file delete $path(test1)
+} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
chan configure $f1 -translation lf -blocking 0
@@ -6564,31 +6664,32 @@ test chan-io-52.6 {TclCopyChannel} {fcopy} {
chan close $f2
set s1 [file size $thisScript]
set s2 [file size $path(test1)]
- if {("$s1" == "$s2") && ($s0 == $s1)} {
+ if {($s1 == $s2) && ($s0 == $s1)} {
lappend result ok
}
- set result
-} {0 0 ok}
-test chan-io-52.7 {TclCopyChannel} {fcopy} {
+ return $result
+} -result {0 0 ok}
+test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup {
file delete $path(test1)
+} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
chan configure $f1 -translation lf -blocking 0
chan configure $f2 -translation lf -blocking 0
chan copy $f1 $f2
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
- set s1 [file size $thisScript]
- set s2 [file size $path(test1)]
- chan close $f1
- chan close $f2
- if {"$s1" == "$s2"} {
+ if {[file size $thisScript] == [file size $path(test1)]} {
lappend result ok
}
- set result
-} {0 0 ok}
-test chan-io-52.8 {TclCopyChannel} {stdio openpipe fcopy} {
+ return $result
+} -cleanup {
+ chan close $f1
+ chan close $f2
+} -result {0 0 ok}
+test chan-io-52.8 {TclCopyChannel} -setup {
file delete $path(test1)
file delete $path(pipe)
+} -constraints {stdio openpipe fcopy} -body {
set f1 [open $path(pipe) w]
chan configure $f1 -translation lf
chan puts $f1 "
@@ -6600,7 +6701,7 @@ test chan-io-52.8 {TclCopyChannel} {stdio openpipe fcopy} {
chan close \$f1
"
chan close $f1
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
chan configure $f1 -translation lf
chan gets $f1
chan puts $f1 ready
@@ -6611,7 +6712,7 @@ test chan-io-52.8 {TclCopyChannel} {stdio openpipe fcopy} {
catch {chan close $f1}
chan close $f2
list $s0 [file size $path(test1)]
-} {40 40}
+} -result {40 40}
# Empty files, to register them with the test facility
set path(kyrillic.txt) [makeFile {} kyrillic.txt]
set path(utf8-fcopy.txt) [makeFile {} utf8-fcopy.txt]
@@ -6668,8 +6769,9 @@ test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} {
file size $path(kyrillic.txt)
} 3
-test chan-io-53.1 {CopyData} {fcopy} {
+test chan-io-53.1 {CopyData} -setup {
file delete $path(test1)
+} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
chan configure $f1 -translation lf -blocking 0
@@ -6679,9 +6781,10 @@ test chan-io-53.1 {CopyData} {fcopy} {
chan close $f1
chan close $f2
lappend result [file size $path(test1)]
-} {0 0 0}
-test chan-io-53.2 {CopyData} {fcopy} {
+} -result {0 0 0}
+test chan-io-53.2 {CopyData} -setup {
file delete $path(test1)
+} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
chan configure $f1 -translation lf -blocking 0
@@ -6694,18 +6797,19 @@ test chan-io-53.2 {CopyData} {fcopy} {
chan close $f2
set s1 [file size $thisScript]
set s2 [file size $path(test1)]
- if {("$s1" == "$s2") && ($s0 == $s1)} {
+ if {($s1 == $s2) && ($s0 == $s1)} {
lappend result ok
}
- set result
-} {0 0 ok}
-test chan-io-53.3 {CopyData: background read underflow} {stdio unix openpipe fcopy} {
+ return $result
+} -result {0 0 ok}
+test chan-io-53.3 {CopyData: background read underflow} -setup {
file delete $path(test1)
file delete $path(pipe)
+} -constraints {stdio unix openpipe fcopy} -body {
set f1 [open $path(pipe) w]
chan puts -nonewline $f1 {
chan puts ready
- chan flush stdout ;# Don't assume line buffered!
+ chan flush stdout ;# Don't assume line buffered!
chan copy stdin stdout -command { set x }
vwait x
set f [}
@@ -6716,7 +6820,7 @@ test chan-io-53.3 {CopyData: background read underflow} {stdio unix openpipe fco
chan close $f
}
chan close $f1
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
set result [chan gets $f1]
chan puts $f1 line1
chan flush $f1
@@ -6728,10 +6832,10 @@ test chan-io-53.3 {CopyData: background read underflow} {stdio unix openpipe fco
after 500
set f [open $path(test1)]
lappend result [chan read $f]
+} -cleanup {
chan close $f
- set result
-} "ready line1 line2 {done\n}"
-test chan-io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileevent fcopy} {
+} -result "ready line1 line2 {done\n}"
+test chan-io-53.4 {CopyData: background write overflow} -setup {
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
variable x
for {set x 0} {$x < 12} {incr x} {
@@ -6739,6 +6843,7 @@ test chan-io-53.4 {CopyData: background write overflow} {stdio unix openpipe fil
}
file delete $path(test1)
file delete $path(pipe)
+} -constraints {stdio unix openpipe fileevent fcopy} -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan puts ready
@@ -6750,7 +6855,7 @@ test chan-io-53.4 {CopyData: background write overflow} {stdio unix openpipe fil
chan close $f
}
chan close $f1
- set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ set f1 [openpipe r+ $path(pipe)]
set result [chan gets $f1]
chan configure $f1 -blocking 0
chan puts $f1 $big
@@ -6764,10 +6869,11 @@ test chan-io-53.4 {CopyData: background write overflow} {stdio unix openpipe fil
}
}]
vwait [namespace which -variable x]
- chan close $f1
+ return $x
+} -cleanup {
set big {}
- set x
-} done
+ chan close $f1
+} -result done
set result {}
proc FcopyTestAccept {sock args} {
after 1000 "chan close $sock"
@@ -6796,25 +6902,27 @@ test chan-io-53.5 {CopyData: error during chan copy} {socket fcopy} {
chan close $out
set fcopyTestDone ;# 1 for error condition
} 1
-test chan-io-53.6 {CopyData: error during chan copy} {stdio openpipe fcopy} {
+test chan-io-53.6 {CopyData: error during chan copy} -setup {
variable fcopyTestDone
file delete $path(pipe)
file delete $path(test1)
catch {unset fcopyTestDone}
+} -constraints {stdio openpipe fcopy} -body {
set f1 [open $path(pipe) w]
chan puts $f1 "exit 1"
chan close $f1
- set in [open "|[list [interpreter] $path(pipe)]" r+]
+ set in [openpipe r+ $path(pipe)]
set out [open $path(test1) w]
chan copy $in $out -command [namespace code FcopyTestDone]
variable fcopyTestDone
if ![info exists fcopyTestDone] {
vwait [namespace which -variable fcopyTestDone]
}
+ return $fcopyTestDone ;# 0 for plain end of file
+} -cleanup {
catch {chan close $in}
chan close $out
- set fcopyTestDone ;# 0 for plain end of file
-} {0}
+} -result 0
proc doFcopy {in out {bytes 0} {error {}}} {
variable fcopyTestDone
variable fcopyTestCount
@@ -6829,10 +6937,11 @@ proc doFcopy {in out {bytes 0} {error {}}} {
-command [namespace code [list doFcopy $in $out]]]
}
}
-test chan-io-53.7 {CopyData: Flooding chan copy from pipe} {stdio openpipe fcopy} {
+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 {
set fcopyTestCount 0
set f1 [open $path(pipe) w]
chan puts $f1 {
@@ -6851,21 +6960,22 @@ test chan-io-53.7 {CopyData: Flooding chan copy from pipe} {stdio openpipe fcopy
exit 0
}
chan close $f1
- set in [open "|[list [interpreter] $path(pipe) &]" r+]
+ set in [openpipe r+ $path(pipe) &]
set out [open $path(test1) w]
doFcopy $in $out
variable fcopyTestDone
- if ![info exists fcopyTestDone] {
+ if {![info exists fcopyTestDone]} {
vwait [namespace which -variable fcopyTestDone]
}
- catch {chan close $in}
- chan close $out
# -1=error 0=script error N=number of bytes
expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
-} {3450}
+} -cleanup {
+ catch {chan close $in}
+ chan close $out
+} -result {3450}
test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
# copy progress callback. errors out intentionally
- proc ::cmd args {
+ proc cmd args {
lappend ::RES "CMD $args"
error !STOP
}
@@ -6885,12 +6995,12 @@ test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -se
# Record input size, so that result is always defined
lappend ::RES [file size $bar]
# Run the copy. Should not invoke -command now.
- chan copy $f $g -size 2 -command ::cmd
+ chan copy $f $g -size 2 -command [namespace code cmd]
# Check that -command was not called synchronously
set sbs [file size $bar]
lappend ::RES [expr {($sbs > 0) ? "sync/FAIL" : "sync/OK"}] $sbs
- # Now let the async part happen. Should capture the error in cmd
- # via bgerror. If not break the event loop via timer.
+ # Now let the async part happen. Should capture the error in cmd via
+ # bgerror. If not break the event loop via timer.
set token [after 1000 {
lappend ::RES {bgerror/FAIL timeout}
set ::forever has-been-reached
@@ -6898,20 +7008,19 @@ test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -se
vwait ::forever
catch {after cancel $token}
# Report
- set ::RES
+ return $::RES
} -cleanup {
chan close $f
chan close $g
catch {unset ::RES}
catch {unset ::forever}
- rename ::cmd {}
rename ::bgerror {}
removeFile foo
removeFile bar
} -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}}
test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} -setup {
- # copy progress callback. errors out intentionally
- proc ::cmd args {
+ # copy progress callback.
+ proc cmd args {
lappend ::RES "CMD $args"
set ::forever has-been-reached
return
@@ -6927,7 +7036,7 @@ test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at
chan seek $f 0 end ; chan read $f 1
set ::RES [chan eof $f]
# Run the copy. Should not invoke -command now.
- chan copy $f $g -size 2 -command ::cmd
+ chan copy $f $g -size 2 -command [namespace code cmd]
# Check that -command was not called synchronously
lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}]
# Now let the async part happen. Should capture the eof in cmd
@@ -6939,13 +7048,12 @@ test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at
vwait ::forever
catch {after cancel $token}
# Report
- set ::RES
+ return $::RES
} -cleanup {
chan close $f
chan close $g
catch {unset ::RES}
catch {unset ::forever}
- rename ::cmd {}
removeFile foo
removeFile bar
} -result {1 sync/OK {CMD 0}}
@@ -6992,8 +7100,10 @@ test chan-io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
} -cleanup {
chan close $pipe
rename ::done {}
- after 1000; # Allow Windows time to figure out that the
+ if {[testConstraint win]} {
+ after 1000; # Allow Windows time to figure out that the
# process is gone
+ }
catch {close $out}
catch {removeFile out}
catch {removeFile err}
@@ -7021,7 +7131,7 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
global l srv
chan configure $sok -translation binary -buffering none
lappend l $sok
- if {[llength $l]==2} {
+ if {[llength $l] == 2} {
chan close $srv
foreach {a b} $l break
chan copy $a $b -command [list geof $a]
@@ -7041,7 +7151,7 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
# wait for OK from server.
chan gets $pipe
# Now the two clients.
- proc ::done {sock} {
+ proc done {sock} {
if {[chan eof $sock]} { chan close $sock ; return }
lappend ::forever [chan gets $sock]
return
@@ -7050,8 +7160,8 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
set b [socket 127.0.0.1 9999]
chan configure $a -translation binary -buffering none
chan configure $b -translation binary -buffering none
- chan event $a readable [list ::done $a]
- chan event $b readable [list ::done $b]
+ chan event $a readable [namespace code "done $a"]
+ chan event $b readable [namespace code "done $b"]
} -constraints {stdio openpipe fcopy} -body {
# Now pass data through the server in both directions.
set ::forever {}
@@ -7064,8 +7174,9 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
catch {chan close $a}
catch {chan close $b}
chan close $pipe
- rename ::done {}
- after 1000 ;# Give Windows time to kill the process
+ if {[testConstraint win]} {
+ after 1000 ;# Give Windows time to kill the process
+ }
removeFile err
catch {unset ::forever}
} -result {AB BA}
@@ -7095,7 +7206,9 @@ test chan-io-54.1 {Recursive channel events} {socket fileevent} {
# completes.
set done 0
for {set i 0} {$i < 10} {incr i} {
- if {![catch {set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]]}]} {
+ if {![catch {
+ set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]]
+ }]} then {
set done 1
break
}
@@ -7121,9 +7234,11 @@ test chan-io-54.1 {Recursive channel events} {socket fileevent} {
chan close $cs
list $result $x
} {{{line 1} 1 2} 2}
-test chan-io-54.2 {Testing for busy-wait in recursive channel events} {socket fileevent} {
+test chan-io-54.2 {Testing for busy-wait in recursive channel events} -setup {
set accept {}
set after {}
+ variable done 0
+} -constraints {socket fileevent} -body {
variable s [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
proc accept {s a p} {
variable counter 0
@@ -7135,17 +7250,20 @@ test chan-io-54.2 {Testing for busy-wait in recursive channel events} {socket fi
variable counter
variable after
incr counter
- set l [chan gets $s]
- if {"$l" == ""} {
+ if {[chan gets $s] eq ""} {
chan event $s readable [namespace code "doit1 $s"]
- set after [after 1000 [namespace code newline]]
+ set after [after 1000 [namespace code {
+ chan puts $writer hello
+ chan flush $writer
+ set done 1
+ }]]
}
}
proc doit1 {s} {
variable counter
variable accept
incr counter
- set l [chan gets $s]
+ chan gets $s
chan close $s
set accept {}
}
@@ -7157,22 +7275,15 @@ test chan-io-54.2 {Testing for busy-wait in recursive channel events} {socket fi
chan puts -nonewline $writer hello
chan flush $writer
}
- proc newline {} {
- variable done
- variable writer
- chan puts $writer hello
- chan flush $writer
- set done 1
- }
producer
- variable done
vwait [namespace which -variable done]
chan close $writer
chan close $s
after cancel $after
+ return $counter
+} -cleanup {
if {$accept ne {}} {chan close $accept}
- set counter
-} 1
+} -result 1
set path(fooBar) [makeFile {} fooBar]
@@ -7196,7 +7307,7 @@ test chan-io-55.1 {ChannelEventScriptInvoker: deletion} -constraints {
chan event $f writable [namespace code [list eventScript $f]]
variable x not_done
vwait [namespace which -variable x]
- set x
+ return $x
} -cleanup {
interp bgerror {} $handler
} -result {got_error}
@@ -7222,14 +7333,15 @@ test chan-io-56.1 {ChannelTimerProc} {testchannelevent} {
lappend result $y
} {2 done}
-test chan-io-57.1 {buffered data and file events, gets} {fileevent} {
+test chan-io-57.1 {buffered data and file events, gets} -setup {
+ variable s2
+} -constraints {fileevent} -body {
proc accept {sock args} {
variable s2
set s2 $sock
}
set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set s [socket 127.0.0.1 [lindex [chan configure $server -sockname] 2]]
- variable s2
vwait [namespace which -variable s2]
update
chan event $s2 readable [namespace code {lappend result readable}]
@@ -7240,19 +7352,21 @@ test chan-io-57.1 {buffered data and file events, gets} {fileevent} {
vwait [namespace which -variable result]
lappend result [chan gets $s2]
vwait [namespace which -variable result]
+ return $result
+} -cleanup {
chan close $s
chan close $s2
chan close $server
- set result
-} {12 readable 34567890 timer}
-test chan-io-57.2 {buffered data and file events, read} {fileevent} {
+} -result {12 readable 34567890 timer}
+test chan-io-57.2 {buffered data and file events, read} -setup {
+ variable s2
+} -constraints {fileevent} -body {
proc accept {sock args} {
variable s2
set s2 $sock
}
set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set s [socket 127.0.0.1 [lindex [chan configure $server -sockname] 2]]
- variable s2
vwait [namespace which -variable s2]
update
chan event $s2 readable [namespace code {lappend result readable}]
@@ -7263,11 +7377,12 @@ test chan-io-57.2 {buffered data and file events, read} {fileevent} {
vwait [namespace which -variable result]
lappend result [chan read $s2 9]
vwait [namespace which -variable result]
+ return $result
+} -cleanup {
chan close $s
chan close $s2
chan close $server
- set result
-} {1 readable 234567890 timer}
+} -result {1 readable 234567890 timer}
test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc openpipe fileevent} {
set out [open $path(script) w]
@@ -7288,7 +7403,7 @@ test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc ope
}
}
chan close $out
- set pipe [open "|[list [interpreter] $path(script)]" r]
+ set pipe [openpipe r $path(script)]
chan event $pipe readable [namespace code [list readit $pipe]]
variable x ""
set result ""
@@ -7301,7 +7416,6 @@ test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} {
# More complicated tests (like that the reference changes as a channel is
# moved from thread to thread) can be done only in the extension which
# fully implements the moving of channels between threads, i.e. 'Threads'.
- # Or we have to extend [testthread] as well.
set f [open $path(longfile) r]
set result [testchannel mthread $f]
chan close $f
@@ -7327,7 +7441,7 @@ test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent} {
}
}
chan close $out
- set pipe [open "|[list [interpreter] $path(script)]" r]
+ set pipe [openpipe r $path(script)]
chan event $pipe readable [namespace code [list readit $pipe]]
variable x ""
set result ""
@@ -7358,9 +7472,8 @@ test chan-io-61.1 {Reset eof state after changing the eof char} -setup {
#chan seek $f 0 start
#chan seek $f 0 current
#lappend res [chan read $f; chan tell $f]
- chan close $f
- set res
} -cleanup {
+ chan close $f
removeFile eofchar
} -result {77 = 23431}
@@ -7369,51 +7482,42 @@ test chan-io-61.1 {Reset eof state after changing the eof char} -setup {
# can also be used to emulate transfer of channels between threads, and is
# used for that here.
-test chan-io-70.0 {Cutting & Splicing channels} {testchannel} {
+test chan-io-70.0 {Cutting & Splicing channels} -setup {
set f [makeFile {... dummy ...} cutsplice]
+ set res {}
+} -constraints {testchannel} -body {
set c [open $f r]
- set res {}
lappend res [catch {chan seek $c 0 start}]
testchannel cut $c
lappend res [catch {chan seek $c 0 start}]
testchannel splice $c
lappend res [catch {chan seek $c 0 start}]
+} -cleanup {
chan close $c
removeFile cutsplice
- set res
-} {0 1 0}
-# Duplicate of code in "thread.test". Find a better way of doing this without
-# duplication. Maybe placement into a proc which transforms to nop after the
-# first call, and placement of its defintion in a central location.
-if {[testConstraint testthread]} {
- testthread errorproc ThreadError
- proc ThreadError {id info} {
- global threadError
- set threadError $info
- }
- proc ThreadNullError {id info} {
- # ignore
- }
-}
-test chan-io-70.1 {Transfer channel} {testchannel testthread} {
+} -result {0 1 0}
+
+test chan-io-70.1 {Transfer channel} -setup {
set f [makeFile {... dummy ...} cutsplice]
+ set res {}
+} -constraints {testchannel thread} -body {
set c [open $f r]
- set res {}
lappend res [catch {chan seek $c 0 start}]
testchannel cut $c
lappend res [catch {chan seek $c 0 start}]
- set tid [testthread create]
- testthread send $tid [list set c $c]
- lappend res [testthread send $tid {
+ set tid [thread::create -preserved]
+ thread::send $tid [list set c $c]
+ thread::send $tid {load {} Tcltest}
+ lappend res [thread::send $tid {
testchannel splice $c
set res [catch {chan seek $c 0 start}]
chan close $c
set res
}]
- tcltest::threadReap
+} -cleanup {
+ thread::release $tid
removeFile cutsplice
- set res
-} {0 1 0}
+} -result {0 1 0}
# ### ### ### ######### ######### #########
@@ -7578,34 +7682,36 @@ foreach {n msg expected} {
f2 {-code ok -code 0 -level X -f ba} {-code 1 -level 0 -f ba}
f3 {-code boss -code 0 -level X -f ba} {-code 1 -level 0 -f ba}
} {
- test chan-io-71.$n {Tcl_SetChannelError} {testchannel} {
+ test chan-io-71.$n {Tcl_SetChannelError} -setup {
set f [makeFile {... dummy ...} cutsplice]
+ } -constraints {testchannel} -body {
set c [open $f r]
- set res [testchannel setchannelerror $c [lrange $msg 0 end]]
+ testchannel setchannelerror $c [lrange $msg 0 end]
+ } -cleanup {
chan close $c
removeFile cutsplice
- set res
- } [lrange $expected 0 end]
- test chan-io-72.$n {Tcl_SetChannelErrorInterp} {testchannel} {
+ } -result [lrange $expected 0 end]
+ test chan-io-72.$n {Tcl_SetChannelErrorInterp} -setup {
set f [makeFile {... dummy ...} cutsplice]
+ } -constraints {testchannel} -body {
set c [open $f r]
- set res [testchannel setchannelerrorinterp $c [lrange $msg 0 end]]
+ testchannel setchannelerrorinterp $c [lrange $msg 0 end]
+ } -cleanup {
chan close $c
removeFile cutsplice
- set res
- } [lrange $expected 0 end]
+ } -result [lrange $expected 0 end]
}
-test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
+test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} -body {
# Test for Bug 1847044 - don't spoil type unless we have a valid channel
- catch {chan close [lreplace [list a] 0 end]}
-} {1}
+ chan close [lreplace [list a] 0 end]
+} -returnCodes error -match glob -result *
# ### ### ### ######### ######### #########
# cleanup
foreach file [list fooBar longfile script output test1 pipe my_script \
- test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
+ test2 test3 cat kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
removeFile $file
}
cleanupTests
diff --git a/tests/clock.test b/tests/clock.test
index d5957bd..0202fc7 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: clock.test,v 1.94 2009/10/29 01:17:54 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -19,11 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
}
if {[testConstraint win]} {
- if {[catch {package require registry 1.1}]
- && [catch {load {} Registry}]
- && [catch {
+ if {[catch {
::tcltest::loadTestedCommands
- load $::reglib Registry
+ package require registry
}]} {
namespace eval ::tcl::clock {variable NoRegistry {}}
}
@@ -35897,6 +35893,39 @@ test clock-38.1 {regression - convertUTCToLocalViaC - east of Greenwich} \
} \
-result {01:00:00}
+test clock-38.2 {make sure TZ is not cached after unset} \
+ -setup {
+ if { [info exists env(TZ)] } {
+ set oldTZ $env(TZ)
+ unset env(TZ)
+ }
+ if { [info exists env(TCL_TZ)] } {
+ set oldTCLTZ $env(TCL_TZ)
+ unset env(TCL_TZ)
+ }
+ } \
+ -body {
+ set t1 [clock format 0]
+ # a time zone that is unlikely to anywhere
+ set env(TZ) "+04:20"
+ set t2 [clock format 0]
+ unset env(TZ)
+ set t3 [clock format 0]
+ expr {$t1 eq $t3 && $t1 ne $t2}
+ } \
+ -cleanup {
+ if { [info exists oldTZ] } {
+ set env(TZ) $oldTZ
+ unset oldTZ
+ }
+ if { [info exists oldTclTZ] } {
+ set env(TCL_TZ) $oldTclTZ
+ unset oldTclTZ
+ }
+ } \
+ -result 1
+
+
test clock-39.1 {regression - synonym timezones} {
clock format 0 -format {%H:%M:%S} -timezone :US/Eastern
} {19:00:00}
@@ -36519,6 +36548,154 @@ test clock-56.3 {use of zoneinfo, version 2, Y2038 compliance} {*}{
-result {2040-07-01 00:00:00 PDT}
}
+test clock-56.4 {Bug 3470928} {*}{
+ -setup {
+ clock format [clock seconds]
+ set tzdir [makeDirectory zoneinfo]
+ set tzdir2 [makeDirectory Test $tzdir]
+ set tzfile [makeFile {} Windhoek $tzdir2]
+ set f [open $tzfile wb]
+ puts -nonewline $f [binary format c* {
+ 0x54 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
+ 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x06 0x00 0x00
+ 0x00 0x06 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x5c 0x00 0x00 0x00
+ 0x06 0x00 0x00 0x00 0x13 0x82 0x46 0xcf 0x68 0xcc 0xae 0x8c 0x80
+ 0xcd 0x9e 0x6f 0x70 0x26 0x06 0xa7 0xe0 0x2d 0x9d 0xea 0xe0 0x2e
+ 0x69 0x1c 0x10 0x2f 0x7d 0xe9 0x00 0x30 0x48 0xfe 0x10 0x31 0x67
+ 0x05 0x80 0x32 0x28 0xe0 0x10 0x33 0x46 0xe7 0x80 0x34 0x11 0xfc
+ 0x90 0x35 0x26 0xc9 0x80 0x35 0xf1 0xde 0x90 0x37 0x06 0xab 0x80
+ 0x37 0xd1 0xc0 0x90 0x38 0xe6 0x8d 0x80 0x39 0xb1 0xa2 0x90 0x3a
+ 0xc6 0x6f 0x80 0x3b 0x91 0x84 0x90 0x3c 0xaf 0x8c 0x00 0x3d 0x71
+ 0x66 0x90 0x3e 0x8f 0x6e 0x00 0x3f 0x5a 0x83 0x10 0x40 0x6f 0x50
+ 0x00 0x41 0x3a 0x65 0x10 0x42 0x4f 0x32 0x00 0x43 0x1a 0x47 0x10
+ 0x44 0x2f 0x14 0x00 0x44 0xfa 0x29 0x10 0x46 0x0e 0xf6 0x00 0x46
+ 0xda 0x0b 0x10 0x47 0xf8 0x12 0x80 0x48 0xc3 0x27 0x90 0x49 0xd7
+ 0xf4 0x80 0x4a 0xa3 0x09 0x90 0x4b 0xb7 0xd6 0x80 0x4c 0x82 0xeb
+ 0x90 0x4d 0x97 0xb8 0x80 0x4e 0x62 0xcd 0x90 0x4f 0x77 0x9a 0x80
+ 0x50 0x42 0xaf 0x90 0x51 0x60 0xb7 0x00 0x52 0x22 0x91 0x90 0x53
+ 0x40 0x99 0x00 0x54 0x0b 0xae 0x10 0x55 0x20 0x7b 0x00 0x55 0xeb
+ 0x90 0x10 0x57 0x00 0x5d 0x00 0x57 0xcb 0x72 0x10 0x58 0xe0 0x3f
+ 0x00 0x59 0xab 0x54 0x10 0x5a 0xc0 0x21 0x00 0x5b 0x8b 0x36 0x10
+ 0x5c 0xa9 0x3d 0x80 0x5d 0x6b 0x18 0x10 0x5e 0x89 0x1f 0x80 0x5f
+ 0x54 0x34 0x90 0x60 0x69 0x01 0x80 0x61 0x34 0x16 0x90 0x62 0x48
+ 0xe3 0x80 0x63 0x13 0xf8 0x90 0x64 0x28 0xc5 0x80 0x64 0xf3 0xda
+ 0x90 0x66 0x11 0xe2 0x00 0x66 0xd3 0xbc 0x90 0x67 0xf1 0xc4 0x00
+ 0x68 0xbc 0xd9 0x10 0x69 0xd1 0xa6 0x00 0x6a 0x9c 0xbb 0x10 0x6b
+ 0xb1 0x88 0x00 0x6c 0x7c 0x9d 0x10 0x6d 0x91 0x6a 0x00 0x6e 0x5c
+ 0x7f 0x10 0x6f 0x71 0x4c 0x00 0x70 0x3c 0x61 0x10 0x71 0x5a 0x68
+ 0x80 0x72 0x1c 0x43 0x10 0x73 0x3a 0x4a 0x80 0x74 0x05 0x5f 0x90
+ 0x75 0x1a 0x2c 0x80 0x75 0xe5 0x41 0x90 0x76 0xfa 0x0e 0x80 0x77
+ 0xc5 0x23 0x90 0x78 0xd9 0xf0 0x80 0x79 0xa5 0x05 0x90 0x7a 0xb9
+ 0xd2 0x80 0x7b 0x84 0xe7 0x90 0x7c 0xa2 0xef 0x00 0x7d 0x6e 0x04
+ 0x10 0x7e 0x82 0xd1 0x00 0x7f 0x4d 0xe6 0x10 0x01 0x02 0x01 0x03
+ 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05
+ 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04
+ 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05
+ 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04
+ 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05
+ 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04
+ 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x00 0x00 0x15
+ 0x18 0x00 0x00 0x00 0x00 0x1c 0x20 0x00 0x05 0x00 0x00 0x2a 0x30
+ 0x01 0x05 0x00 0x00 0x1c 0x20 0x00 0x0a 0x00 0x00 0x1c 0x20 0x01
+ 0x0e 0x00 0x00 0x0e 0x10 0x00 0x01 0x53 0x57 0x41 0x54 0x00 0x53
+ 0x41 0x53 0x54 0x00 0x43 0x41 0x54 0x00 0x57 0x41 0x53 0x54 0x00
+ 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x54
+ 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
+ 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x07 0x00 0x00 0x00
+ 0x07 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x5d 0x00 0x00 0x00 0x07
+ 0x00 0x00 0x00 0x17 0xff 0xff 0xff 0xff 0x6d 0x7b 0x4b 0x78 0xff
+ 0xff 0xff 0xff 0x82 0x46 0xcf 0x68 0xff 0xff 0xff 0xff 0xcc 0xae
+ 0x8c 0x80 0xff 0xff 0xff 0xff 0xcd 0x9e 0x6f 0x70 0x00 0x00 0x00
+ 0x00 0x26 0x06 0xa7 0xe0 0x00 0x00 0x00 0x00 0x2d 0x9d 0xea 0xe0
+ 0x00 0x00 0x00 0x00 0x2e 0x69 0x1c 0x10 0x00 0x00 0x00 0x00 0x2f
+ 0x7d 0xe9 0x00 0x00 0x00 0x00 0x00 0x30 0x48 0xfe 0x10 0x00 0x00
+ 0x00 0x00 0x31 0x67 0x05 0x80 0x00 0x00 0x00 0x00 0x32 0x28 0xe0
+ 0x10 0x00 0x00 0x00 0x00 0x33 0x46 0xe7 0x80 0x00 0x00 0x00 0x00
+ 0x34 0x11 0xfc 0x90 0x00 0x00 0x00 0x00 0x35 0x26 0xc9 0x80 0x00
+ 0x00 0x00 0x00 0x35 0xf1 0xde 0x90 0x00 0x00 0x00 0x00 0x37 0x06
+ 0xab 0x80 0x00 0x00 0x00 0x00 0x37 0xd1 0xc0 0x90 0x00 0x00 0x00
+ 0x00 0x38 0xe6 0x8d 0x80 0x00 0x00 0x00 0x00 0x39 0xb1 0xa2 0x90
+ 0x00 0x00 0x00 0x00 0x3a 0xc6 0x6f 0x80 0x00 0x00 0x00 0x00 0x3b
+ 0x91 0x84 0x90 0x00 0x00 0x00 0x00 0x3c 0xaf 0x8c 0x00 0x00 0x00
+ 0x00 0x00 0x3d 0x71 0x66 0x90 0x00 0x00 0x00 0x00 0x3e 0x8f 0x6e
+ 0x00 0x00 0x00 0x00 0x00 0x3f 0x5a 0x83 0x10 0x00 0x00 0x00 0x00
+ 0x40 0x6f 0x50 0x00 0x00 0x00 0x00 0x00 0x41 0x3a 0x65 0x10 0x00
+ 0x00 0x00 0x00 0x42 0x4f 0x32 0x00 0x00 0x00 0x00 0x00 0x43 0x1a
+ 0x47 0x10 0x00 0x00 0x00 0x00 0x44 0x2f 0x14 0x00 0x00 0x00 0x00
+ 0x00 0x44 0xfa 0x29 0x10 0x00 0x00 0x00 0x00 0x46 0x0e 0xf6 0x00
+ 0x00 0x00 0x00 0x00 0x46 0xda 0x0b 0x10 0x00 0x00 0x00 0x00 0x47
+ 0xf8 0x12 0x80 0x00 0x00 0x00 0x00 0x48 0xc3 0x27 0x90 0x00 0x00
+ 0x00 0x00 0x49 0xd7 0xf4 0x80 0x00 0x00 0x00 0x00 0x4a 0xa3 0x09
+ 0x90 0x00 0x00 0x00 0x00 0x4b 0xb7 0xd6 0x80 0x00 0x00 0x00 0x00
+ 0x4c 0x82 0xeb 0x90 0x00 0x00 0x00 0x00 0x4d 0x97 0xb8 0x80 0x00
+ 0x00 0x00 0x00 0x4e 0x62 0xcd 0x90 0x00 0x00 0x00 0x00 0x4f 0x77
+ 0x9a 0x80 0x00 0x00 0x00 0x00 0x50 0x42 0xaf 0x90 0x00 0x00 0x00
+ 0x00 0x51 0x60 0xb7 0x00 0x00 0x00 0x00 0x00 0x52 0x22 0x91 0x90
+ 0x00 0x00 0x00 0x00 0x53 0x40 0x99 0x00 0x00 0x00 0x00 0x00 0x54
+ 0x0b 0xae 0x10 0x00 0x00 0x00 0x00 0x55 0x20 0x7b 0x00 0x00 0x00
+ 0x00 0x00 0x55 0xeb 0x90 0x10 0x00 0x00 0x00 0x00 0x57 0x00 0x5d
+ 0x00 0x00 0x00 0x00 0x00 0x57 0xcb 0x72 0x10 0x00 0x00 0x00 0x00
+ 0x58 0xe0 0x3f 0x00 0x00 0x00 0x00 0x00 0x59 0xab 0x54 0x10 0x00
+ 0x00 0x00 0x00 0x5a 0xc0 0x21 0x00 0x00 0x00 0x00 0x00 0x5b 0x8b
+ 0x36 0x10 0x00 0x00 0x00 0x00 0x5c 0xa9 0x3d 0x80 0x00 0x00 0x00
+ 0x00 0x5d 0x6b 0x18 0x10 0x00 0x00 0x00 0x00 0x5e 0x89 0x1f 0x80
+ 0x00 0x00 0x00 0x00 0x5f 0x54 0x34 0x90 0x00 0x00 0x00 0x00 0x60
+ 0x69 0x01 0x80 0x00 0x00 0x00 0x00 0x61 0x34 0x16 0x90 0x00 0x00
+ 0x00 0x00 0x62 0x48 0xe3 0x80 0x00 0x00 0x00 0x00 0x63 0x13 0xf8
+ 0x90 0x00 0x00 0x00 0x00 0x64 0x28 0xc5 0x80 0x00 0x00 0x00 0x00
+ 0x64 0xf3 0xda 0x90 0x00 0x00 0x00 0x00 0x66 0x11 0xe2 0x00 0x00
+ 0x00 0x00 0x00 0x66 0xd3 0xbc 0x90 0x00 0x00 0x00 0x00 0x67 0xf1
+ 0xc4 0x00 0x00 0x00 0x00 0x00 0x68 0xbc 0xd9 0x10 0x00 0x00 0x00
+ 0x00 0x69 0xd1 0xa6 0x00 0x00 0x00 0x00 0x00 0x6a 0x9c 0xbb 0x10
+ 0x00 0x00 0x00 0x00 0x6b 0xb1 0x88 0x00 0x00 0x00 0x00 0x00 0x6c
+ 0x7c 0x9d 0x10 0x00 0x00 0x00 0x00 0x6d 0x91 0x6a 0x00 0x00 0x00
+ 0x00 0x00 0x6e 0x5c 0x7f 0x10 0x00 0x00 0x00 0x00 0x6f 0x71 0x4c
+ 0x00 0x00 0x00 0x00 0x00 0x70 0x3c 0x61 0x10 0x00 0x00 0x00 0x00
+ 0x71 0x5a 0x68 0x80 0x00 0x00 0x00 0x00 0x72 0x1c 0x43 0x10 0x00
+ 0x00 0x00 0x00 0x73 0x3a 0x4a 0x80 0x00 0x00 0x00 0x00 0x74 0x05
+ 0x5f 0x90 0x00 0x00 0x00 0x00 0x75 0x1a 0x2c 0x80 0x00 0x00 0x00
+ 0x00 0x75 0xe5 0x41 0x90 0x00 0x00 0x00 0x00 0x76 0xfa 0x0e 0x80
+ 0x00 0x00 0x00 0x00 0x77 0xc5 0x23 0x90 0x00 0x00 0x00 0x00 0x78
+ 0xd9 0xf0 0x80 0x00 0x00 0x00 0x00 0x79 0xa5 0x05 0x90 0x00 0x00
+ 0x00 0x00 0x7a 0xb9 0xd2 0x80 0x00 0x00 0x00 0x00 0x7b 0x84 0xe7
+ 0x90 0x00 0x00 0x00 0x00 0x7c 0xa2 0xef 0x00 0x00 0x00 0x00 0x00
+ 0x7d 0x6e 0x04 0x10 0x00 0x00 0x00 0x00 0x7e 0x82 0xd1 0x00 0x00
+ 0x00 0x00 0x00 0x7f 0x4d 0xe6 0x10 0x01 0x02 0x03 0x02 0x04 0x06
+ 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05
+ 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06
+ 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05
+ 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06
+ 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05
+ 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06
+ 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x00 0x00 0x10 0x08
+ 0x00 0x00 0x00 0x00 0x15 0x18 0x00 0x04 0x00 0x00 0x1c 0x20 0x00
+ 0x09 0x00 0x00 0x2a 0x30 0x01 0x09 0x00 0x00 0x1c 0x20 0x00 0x0e
+ 0x00 0x00 0x1c 0x20 0x01 0x12 0x00 0x00 0x0e 0x10 0x00 0x05 0x4c
+ 0x4d 0x54 0x00 0x53 0x57 0x41 0x54 0x00 0x53 0x41 0x53 0x54 0x00
+ 0x43 0x41 0x54 0x00 0x57 0x41 0x53 0x54 0x00 0x00 0x00 0x00 0x00
+ 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a 0x57 0x41
+ 0x54 0x2d 0x31 0x57 0x41 0x53 0x54 0x2c 0x4d 0x39 0x2e 0x31 0x2e
+ 0x30 0x2c 0x4d 0x34 0x2e 0x31 0x2e 0x30 0x0a
+ }]
+ close $f
+ set ::tcl::clock::ZoneinfoPaths \
+ [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir]
+ ::tcl::clock::ClearCaches
+ }
+ -body {
+ clock format 1326054606 -timezone :Test/Windhoek
+ }
+ -cleanup {
+ set ::tcl::clock::ZoneinfoPaths \
+ [lrange $::tcl::clock::ZoneinfoPaths 1 end]
+ ::tcl::clock::ClearCaches
+ removeFile Windhoek $tzdir2
+ removeDirectory Test $tzdir
+ removeDirectory zoneinfo
+ }
+ -result {Sun Jan 08 22:30:06 WAST 2012}
+}
+
test clock-57.1 {clock scan - abbreviated options} {
clock scan 1970-01-01 -f %Y-%m-%d -g true
} 0
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index f7ba584..3051bfb 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -9,14 +9,15 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: cmdAH.test,v 1.68 2010/02/05 14:33:09 dkf Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2.1
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testchmod [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype [llength [info commands testvolumetype]]
@@ -69,6 +70,12 @@ test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
test cmdAH-1.3 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
catch foo bar baz spaz
} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
+test cmdAH-1.4 {Bug 3595576} {
+ catch {catch {} -> noSuchNs::var}
+} 1
+test cmdAH-1.5 {Bug 3595576} {
+ catch {catch error -> noSuchNs::var}
+} 1
test cmdAH-2.1 {Tcl_CdObjCmd} -returnCodes error -body {
cd foo bar
@@ -218,10 +225,10 @@ test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup {
test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
file
-} -result {wrong # args: should be "file option ?arg ...?"}
+} -result {wrong # args: should be "file subcommand ?arg ...?"}
test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
file x
-} -result {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
+} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body {
file exists
} -result {wrong # args: should be "file exists name"}
@@ -236,14 +243,15 @@ test cmdAH-6.1 {Tcl_FileObjCmd: volumes} -returnCodes error -body {
test cmdAH-6.2 {Tcl_FileObjCmd: volumes} -body {
lindex [file volumes] 0
} -match glob -result ?*
-test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {unix} {
+test cmdAH-6.3 {Tcl_FileObjCmd: volumes} -constraints unix -body {
set volumeList [file volumes]
- catch [list glob -nocomplain [lindex $volumeList 0]*]
-} {0}
-test cmdAH-6.4 {Tcl_FileObjCmd: volumes} win {
+ glob -nocomplain [lindex $volumeList 0]*
+} -match glob -result *
+test cmdAH-6.4 {Tcl_FileObjCmd: volumes} -constraints win -body {
set volumeList [string tolower [file volumes]]
- list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
-} {0 1 0}
+ set element [lsearch -exact $volumeList "c:/"]
+ list [expr {$element>-1}] [glob -nocomplain [lindex $volumeList $element]*]
+} -match glob -result {1 *}
# attributes
test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} -setup {
@@ -251,11 +259,11 @@ test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} -setup {
catch {file delete -force $foofile}
} -body {
close [open $foofile w]
- catch {file attributes $foofile}
+ file attributes $foofile
} -cleanup {
# We used [makeFile] so we undo with [removeFile]
removeFile $foofile
-} -result {0}
+} -match glob -result *
# dirname
test cmdAH-8.1 {Tcl_FileObjCmd: dirname} -returnCodes error -body {
@@ -497,33 +505,36 @@ test cmdAH-9.26 {Tcl_FileObjCmd: tail} testsetplatform {
testsetplatform windows
file tail {//foo/bar}
} {}
-test cmdAH-9.42 {Tcl_FileObjCmd: tail} testsetplatform {
+test cmdAH-9.42 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup {
global env
set temp $env(HOME)
+} -body {
set env(HOME) "/home/test"
testsetplatform unix
- set result [file tail ~]
+ file tail ~
+} -cleanup {
set env(HOME) $temp
- set result
-} test
-test cmdAH-9.43 {Tcl_FileObjCmd: tail} testsetplatform {
+} -result test
+test cmdAH-9.43 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup {
global env
set temp $env(HOME)
+} -body {
set env(HOME) "~"
testsetplatform unix
- set result [file tail ~]
+ file tail ~
+} -cleanup {
set env(HOME) $temp
- set result
-} {}
-test cmdAH-9.44 {Tcl_FileObjCmd: tail} testsetplatform {
+} -result {}
+test cmdAH-9.44 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup {
global env
set temp $env(HOME)
+} -body {
set env(HOME) "/home/test"
testsetplatform windows
- set result [file tail ~]
+ file tail ~
+} -cleanup {
set env(HOME) $temp
- set result
-} test
+} -result test
test cmdAH-9.46 {Tcl_FileObjCmd: tail} testsetplatform {
testsetplatform unix
file tail {f.oo\bar/baz.bat}
@@ -923,10 +934,10 @@ test cmdAH-19.7 {Tcl_FileObjCmd: nativename} -body {
test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} {
file exists ~nOsUcHuSeR
} 0
-test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} {
- # should probably be 0 in fact...
- catch {file nativename ~nOsUcHuSeR}
-} 1
+test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} -body {
+ # should probably be a non-error in fact...
+ file nativename ~nOsUcHuSeR
+} -returnCodes error -match glob -result *
# The test below has to be done in /tmp rather than the current directory in
# order to guarantee (?) a local file system: some NFS file systems won't do
# the stuff below correctly.
@@ -963,7 +974,7 @@ test cmdAH-20.1 {Tcl_FileObjCmd: atime} -returnCodes error -body {
file atime a b c
} -result {wrong # args: should be "file atime name ?time?"}
test cmdAH-20.2 {Tcl_FileObjCmd: atime} -setup {
- catch {unset stat}
+ unset -nocomplain stat
} -body {
file stat $gorpfile stat
list [expr {[file mtime $gorpfile] == $stat(mtime)}] \
@@ -1031,13 +1042,13 @@ test cmdAH-23.2 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
file lstat a b c
} -result {wrong # args: should be "file lstat name varName"}
test cmdAH-23.3 {Tcl_FileObjCmd: lstat} -setup {
- catch {unset stat}
+ unset -nocomplain stat
} -constraints {unix nonPortable} -body {
file lstat $linkfile stat
lsort [array names stat]
} -result {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup {
- catch {unset stat}
+ unset -nocomplain stat
} -constraints {unix nonPortable} -body {
file lstat $linkfile stat
list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
@@ -1047,12 +1058,12 @@ test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
$errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} -setup {
- catch {unset x}
+ unset -nocomplain x
} -body {
set x 44
list [catch {file lstat $gorpfile x} msg] $msg $errorCode
} -result {1 {can't set "x(dev)": variable isn't array} {TCL LOOKUP VARNAME x}}
-catch {unset stat}
+unset -nocomplain stat
# mkdir
set dirA [file join [temporaryDirectory] a]
set dirB [file join [temporaryDirectory] a]
@@ -1128,7 +1139,7 @@ test cmdAH-24.2 {Tcl_FileObjCmd: mtime} -setup {
}
} -result {1}
test cmdAH-24.3 {Tcl_FileObjCmd: mtime} -setup {
- catch {unset stat}
+ unset -nocomplain stat
} -body {
file stat $gorpfile stat
list [expr {[file mtime $gorpfile] == $stat(mtime)}] \
@@ -1294,7 +1305,7 @@ test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body {
file stat _bogus_ a b
} -result {wrong # args: should be "file stat name varName"}
test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup {
- catch {unset stat}
+ unset -nocomplain stat
set stat(blocks) [set stat(blksize) {}]
} -body {
file stat $gorpfile stat
@@ -1302,13 +1313,13 @@ test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup {
lsort [array names stat]
} -result {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup {
- catch {unset stat}
+ unset -nocomplain stat
} -body {
file stat $gorpfile stat
list $stat(nlink) $stat(size) $stat(type)
} -result {1 12 file}
test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup {
- catch {unset stat}
+ unset -nocomplain stat
} -body {
file stat $gorpfile stat
expr {$stat(mode) & 0o777}
@@ -1317,7 +1328,7 @@ test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
list [catch {file stat _bogus_ stat} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-28.7 {Tcl_FileObjCmd: stat} -setup {
- catch {unset x}
+ unset -nocomplain x
} -returnCodes error -body {
set x 44
file stat $gorpfile x
@@ -1371,7 +1382,7 @@ test cmdAH-28.12 {Tcl_FileObjCmd: stat} -setup {
} -cleanup {
removeFile $filename
} -result 1
-catch {unset stat}
+unset -nocomplain stat
# type
test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
@@ -1415,25 +1426,25 @@ test cmdAH-29.5 {Tcl_FileObjCmd: type} {
# Error conditions
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file gorp x
-} -result {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
+} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file ex x
-} -match glob -result {ambiguous option "ex": must be *}
+} -match glob -result {unknown or ambiguous subcommand "ex": must be *}
test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file is x
-} -match glob -result {ambiguous option "is": must be *}
+} -match glob -result {unknown or ambiguous subcommand "is": must be *}
test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file z x
-} -match glob -result {bad option "z": must be *}
+} -match glob -result {unknown or ambiguous subcommand "z": must be *}
test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file read x
-} -match glob -result {ambiguous option "read": must be *}
+} -match glob -result {unknown or ambiguous subcommand "read": must be *}
test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file s x
-} -match glob -result {ambiguous option "s": must be *}
+} -match glob -result {unknown or ambiguous subcommand "s": must be *}
test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file t x
-} -match glob -result {ambiguous option "t": must be *}
+} -match glob -result {unknown or ambiguous subcommand "t": must be *}
test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file dirname ~woohgy
} -result {user "woohgy" doesn't exist}
@@ -1445,7 +1456,7 @@ test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
interp create simpleInterp
interp create -safe safeInterp
interp create
-safeInterp expose file file
+catch {safeInterp expose file file}
test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} -body {
file channels a b
@@ -1513,7 +1524,7 @@ test cmdAH-32.2 {file tempfile - returns a read/write channel} -body {
catch {close $f}
} -result ok
test cmdAH-32.3 {file tempfile - makes filenames} -setup {
- catch {unset name}
+ unset -nocomplain name
} -body {
set result [info exists name]
set f [file tempfile name]
@@ -1556,7 +1567,7 @@ interp delete simpleInterp
# cleanup
catch {testsetplatform $platform}
-catch {unset platform}
+unset -nocomplain platform
# Tcl_ForObjCmd is tested in for.test
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index ca81ea5..721773f 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -7,14 +7,15 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: cmdIL.test,v 1.43 2009/12/22 19:49:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
testConstraint testobj [llength [info commands testobj]]
@@ -458,6 +459,9 @@ test cmdIL-5.5 {lsort with list style index and sharing} -body {
} -result 0 -cleanup {
rename test_lsort ""
}
+test cmdIL-5.6 {lsort with multiple list-style index options} {
+ lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}}
+} {{a b} {b e} {c d}}
# Compiled version
test cmdIL-6.1 {lassign command syntax} -returnCodes error -body {
@@ -713,6 +717,16 @@ test cmdIL-7.8 {lreverse command - shared intrep [Bug 1675044]} -setup {
rename K {}
} -result 1
+# This belongs in info test, but adding tests there breaks tests
+# that compute source file line numbers.
+test info-20.6 {Bug 3587651} -setup {
+ namespace eval my {namespace eval tcl {namespace eval mathfunc {
+ proc demo x {return 42}
+ }}}} -body { namespace eval my {expr {"demo" in [info functions]}}} -cleanup {
+ namespace delete my
+} -result 1
+
+
# cleanup
::tcltest::cleanupTests
return
diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test
index 010d3d1..69d7171 100644
--- a/tests/cmdInfo.test
+++ b/tests/cmdInfo.test
@@ -12,14 +12,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: cmdInfo.test,v 1.10 2006/11/03 00:34:52 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testcmdinfo [llength [info commands testcmdinfo]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index c7f6e44..2d68138 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: cmdMZ.test,v 1.30 2010/04/05 19:44:45 ferrieux Exp $
if {[catch {package require tcltest 2.1}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
@@ -38,7 +36,7 @@ namespace eval ::tcl::test::cmdMZ {
return 1
}
customMatch listGlob [namespace which ListGlobMatch]
-
+
# Tcl_PwdObjCmd
test cmdMZ-1.1 {Tcl_PwdObjCmd} -returnCodes error -body {
@@ -166,35 +164,31 @@ test cmdMZ-return-2.13 {return option handling} -body {
test cmdMZ-return-2.14 {return option handling} -body {
return -level 0 -code error -options {-code foo -options {-code break}}
} -returnCodes break -result {}
-test cmdMZ-return-2.15 {return opton handling} -setup {
- proc p {} {
- return -code error -errorcode {a b} c
- }
-} -body {
- list [catch p result] $result $::errorCode
-} -cleanup {
- rename p {}
-} -result {1 c {a b}}
-test cmdMZ-return-2.16 {return opton handling} -setup {
- proc p {} {
- return -code error -errorcode [list a b] c
- }
-} -body {
- list [catch p result] $result $::errorCode
-} -cleanup {
- rename p {}
-} -result {1 c {a b}}
-test cmdMZ-return-2.17 {return opton handling} -setup {
- proc p {} {
- return -code error -errorcode a\ b c
- }
-} -body {
- list [catch p result] $result $::errorCode
-} -cleanup {
- rename p {}
-} -result {1 c {a b}}
+test cmdMZ-return-2.15 {return opton handling} {
+ list [catch {
+ apply {{} {
+ return -code error -errorcode {a b} c
+ }}
+ } result] $result $::errorCode
+} {1 c {a b}}
+test cmdMZ-return-2.16 {return opton handling} {
+ list [catch {
+ apply {{} {
+ return -code error -errorcode [list a b] c
+ }}
+ } result] $result $::errorCode
+} {1 c {a b}}
+test cmdMZ-return-2.17 {return opton handling} {
+ list [catch {
+ apply {{} {
+ return -code error -errorcode a\ b c
+ }}
+ } result] $result $::errorCode
+} {1 c {a b}}
test cmdMZ-return-2.18 {return option handling} {
- list [catch {return -code error -errorstack [list CALL a CALL b] yo} -> foo] [dictSort $foo] [info errorstack]
+ list [catch {
+ return -code error -errorstack [list CALL a CALL b] yo
+ } -> foo] [dictSort $foo] [info errorstack]
} {2 {-code 1 -errorcode NONE -errorstack {CALL a CALL b} -level 1} {CALL a CALL b}}
# Check that the result of a [return -options $opts $result] is
@@ -349,7 +343,7 @@ test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
"time {error foo}"}}
# The tests for Tcl_WhileObjCmd are in while.test
-
+
# cleanup
cleanupTests
}
diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test
index f7fe427..bae26a0 100644
--- a/tests/compExpr-old.test
+++ b/tests/compExpr-old.test
@@ -11,14 +11,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: compExpr-old.test,v 1.23 2007/12/13 15:26:06 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
testConstraint testmathfunctions 0
} else {
diff --git a/tests/compExpr.test b/tests/compExpr.test
index c3e68c1..14c875d 100644
--- a/tests/compExpr.test
+++ b/tests/compExpr.test
@@ -1,20 +1,21 @@
-# This file contains a collection of tests for the procedures in the
-# file tclCompExpr.c. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for the procedures in the file
+# tclCompExpr.c. Sourcing this file into Tcl runs the tests and generates
+# output for errors. No output means no errors were found.
#
# Copyright (c) 1997 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.
-#
-# RCS: @(#) $Id: compExpr.test,v 1.17 2008/01/16 21:54:33 dgp Exp $
+# 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
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
testConstraint testmathfunctions 0
} else {
@@ -25,7 +26,7 @@ if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"
testConstraint memory [llength [info commands memory]]
catch {unset a}
-
+
test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {
expr 1+2
} 3
@@ -35,17 +36,17 @@ test compExpr-1.2 {TclCompileExpr procedure, error parsing expr} -body {
test compExpr-1.3 {TclCompileExpr procedure, error compiling expr} -body {
list [catch {expr "foo(123)"} msg] $msg
} -match glob -result {1 {* "*foo"}}
-
test compExpr-1.4 {TclCompileExpr procedure, expr has no operators} {
set a {0o00123}
expr {$a}
} 83
-test compExpr-2.1 {CompileSubExpr procedure, TCL_TOKEN_WORD parse token} {
- catch {unset a}
+test compExpr-2.1 {CompileSubExpr procedure, TCL_TOKEN_WORD parse token} -setup {
+ unset -nocomplain a
+} -body {
set a 27
expr {"foo$a" < "bar"}
-} 0
+} -result 0
test compExpr-2.2 {CompileSubExpr procedure, error compiling TCL_TOKEN_WORD parse token} -body {
expr {"00[expr 1+]" + 17}
} -returnCodes error -match glob -result *
@@ -68,30 +69,33 @@ test compExpr-2.7 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} {
test compExpr-2.8 {CompileSubExpr procedure, error in TCL_TOKEN_COMMAND parse token} -body {
expr {[foo "bar"xxx] + 17}
} -returnCodes error -match glob -result *
-test compExpr-2.9 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} {
- catch {unset a}
+test compExpr-2.9 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} -setup {
+ unset -nocomplain a
+} -body {
set a 123
expr {$a*2}
-} 246
-test compExpr-2.10 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} {
- catch {unset a}
- catch {unset b}
+} -result 246
+test compExpr-2.10 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} -setup {
+ unset -nocomplain a
+ unset -nocomplain b
+} -body {
set a(george) martha
set b geo
expr {$a(${b}rge)}
-} martha
-test compExpr-2.11 {CompileSubExpr procedure, error in TCL_TOKEN_VARIABLE parse token} {
- catch {unset a}
- list [catch {expr {$a + 17}} msg] $msg
-} {1 {can't read "a": no such variable}}
+} -result martha
+test compExpr-2.11 {CompileSubExpr procedure, error in TCL_TOKEN_VARIABLE parse token} -body {
+ unset -nocomplain a
+ expr {$a + 17}
+} -returnCodes error -result {can't read "a": no such variable}
test compExpr-2.12 {CompileSubExpr procedure, TCL_TOKEN_SUB_EXPR parse token} {
expr {27||3? 3<<(1+4) : 4&&9}
} 96
-test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} {
- catch {unset a}
+test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup {
+ unset -nocomplain a
+} -body {
set a 15
list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg
-} {0 1}
+} -result {0 1}
test compExpr-2.14 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, op found} {
expr {5*6}
} 30
@@ -149,11 +153,12 @@ test compExpr-2.31 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal o
test compExpr-2.32 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, 1 operand} {
expr {~4}
} -5
-test compExpr-2.33 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, comparison} {
- catch {unset a}
+test compExpr-2.33 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, comparison} -setup {
+ unset -nocomplain a
+} -body {
set a 15
expr {$a==15} ;# compiled out-of-line to runtime call on Tcl_ExprObjCmd
-} 1
+} -result 1
test compExpr-2.34 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
expr {+2}
} 2
@@ -175,72 +180,84 @@ test compExpr-2.39 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special
test compExpr-2.40 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
expr {4-2}
} 2
-test compExpr-2.41 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
- catch {unset a}
+test compExpr-2.41 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup {
+ unset -nocomplain a
+} -body {
set a true
expr {0||$a}
-} 1
-test compExpr-2.42 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} {
- catch {unset a}
+} -result 1
+test compExpr-2.42 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup {
+ unset -nocomplain a
+} -body {
set a 15
list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg
-} {0 1}
-test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
- catch {unset a}
+} -result {0 1}
+test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup {
+ unset -nocomplain a
+} -body {
set a false
expr {3&&$a}
-} 0
-test compExpr-2.44 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
- catch {unset a}
+} -result 0
+test compExpr-2.44 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup {
+ unset -nocomplain a
+} -body {
set a false
expr {$a||1? 1 : 0}
-} 1
-test compExpr-2.45 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} {
- catch {unset a}
+} -result 1
+test compExpr-2.45 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup {
+ unset -nocomplain a
+} -body {
set a 15
list [catch {expr {1? 54 : "$a[expr 1+]00"}} msg] $msg
-} {0 54}
+} -result {0 54}
-test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} {
- catch {unset a}
+test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} -setup {
+ unset -nocomplain a
+} -body {
set a 2
expr {[set a]||0}
-} 1
-test compExpr-3.2 {CompileLandOrLorExpr procedure, nonnumeric 1st operand} {
- catch {unset a}
+} -result 1
+test compExpr-3.2 {CompileLandOrLorExpr procedure, nonnumeric 1st operand} -setup {
+ unset -nocomplain a
+} -body {
set a no
expr {$a&&1}
-} 0
+} -result 0
test compExpr-3.3 {CompileSubExpr procedure, error in 1st operand} -body {
expr {[expr *2]||0}
} -returnCodes error -match glob -result *
-test compExpr-3.4 {CompileLandOrLorExpr procedure, result is 1 or 0} {
- catch {unset a}
- catch {unset b}
+test compExpr-3.4 {CompileLandOrLorExpr procedure, result is 1 or 0} -setup {
+ unset -nocomplain a
+ unset -nocomplain b
+} -body {
set a no
set b true
expr {$a || $b}
-} 1
-test compExpr-3.5 {CompileLandOrLorExpr procedure, short-circuit semantics} {
- catch {unset a}
+} -result 1
+test compExpr-3.5 {CompileLandOrLorExpr procedure, short-circuit semantics} -setup {
+ unset -nocomplain a
+} -body {
set a yes
expr {$a || [exit]}
-} 1
-test compExpr-3.6 {CompileLandOrLorExpr procedure, short-circuit semantics} {
- catch {unset a}
+} -result 1
+test compExpr-3.6 {CompileLandOrLorExpr procedure, short-circuit semantics} -setup {
+ unset -nocomplain a
+} -body {
set a no
expr {$a && [exit]}
-} 0
-test compExpr-3.7 {CompileLandOrLorExpr procedure, numeric 2nd operand} {
- catch {unset a}
+} -result 0
+test compExpr-3.7 {CompileLandOrLorExpr procedure, numeric 2nd operand} -setup {
+ unset -nocomplain a
+} -body {
set a 2
expr {0||[set a]}
-} 1
-test compExpr-3.8 {CompileLandOrLorExpr procedure, nonnumeric 2nd operand} {
- catch {unset a}
+} -result 1
+test compExpr-3.8 {CompileLandOrLorExpr procedure, nonnumeric 2nd operand} -setup {
+ unset -nocomplain a
+} -body {
set a no
expr {1&&$a}
-} 0
+} -result 0
test compExpr-3.9 {CompileLandOrLorExpr procedure, error in 2nd operand} -body {
expr {0||[expr %2]}
} -returnCodes error -match glob -result *
@@ -250,42 +267,48 @@ test compExpr-3.10 {CompileLandOrLorExpr procedure, long lor/land arm} {
expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]}
} 1
-test compExpr-4.1 {CompileCondExpr procedure, simple test} {
- catch {unset a}
+test compExpr-4.1 {CompileCondExpr procedure, simple test} -setup {
+ unset -nocomplain a
+} -body {
set a 2
expr {($a > 1)? "ok" : "nope"}
-} ok
-test compExpr-4.2 {CompileCondExpr procedure, complex test, convert to numeric} {
- catch {unset a}
+} -result ok
+test compExpr-4.2 {CompileCondExpr procedure, complex test, convert to numeric} -setup {
+ unset -nocomplain a
+} -body {
set a no
expr {[set a]? 27 : -54}
-} -54
+} -result -54
test compExpr-4.3 {CompileCondExpr procedure, error in test} -body {
expr {[expr *2]? +1 : -1}
} -returnCodes error -match glob -result *
-test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} {
- catch {unset a}
+test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} -setup {
+ unset -nocomplain a
+} -body {
set a no
expr {1? (27-2) : -54}
-} 25
-test compExpr-4.5 {CompileCondExpr procedure, convert "true" clause to numeric} {
- catch {unset a}
+} -result 25
+test compExpr-4.5 {CompileCondExpr procedure, convert "true" clause to numeric} -setup {
+ unset -nocomplain a
+} -body {
set a no
expr {1? $a : -54}
-} no
+} -result no
test compExpr-4.6 {CompileCondExpr procedure, error in "true" clause} -body {
expr {1? [expr *2] : -127}
} -returnCodes error -match glob -result *
-test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} {
- catch {unset a}
+test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} -setup {
+ unset -nocomplain a
+} -body {
set a no
expr {(2-2)? -3.14159 : "nope"}
-} nope
-test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric} {
- catch {unset a}
+} -result nope
+test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric} -setup {
+ unset -nocomplain a
+} -body {
set a 0o0123
expr {0? 42 : $a}
-} 83
+} -result 83
test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} {
list [catch {expr {1? 15 : [expr *2]}} msg] $msg
} {0 15}
@@ -294,8 +317,8 @@ test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
format %.6g [expr atan2(1.0, 2.0)]
} 0.463648
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
- list [catch {expr {do_it()}} msg] $msg
-} -match glob -result {1 {* "*do_it"}}
+ expr {do_it()}
+} -returnCodes error -match glob -result {* "*do_it"}
test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions {
expr 3*T1()-1
} 368
@@ -303,8 +326,8 @@ test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathf
expr T2()*3
} 1035
test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body {
- list [catch {expr {atan2(1.0)}} msg] $msg
-} -match glob -result {1 {too few arguments for math function*}}
+ expr {atan2(1.0)}
+} -returnCodes error -match glob -result {too few arguments for math function*}
test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} {
format %.6g [expr pow(2.1, 27.5-(24.4*(5%2)))]
} 9.97424
@@ -312,11 +335,11 @@ test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body {
expr {sinh(2.*)}
} -returnCodes error -match glob -result *
test compExpr-5.8 {CompileMathFuncCall procedure, too many arguments} -body {
- list [catch {expr {sinh(2.0, 3.0)}} msg] $msg
-} -match glob -result {1 {too many arguments for math function*}}
+ expr {sinh(2.0, 3.0)}
+} -returnCodes error -match glob -result {too many arguments for math function*}
test compExpr-5.9 {CompileMathFuncCall procedure, too many arguments} -body {
- list [catch {expr {0 <= rand(5.2)}} msg] $msg
-} -match glob -result {1 {too many arguments for math function*}}
+ expr {0 <= rand(5.2)}
+} -returnCodes error -match glob -result {too many arguments for math function*}
test compExpr-6.1 {LogSyntaxError procedure, error in expr longer than 60 chars} -body {
expr {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1 foo 3
@@ -360,9 +383,14 @@ test compExpr-7.2 {[Bug 1869989]: expr parser memleak} -constraints memory -setu
unset end i tmp
rename getbytes {}
} -result 0
-
+
# cleanup
catch {unset a}
catch {unset b}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/compile.test b/tests/compile.test
index d9567cc..4d91940 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -1,21 +1,22 @@
-# This file contains tests for the files tclCompile.c, tclCompCmds.c
-# and tclLiteral.c
+# This file contains tests for the files tclCompile.c, tclCompCmds.c and
+# tclLiteral.c
#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
#
# Copyright (c) 1997 by 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.
-#
-# RCS: @(#) $Id: compile.test,v 1.51 2009/10/29 17:21:48 dgp Exp $
+# 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::*
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint exec [llength [info commands exec]]
testConstraint memory [llength [info commands memory]]
testConstraint testevalex [llength [info commands testevalex]]
@@ -28,10 +29,11 @@ catch {namespace delete test_ns_compile}
catch {unset x}
catch {unset y}
catch {unset a}
-
-test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} {
+
+test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} -setup {
catch {namespace delete test_ns_compile}
catch {unset x}
+} -body {
set x 123
namespace eval test_ns_compile {
proc set {args} {
@@ -43,63 +45,70 @@ test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} {
}
}
list [test_ns_compile::p] [set x]
-} {{123 test_ns_compile::set} {123 test_ns_compile::set}}
+} -result {{123 test_ns_compile::set} {123 test_ns_compile::set}}
test compile-1.2 {TclCompileString, error result is reset if TclGetLong determines word isn't an integer} {
proc p {x} {info commands 3m}
list [catch {p} msg] $msg
} {1 {wrong # args: should be "p x"}}
-test compile-2.1 {TclCompileDollarVar: global scalar name with ::s} {
+
+test compile-2.1 {TclCompileDollarVar: global scalar name with ::s} -setup {
catch {unset x}
+} -body {
set x 123
- list $::x [expr {[lsearch -exact [info globals] x] != 0}]
-} {123 1}
-test compile-2.2 {TclCompileDollarVar: global scalar name with ::s} {
+ list $::x [expr {"x" in [info globals]}]
+} -result {123 1}
+test compile-2.2 {TclCompileDollarVar: global scalar name with ::s} -setup {
catch {unset y}
+} -body {
proc p {} {
set ::y 789
return $::y
}
- list [p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
-} {789 789 1}
-test compile-2.3 {TclCompileDollarVar: global array name with ::s} {
+ list [p] $::y [expr {"y" in [info globals]}]
+} -result {789 789 1}
+test compile-2.3 {TclCompileDollarVar: global array name with ::s} -setup {
catch {unset a}
+} -body {
set ::a(1) 2
- list $::a(1) [set ::a($::a(1)) 3] $::a(2) [expr {[lsearch -exact [info globals] a] != 0}]
-} {2 3 3 1}
-test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} {
+ list $::a(1) [set ::a($::a(1)) 3] $::a(2) [expr {"a" in [info globals]}]
+} -result {2 3 3 1}
+test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} -setup {
catch {unset a}
+} -body {
proc p {} {
set ::a(1) 1
return $::a($::a(1))
}
- list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
-} {1 1 1}
-test compile-2.5 {TclCompileDollarVar: global array, called as ${arrName(0)}} {
+ list [p] $::a(1) [expr {"a" in [info globals]}]
+} -result {1 1 1}
+test compile-2.5 {TclCompileDollarVar: global array, called as ${arrName(0)}} -setup {
catch {unset a}
+} -body {
proc p {} {
global a
set a(1) 1
return ${a(1)}$::a(1)$a(1)
}
- list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
-} {111 1 1}
+ list [p] $::a(1) [expr {"a" in [info globals]}]
+} -result {111 1 1}
-test compile-3.1 {TclCompileCatchCmd: only catch cmds with scalar vars are compiled inline} {
+test compile-3.1 {TclCompileCatchCmd: only catch cmds with scalar vars are compiled inline} -setup {
catch {unset a}
+} -body {
set a(1) xyzzyx
proc p {} {
global a
catch {set x 123} a(1)
}
list [p] $a(1)
-} {0 123}
+} -result {0 123}
test compile-3.2 {TclCompileCatchCmd: non-local variables} {
set ::foo 1
proc catch-test {} {
catch {set x 3} ::foo
}
catch-test
- set ::foo
+ return $::foo
} 3
test compile-3.3 {TclCompileCatchCmd: overagressive compiling [bug 219184]} {
proc catch-test {str} {
@@ -107,7 +116,7 @@ test compile-3.3 {TclCompileCatchCmd: overagressive compiling [bug 219184]} {
error BAD
}
catch {catch-test error} ::foo
- set ::foo
+ return $::foo
} {GOOD}
test compile-3.4 {TclCompileCatchCmd: bcc'ed [return] is caught} {
proc foo {} {
@@ -128,6 +137,35 @@ test compile-3.5 {TclCompileCatchCmd: recover from error, [Bug 705406]} {
}
list [catch foo msg] $msg
} {0 1}
+test compile-3.6 {TclCompileCatchCmd: error in storing result [Bug 3098302]} {*}{
+ -setup {
+ namespace eval catchtest {
+ variable result1 {}
+ }
+ trace add variable catchtest::result1 write catchtest::failtrace
+ proc catchtest::failtrace {n1 n2 op} {
+ return -code error "trace on $n1 fails by request"
+ }
+ }
+ -body {
+ proc catchtest::x {} {
+ variable result1
+ set count 0
+ for {set i 0} {$i < 10} {incr i} {
+ set status2 [catch {
+ set status1 [catch {
+ return -code error -level 0 "original failure"
+ } result1 options1]
+ } result2 options2]
+ incr count
+ }
+ list $count $result2
+ }
+ catchtest::x
+ }
+ -result {10 {can't set "result1": trace on result1 fails by request}}
+ -cleanup {namespace delete catchtest}
+}
test compile-4.1 {TclCompileForCmd: command substituted test expression} {
set i 0
@@ -157,29 +195,32 @@ test compile-5.2 {TclCompileForeachCmd: non-local variables} {
set ::foo
} 3
-test compile-6.1 {TclCompileSetCmd: global scalar names with ::s} {
+test compile-6.1 {TclCompileSetCmd: global scalar names with ::s} -setup {
catch {unset x}
catch {unset y}
+} -body {
set x 123
proc p {} {
set ::y 789
return $::y
}
- list $::x [expr {[lsearch -exact [info globals] x] != 0}] \
- [p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
-} {123 1 789 789 1}
-test compile-6.2 {TclCompileSetCmd: global array names with ::s} {
+ list $::x [expr {"x" in [info globals]}] \
+ [p] $::y [expr {"y" in [info globals]}]
+} -result {123 1 789 789 1}
+test compile-6.2 {TclCompileSetCmd: global array names with ::s} -setup {
catch {unset a}
+} -body {
set ::a(1) 2
proc p {} {
set ::a(1) 1
return $::a($::a(1))
}
- list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
-} {2 1 3 3 1}
-test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} {
+ list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {"a" in [info globals]}]
+} -result {2 1 3 3 1}
+test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} -setup {
catch {namespace delete test_ns_compile}
catch {unset x}
+} -body {
namespace eval test_ns_compile {
variable v hello
variable arr
@@ -187,7 +228,7 @@ test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} {
set ::test_ns_compile::arr(1) 123
}
list $::x $::test_ns_compile::arr(1)
-} {hello 123}
+} -result {hello 123}
test compile-7.1 {TclCompileWhileCmd: command substituted test expression} {
set i 0
@@ -228,53 +269,45 @@ test compile-10.1 {BLACKBOX: exception stack overflow} {
}
} {}
-test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
- proc p {} {
+test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+ apply {{} {
# shared object - Interp result && Var 'r'
set r [list foobar]
# command that will add error to result
lindex a bogus
- }
- list [catch {p} msg] $msg
-} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
-test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
- proc p {} { set r [list foobar] ; string index a bogus }
- list [catch {p} msg] $msg
-} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
+ }}
+} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
+test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+ apply {{} { set r [list foobar] ; string index a bogus }}
+} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
- proc p {} { set r [list foobar] ; string index a 0o9 }
- list [catch {p} msg] $msg
-} -match glob -result {1 {*invalid octal number*}}
-test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
- proc p {} { set r [list foobar] ; array set var {one two many} }
- list [catch {p} msg] $msg
-} {1 {list must have an even number of elements}}
-test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
- proc p {} { set r [list foobar] ; incr foo bar baz}
- list [catch {p} msg] $msg
-} {1 {wrong # args: should be "incr varName ?increment?"}}
-test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
- proc p {} { set r [list foobar] ; incr}
- list [catch {p} msg] $msg
-} {1 {wrong # args: should be "incr varName ?increment?"}}
+ apply {{} { set r [list foobar] ; string index a 0o9 }}
+} -returnCodes error -match glob -result {*invalid octal number*}
+test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+ apply {{} { set r [list foobar] ; array set var {one two many} }}
+} -returnCodes error -result {list must have an even number of elements}
+test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+ apply {{} { set r [list foobar] ; incr foo bar baz}}
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
+test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+ apply {{} { set r [list foobar] ; incr}}
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
- proc p {} { set r [list foobar] ; expr !a }
- p
+ apply {{} { set r [list foobar] ; expr !a }}
} -returnCodes error -match glob -result *
test compile-11.8 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
- proc p {} { set r [list foobar] ; expr {!a} }
- p
+ apply {{} { set r [list foobar] ; expr {!a} }}
} -returnCodes error -match glob -result *
-test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
- proc p {} { set r [list foobar] ; llength "\{" }
+test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+ apply {{} { set r [list foobar] ; llength "\{" }}
list [catch {p} msg] $msg
-} {1 {unmatched open brace in list}}
+} -returnCodes error -result {unmatched open brace in list}
#
# Special section for tests of tclLiteral.c
# The following tests check for incorrect memory handling in
-# TclReleaseLiteral. They are only effective when tcl is compiled
-# with TCL_MEM_DEBUG
+# TclReleaseLiteral. They are only effective when tcl is compiled with
+# TCL_MEM_DEBUG
#
# Special test for leak on interp delete [Bug 467523].
test compile-12.1 {testing literal leak on interp delete} -setup {
@@ -298,9 +331,9 @@ test compile-12.1 {testing literal leak on interp delete} -setup {
rename getbytes {}
unset -nocomplain end i tmp leakedBytes
} -result 0
-# Special test for a memory error in a preliminary fix of [Bug 467523].
-# It requires executing a helpfile. Presumably the child process is
-# used because when this test fails, it crashes.
+# Special test for a memory error in a preliminary fix of [Bug 467523]. It
+# requires executing a helpfile. Presumably the child process is used because
+# when this test fails, it crashes.
test compile-12.2 {testing error on literal deletion} -constraints {memory exec} -body {
set sourceFile [makeFile {
for {set i 0} {$i < 5} {incr i} {
@@ -325,29 +358,28 @@ test compile-12.3 {check for a buffer overrun} -body {
test compile-12.4 {TclCleanupLiteralTable segfault} -body {
# Tcl Bug 1001997
# Here, we're trying to test a case that causes a crash in
- # TclCleanupLiteralTable. The conditions that we're trying to
- # establish are:
- # - TclCleanupLiteralTable is attempting to clean up a bytecode
- # object in the literal table.
- # - The bytecode object in question contains the only reference
- # to another literal.
+ # TclCleanupLiteralTable. The conditions that we're trying to establish
+ # are:
+ # - TclCleanupLiteralTable is attempting to clean up a bytecode object in
+ # the literal table.
+ # - The bytecode object in question contains the only reference to another
+ # literal.
# - The literal in question is in the same hash bucket as the bytecode
# object, and immediately follows it in the chain.
- # Since newly registered literals are added at the FRONT of the
- # bucket chains, and since the bytecode object is registered before
- # its literals, this is difficult to achieve. What we do is:
- # (a) do a [namespace eval] of a string that's calculated to
- # hash into the same bucket as a literal that it contains.
- # In this case, the script and the variable 'bugbug'
- # land in the same bucket.
- # (b) do a [namespace eval] of a string that contains enough
- # literals to force TclRegisterLiteral to rebuild the global
- # literal table. The newly created hash buckets will contain
- # the literals, IN REVERSE ORDER, thus putting the bytecode
- # immediately ahead of 'bugbug' and 'bug4345bug'. The bytecode
- # object will contain the only references to those two literals.
- # (c) Delete the interpreter to invoke TclCleanupLiteralTable
- # and tickle the bug.
+ # Since newly registered literals are added at the FRONT of the bucket
+ # chains, and since the bytecode object is registered before its literals,
+ # this is difficult to achieve. What we do is:
+ # (a) do a [namespace eval] of a string that's calculated to hash into
+ # the same bucket as a literal that it contains. In this case, the
+ # script and the variable 'bugbug' land in the same bucket.
+ # (b) do a [namespace eval] of a string that contains enough literals to
+ # force TclRegisterLiteral to rebuild the global literal table. The
+ # newly created hash buckets will contain the literals, IN REVERSE
+ # ORDER, thus putting the bytecode immediately ahead of 'bugbug' and
+ # 'bug4345bug'. The bytecode object will contain the only references
+ # to those two literals.
+ # (c) Delete the interpreter to invoke TclCleanupLiteralTable and tickle
+ # the bug.
proc foo {} {
set i [interp create]
$i eval {
@@ -381,9 +413,8 @@ test compile-12.4 {TclCleanupLiteralTable segfault} -body {
rename foo {}
} -result ok
-# Special test for underestimating the maxStackSize required for a
-# compiled command. A failure will cause a segfault in the child
-# process.
+# Special test for underestimating the maxStackSize required for a compiled
+# command. A failure will cause a segfault in the child process.
test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} {
set body {set x [list}
for {set i 0} {$i < 3000} {incr i} {
@@ -394,8 +425,8 @@ test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} {
list [catch {exec [interpreter] << $script} msg] $msg
} {0 OK}
-# Special test for compiling tokens from a copy of the source
-# string [Bug #599788]
+# Special test for compiling tokens from a copy of the source string. [Bug
+# 599788]
test compile-14.1 {testing errors in element name; segfault?} {} {
catch {set a([error])} msg1
catch {set bubba([join $abba $jubba]) $vol} msg2
@@ -404,34 +435,19 @@ test compile-14.1 {testing errors in element name; segfault?} {} {
# Tests compile-15.* cover Tcl Bug 633204
test compile-15.1 {proper TCL_RETURN code from [return]} {
- proc p {} {catch return}
- set result [p]
- rename p {}
- set result
+ apply {{} {catch return}}
} 2
test compile-15.2 {proper TCL_RETURN code from [return]} {
- proc p {} {catch {return foo}}
- set result [p]
- rename p {}
- set result
+ apply {{} {catch {return foo}}}
} 2
test compile-15.3 {proper TCL_RETURN code from [return]} {
- proc p {} {catch {return $::tcl_library}}
- set result [p]
- rename p {}
- set result
+ apply {{} {catch {return $::tcl_library}}}
} 2
test compile-15.4 {proper TCL_RETURN code from [return]} {
- proc p {} {catch {return [info library]}}
- set result [p]
- rename p {}
- set result
+ apply {{} {catch {return [info library]}}}
} 2
test compile-15.5 {proper TCL_RETURN code from [return]} {
- proc p {} {catch {set a 1}; return}
- set result [p]
- rename p {}
- set result
+ apply {{} {catch {set a 1}; return}}
} ""
for {set noComp 0} {$noComp <= 1} {incr noComp} {
@@ -506,17 +522,16 @@ test compile-16.17.$noComp {TclCompileScript: word expansion} $constraints {
run {list {*}x y z}
} {x y z}
-# These tests note that expansion can in theory cause the number of
-# arguments to a command to exceed INT_MAX, which is as big as objc
-# is allowed to get.
+# These tests note that expansion can in theory cause the number of arguments
+# to a command to exceed INT_MAX, which is as big as objc is allowed to get.
#
-# In practice, it seems we will run out of memory before we confront
-# this issue. Note that compiled operations run out of memory at
-# smaller objc values than direct string evaluation.
+# In practice, it seems we will run out of memory before we confront this
+# issue. Note that compiled operations run out of memory at smaller objc
+# values than direct string evaluation.
#
-# These tests are constrained as knownBug because they are likely
-# to cause memory allocation panics somewhere, and we don't want
-# panics in the test suite.
+# These tests are constrained as knownBug because they are likely to cause
+# memory allocation panics somewhere, and we don't want panics in the test
+# suite.
#
test compile-16.18.$noComp {TclCompileScript: word expansion} -body {
proc LongList {} {return [lrepeat [expr {1<<10}] x]}
@@ -578,8 +593,8 @@ test compile-16.26.$noComp {TclCompileScript: word expansion, protected backslas
} {a {\n} b}
} ;# End of noComp loop
-# These tests are messy because it wrecks the interpreter it runs in!
-# They demonstrate issues arising from [FRQ 1101710]
+# These tests are messy because it wrecks the interpreter it runs in! They
+# demonstrate issues arising from [FRQ 1101710]
test compile-17.1 {Command interpretation binding for compiled code} -constraints knownBug -setup {
set i [interp create]
} -body {
@@ -693,7 +708,7 @@ test compile-18.19 {disassembler - basics} -setup {
foo destroy
} -match glob -result *
# TODO sometime - check that bytecode from tbcload is *not* disassembled.
-
+
# cleanup
catch {rename p ""}
catch {namespace delete test_ns_compile}
@@ -702,3 +717,8 @@ catch {unset y}
catch {unset a}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/concat.test b/tests/concat.test
index c369340..eeb11ca 100644
--- a/tests/concat.test
+++ b/tests/concat.test
@@ -1,23 +1,21 @@
# Commands covered: concat
#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-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.
-#
-# RCS: @(#) $Id: concat.test,v 1.6 2004/05/19 10:55:05 dkf Exp $
+# 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
namespace import -force ::tcltest::*
}
-
+
test concat-1.1 {simple concatenation} {
concat a b c d e f g
} {a b c d e f g}
@@ -48,7 +46,12 @@ test concat-4.2 {pruning off extra white space} {
test concat-4.3 {pruning off extra white space sets length correctly} {
llength [concat { {{a}} }]
} 1
-
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/config.test b/tests/config.test
index cc951fb..d14837e 100644
--- a/tests/config.test
+++ b/tests/config.test
@@ -11,8 +11,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: config.test,v 1.5 2008/07/19 22:50:38 nijtmans Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/coroutine.test b/tests/coroutine.test
index d7b30bc..8272717 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -8,14 +8,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: coroutine.test,v 1.14 2010/08/11 23:38:57 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testnrelevels [llength [info commands testnrelevels]]
testConstraint memory [llength [info commands memory]]
@@ -437,6 +438,31 @@ test coroutine-4.5 {bug #2724403} -constraints {memory} \
unset i ns start end
} -result 0
+test coroutine-4.6 {compile context, bug #3282869} -setup {
+ unset ::x
+ proc f x {
+ coroutine D eval {yield X$x;yield Y}
+ }
+} -body {
+ f 12
+} -cleanup {
+ rename f {}
+} -returnCodes error -match glob -result {can't read *}
+
+test coroutine-4.7 {compile context, bug #3282869} -setup {
+ proc f x {
+ coroutine D eval {yield X$x;yield Y$x}
+ }
+} -body {
+ set ::x 15
+ set ::x [f 12]
+ D
+} -cleanup {
+ D
+ unset ::x
+ rename f {}
+} -result YX15
+
test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels} \
-setup {
proc nestedYield {{val {}}} {
@@ -534,12 +560,25 @@ test coroutine-6.3 {coroutine nargs} -body {
} -cleanup {
rename a {}
} -returnCodes error -result {wrong # args: should be "a ?arg?"}
-test coroutine-6.4 {unsupported: multi-argument yield} -body {
+
+test coroutine-7.1 {yieldto} -body {
+ coroutine c apply {{} {
+ yield
+ yieldto return -level 0 -code 1 quux
+ return quuy
+ }}
+ set res [list [catch c msg] $msg]
+ lappend res [catch c msg] $msg
+ lappend res [catch c msg] $msg
+} -cleanup {
+ unset res
+} -result [list 1 quux 0 quuy 1 {invalid command name "c"}]
+test coroutine-7.2 {multi-argument yielding with yieldto} -body {
proc corobody {} {
set a 1
while 1 {
set a [yield $a]
- set a [::tcl::unsupported::yieldm $a]
+ set a [yieldto return -level 0 $a]
lappend a [llength $a]
}
}
@@ -550,20 +589,26 @@ test coroutine-6.4 {unsupported: multi-argument yield} -body {
} -cleanup {
rename corobody {}
} -result {x {y z 2} \{p {\{q r 2} {} 0 {} ok {}}
-
-test coroutine-7.1 {yieldTo} -body {
- coroutine c apply {{} {
- yield
- tcl::unsupported::yieldTo return -level 0 -code 1 quux
- return quuy
- }}
- set res [list [catch c msg] $msg]
- lappend res [catch c msg] $msg
- lappend res [catch c msg] $msg
+test coroutine-7.3 {yielding between coroutines} -body {
+ proc juggler {target {value ""}} {
+ if {$value eq ""} {
+ set value [yield [info coroutine]]
+ }
+ while {[llength $value]} {
+ lappend ::result $value [info coroutine]
+ set value [lrange $value 0 end-1]
+ lassign [yieldto $target $value] value
+ }
+ # Clear nested collection of coroutines
+ catch $target
+ }
+ set result ""
+ coroutine j1 juggler [coroutine j2 juggler [coroutine j3 juggler j1]]\
+ {a b c d e}
+ list $result [info command j1] [info command j2] [info command j3]
} -cleanup {
- unset res
-} -result [list 1 quux 0 quuy 1 {invalid command name "c"}]
-
+ catch {rename juggler ""}
+} -result {{{a b c d e} ::j1 {a b c d} ::j2 {a b c} ::j3 {a b} ::j1 a ::j2} {} {} {}}
# cleanup
unset lambda
diff --git a/tests/dcall.test b/tests/dcall.test
index 55f6731..3df0ac8 100644
--- a/tests/dcall.test
+++ b/tests/dcall.test
@@ -10,14 +10,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: dcall.test,v 1.6 2004/05/19 10:54:20 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testdcall [llength [info commands testdcall]]
test dcall-1.1 {deletion callbacks} testdcall {
diff --git a/tests/dict.test b/tests/dict.test
index c7d186d..72a336c 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -8,8 +8,6 @@
# Copyright (c) 2003-2009 Donal K. Fellows
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: dict.test,v 1.37 2010/05/20 08:37:09 ferrieux Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -80,6 +78,24 @@ test dict-2.7 {dict create command - #-quoting in string rep} {
test dict-2.8 {dict create command - #-quoting in string rep} -body {
dict create #a x #b x
} -match glob -result {{#?} x #? x}
+test dict-2.9 {dict create command: compilation} {
+ apply {{} {dict create [format a] b}}
+} {a b}
+test dict-2.10 {dict create command: compilation} {
+ apply {{} {dict create [format a] b c d}}
+} {a b c d}
+test dict-2.11 {dict create command: compilation} {
+ apply {{} {dict create [format a] b c d a x}}
+} {a x c d}
+test dict-2.12 {dict create command: non-compilation} {
+ dict create [format a] b
+} {a b}
+test dict-2.13 {dict create command: non-compilation} {
+ dict create [format a] b c d
+} {a b c d}
+test dict-2.14 {dict create command: non-compilation} {
+ dict create [format a] b c d a x
+} {a x c d}
test dict-3.1 {dict get command} {dict get {a b} a} b
test dict-3.2 {dict get command} {dict get {a b c d} a} b
@@ -216,9 +232,7 @@ test dict-9.2 {dict exists command} {dict exists {a b} b} 0
test dict-9.3 {dict exists command} {dict exists {a {b c}} a b} 1
test dict-9.4 {dict exists command} {dict exists {a {b c}} a c} 0
test dict-9.5 {dict exists command} {dict exists {a {b c}} b c} 0
-test dict-9.6 {dict exists command} -returnCodes error -body {
- dict exists {a {b c d}} a c
-} -result {missing value to go with key}
+test dict-9.6 {dict exists command} {dict exists {a {b c d}} a c} 0
test dict-9.7 {dict exists command} -returnCodes error -body {
dict exists
} -result {wrong # args: should be "dict exists dictionary key ?key ...?"}
@@ -426,6 +440,9 @@ test dict-12.10 {dict lappend command: write failure} -setup {
} -returnCodes error -cleanup {
unset dictVar
} -result {can't set "dictVar": variable is array}
+test dict-12.11 {compiled dict append: invalidate string rep - Bug 3079830} {
+ apply {{} {set d {a 1 b 2 c 3}; dict lappend d b 22}}
+} {a 1 b {2 22} c 3}
test dict-13.1 {dict append command} -body {
set dictv {a a}
@@ -487,6 +504,9 @@ test dict-13.9 {dict append command: write failure} -setup {
test dict-13.10 {compiled dict append: crash case} {
apply {{} {dict append dictVar a o k}}
} {a ok}
+test dict-13.11 {compiled dict append: invalidate string rep - Bug 3079830} {
+ apply {{} {set d {a 1 b 2 c 3}; dict append d b 22}}
+} {a 1 b 222 c 3}
test dict-14.1 {dict for command: syntax} -returnCodes error -body {
dict for
@@ -779,6 +799,55 @@ test dict-16.9 {dict unset command: write failure} -setup {
} -returnCodes error -cleanup {
unset dictVar
} -result {can't set "dictVar": variable is array}
+# Now test with an LVT present (i.e., the bytecoded version).
+test dict-16.10 {dict unset command} -body {
+ apply {{} {
+ set dictVar {a b c d}
+ dict unset dictVar a
+ }}
+} -result {c d}
+test dict-16.11 {dict unset command} -body {
+ apply {{} {
+ set dictVar {a b c d}
+ dict unset dictVar c
+ }}
+} -result {a b}
+test dict-16.12 {dict unset command} -body {
+ apply {{} {
+ set dictVar {a b}
+ dict unset dictVar c
+ }}
+} -result {a b}
+test dict-16.13 {dict unset command} -body {
+ apply {{} {
+ set dictVar {a {b c d e}}
+ dict unset dictVar a b
+ }}
+} -result {a {d e}}
+test dict-16.14 {dict unset command} -returnCodes error -body {
+ apply {{} {
+ set dictVar a
+ dict unset dictVar a
+ }}
+} -result {missing value to go with key}
+test dict-16.15 {dict unset command} -returnCodes error -body {
+ apply {{} {
+ set dictVar {a b}
+ dict unset dictVar c d
+ }}
+} -result {key "c" not known in dictionary}
+test dict-16.16 {dict unset command} -body {
+ apply {{} {list [info exists dictVar] [dict unset dictVar a] [info exists dictVar]}}
+} -result {0 {} 1}
+test dict-16.17 {dict unset command} -returnCodes error -body {
+ apply {{} {dict unset dictVar}}
+} -result {wrong # args: should be "dict unset varName key ?key ...?"}
+test dict-16.18 {dict unset command: write failure} -body {
+ apply {{} {
+ set dictVar(block) {}
+ dict unset dictVar a
+ }}
+} -returnCodes error -result {can't set "dictVar": variable is array}
test dict-17.1 {dict filter command: key} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
@@ -1109,6 +1178,36 @@ test dict-20.9 {dict merge command} {
test dict-20.10 {dict merge command} {
dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}
} {a - c d e f 1 - 3 4}
+test dict-20.11 {dict merge command} {
+ apply {{} {dict merge}}
+} {}
+test dict-20.12 {dict merge command} {
+ apply {{} {dict merge {a b c d e f}}}
+} {a b c d e f}
+test dict-20.13 {dict merge command} -body {
+ apply {{} {dict merge {a b c d e}}}
+} -result {missing value to go with key} -returnCodes error
+test dict-20.14 {dict merge command} {
+ apply {{} {dict merge {a b c d} {e f g h}}}
+} {a b c d e f g h}
+test dict-20.15 {dict merge command} -body {
+ apply {{} {dict merge {a b c d e} {e f g h}}}
+} -result {missing value to go with key} -returnCodes error
+test dict-20.16 {dict merge command} -body {
+ apply {{} {dict merge {a b c d} {e f g h i}}}
+} -result {missing value to go with key} -returnCodes error
+test dict-20.17 {dict merge command} {
+ apply {{} {dict merge {a b c d e f} {e x g h}}}
+} {a b c d e x g h}
+test dict-20.18 {dict merge command} {
+ apply {{} {dict merge {a b c d} {a x c y}}}
+} {a x c y}
+test dict-20.19 {dict merge command} {
+ apply {{} {dict merge {a b c d} {c y a x}}}
+} {a x c y}
+test dict-20.20 {dict merge command} {
+ apply {{} {dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}}}
+} {a - c d e f 1 - 3 4}
test dict-21.1 {dict update command} -returnCodes 1 -body {
dict update
@@ -1354,6 +1453,433 @@ test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} -body
} -cleanup {
unset foo t inner
} -result OK
+test dict-22.12 {dict with: compiled} {
+ apply {{} {
+ set d {a 1 b 2}
+ list [dict with d {
+ set a $b
+ unset b
+ dict set d c 3
+ list ok
+ }] $d
+ }}
+} {ok {a 2 c 3}}
+test dict-22.13 {dict with: compiled} {
+ apply {i {
+ set d($i) {a 1 b 2}
+ list [dict with d($i) {
+ set a $b
+ unset b
+ dict set d($i) c 3
+ list ok
+ }] [array get d]
+ }} e
+} {ok {e {a 2 c 3}}}
+test dict-22.14 {dict with: compiled} {
+ apply {{} {
+ set d {a 1 b 2}
+ foreach x {1 2 3} {
+ dict with d {
+ incr a $b
+ if {$x == 2} break
+ }
+ unset a b
+ }
+ list $a $b $x $d
+ }}
+} {5 2 2 {a 5 b 2}}
+test dict-22.15 {dict with: compiled} {
+ apply {i {
+ set d($i) {a 1 b 2}
+ foreach x {1 2 3} {
+ dict with d($i) {
+ incr a $b
+ if {$x == 2} break
+ }
+ unset a b
+ }
+ list $a $b $x [array get d]
+ }} e
+} {5 2 2 {e {a 5 b 2}}}
+test dict-22.16 {dict with: compiled} {
+ apply {{} {
+ set d {p {q {a 1 b 2}}}
+ dict with d p q {
+ set a $b.$a
+ }
+ return $d
+ }}
+} {p {q {a 2.1 b 2}}}
+test dict-22.17 {dict with: compiled} {
+ apply {i {
+ set d($i) {p {q {a 1 b 2}}}
+ dict with d($i) p q {
+ set a $b.$a
+ }
+ array get d
+ }} e
+} {e {p {q {a 2.1 b 2}}}}
+test dict-22.18 {dict with: compiled} {
+ set ::d {a 1 b 2}
+ apply {{} {
+ dict with ::d {
+ set a $b.$a
+ }
+ return $::d
+ }}
+} {a 2.1 b 2}
+test dict-22.19 {dict with: compiled} {
+ set ::d {p {q {r {a 1 b 2}}}}
+ apply {{} {
+ dict with ::d p q r {
+ set a $b.$a
+ }
+ return $::d
+ }}
+} {p {q {r {a 2.1 b 2}}}}
+test dict-22.20 {dict with: compiled} {
+ apply {d {
+ dict with d {
+ }
+ return $a,$b
+ }} {a 1 b 2}
+} 1,2
+test dict-22.21 {dict with: compiled} {
+ apply {d {
+ dict with d p q {
+ }
+ return $a,$b
+ }} {p {q {a 1 b 2}}}
+} 1,2
+test dict-22.22 {dict with: compiled} {
+ set ::d {a 1 b 2}
+ apply {{} {
+ dict with ::d {
+ }
+ return $a,$b
+ }}
+} 1,2
+test dict-22.23 {dict with: compiled} {
+ set ::d {p {q {a 1 b 2}}}
+ apply {{} {
+ dict with ::d p q {
+ }
+ return $a,$b
+ }}
+} 1,2
+
+proc linenumber {} {
+ dict get [info frame -1] line
+}
+test dict-23.1 {dict compilation crash: Bug 3487626} {
+ apply {{} {apply {n {
+ set e {}
+ set k {}
+ dict for {a b} {c {d {e {f g}}}} {
+ ::tcl::dict::for {h i} $b {
+ dict update i e j {
+ ::tcl::dict::update j f k {
+ return [expr {$n - [linenumber]}]
+ }
+ }
+ }
+ }
+ }} [linenumber]}}
+} 5
+test dict-23.2 {dict compilation crash: Bug 3487626} knownBug {
+ # Something isn't quite right in line number and continuation line
+ # tracking; at time of writing, this test produces 7, not 5, which
+ # indicates that the extra newlines in the non-script argument are
+ # confusing things.
+ apply {{} {apply {n {
+ set e {}
+ set k {}
+ dict for {a {
+b
+}} {c {d {e {f g}}}} {
+ ::tcl::dict::for {h {
+i
+}} ${
+b
+} {
+ dict update {
+i
+} e {
+j
+} {
+ ::tcl::dict::update {
+j
+} f k {
+ return [expr {$n - [linenumber]}]
+ }
+ }
+ }
+ }
+ }} [linenumber]}}
+} 5
+rename linenumber {}
+
+test dict-24.1 {dict map command: syntax} -returnCodes error -body {
+ dict map
+} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+test dict-24.2 {dict map command: syntax} -returnCodes error -body {
+ dict map x
+} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+test dict-24.3 {dict map command: syntax} -returnCodes error -body {
+ dict map x x
+} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+test dict-24.4 {dict map command: syntax} -returnCodes error -body {
+ dict map x x x x
+} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+test dict-24.5 {dict map command: syntax} -returnCodes error -body {
+ dict map x x x
+} -result {must have exactly two variable names}
+test dict-24.6 {dict map command: syntax} -returnCodes error -body {
+ dict map {x x x} x x
+} -result {must have exactly two variable names}
+test dict-24.7 {dict map command: syntax} -returnCodes error -body {
+ dict map "\{x" x x
+} -result {unmatched open brace in list}
+test dict-24.8 {dict map command} -setup {
+ set values {}
+ set keys {}
+} -body {
+ # This test confirms that [dict keys], [dict values] and [dict map]
+ # all traverse a dictionary in the same order.
+ set dictv {a A b B c C}
+ dict map {k v} $dictv {
+ lappend keys $k
+ lappend values $v
+ }
+ set result [expr {
+ $keys eq [dict keys $dictv] && $values eq [dict values $dictv]
+ }]
+ expr {$result ? "YES" : [list "NO" $dictv $keys $values]}
+} -cleanup {
+ unset result keys values k v dictv
+} -result YES
+test dict-24.9 {dict map command} {
+ dict map {k v} {} {
+ error "unexpected execution of 'dict map' body"
+ }
+} {}
+test dict-24.10 {dict map command: script results} -body {
+ set times 0
+ dict map {k v} {a a b b} {
+ incr times
+ continue
+ error "shouldn't get here"
+ }
+ return $times
+} -cleanup {
+ unset times k v
+} -result 2
+test dict-24.11 {dict map command: script results} -body {
+ set times 0
+ dict map {k v} {a a b b} {
+ incr times
+ break
+ error "shouldn't get here"
+ }
+ return $times
+} -cleanup {
+ unset times k v
+} -result 1
+test dict-24.12 {dict map command: script results} -body {
+ set times 0
+ list [catch {
+ dict map {k v} {a a b b} {
+ incr times
+ error test
+ }
+ } msg] $msg $times $::errorInfo
+} -cleanup {
+ unset times k v msg
+} -result {1 test 1 {test
+ while executing
+"error test"
+ ("dict map" body line 3)
+ invoked from within
+"dict map {k v} {a a b b} {
+ incr times
+ error test
+ }"}}
+test dict-24.13 {dict map command: script results} {
+ apply {{} {
+ dict map {k v} {a b} {
+ return ok,$k,$v
+ error "skipped return completely"
+ }
+ error "return didn't go far enough"
+ }}
+} ok,a,b
+test dict-24.14 {dict map command: handle representation loss} -setup {
+ set keys {}
+ set values {}
+} -body {
+ set dictVar {a b c d e f g h}
+ list [dict size [dict map {k v} $dictVar {
+ if {[llength $dictVar]} {
+ lappend keys $k
+ lappend values $v
+ return -level 0 $k
+ }
+ }]] [lsort $keys] [lsort $values]
+} -cleanup {
+ unset dictVar keys values k v
+} -result {4 {a c e g} {b d f h}}
+test dict-24.14a {dict map command: handle representation loss} -body {
+ apply {{} {
+ set dictVar {a b c d e f g h}
+ list [dict size [dict map {k v} $dictVar {
+ if {[llength $dictVar]} {
+ lappend keys $k
+ lappend values $v
+ return -level 0 $k
+ }
+ }]] [lsort $keys] [lsort $values]
+ }}
+} -result {4 {a c e g} {b d f h}}
+test dict-24.15 {dict map command: keys are unique and iterated over once only} -setup {
+ unset -nocomplain accum
+ array set accum {}
+} -body {
+ set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
+ dict map {k v} $dictVar {
+ append accum($k) $v,
+ }
+ set result [lsort [array names accum]]
+ lappend result :
+ foreach k $result {
+ catch {lappend result $accum($k)}
+ }
+ return $result
+} -cleanup {
+ unset dictVar k v result accum
+} -result {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
+test dict-24.16 {dict map command in compilation context} {
+ apply {{} {
+ set res {x x x x x x}
+ dict map {k v} {a 0 b 1 c 2 d 3 e 4 f 5} {
+ lset res $v $k
+ continue
+ }
+ return $res
+ }}
+} {a b c d e f}
+test dict-24.17 {dict map command in compilation context} {
+ # Bug 1379349 (dict for)
+ apply {{} {
+ set d [dict create a 1] ;# Dict must be unshared!
+ dict map {k v} $d {
+ dict set d $k 0 ;# Any modification will do
+ }
+ return $d
+ }}
+} {a 0}
+test dict-24.17a {dict map command in compilation context} {
+ # Bug 1379349 (dict for)
+ apply {{} {
+ set d [dict create a 1] ;# Dict must be unshared!
+ dict map {k v} $d {
+ dict set d $k 0 ;# Any modification will do
+ }
+ }}
+} {a {a 0}}
+test dict-24.18 {dict map command in compilation context} {
+ # Bug 1382528 (dict for)
+ apply {{} {
+ dict map {k v} {} {} ;# Note empty dict
+ catch { error foo } ;# Note compiled [catch]
+ }}
+} 1
+test dict-24.19 {dict map and invalid dicts: 'dict for' bug 1531184} -body {
+ di[list]ct map {k v} x {}
+} -returnCodes 1 -result {missing value to go with key}
+test dict-24.20 {dict map stack space compilation: 'dict for' bug 1903325} {
+ apply {{x y args} {
+ dict map {a b} $x {}
+ concat "c=$y,$args"
+ }} {} 1 2 3
+} {c=1,2 3}
+proc linenumber {} {
+ dict get [info frame -1] line
+}
+test dict-24.20.1 {dict compilation crash: 'dict for' bug 3487626} {
+ apply {{} {apply {n {
+ set e {}
+ set k {}
+ dict map {a b} {c {d {e {f g}}}} {
+ ::tcl::dict::map {h i} $b {
+ dict update i e j {
+ ::tcl::dict::update j f k {
+ return [expr {$n - [linenumber]}]
+ }
+ }
+ }
+ }
+ }} [linenumber]}}
+} 5
+test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} knownBug {
+ apply {{} {apply {n {
+ set e {}
+ set k {}
+ dict map {a {
+b
+}} {c {d {e {f g}}}} {
+ ::tcl::dict::map {h {
+i
+}} ${
+b
+} {
+ dict update {
+i
+} e {
+j
+} {
+ ::tcl::dict::update {
+j
+} f k {
+ return [expr {$n - [linenumber]}]
+ }
+ }
+ }
+ }
+ }} [linenumber]}}
+} 5
+rename linenumber {}
+test dict-24.22 {dict map results (non-compiled)} {
+ dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
+ return -level 0 "$k,$v"
+ }
+} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
+test dict-24.23 {dict map results (compiled)} {
+ apply {{} {
+ dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
+ return -level 0 "$k,$v"
+ }
+ }}
+} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
+test dict-24.23a {dict map results (compiled)} {
+ apply {{list} {
+ dict map {k v} [dict map {k v} $list { list $v $k }] {
+ return -level 0 "$k,$v"
+ }
+ }} {a 1 b 2 c 3 d 4}
+} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
+test dict-24.24 {dict map with huge dict (non-compiled)} {
+ tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat 100000 x] x] {
+ expr { $k * $v }
+ }]
+} 166666666600000
+test dict-24.25 {dict map with huge dict (compiled)} {
+ apply {{n} {
+ tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat $n y] y] {
+ expr { $k * $v }
+ }]
+ }} 100000
+} 166666666600000
+
# cleanup
::tcltest::cleanupTests
diff --git a/tests/dstring.test b/tests/dstring.test
index 033e29e..06121a3 100644
--- a/tests/dstring.test
+++ b/tests/dstring.test
@@ -1,44 +1,57 @@
# Commands covered: none
#
-# This file contains a collection of tests for Tcl's dynamic string
-# library procedures. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for Tcl's dynamic string library
+# procedures. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 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.
-#
-# RCS: @(#) $Id: dstring.test,v 1.8 2004/06/24 10:34:12 dkf Exp $
+# 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
namespace import -force ::tcltest::*
}
-testConstraint testdstring [llength [info commands testdstring]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
-test dstring-1.1 {appending and retrieving} testdstring {
+testConstraint testdstring [llength [info commands testdstring]]
+if {[testConstraint testdstring]} {
+ testdstring free
+}
+
+test dstring-1.1 {appending and retrieving} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring append "abc" -1
list [testdstring get] [testdstring length]
-} {abc 3}
-test dstring-1.2 {appending and retrieving} testdstring {
+} -cleanup {
testdstring free
+} -result {abc 3}
+test dstring-1.2 {appending and retrieving} -constraints testdstring -setup {
+ testdstring free
+} -body {
testdstring append "abc" -1
testdstring append " xyzzy" 3
testdstring append " 12345" -1
list [testdstring get] [testdstring length]
-} {{abc xy 12345} 12}
-test dstring-1.3 {appending and retrieving} testdstring {
+} -cleanup {
+ testdstring free
+} -result {{abc xy 12345} 12}
+test dstring-1.3 {appending and retrieving} -constraints testdstring -setup {
testdstring free
+} -body {
foreach l {a b c d e f g h i j k l m n o p} {
testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
}
list [testdstring get] [testdstring length]
-} {{aaaaaaaaaaaaaaaaaaaaa
+} -cleanup {
+ testdstring free
+} -result {{aaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccc
ddddddddddddddddddddd
@@ -56,101 +69,143 @@ ooooooooooooooooooooo
ppppppppppppppppppppp
} 352}
-test dstring-2.1 {appending list elements} testdstring {
+test dstring-2.1 {appending list elements} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring element "abc"
testdstring element "d e f"
list [testdstring get] [testdstring length]
-} {{abc {d e f}} 11}
-test dstring-2.2 {appending list elements} testdstring {
+} -cleanup {
testdstring free
+} -result {{abc {d e f}} 11}
+test dstring-2.2 {appending list elements} -constraints testdstring -setup {
+ testdstring free
+} -body {
testdstring element "x"
testdstring element "\{"
testdstring element "ab\}"
testdstring get
-} {x \{ ab\}}
-test dstring-2.3 {appending list elements} testdstring {
+} -cleanup {
+ testdstring free
+} -result {x \{ ab\}}
+test dstring-2.3 {appending list elements} -constraints testdstring -setup {
testdstring free
+} -body {
foreach l {a b c d e f g h i j k l m n o p} {
testdstring element $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l
}
testdstring get
-} {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp}
-test dstring-2.4 {appending list elements} testdstring {
+} -cleanup {
testdstring free
+} -result {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp}
+test dstring-2.4 {appending list elements} -constraints testdstring -setup {
+ testdstring free
+} -body {
testdstring append "a\{" -1
testdstring element abc
testdstring append " \{" -1
testdstring element xyzzy
testdstring get
-} "a{ abc {xyzzy"
-test dstring-2.5 {appending list elements} testdstring {
+} -cleanup {
+ testdstring free
+} -result "a{ abc {xyzzy"
+test dstring-2.5 {appending list elements} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring append " \{" -1
testdstring element abc
testdstring get
-} " {abc"
-test dstring-2.6 {appending list elements} testdstring {
+} -cleanup {
+ testdstring free
+} -result " {abc"
+test dstring-2.6 {appending list elements} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring append " " -1
testdstring element abc
testdstring get
-} { abc}
-test dstring-2.7 {appending list elements} testdstring {
+} -cleanup {
testdstring free
+} -result { abc}
+test dstring-2.7 {appending list elements} -constraints testdstring -setup {
+ testdstring free
+} -body {
testdstring append "\\ " -1
testdstring element abc
testdstring get
-} "\\ abc"
-test dstring-2.8 {appending list elements} testdstring {
+} -cleanup {
+ testdstring free
+} -result "\\ abc"
+test dstring-2.8 {appending list elements} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring append "x " -1
testdstring element abc
testdstring get
-} {x abc}
-test dstring-2.9 {appending list elements} testdstring {
+} -cleanup {
+ testdstring free
+} -result {x abc}
+test dstring-2.9 {appending list elements} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring element #
testdstring get
-} {{#}}
-test dstring-2.10 {appending list elements} testdstring {
+} -cleanup {
testdstring free
+} -result {{#}}
+test dstring-2.10 {appending list elements} -constraints testdstring -setup {
+ testdstring free
+} -body {
testdstring append " " -1
testdstring element #
testdstring get
-} { {#}}
-test dstring-2.11 {appending list elements} testdstring {
+} -cleanup {
+ testdstring free
+} -result { {#}}
+test dstring-2.11 {appending list elements} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring append \t -1
testdstring element #
testdstring get
-} \t{#}
-test dstring-2.12 {appending list elements} testdstring {
+} -cleanup {
+ testdstring free
+} -result \t{#}
+test dstring-2.12 {appending list elements} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring append x -1
testdstring element #
testdstring get
-} {x #}
-test dstring-2.13 {appending list elements} testdstring {
+} -cleanup {
+ testdstring free
+} -result {x #}
+test dstring-2.13 {appending list elements} -constraints testdstring -body {
# This test shows lack of sophistication in Tcl_DStringAppendElement's
# decision about whether #-quoting can be disabled.
testdstring free
testdstring append "x " -1
testdstring element #
testdstring get
-} {x {#}}
+} -cleanup {
+ testdstring free
+} -result {x {#}}
-test dstring-3.1 {nested sublists} testdstring {
+test dstring-3.1 {nested sublists} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring start
testdstring element foo
testdstring element bar
testdstring end
testdstring element another
testdstring get
-} {{foo bar} another}
-test dstring-3.2 {nested sublists} testdstring {
+} -cleanup {
testdstring free
+} -result {{foo bar} another}
+test dstring-3.2 {nested sublists} -constraints testdstring -setup {
+ testdstring free
+} -body {
testdstring start
testdstring start
testdstring element abc
@@ -159,9 +214,12 @@ test dstring-3.2 {nested sublists} testdstring {
testdstring end
testdstring element ghi
testdstring get
-} {{{abc def}} ghi}
-test dstring-3.3 {nested sublists} testdstring {
+} -cleanup {
+ testdstring free
+} -result {{{abc def}} ghi}
+test dstring-3.3 {nested sublists} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring start
testdstring start
testdstring start
@@ -173,9 +231,12 @@ test dstring-3.3 {nested sublists} testdstring {
testdstring end
testdstring element foo4
testdstring get
-} {{{{foo foo2}} foo3} foo4}
-test dstring-3.4 {nested sublists} testdstring {
+} -cleanup {
+ testdstring free
+} -result {{{{foo foo2}} foo3} foo4}
+test dstring-3.4 {nested sublists} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring element before
testdstring start
testdstring element during
@@ -183,52 +244,69 @@ test dstring-3.4 {nested sublists} testdstring {
testdstring end
testdstring element last
testdstring get
-} {before {during more} last}
-test dstring-3.5 {nested sublists} testdstring {
+} -cleanup {
testdstring free
+} -result {before {during more} last}
+test dstring-3.5 {nested sublists} -constraints testdstring -setup {
+ testdstring free
+} -body {
testdstring element "\{"
testdstring start
testdstring element first
testdstring element second
testdstring end
testdstring get
-} {\{ {first second}}
-test dstring-3.6 {appending list elements} testdstring {
+} -cleanup {
+ testdstring free
+} -result {\{ {first second}}
+test dstring-3.6 {appending list elements} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring append x -1
testdstring start
testdstring element #
testdstring end
testdstring get
-} {x {{#}}}
-test dstring-3.7 {appending list elements} testdstring {
+} -cleanup {
+ testdstring free
+} -result {x {{#}}}
+test dstring-3.7 {appending list elements} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring append x -1
testdstring start
testdstring append " " -1
testdstring element #
testdstring end
testdstring get
-} {x { {#}}}
-test dstring-3.8 {appending list elements} testdstring {
+} -cleanup {
testdstring free
+} -result {x { {#}}}
+test dstring-3.8 {appending list elements} -constraints testdstring -setup {
+ testdstring free
+} -body {
testdstring append x -1
testdstring start
testdstring append \t -1
testdstring element #
testdstring end
testdstring get
-} "x {\t{#}}"
-test dstring-3.9 {appending list elements} testdstring {
+} -cleanup {
+ testdstring free
+} -result "x {\t{#}}"
+test dstring-3.9 {appending list elements} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring append x -1
testdstring start
testdstring append x -1
testdstring element #
testdstring end
testdstring get
-} {x {x #}}
-test dstring-3.10 {appending list elements} testdstring {
+} -cleanup {
+ testdstring free
+} -result {x {x #}}
+test dstring-3.10 {appending list elements} -constraints testdstring -body {
# This test shows lack of sophistication in Tcl_DStringAppendElement's
# decision about whether #-quoting can be disabled.
testdstring free
@@ -238,36 +316,50 @@ test dstring-3.10 {appending list elements} testdstring {
testdstring element #
testdstring end
testdstring get
-} {x {x {#}}}
+} -cleanup {
+ testdstring free
+} -result {x {x {#}}}
-test dstring-4.1 {truncation} testdstring {
+test dstring-4.1 {truncation} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring append "abcdefg" -1
testdstring trunc 3
list [testdstring get] [testdstring length]
-} {abc 3}
-test dstring-4.2 {truncation} testdstring {
+} -cleanup {
+ testdstring free
+} -result {abc 3}
+test dstring-4.2 {truncation} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring append "xyzzy" -1
testdstring trunc 0
list [testdstring get] [testdstring length]
-} {{} 0}
+} -cleanup {
+ testdstring free
+} -result {{} 0}
-test dstring-5.1 {copying to result} testdstring {
+test dstring-5.1 {copying to result} -constraints testdstring -setup {
testdstring free
+} -body {
testdstring append xyz -1
testdstring result
-} xyz
-test dstring-5.2 {copying to result} testdstring {
+} -cleanup {
+ testdstring free
+} -result xyz
+test dstring-5.2 {copying to result} -constraints testdstring -setup {
testdstring free
- catch {unset a}
+ unset -nocomplain a
+} -body {
foreach l {a b c d e f g h i j k l m n o p} {
testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
}
set a [testdstring result]
testdstring append abc -1
list $a [testdstring get]
-} {{aaaaaaaaaaaaaaaaaaaaa
+} -cleanup {
+ testdstring free
+} -result {{aaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccc
ddddddddddddddddddddd
@@ -285,23 +377,31 @@ ooooooooooooooooooooo
ppppppppppppppppppppp
} abc}
-test dstring-6.1 {Tcl_DStringGetResult} testdstring {
+test dstring-6.1 {Tcl_DStringGetResult} -constraints testdstring -setup {
testdstring free
+} -body {
list [testdstring gresult staticsmall] [testdstring get]
-} {{} short}
-test dstring-6.2 {Tcl_DStringGetResult} testdstring {
+} -cleanup {
testdstring free
+} -result {{} short}
+test dstring-6.2 {Tcl_DStringGetResult} -constraints testdstring -setup {
+ testdstring free
+} -body {
foreach l {a b c d e f g h i j k l m n o p} {
testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
}
list [testdstring gresult staticsmall] [testdstring get]
-} {{} short}
-test dstring-6.3 {Tcl_DStringGetResult} testdstring {
+} -cleanup {
+ testdstring free
+} -result {{} short}
+test dstring-6.3 {Tcl_DStringGetResult} -constraints testdstring -body {
set result {}
lappend result [testdstring gresult staticlarge]
testdstring append x 1
lappend result [testdstring get]
-} {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9
+} -cleanup {
+ testdstring free
+} -result {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9
second0 second1 second2 second3 second4 second5 second6 second7 second8 second9
third0 third1 third2 third3 third4 third5 third6 third7 third8 third9
fourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9
@@ -309,22 +409,31 @@ fifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9
sixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9
seventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9
x}}
-test dstring-6.4 {Tcl_DStringGetResult} testdstring {
+test dstring-6.4 {Tcl_DStringGetResult} -constraints testdstring -body {
set result {}
lappend result [testdstring gresult free]
testdstring append y 1
lappend result [testdstring get]
-} {{} {This is a malloc-ed stringy}}
-test dstring-6.5 {Tcl_DStringGetResult} testdstring {
+} -cleanup {
+ testdstring free
+} -result {{} {This is a malloc-ed stringy}}
+test dstring-6.5 {Tcl_DStringGetResult} -constraints testdstring -body {
set result {}
lappend result [testdstring gresult special]
testdstring append z 1
lappend result [testdstring get]
-} {{} {This is a specially-allocated stringz}}
-
+} -cleanup {
+ testdstring free
+} -result {{} {This is a specially-allocated stringz}}
+
# cleanup
if {[testConstraint testdstring]} {
testdstring free
}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/encoding.test b/tests/encoding.test
index bc57b2d..0374e2d 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -1,14 +1,12 @@
# This file contains a collection of tests for tclEncoding.c
-# Sourcing this file into Tcl runs the tests and generates output for
-# errors. No output means no errors were found.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
#
# Copyright (c) 1997 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.
-#
-# RCS: @(#) $Id: encoding.test,v 1.29 2009/11/16 17:38:09 ferrieux Exp $
+# 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
@@ -17,6 +15,11 @@ namespace eval ::tcl::test::encoding {
namespace import -force ::tcltest::*
+catch {
+ ::tcltest::loadTestedCommands
+ package require -exact Tcltest [info patchlevel]
+}
+
proc toutf {args} {
variable x
lappend x "toutf $args"
@@ -27,32 +30,34 @@ proc fromutf {args} {
}
proc runtests {} {
-
variable x
# Some tests require the testencoding command
testConstraint testencoding [llength [info commands testencoding]]
testConstraint exec [llength [info commands exec]]
-
+testConstraint testgetdefenc [llength [info commands testgetdefenc]]
+
# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested
-test encoding-1.1 {Tcl_GetEncoding: system encoding} {testencoding} {
- testencoding create foo [namespace origin toutf] [namespace origin fromutf]
+test encoding-1.1 {Tcl_GetEncoding: system encoding} -setup {
set old [encoding system]
+} -constraints {testencoding} -body {
+ testencoding create foo [namespace origin toutf] [namespace origin fromutf]
encoding system foo
set x {}
encoding convertto abcd
+ return $x
+} -cleanup {
encoding system $old
testencoding delete foo
- set x
-} {{fromutf }}
+} -result {{fromutf }}
test encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} {
testencoding create foo [namespace origin toutf] [namespace origin fromutf]
set x {}
encoding convertto foo abcd
testencoding delete foo
- set x
+ return $x
} {{fromutf }}
test encoding-1.3 {Tcl_GetEncoding: load encoding} {
list [encoding convertto jis0208 \u4e4e] \
@@ -62,71 +67,77 @@ test encoding-1.3 {Tcl_GetEncoding: load encoding} {
test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
encoding convertto jis0208 \u4e4e
} {8C}
-test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} {
+test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} -setup {
set system [encoding system]
set path [encoding dirs]
+} -constraints {testencoding} -body {
encoding system shiftjis ;# incr ref count
encoding dirs [list [pwd]]
set x [encoding convertto shiftjis \u4e4e] ;# old one found
encoding system identity
llength shiftjis ;# Shimmer away any cache of Tcl_Encoding
lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
+} -cleanup {
encoding system identity
encoding dirs $path
encoding system $system
- set x
-} "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"
+} -result "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"
-test encoding-3.1 {Tcl_GetEncodingName, NULL} {
+test encoding-3.1 {Tcl_GetEncodingName, NULL} -setup {
set old [encoding system]
+} -body {
encoding system shiftjis
- set x [encoding system]
+ encoding system
+} -cleanup {
encoding system $old
- set x
-} {shiftjis}
-test encoding-3.2 {Tcl_GetEncodingName, non-null} {
+} -result {shiftjis}
+test encoding-3.2 {Tcl_GetEncodingName, non-null} -setup {
set old [fconfigure stdout -encoding]
+} -body {
fconfigure stdout -encoding jis0208
- set x [fconfigure stdout -encoding]
+ fconfigure stdout -encoding
+} -cleanup {
fconfigure stdout -encoding $old
- set x
-} {jis0208}
+} -result {jis0208}
-test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
+test encoding-4.1 {Tcl_GetEncodingNames} -constraints {testencoding} -setup {
cd [makeDirectory tmp]
makeDirectory [file join tmp encoding]
- makeFile {} [file join tmp encoding junk.enc]
- makeFile {} [file join tmp encoding junk2.enc]
set path [encoding dirs]
encoding dirs {}
catch {unset encodings}
catch {unset x}
+} -body {
foreach encoding [encoding names] {
set encodings($encoding) 1
}
+ makeFile {} [file join tmp encoding junk.enc]
+ makeFile {} [file join tmp encoding junk2.enc]
encoding dirs [list [file join [pwd] encoding]]
foreach encoding [encoding names] {
if {![info exists encodings($encoding)]} {
lappend x $encoding
}
}
+ lsort $x
+} -cleanup {
encoding dirs $path
cd [workingDirectory]
removeFile [file join tmp encoding junk2.enc]
removeFile [file join tmp encoding junk.enc]
removeDirectory [file join tmp encoding]
removeDirectory tmp
- lsort $x
-} {junk junk2}
+} -result {junk junk2}
-test encoding-5.1 {Tcl_SetSystemEncoding} {
+test encoding-5.1 {Tcl_SetSystemEncoding} -setup {
set old [encoding system]
+} -body {
encoding system jis0208
- set x [encoding convertto \u4e4e]
+ encoding convertto \u4e4e
+} -cleanup {
encoding system identity
encoding system $old
- set x
-} {8C}
+} -result {8C}
test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
set old [encoding system]
encoding system $old
@@ -140,7 +151,7 @@ test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} {
encoding convertfrom foo abcd
encoding convertto foo abcd
testencoding delete foo
- set x
+ return $x
} {{toutf 1} {fromutf 2}}
test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {
testencoding create foo [namespace code {toutf a}] \
@@ -149,7 +160,7 @@ test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {
encoding convertfrom foo abcd
encoding convertto foo abcd
testencoding delete foo
- set x
+ return $x
} {{toutf a} {fromutf b}}
test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {
@@ -175,7 +186,7 @@ test encoding-8.1 {Tcl_ExternalToUtf} {
set x [read $f]
close $f
file delete [file join [temporaryDirectory] dummy]
- set x
+ return $x
} "ab\u4e4eg"
test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
@@ -203,7 +214,7 @@ test encoding-10.1 {Tcl_UtfToExternal} {
set x [read $f]
close $f
file delete [file join [temporaryDirectory] dummy]
- set x
+ return $x
} "ab\x8c\xc1g"
proc viewable {str} {
@@ -244,10 +255,11 @@ test encoding-11.5 {LoadEncodingFile: escape file} {
test encoding-11.5.1 {LoadEncodingFile: escape file} {
viewable [encoding convertto iso2022-jp \u4e4e]
} [viewable "\x1b\$B8C\x1b(B"]
-test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
+test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup {
set system [encoding system]
set path [encoding dirs]
encoding system identity
+} -body {
cd [temporaryDirectory]
encoding dirs [file join tmp encoding]
makeDirectory tmp
@@ -256,15 +268,15 @@ test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
fconfigure $f -translation binary
puts $f "abcdefghijklmnop"
close $f
- set x [list [catch {encoding convertto splat \u4e4e} msg] $msg]
+ encoding convertto splat \u4e4e
+} -returnCodes error -cleanup {
file delete [file join [temporaryDirectory] tmp encoding splat.enc]
removeDirectory [file join tmp encoding]
removeDirectory tmp
cd [workingDirectory]
encoding dirs $path
encoding system $system
- set x
-} {1 {invalid encoding file "splat"}}
+} -result {invalid encoding file "splat"}
# OpenEncodingFile is fully tested by the rest of the tests in this file.
@@ -302,7 +314,6 @@ test encoding-14.1 {BinaryProc} {
test encoding-15.1 {UtfToUtfProc} {
encoding convertto utf-8 \xa3
} "\xc2\xa3"
-
test encoding-15.2 {UtfToUtfProc null character output} {
set x \u0000
set y [encoding convertto utf-8 \u0000]
@@ -310,7 +321,6 @@ test encoding-15.2 {UtfToUtfProc null character output} {
binary scan $y H* z
list [string bytelength $x] [string bytelength $y] $z
} {2 1 00}
-
test encoding-15.3 {UtfToUtfProc null character input} {
set x [encoding convertfrom identity \x00]
set y [encoding convertfrom utf-8 $x]
@@ -390,44 +400,41 @@ test encoding-23.3 {iso2022-jp escape encoding test} {
fconfigure $fid -encoding iso2022-jp
set data [read $fid 50]
close $fid
- set data
+ return $data
} [string range $iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
cd [workingDirectory]
-test encoding-24.1 {EscapeFreeProc on open channels} -constraints {
- exec
-} -setup {
- # Bug #524674 input
- set file [makeFile {
+# Code to make the next few tests more intelligible; the code being tested
+# should be in the body of the test!
+proc runInSubprocess {contents {filename iso2022.tcl}} {
+ set theFile [makeFile $contents $filename]
+ try {
+ exec [interpreter] $theFile
+ } finally {
+ removeFile $theFile
+ }
+}
+
+test encoding-24.1 {EscapeFreeProc on open channels} exec {
+ runInSubprocess {
set f [open [file join [file dirname [info script]] iso2022.txt]]
fconfigure $f -encoding iso2022-jp
gets $f
- } iso2022.tcl]
-} -body {
- exec [interpreter] $file
-} -cleanup {
- removeFile iso2022.tcl
-} -result {}
-
-test encoding-24.2 {EscapeFreeProc on open channels} -constraints {
- exec
-} -setup {
+ }
+} {}
+test encoding-24.2 {EscapeFreeProc on open channels} {exec} {
# Bug #524674 output
- set file [makeFile {
+ viewable [runInSubprocess {
encoding system cp1252; # Bug #2891556 crash revelator
fconfigure stdout -encoding iso2022-jp
puts ab\u4e4e\u68d9g
- testfinexit
- } iso2022.tcl]
-} -body {
- viewable [exec [interpreter] $file]
-} -cleanup {
- removeFile iso2022.tcl
-} -result "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
-
+ set env(TCL_FINALIZE_ON_EXIT) 1
+ exit
+ }]
+} "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
- # Bug #219314 - if we don't free escape encodings correctly on
- # channel closure, we go boom
+ # Bug #219314 - if we don't free escape encodings correctly on channel
+ # closure, we go boom
set file [makeFile {
encoding system iso2022-jp
set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
@@ -471,18 +478,14 @@ proc foreach-jisx0208 {varName command} {
} {
if {[llength $range] == 2} {
# for adhoc range. simple {first last}. inclusive.
- set first [scan [lindex $range 0] %x]
- set last [scan [lindex $range 1] %x]
+ scan $range %x%x first last
for {set i $first} {$i <= $last} {incr i} {
set code $i
uplevel 1 $command
}
} elseif {[llength $range] == 4} {
# for uniform range.
- set h0 [scan [lindex $range 0] %x]
- set l0 [scan [lindex $range 1] %x]
- set hend [scan [lindex $range 2] %x]
- set lend [scan [lindex $range 3] %x]
+ scan $range %x%x%x%x h0 l0 hend lend
for {set hi $h0} {$hi <= $hend} {incr hi} {
for {set lo $l0} {$lo <= $lend} {incr lo} {
set code [expr {$hi << 8 | ($lo & 0xff)}]
@@ -526,7 +529,7 @@ proc channel-diff {fa fb} {
binary scan [lindex $lb 1] H* got
lappend diff [list $code $expected $got]
}
- set diff
+ return $diff
}
# Create char tables.
@@ -545,8 +548,9 @@ file copy -force cp932.chars shiftjis.chars
set NUM 0
foreach from {cp932 shiftjis euc-jp iso2022-jp} {
foreach to {cp932 shiftjis euc-jp iso2022-jp} {
- test encoding-25.[incr NUM] "jisx0208 $from => $to" {
+ test encoding-25.[incr NUM] "jisx0208 $from => $to" -setup {
cd [temporaryDirectory]
+ } -body {
set f [open $from.chars]
fconfigure $f -encoding $from
set out [open $from.$to.tcltestout w]
@@ -554,40 +558,43 @@ foreach from {cp932 shiftjis euc-jp iso2022-jp} {
puts -nonewline $out [read $f]
close $out
close $f
-
# then compare $to.chars <=> $from.to.tcltestout as binary.
- set fa [open $to.chars]
- fconfigure $fa -encoding binary
- set fb [open $from.$to.tcltestout]
- fconfigure $fb -encoding binary
- set diff [channel-diff $fa $fb]
+ set fa [open $to.chars rb]
+ set fb [open $from.$to.tcltestout rb]
+ channel-diff $fa $fb
+ # Difference should be empty.
+ } -cleanup {
close $fa
close $fb
-
- # Difference should be empty.
- set diff
- } {}
+ } -result {}
}
}
-testConstraint testgetdefenc [llength [info commands testgetdefenc]]
-
test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints {
- testgetdefenc
+ testgetdefenc
} -setup {
- set origDir [testgetdefenc]
- testsetdefenc slappy
+ set origDir [testgetdefenc]
+ testsetdefenc slappy
} -body {
- testgetdefenc
+ testgetdefenc
} -cleanup {
- testsetdefenc $origDir
+ testsetdefenc $origDir
} -result slappy
file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout]
# ===> Cut here <===
-# EscapeFreeProc, GetTableEncoding, unilen
-# are fully tested by the rest of this file
+# EscapeFreeProc, GetTableEncoding, unilen are fully tested by the rest of
+# this file.
+
+
+test encoding-27.1 {encoding dirs basic behavior} -returnCodes error -body {
+ encoding dirs ? ?
+} -result {wrong # args: should be "encoding dirs ?dirList?"}
+test encoding-27.2 {encoding dirs basic behavior} -returnCodes error -body {
+ encoding dirs "\{not a list"
+} -result "expected directory list but got \"\{not a list\""
+
}
runtests
@@ -597,3 +604,7 @@ runtests
namespace delete ::tcl::test::encoding
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/env.test b/tests/env.test
index f5669d7..9010f52 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: env.test,v 1.32 2009/12/21 23:25:40 nijtmans Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -91,6 +89,7 @@ set printenvScript [makeFile {
SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
+ CommonProgramFiles ProgramFiles
} {
lrem names $name
}
@@ -99,6 +98,7 @@ set printenvScript [makeFile {
}
exit
} printenv]
+
# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
@@ -121,6 +121,7 @@ foreach name [array names env] {
SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
SECURITYSESSIONID LANG WINDIR TERM
+ CommonProgramFiles ProgramFiles
}} {
unset env($name)
}
diff --git a/tests/error.test b/tests/error.test
index e30fd50..97bcc0a 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: error.test,v 1.33 2010/06/02 23:36:26 ferrieux Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -140,7 +138,7 @@ test error-3.3 {errors in catch command} {
catch {unset a}
set a(0) 22
list [catch {catch {format 44} a} msg] $msg
-} {1 {couldn't save command result in variable}}
+} {1 {can't set "a": variable is array}}
catch {unset a}
# More tests related to errorInfo and errorCode
@@ -174,13 +172,13 @@ test error-4.6 {errorstack via info } -body {
proc g x {error G:$x}
catch {f 12}
info errorstack
-} -match glob -result {CALL {g 1212} CALL {f 12} UP 1}
+} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
test error-4.7 {errorstack via options dict } -body {
proc f x {g $x$x}
proc g x {error G:$x}
catch {f 12} m d
dict get $d -errorstack
-} -match glob -result {CALL {g 1212} CALL {f 12} UP 1}
+} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
# Errors in error command itself
@@ -244,7 +242,7 @@ test error-6.10 {catch must reset errorstack} -body {
catch {f 13}
set e2 [info errorstack]
list $e1 $e2
-} -match glob -result {{CALL {g 1212} CALL {f 12} UP 1} {CALL {g 1313} CALL {f 13} UP 1}}
+} -match glob -result {{INNER * CALL {g 1212} CALL {f 12} UP 1} {INNER * CALL {g 1313} CALL {f 13} UP 1}}
test error-7.1 {Bug 1397843} -body {
variable cmds
@@ -419,7 +417,7 @@ test error-12.4 {try with result/opts variable assignment in on handler} {
} {bar,FOO}
test error-12.5 {try with result/opts variable assignment in on handler, vars remain in scope} {
try { throw FOO bar } on error {res opts} { list d e f }
- set r "$res,[dict get $opts -errorcode]"
+ set r "$res,[dict get $opts -errorcode]"
} {bar,FOO}
test error-12.6 {try result is propagated if no matching handler} {
try { list a b c } on error {} { list d e f }
@@ -461,7 +459,7 @@ test error-13.8 {try with multiple handlers and finally (ok)} {
try list on error {} {} trap {} {} {} finally {}
} {}
test error-13.9 {last handler body can't be a fallthrough #1} -body {
- try list on error {} {} on break {} -
+ try list on error {} {} on break {} -
} -returnCodes error -result {last non-finally clause must not have a body of "-"}
test error-13.10 {last handler body can't be a fallthrough #2} -body {
try list on error {} {} on break {} - finally { list d e f }
@@ -473,7 +471,7 @@ test error-14.1 {try with multiple handlers (only one matches) #1} {
try { throw FOO bar } on ok {} { list a b c } trap FOO {} { list d e f }
} {d e f}
test error-14.2 {try with multiple handlers (only one matches) #2} {
- try { throw FOO bar } trap FOO {} { list d e f } on ok {} { list a b c }
+ try { throw FOO bar } trap FOO {} { list d e f } on ok {} { list a b c }
} {d e f}
test error-14.3 {try with multiple handlers (only one matches) #3} {
try {
@@ -484,7 +482,7 @@ test error-14.3 {try with multiple handlers (only one matches) #3} {
list d e f
} on ok {} {
list a b c
- }
+ }
} {d e f}
test error-14.4 {try with multiple matching handlers (only the first in left-to-right order runs) #1} {
try { throw FOO bar } on error {} { list a b c } trap FOO {} { list d e f }
@@ -595,16 +593,16 @@ test error-16.6 {try with variable assignment and propagation #1} {
catch {
try { throw FOO bar } trap FOO {em} { throw BAR baz }
}
- set em
+ set em
} {bar}
test error-16.7 {try with variable assignment and propagation #2} {
catch {
try { throw FOO bar } trap FOO {em opts} { throw BAR baz }
}
- list $em [dict get $opts -errorcode]
+ list $em [dict get $opts -errorcode]
} {bar FOO}
test error-16.8 {exception chaining (try=ok, handler=error)} {
- #FIXME is the intent of this test correct?
+ #FIXME is the intent of this test correct?
catch {
try { list a b c } on ok {em opts} { throw BAR baz }
} tryem tryopts
@@ -688,7 +686,7 @@ test error-17.11 {successful finally doesn't affect variable assignment or propa
catch {
try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { list d e f }
}
- list $em [dict get $opts -errorcode]
+ list $em [dict get $opts -errorcode]
} {bar FOO}
# try tests - propagation (exceptions in finally, exception chaining)
@@ -709,11 +707,11 @@ test error-18.5 {exception in finally doesn't affect variable assignment} {
catch {
try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { throw BAZ zing }
}
- list $em [dict get $opts -errorcode]
+ list $em [dict get $opts -errorcode]
} {bar FOO}
test error-18.6 {exception chaining in finally (try=ok)} {
catch {
- list a b c
+ list a b c
} em expopts
catch {
try { list a b c } finally { throw BAR foo }
@@ -784,14 +782,14 @@ test error-19.1 {try with fallthrough body #1} {
} {1}
test error-19.2 {try with fallthrough body #2} {
set RES {}
- try {
- throw FOO bar
+ try {
+ throw FOO bar
} trap BAR {} {
} trap FOO {} - trap {} {} {
set RES foo
} on error {} {
set RES err
- }
+ }
set RES
} {foo}
test error-19.3 {try with cascade fallthrough} {
@@ -807,22 +805,22 @@ test error-19.4 {multiple unrelated fallthroughs #1} {
set RES {}
try {
throw FOO bar
- } trap FOO {} - trap BAR {} {
+ } trap FOO {} - trap BAR {} {
set RES foo
} trap {} {} - on error {} {
set RES err
- }
+ }
set RES
} {foo}
test error-19.5 {multiple unrelated fallthroughs #2} {
set RES {}
try {
throw BAZ zing
- } trap FOO {} - trap BAR {} {
+ } trap FOO {} - trap BAR {} {
set RES foo
} trap {} {} - on error {} {
set RES err
- }
+ }
set RES
} {err}
proc addmsg msg {
@@ -912,6 +910,72 @@ test error-19.10 {compiled try with chained clauses} -setup {
} -cleanup {
unset RES
} -result {handler {ok good finally}}
+test error-19.11 {compiled try and errors on variable write} -setup {
+ set RES {}
+} -body {
+ apply {{} {
+ array set foo {bar boo}
+ set bar unset
+ catch {
+ try {
+ addmsg body
+ return a
+ } on return {bar foo} {
+ addmsg handler
+ return b
+ } finally {
+ addmsg finally,$bar
+ }
+ } msg
+ addmsg $msg
+ } ::tcl::test::error}
+} -cleanup {
+ unset RES
+} -result {body finally,a {can't set "foo": variable is array}}
+test error-19.12 {interpreted try and errors on variable write} -setup {
+ set RES {}
+} -body {
+ apply {try {
+ array set foo {bar boo}
+ set bar unset
+ catch {
+ $try {
+ addmsg body
+ return a
+ } on return {bar foo} {
+ addmsg handler
+ return b
+ } finally {
+ addmsg finally,$bar
+ }
+ } msg
+ addmsg $msg
+ } ::tcl::test::error} try
+} -cleanup {
+ unset RES
+} -result {body finally,a {can't set "foo": variable is array}}
+test error-19.13 {compiled try and errors on variable write} -setup {
+ set RES {}
+} -body {
+ apply {{} {
+ array set foo {bar boo}
+ set bar unset
+ catch {
+ try {
+ addmsg body
+ return a
+ } on return {bar foo} - on error {bar foo} {
+ addmsg handler
+ return b
+ } finally {
+ addmsg finally,$bar
+ }
+ } msg
+ addmsg $msg
+ } ::tcl::test::error}
+} -cleanup {
+ unset RES
+} -result {body finally,a {can't set "foo": variable is array}}
rename addmsg {}
# FIXME test what vars get set on fallthough ... what is the correct behavior?
@@ -990,7 +1054,7 @@ namespace delete ::tcl::test::error
# cleanup
catch {rename p ""}
::tcltest::cleanupTests
-return
+return
# Local Variables:
# mode: tcl
diff --git a/tests/eval.test b/tests/eval.test
index 98acd08..70ceac8 100644
--- a/tests/eval.test
+++ b/tests/eval.test
@@ -1,23 +1,21 @@
# Commands covered: eval
#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 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.
-#
-# RCS: @(#) $Id: eval.test,v 1.9 2006/10/09 19:15:44 msofer Exp $
+# 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
namespace import -force ::tcltest::*
}
-
+
test eval-1.1 {single argument} {
eval {format 22}
} 22
@@ -80,7 +78,12 @@ test eval-3.4 {concatenating eval and canonical lists} {
unset dummy
eval $cmd $cmd2
} {1 2 3 4 5}
-
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/event.test b/tests/event.test
index c6ac019..0d1b06c 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -8,12 +8,17 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: event.test,v 1.29 2010/07/05 09:50:10 dkf Exp $
package require tcltest 2
namespace import -force ::tcltest::*
+catch {
+ ::tcltest::loadTestedCommands
+ package require -exact Tcltest [info patchlevel]
+ set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
+}
+
+
testConstraint testfilehandler [llength [info commands testfilehandler]]
testConstraint testexithandler [llength [info commands testexithandler]]
testConstraint testfilewait [llength [info commands testfilewait]]
@@ -429,6 +434,7 @@ catch {rename bgerror {}}
test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
set child [open |[list [interpreter]] r+]
+ puts $child "catch {load $::tcltestlib Tcltest}"
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; exit"
flush $child
@@ -442,6 +448,7 @@ odd 41
test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
set child [open |[list [interpreter]] r+]
+ puts $child "catch {load $::tcltestlib Tcltest}"
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 41"
puts $child "testexithandler create 16; exit"
@@ -455,6 +462,7 @@ even 4
}
test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
set child [open |[list [interpreter]] r+]
+ puts $child "catch {load $::tcltestlib Tcltest}"
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 4"
puts $child "testexithandler create 16; exit"
@@ -468,6 +476,7 @@ odd 41
}
test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
set child [open |[list [interpreter]] r+]
+ puts $child "catch {load $::tcltestlib Tcltest}"
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 6"
puts $child "testexithandler create 16; exit"
@@ -481,6 +490,7 @@ odd 41
}
test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
set child [open |[list [interpreter]] r+]
+ puts $child "catch {load $::tcltestlib Tcltest}"
puts $child "testexithandler create 41; testexithandler delete 41"
puts $child "testexithandler create 16; exit"
flush $child
diff --git a/tests/exec.test b/tests/exec.test
index 61b818e..64d3517 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: exec.test,v 1.33 2009/05/08 08:13:31 dkf Exp $
package require tcltest 2
namespace import -force ::tcltest::*
diff --git a/tests/execute.test b/tests/execute.test
index 9e5b1f6..94af158 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -1,26 +1,27 @@
-# This file contains tests for the tclExecute.c source file. Tests appear
-# in the same order as the C code that they test. The set of tests is
-# currently incomplete since it currently includes only new tests for
-# code changed for the addition of Tcl namespaces. Other execution-
-# related tests appear in several other test files including
-# namespace.test, basic.test, eval.test, for.test, etc.
+# This file contains tests for the tclExecute.c source file. Tests appear in
+# the same order as the C code that they test. The set of tests is currently
+# incomplete since it currently includes only new tests for code changed for
+# the addition of Tcl namespaces. Other execution-related tests appear in
+# several other test files including namespace.test, basic.test, eval.test,
+# for.test, etc.
#
-# Sourcing this file into Tcl runs the tests and generates output for
-# errors. No output means no errors were found.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
#
# Copyright (c) 1997 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.
-#
-# RCS: @(#) $Id: execute.test,v 1.36 2010/09/22 17:21:03 msofer Exp $
+# 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
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}
catch {unset x}
@@ -35,7 +36,7 @@ testConstraint testobj [expr {
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint testexprlongobj [llength [info commands testexprlongobj]]
-
+
# Tests for the omnibus TclExecuteByteCode function:
# INST_DONE not tested
@@ -498,10 +499,11 @@ test execute-3.77 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is non-numeri
# INST_PUSH_RESULT not tested
# INST_PUSH_RETURN_CODE not tested
-test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
+test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
- catch {unset x}
- catch {unset y}
+ unset -nocomplain x
+ unset -nocomplain y
+} -body {
namespace eval test_ns_1 {
namespace export cmd1
proc cmd1 {args} {return "cmd1: $args"}
@@ -515,11 +517,12 @@ test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
list [namespace which -command ${x}${y}cmd1] \
[catch {namespace which -command ${x}${y}cmd2} msg] $msg \
[catch {namespace which -command ${x}${y}:cmd2} msg] $msg
-} {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
-test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {
+} -result {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
+test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}
- catch {unset l}
+ unset -nocomplain l
+} -body {
proc foo {} {
return "global foo"
}
@@ -536,11 +539,11 @@ test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is inval
}
}
lappend l [test_ns_1::whichFoo]
- set l
-} {::foo ::test_ns_1::foo}
-test execute-4.3 {Tcl_GetCommandFromObj, command never found} {
+} -result {::foo ::test_ns_1::foo}
+test execute-4.3 {Tcl_GetCommandFromObj, command never found} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}
+} -body {
namespace eval test_ns_1 {
proc foo {} {
return "namespace foo"
@@ -554,17 +557,18 @@ test execute-4.3 {Tcl_GetCommandFromObj, command never found} {
list [namespace eval test_ns_1 {namespace which -command foo}] \
[rename test_ns_1::foo ""] \
[catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg
-} {::test_ns_1::foo {} 0 {}}
+} -result {::test_ns_1::foo {} 0 {}}
-test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {
+test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
- catch {unset l}
+ unset -nocomplain l
+} -body {
proc {} {} {return {}}
{}
set l {}
lindex {} 0
{}
-} {}
+} -result {}
test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
proc {} {} {}
@@ -600,7 +604,7 @@ test execute-6.4 {TclCompEvalObj: don't use cached expr bytecode [Bug 1899164]}
} -cleanup {
rename 0+0 {}
} -result SCRIPT
-test execute-6.5 {TclCompEvalObj: bytecode epoch validation} {
+test execute-6.5 {TclCompEvalObj: bytecode epoch validation} -body {
set script { llength {} }
set result {}
lappend result [if 1 $script]
@@ -608,20 +612,22 @@ test execute-6.5 {TclCompEvalObj: bytecode epoch validation} {
rename $origName llength.orig
proc $origName {args} {return AHA!}
lappend result [if 1 $script]
+} -cleanup {
rename $origName {}
rename llength.orig $origName
- set result
-} {0 AHA!}
-test execute-6.6 {TclCompEvalObj: proc-body bytecode invalid for script} {
+} -result {0 AHA!}
+test execute-6.6 {TclCompEvalObj: proc-body bytecode invalid for script} -body {
proc foo {} {set a 1}
set a untouched
set result {}
lappend result [foo] $a
lappend result [if 1 [info body foo]] $a
+} -cleanup {
rename foo {}
- set result
-} {1 untouched 1 1}
-test execute-6.7 {TclCompEvalObj: bytecode context validation} {
+} -result {1 untouched 1 1}
+test execute-6.7 {TclCompEvalObj: bytecode context validation} -setup {
+ namespace eval foo {}
+} -body {
set script { llength {} }
namespace eval foo {
proc llength {args} {return AHA!}
@@ -629,10 +635,12 @@ test execute-6.7 {TclCompEvalObj: bytecode context validation} {
set result {}
lappend result [if 1 $script]
lappend result [namespace eval foo $script]
+} -cleanup {
namespace delete foo
- set result
-} {0 AHA!}
-test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} {
+} -result {0 AHA!}
+test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} -setup {
+ namespace eval foo {}
+} -body {
set script { llength {} }
set result {}
lappend result [namespace eval foo $script]
@@ -640,20 +648,21 @@ test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} {
proc llength {args} {return AHA!}
}
lappend result [namespace eval foo $script]
+} -cleanup {
namespace delete foo
- set result
-} {0 AHA!}
-test execute-6.9 {TclCompEvalObj: bytecode interp validation} {
- set script { llength {} }
+} -result {0 AHA!}
+test execute-6.9 {TclCompEvalObj: bytecode interp validation} -setup {
interp create slave
+} -body {
+ set script { llength {} }
slave eval {proc llength args {return AHA!}}
set result {}
lappend result [if 1 $script]
lappend result [slave eval $script]
+} -cleanup {
interp delete slave
- set result
-} {0 AHA!}
-test execute-6.10 {TclCompEvalObj: bytecode interp validation} {
+} -result {0 AHA!}
+test execute-6.10 {TclCompEvalObj: bytecode interp validation} -body {
set script { llength {} }
interp create slave
set result {}
@@ -661,13 +670,14 @@ test execute-6.10 {TclCompEvalObj: bytecode interp validation} {
interp delete slave
interp create slave
lappend result [slave eval $script]
- interp delete slave
- set result
-} {0 0}
-test execute-6.11 {Tcl_ExprObj: exprcode interp validation} testexprlongobj {
+} -cleanup {
+ catch {interp delete slave}
+} -result {0 0}
+test execute-6.11 {Tcl_ExprObj: exprcode interp validation} -setup {
+ interp create slave
+} -constraints testexprlongobj -body {
set e { [llength {}]+1 }
set result {}
- interp create slave
load {} Tcltest slave
interp alias {} e slave testexprlongobj
lappend result [e $e]
@@ -676,23 +686,24 @@ test execute-6.11 {Tcl_ExprObj: exprcode interp validation} testexprlongobj {
load {} Tcltest slave
interp alias {} e slave testexprlongobj
lappend result [e $e]
+} -cleanup {
interp delete slave
- set result
-} {{This is a result: 1} {This is a result: 1}}
-test execute-6.12 {Tcl_ExprObj: exprcode interp validation} {
+} -result {{This is a result: 1} {This is a result: 1}}
+test execute-6.12 {Tcl_ExprObj: exprcode interp validation} -setup {
+ interp create slave
+} -body {
set e { [llength {}]+1 }
set result {}
- interp create slave
interp alias {} e slave expr
lappend result [e $e]
interp delete slave
interp create slave
interp alias {} e slave expr
lappend result [e $e]
+} -cleanup {
interp delete slave
- set result
-} {1 1}
-test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} {
+} -result {1 1}
+test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} -body {
set e { [llength {}]+1 }
set result {}
lappend result [expr $e]
@@ -700,11 +711,13 @@ test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} {
rename $origName llength.orig
proc $origName {args} {return 1}
lappend result [expr $e]
+} -cleanup {
rename $origName {}
rename llength.orig $origName
- set result
-} {1 2}
-test execute-6.14 {Tcl_ExprObj: exprcode context validation} {
+} -result {1 2}
+test execute-6.14 {Tcl_ExprObj: exprcode context validation} -setup {
+ namespace eval foo {}
+} -body {
set e { [llength {}]+1 }
namespace eval foo {
proc llength {args} {return 1}
@@ -712,10 +725,12 @@ test execute-6.14 {Tcl_ExprObj: exprcode context validation} {
set result {}
lappend result [expr $e]
lappend result [namespace eval foo {expr $e}]
+} -cleanup {
namespace delete foo
- set result
-} {1 2}
-test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} {
+} -result {1 2}
+test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} -setup {
+ namespace eval foo {}
+} -body {
set e { [llength {}]+1 }
set result {}
lappend result [namespace eval foo {expr $e}]
@@ -723,42 +738,43 @@ test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} {
proc llength {args} {return 1}
}
lappend result [namespace eval foo {expr $e}]
+} -cleanup {
namespace delete foo
- set result
-} {1 2}
-test execute-6.16 {Tcl_ExprObj: exprcode interp validation} {
- set e { [llength {}]+1 }
+} -result {1 2}
+test execute-6.16 {Tcl_ExprObj: exprcode interp validation} -setup {
interp create slave
+} -body {
+ set e { [llength {}]+1 }
interp alias {} e slave expr
slave eval {proc llength args {return 1}}
set result {}
lappend result [expr $e]
lappend result [e $e]
+} -cleanup {
interp delete slave
- set result
-} {1 2}
-test execute-6.17 {Tcl_ExprObj: exprcode context validation} {
- set e { $v }
+} -result {1 2}
+test execute-6.17 {Tcl_ExprObj: exprcode context validation} -body {
proc foo e {set v 0; expr $e}
proc bar e {set v 1; expr $e}
+ set e { $v }
set result {}
lappend result [foo $e]
lappend result [bar $e]
+} -cleanup {
rename foo {}
rename bar {}
- set result
-} {0 1}
-test execute-6.18 {Tcl_ExprObj: exprcode context validation} {
- set e { [llength $v] }
+} -result {0 1}
+test execute-6.18 {Tcl_ExprObj: exprcode context validation} -body {
proc foo e {set v {}; expr $e}
proc bar e {set v v; expr $e}
+ set e { [llength $v] }
set result {}
lappend result [foo $e]
lappend result [bar $e]
+} -cleanup {
rename foo {}
rename bar {}
- set result
-} {0 1}
+} -result {0 1}
test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {
set x 0x100000000
@@ -882,8 +898,8 @@ test execute-7.34 {Wide int handling} {
} 1099511627776
test execute-8.1 {Stack protection} -setup {
- # If [Bug #804681] has not been properly
- # taken care of, this should segfault
+ # If [Bug #804681] has not been properly taken care of, this should
+ # segfault
proc whatever args {llength $args}
trace add variable ::errorInfo {write unset} whatever
} -body {
@@ -892,23 +908,27 @@ test execute-8.1 {Stack protection} -setup {
trace remove variable ::errorInfo {write unset} whatever
rename whatever {}
} -returnCodes error -match glob -result *
-test execute-8.2 {Stack restoration} -body {
- # Test for [Bug #816641], correct restoration
- # of the stack top after the stack is grown
- proc f {args} { f bee bop }
- catch f msg
- set msg
-} -setup {
+test execute-8.2 {Stack restoration} -setup {
# Avoid crashes when system stack size is limited (thread-enabled!)
set limit [interp recursionlimit {}]
interp recursionlimit {} 100
+} -body {
+ # Test for [Bug #816641], correct restoration of the stack top after the
+ # stack is grown
+ proc f {args} { f bee bop }
+ catch f msg
+ set msg
} -cleanup {
interp recursionlimit {} $limit
} -result {too many nested evaluations (infinite loop?)}
-test execute-8.3 {Stack restoration} -body {
- # Test for [Bug #1055676], correct restoration
- # of the stack top after the epoch is bumped and
- # the stack is grown in a call from a nested evaluation
+test execute-8.3 {Stack restoration} -setup {
+ # Avoid crashes when system stack size is limited (thread-enabled!)
+ set limit [interp recursionlimit {}]
+ interp recursionlimit {} 100
+} -body {
+ # Test for [Bug #1055676], correct restoration of the stack top after the
+ # epoch is bumped and the stack is grown in a call from a nested
+ # evaluation
set arglst [string repeat "a " 1000]
proc f {args} "f $arglst"
proc run {} {
@@ -919,10 +939,6 @@ test execute-8.3 {Stack restoration} -body {
set msg
}
run
-} -setup {
- # Avoid crashes when system stack size is limited (thread-enabled!)
- set limit [interp recursionlimit {}]
- interp recursionlimit {} 100
} -cleanup {
interp recursionlimit {} $limit
} -result {too many nested evaluations (infinite loop?)}
@@ -979,7 +995,6 @@ test execute-9.1 {Interp result resetting [Bug 1522803]} {
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
} -body {
@@ -992,7 +1007,6 @@ test execute-10.2 {Bug 2802881} -setup {
} -cleanup {
interp delete slave
} -returnCodes error -match glob -result *
-
test execute-10.3 {Bug 3072640} -setup {
proc generate {n} {
for {set i 0} {$i < $n} {incr i} {
@@ -1014,6 +1028,22 @@ test execute-10.3 {Bug 3072640} -setup {
rename coro {}
} -result 4
+test execute-11.1 {Bug 3142026: GrowEvaluationStack off-by-one} -setup {
+ interp create slave
+} -body {
+ slave eval {
+ set x [lrepeat 1320 199]
+ for {set i 0} {$i < 20} {incr i} {
+ lappend x $i
+ lsort -integer $x
+ }
+ # Crashes on failure
+ return ok
+ }
+} -cleanup {
+ interp delete slave
+} -result ok
+
# cleanup
if {[info commands testobj] != {}} {
testobj freeallvars
@@ -1031,4 +1061,5 @@ return
# Local Variables:
# mode: tcl
+# fill-column: 78
# End:
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 40a38dd..4f3cb2e 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -12,14 +12,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: expr-old.test,v 1.40 2007/12/13 15:26:06 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testexprlong [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
diff --git a/tests/expr.test b/tests/expr.test
index 05fc956..6ad7208 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -9,14 +9,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: expr.test,v 1.78 2010/02/21 20:09:38 nijtmans Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testmathfunctions [expr {
([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"})
}]
@@ -7169,6 +7170,10 @@ test expr-49.1 {Bug 2823282} {
foo 1
} 1
+test expr-50.1 {test sqrt() of bignums with non-Inf answer} {
+ expr {sqrt("1[string repeat 0 616]") == 1e308}
+} 1
+
# cleanup
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 1436a28..325b374 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -9,29 +9,31 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: fCmd.test,v 1.70 2009/11/24 00:08:27 patthoyts Exp $
-#
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+cd [temporaryDirectory]
+
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winVista 0
testConstraint win2000orXP 0
-testConstraint winOlderThan2000 0
# Don't know how to determine this constraint correctly
testConstraint notNetworkFilesystem 0
-testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}]
-testConstraint 2000orNewer [expr {[testConstraint win] && ![testConstraint 95or98]}]
testConstraint reg 0
if {[testConstraint win]} {
catch {
# Is the registry extension already static to this shell?
- if [catch {load {} Registry; set ::reglib {}}] {
+ try {
+ load {} Registry
+ set ::reglib {}
+ } on error {} {
# try the location given to use on the commandline to tcltest
::tcltest::loadTestedCommands
load $::reglib Registry
@@ -40,6 +42,7 @@ if {[testConstraint win]} {
}
}
+set tmpspace /tmp;# default value
# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.
testConstraint foundGroup [expr {![testConstraint unix]}]
@@ -49,10 +52,19 @@ if {[testConstraint unix]} {
set group [lindex $groupList 0]
testConstraint foundGroup 1
}
+
+ proc dev dir {
+ file stat $dir stat
+ return $stat(dev)
+ }
+
+ if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
+ testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
+ }
}
# Also used in winFCmd...
-if {[testConstraint winOnly]} {
+if {[testConstraint win]} {
set major [string index $tcl_platform(osVersion) 0]
if {[testConstraint nt] && $major > 4} {
if {$major > 5} {
@@ -60,15 +72,14 @@ if {[testConstraint winOnly]} {
} elseif {$major == 5} {
testConstraint win2000orXP 1
}
- } else {
- testConstraint winOlderThan2000 1
}
}
-testConstraint darwin9 [expr {[testConstraint unix] &&
- $tcl_platform(os) eq "Darwin" &&
- int([string range $tcl_platform(osVersion) 0 \
- [string first . $tcl_platform(osVersion)]]) >= 9}]
+testConstraint darwin9 [expr {
+ [testConstraint unix]
+ && $tcl_platform(os) eq "Darwin"
+ && [package vsatisfies 1.$tcl_platform(osVersion) 1.9]
+}]
testConstraint notDarwin9 [expr {![testConstraint darwin9]}]
testConstraint fileSharing 0
@@ -106,11 +117,11 @@ proc createfile {file {string a}} {
# if the file does not exist, or has a different content
#
proc checkcontent {file matchString} {
- if {[catch {
+ try {
set f [open $file]
set fileString [read $f]
close $f
- }]} then {
+ } on error {} {
return 0
}
return [string match $matchString $fileString]
@@ -153,18 +164,11 @@ proc contents {file} {
return $r
}
-cd [temporaryDirectory]
-
-proc dev dir {
- file stat $dir stat
- return $stat(dev)
-}
-testConstraint xdev [expr {[testConstraint unix] && ([dev .] != [dev /tmp])}]
set root [lindex [file split [pwd]] 0]
-# A really long file name
-# length of long is 1216 chars, which should be greater than any static buffer
+# A really long file name.
+# Length of long is 1216 chars, which should be greater than any static buffer
# or allowable filename.
set long "abcdefghihjllmnopqrstuvwxyz01234567890"
@@ -173,7 +177,7 @@ append long $long
append long $long
append long $long
append long $long
-
+
test fCmd-1.1 {TclFileRenameCmd} -constraints {notRoot} -setup {
cleanup
} -body {
@@ -192,7 +196,7 @@ test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup {
test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body {
file rename -xyz
-} -returnCodes error -result {bad option "-xyz": should be -force or --}
+} -returnCodes error -result {bad option "-xyz": must be -force or --}
test fCmd-3.2 {FileCopyRename: not enough args} -constraints {notRoot} -body {
file rename xyz
} -returnCodes error -result {wrong # args: should be "file rename ?-option value ...? source ?source ...? target"}
@@ -390,7 +394,7 @@ test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup {
test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
file delete -xyz
-} -returnCodes error -result {bad option "-xyz": should be -force or --}
+} -returnCodes error -result {bad option "-xyz": must be -force or --}
test fCmd-5.2 {TclFileDeleteCmd: accept 0 files (TIP 323)} -body {
file delete -force -force
} -result {}
@@ -590,12 +594,12 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
} -returnCodes error -match glob -result \
[subst {error renaming "td2" to "[file join td1 td2]": file *}]
test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {
- cleanup /tmp
+ cleanup $tmpspace
} -constraints {unix notRoot} -body {
createfile tf1
- file rename tf1 /tmp
- glob -nocomplain tf* /tmp/tf1
-} -result {/tmp/tf1}
+ file rename tf1 $tmpspace
+ glob -nocomplain tf* [file join $tmpspace tf1]
+} -result [file join $tmpspace tf1]
test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
catch {file delete -force c:/tcl8975@ d:/tcl8975@}
} -body {
@@ -609,28 +613,29 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
catch {file delete -force d:/tcl8975@}
} -result {d:/tcl8975@}
test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup {
- cleanup /tmp
+ cleanup $tmpspace
} -constraints {unix notRoot} -body {
file mkdir td1
- file rename td1 /tmp
- glob -nocomplain td* /tmp/td*
-} -result {/tmp/td1}
+ file rename td1 $tmpspace
+ glob -nocomplain td* [file join $tmpspace td*]
+} -result [file join $tmpspace td1]
test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup {
- cleanup /tmp
+ cleanup $tmpspace
} -constraints {unix notRoot} -body {
createfile tf1
- file rename tf1 /tmp
- glob -nocomplain tf* /tmp/tf*
-} -result {/tmp/tf1}
+ file rename tf1 $tmpspace
+ glob -nocomplain tf* [file join $tmpspace tf*]
+} -result [file join $tmpspace tf1]
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
- cleanup /tmp
-} -constraints {unix notRoot xdev} -body {
+ cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
file mkdir td1/td2/td3
file attributes td1 -permissions 0000
- file rename td1 /tmp
+ file rename td1 $tmpspace
} -returnCodes error -cleanup {
file attributes td1 -permissions 0755
-} -match regexp -result {^error renaming "td1"( to "/tmp/td1")?: permission denied$}
+ cleanup
+} -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$}
test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup {
cleanup
} -constraints {unix notRoot} -body {
@@ -666,54 +671,54 @@ test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup {
file delete -force ~/td1
} -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied"
test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
- cleanup /tmp
-} -constraints {unix notRoot xdev} -returnCodes error -body {
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -returnCodes error -body {
file mkdir td1/td2/td3
- file mkdir /tmp/td1
- createfile /tmp/td1/tf1
- file rename -force td1 /tmp
-} -result {error renaming "td1" to "/tmp/td1": file already exists}
+ file mkdir [file join $tmpspace td1]
+ createfile [file join $tmpspace td1 tf1]
+ file rename -force td1 $tmpspace
+} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file already exists}
test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
- cleanup /tmp
-} -constraints {unix notRoot xdev} -body {
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
file mkdir td1/td2/td3
file attributes td1/td2/td3 -permissions 0000
- file rename td1 /tmp
+ file rename td1 $tmpspace
} -returnCodes error -cleanup {
file attributes td1/td2/td3 -permissions 0755
-} -result {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}
+ cleanup $tmpspace
+} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": "td1/td2/td3": permission denied}
test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
- cleanup /tmp
-} -constraints {unix notRoot xdev} -body {
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
file mkdir td1/td2/td3
- file rename td1 /tmp
- glob td* /tmp/td1/t*
-} -result {/tmp/td1/td2}
+ file rename td1 $tmpspace
+ glob td* [file join $tmpspace td1 t*]
+} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
- cleanup
+ cleanup $tmpspace
} -constraints {unix notRoot} -body {
file mkdir foo/bar
file attr foo -perm 040555
- file rename foo/bar /tmp
+ file rename foo/bar $tmpspace
} -returnCodes error -cleanup {
- catch {file delete /tmp/bar}
+ catch {file delete [file join $tmpspace bar]}
catch {file attr foo -perm 040777}
catch {file delete -force foo}
} -match glob -result {*: permission denied}
test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup {
- catch {cleanup /tmp}
-} -constraints {unix notRoot xdev} -body {
- file mkdir /tmp/td1
- createfile /tmp/td1/tf1
- file rename /tmp/td1/tf1 tf1
- list [file exists /tmp/td1/tf1] [file exists tf1]
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
+ file mkdir [file join $tmpspace td1]
+ createfile [file join $tmpspace td1 tf1]
+ file rename [file join $tmpspace td1 tf1] tf1
+ list [file exists [file join $tmpspace td1 tf1]] [file exists tf1]
} -result {0 1}
test fCmd-6.32 {CopyRenameOneFile: copy} -constraints {notRoot} -setup {
cleanup
} -returnCodes error -body {
file copy tf1 tf2
} -result {error copying "tf1": no such file or directory}
-catch {cleanup /tmp}
test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup {
cleanup
@@ -737,7 +742,7 @@ test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup {
file delete -tf1
} -returnCodes error -cleanup {
file delete -- -tf1
-} -result {bad option "-tf1": should be -force or --}
+} -result {bad option "-tf1": must be -force or --}
test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
@@ -791,9 +796,20 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} -setup {
file rename tf2 tf4
list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
} -result {{tf3 tf4} 1 0}
-test fCmd-9.4 {file rename: comprehensive: dir to new name} -setup {
+test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup {
+ cleanup
+} -constraints {win win2000orXP testchmod} -body {
+ file mkdir td1 td2
+ testchmod 555 td2
+ file rename td1 td3
+ file rename td2 td4
+ list [lsort [glob td*]] [file writable td3] [file writable td4]
+} -cleanup {
cleanup
-} -constraints {unixOrPc notRoot testchmod notDarwin9 win2000orXP} -body {
+} -result {{td3 td4} 1 0}
+test fCmd-9.4.b {file rename: comprehensive: dir to new name} -setup {
+ cleanup
+} -constraints {unix notRoot testchmod notDarwin9} -body {
file mkdir td1 td2
testchmod 555 td2
file rename td1 td3
@@ -812,9 +828,19 @@ test fCmd-9.5 {file rename: comprehensive: file to self} -setup {
file rename -force tf2 tf2
list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
} -result {tf1 tf2 1 0}
-test fCmd-9.6 {file rename: comprehensive: dir to self} -setup {
+test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup {
cleanup
-} -constraints {notRoot unixOrPc testchmod win2000orXP} -body {
+} -constraints {win win2000orXP testchmod} -body {
+ file mkdir td1
+ file mkdir td2
+ testchmod 555 td2
+ file rename -force td1 .
+ file rename -force td2 .
+ list [lsort [glob td*]] [file writable td1] [file writable td2]
+} -result {{td1 td2} 1 0}
+test fCmd-9.6.b {file rename: comprehensive: dir to self} -setup {
+ cleanup
+} -constraints {unix notRoot testchmod} -body {
file mkdir td1
file mkdir td2
testchmod 555 td2
@@ -1022,7 +1048,7 @@ test fCmd-10.2 {file copy: comprehensive: file to new name} -setup {
} -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
cleanup
-} -constraints {notRoot unixOrPc 95or98 testchmod} -body {
+} -constraints {unix notRoot testchmod} -body {
file mkdir [file join td1 tdx]
file mkdir [file join td2 tdy]
testchmod 555 td2
@@ -1036,7 +1062,7 @@ test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0]
test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup {
cleanup
-} -constraints {notRoot 2000orNewer testchmod} -body {
+} -constraints {win notRoot testchmod} -body {
# On Windows with ACLs, copying a directory is defined like this
file mkdir [file join td1 tdx]
file mkdir [file join td2 tdy]
@@ -1123,7 +1149,7 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup {
} -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup {
cleanup
-} -constraints {notRoot unixOrPc 95or98 testchmod} -body {
+} -constraints {unix notRoot testchmod} -body {
file mkdir td1
file mkdir td2
file mkdir td3
@@ -1135,7 +1161,7 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup {
} -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} -setup {
cleanup
-} -constraints {notRoot 2000orNewer testchmod} -body {
+} -constraints {win notRoot testchmod} -body {
# On Windows with ACLs, copying a directory is defined like this
file mkdir td1
file mkdir td2
@@ -1330,23 +1356,23 @@ test fCmd-12.8 {renamefile: generic error} -setup {
file delete -force tfa
} -result {1}
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
- catch {file delete -force -- tfa /tmp/tfa}
+ cleanup $tmpspace
} -constraints {unix notRoot} -body {
set s [createfile tfa]
- file rename tfa /tmp
- list [checkcontent /tmp/tfa $s] [file exists tfa]
+ file rename tfa $tmpspace
+ list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
} -cleanup {
- file delete /tmp/tfa
+ cleanup $tmpspace
} -result {1 0}
test fCmd-12.10 {renamefile: moving a directory across volumes} -setup {
- catch {file delete -force -- tfad /tmp/tfad}
-} -constraints {unix notRoot} -body {
+ cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
file mkdir tfad
set s [createfile tfad/a]
- file rename tfad /tmp
- list [checkcontent /tmp/tfad/a $s] [file exists tfad]
+ file rename tfad $tmpspace
+ list [checkcontent [file join $tmpspace tfad a] $s] [file exists tfad]
} -cleanup {
- file delete -force /tmp/tfad
+ cleanup $tmpspace
} -result {1 0}
#
@@ -1529,8 +1555,7 @@ test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup {
set ::env(HOME) $temp
} -result {1}
#
-# Can Tcl_SplitPath return argc == 0? If so them we need a
-# test for that code.
+# Can Tcl_SplitPath return argc == 0? If so them we need a test for that code.
#
test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup {
catch {file delete -force -- tfa}
@@ -1710,7 +1735,6 @@ test fCmd-17.3 {mkdir several levels deep - absolute} -setup {
#
# Functionality tests for TclFileRenameCmd()
#
-
test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
-setup {
catch {file delete -force -- tfad}
@@ -1918,7 +1942,6 @@ test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
#
# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
#
-
test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup {
catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
@@ -2150,7 +2173,6 @@ test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup {
# TclMacRmdir
# Error cases are not covered.
#
-
test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} -setup {
catch {file delete -force -- tfad}
} -constraints {notRoot} -body {
@@ -2212,7 +2234,6 @@ test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} -setup
#
# Functionality tests for TclDeleteFilesCmd
#
-
test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} -setup {
catch {file delete -force -- tfad1 tfad2}
} -constraints {unix notRoot} -body {
@@ -2405,7 +2426,7 @@ test fCmd-28.12 {file link: cd into a link} -setup {
cd ..
set up [pwd]
cd $orig
- # now '$up' should be either $orig or [file dirname abc.dir], depending on
+ # Now '$up' should be either $orig or [file dirname abc.dir], depending on
# whether 'cd' actually moves to the destination of a link, or simply
# treats the link as a directory. (On windows the former, on unix the
# latter, I believe)
@@ -2530,35 +2551,35 @@ test fCmd-28.22 {file link: relative paths} -setup {
catch {file delete -force d1}
cd [workingDirectory]
} -result d2/d3
-
-test fCmd-29.1 {weird memory corruption fault} -body {
- open [file join ~a_totally_bogus_user_id/foo bar]
-} -returnCodes error -match glob -result *
-
-cd [temporaryDirectory]
-file delete -force abc.link
-file delete -force d1/d2
-file delete -force d1
-cd [workingDirectory]
-
+try {
+ cd [temporaryDirectory]
+ file delete -force abc.link
+ file delete -force d1/d2
+ file delete -force d1
+} finally {
+ cd [workingDirectory]
+}
removeFile abc2.file
removeFile abc.file
removeDirectory abc2.dir
removeDirectory abc.dir
+test fCmd-29.1 {weird memory corruption fault} -body {
+ open [file join ~a_totally_bogus_user_id/foo bar]
+} -returnCodes error -match glob -result *
+
test fCmd-30.1 {file writable on 'My Documents'} -setup {
# Get the localized version of the folder name by looking in the registry.
set mydocsname [registry get {HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} Personal]
-} -constraints {2000orNewer reg} -body {
+} -constraints {win reg} -body {
file writable $mydocsname
} -result 1
-test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {2000orNewer} -body {
+test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win} -body {
expr {[info exists env(USERPROFILE)]
&& [file exists $env(USERPROFILE)/NTUSER.DAT]
&& [file readable $env(USERPROFILE)/NTUSER.DAT]}
-
} -result {1}
-test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {2000orNewer} -body {
+test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win} -body {
set r {}
if {[info exists env(SystemDrive)]} {
set path $env(SystemDrive)/pagefile.sys
@@ -2568,12 +2589,16 @@ test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {2000orNewer} -bod
}
return $r
} -result {exists 1 readable 0 stat 0 {}}
-
+
# cleanup
cleanup
+if {[testConstraint unix]} {
+ removeDirectory tcl[pid] /tmp
+}
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
+# fill-column: 78
# End:
diff --git a/tests/fileName.test b/tests/fileName.test
index d46391a..51f00d1 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -9,14 +9,15 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: fileName.test,v 1.66 2010/01/05 18:58:36 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
testConstraint linkDirectory 1
@@ -42,7 +43,7 @@ global env
if {[testConstraint testsetplatform]} {
set platform [testgetplatform]
}
-
+
# Caution: when using 'testsetplatform' to test different file name platform
# descriptions in this file, one must be very careful not to combine such
# platform manipulation with commands like 'cd', 'pwd'. That is because the
@@ -198,7 +199,7 @@ test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} {
test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split //foo
-} {/ foo}
+} "/ foo"
test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split foo//bar
@@ -435,11 +436,11 @@ test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} {
test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join //a b
-} {/a/b}
+} "/a/b"
test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join /// a b
-} {/a/b}
+} "/a/b"
test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
@@ -748,7 +749,7 @@ test filename-11.13 {Tcl_GlobCmd} {
} [file join $env(HOME)]
set oldpwd [pwd]
set oldhome $env(HOME)
-cd [temporaryDirectory]
+catch {cd [makeDirectory tcl[pid]]}
set env(HOME) [pwd]
file delete -force globTest
file mkdir globTest/a1/b1
@@ -1434,7 +1435,7 @@ test filename-16.13 {windows specific globbing} {win sharedCdrive} {
} //[info hostname]/c/globTest
test filename-16.14 {windows specific globbing} {win} {
cd [lindex [glob -types d -dir C:/ *] 0]
- expr {[lsearch -exact [glob {{.,*}*}] ".."] != -1}
+ expr {".." in [glob {{.,*}*}]}
} {1}
test filename-16.15 {windows specific globbing} {win} {
cd [lindex [glob -types d -dir C:/ *] 0]
@@ -1529,7 +1530,6 @@ test fileName-20.4 {Bug 1750300} -setup {
removeFile TAGS $d
removeDirectory foo
} -result 0
-
test fileName-20.5 {Bug 2837800} -setup {
set dd [makeDirectory isolate]
set d [makeDirectory ./~foo $dd]
@@ -1544,7 +1544,6 @@ test fileName-20.5 {Bug 2837800} -setup {
removeDirectory ./~foo $dd
removeDirectory isolate
} -result ~foo/test
-
test fileName-20.6 {Bug 2837800} -setup {
# Recall that we have $env(HOME) set so that references
# to ~ point to [temporaryDirectory]
@@ -1561,7 +1560,6 @@ test fileName-20.6 {Bug 2837800} -setup {
removeDirectory isolate
removeFile test ~
} -result {}
-
test fileName-20.7 {Bug 2806250} -setup {
set savewd [pwd]
cd [temporaryDirectory]
@@ -1574,7 +1572,6 @@ test fileName-20.7 {Bug 2806250} -setup {
removeDirectory isolate
cd $savewd
} -result 1
-
test fileName-20.8 {Bug 2806250} -setup {
set savewd [pwd]
cd [temporaryDirectory]
@@ -1587,8 +1584,7 @@ test fileName-20.8 {Bug 2806250} -setup {
removeDirectory isolate
cd $savewd
} -result ./~test
-
-test fileName-20.9 {} -setup {
+test fileName-20.9 {globbing for special chars} -setup {
makeFile {} test ~
set d [makeDirectory isolate]
set savewd [pwd]
@@ -1600,8 +1596,7 @@ test fileName-20.9 {} -setup {
removeDirectory isolate
removeFile test ~
} -result ~/test
-
-test fileName-20.10 {} -setup {
+test fileName-20.10 {globbing for special chars} -setup {
set s [makeDirectory sub ~]
makeFile {} fileName-20.10 $s
set d [makeDirectory isolate]
@@ -1615,12 +1610,13 @@ test fileName-20.10 {} -setup {
removeFile fileName-20.10 $s
removeDirectory sub ~
} -result ~/sub/fileName-20.10
-
+
# cleanup
catch {file delete -force C:/globTest}
cd [temporaryDirectory]
file delete -force globTest
cd $oldpwd
+catch {removeDirectory tcl[pid]}
set env(HOME) $oldhome
if {[testConstraint testsetplatform]} {
testsetplatform $platform
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 2fe13d7..b098f35 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -19,6 +19,17 @@ namespace eval ::tcl::test::fileSystem {
file delete -force [file join dir.dir linkinside.file]
}
+testConstraint loaddll 0
+catch {
+ ::tcltest::loadTestedCommands
+ package require -exact Tcltest [info patchlevel]
+ set ::ddever [package require dde]
+ set ::ddelib [lindex [package ifneeded dde $::ddever] 1]
+ set ::regver [package require registry]
+ set ::reglib [lindex [package ifneeded registry $::regver] 1]
+ testConstraint loaddll 1
+}
+
# Test for commands defined in Tcltest executable
testConstraint testfilesystem [llength [info commands ::testfilesystem]]
testConstraint testsetplatform [llength [info commands ::testsetplatform]]
@@ -31,44 +42,39 @@ makeDirectory [file join dir.dir dirinside.dir]
makeFile "test file in directory" [file join dir.dir inside.file]
testConstraint unusedDrive 0
-set drive {}
-if {[testConstraint win]} {
- set vols [string map [list :/ {}] [file volumes]]
- for {set i 0} {$i < 26} {incr i} {
- set drive [format %c [expr {$i + 65}]]
- if {[lsearch -exact $vols $drive] == -1} {
- testConstraint unusedDrive 1
- break
+testConstraint moreThanOneDrive 0
+apply {{} {
+ # The variables 'drive' and 'drives' will be used below.
+ variable drive {} drives {}
+ if {[testConstraint win]} {
+ set vols [string map [list :/ {}] [file volumes]]
+ for {set i 0} {$i < 26} {incr i} {
+ set drive [format %c [expr {$i + 65}]]
+ if {$drive ni $vols} {
+ testConstraint unusedDrive 1
+ break
+ }
}
- }
- unset i vols
- # The variable 'drive' will be used below
-}
-testConstraint moreThanOneDrive 0
-set drives [list]
-if {[testConstraint win]} {
- set dir [pwd]
- foreach vol [file volumes] {
- if {![catch {cd $vol}]} {
- lappend drives $vol
- }
- }
- if {[llength $drives] > 1} {
- testConstraint moreThanOneDrive 1
+ set dir [pwd]
+ try {
+ foreach vol [file volumes] {
+ if {![catch {cd $vol}]} {
+ lappend drives $vol
+ }
+ }
+ testConstraint moreThanOneDrive [llength $drives]
+ } finally {
+ cd $dir
+ }
}
- # The variable 'drives' will be used below
- unset vol
- cd $dir
- unset dir
-}
+} ::tcl::test::fileSystem}
proc testPathEqual {one two} {
if {$one eq $two} {
- return 1
- } else {
- return "not equal: $one $two"
+ return "ok"
}
+ return "not equal: $one $two"
}
testConstraint hasLinks [expr {![catch {
@@ -100,19 +106,19 @@ test filesystem-1.1 {link normalisation} {hasLinks} {
test filesystem-1.2 {link normalisation} {hasLinks unix} {
testPathEqual [file normalize [file join gorp.file foo]] \
[file normalize [file join link.file foo]]
-} {1}
+} ok
test filesystem-1.3 {link normalisation} {hasLinks} {
testPathEqual [file normalize [file join dir.dir foo]] \
[file normalize [file join dir.link foo]]
-} {1}
+} ok
test filesystem-1.4 {link normalisation} {hasLinks} {
testPathEqual [file normalize [file join dir.dir inside.file]] \
[file normalize [file join dir.link inside.file]]
-} {1}
+} ok
test filesystem-1.5 {link normalisation} {hasLinks} {
testPathEqual [file normalize [file join dir.dir linkinside.file]] \
[file normalize [file join dir.dir linkinside.file]]
-} {1}
+} ok
test filesystem-1.6 {link normalisation} {hasLinks} {
string equal [file normalize [file join dir.dir linkinside.file]] \
[file normalize [file join dir.link inside.file]]
@@ -120,28 +126,29 @@ test filesystem-1.6 {link normalisation} {hasLinks} {
test filesystem-1.7 {link normalisation} {hasLinks unix} {
testPathEqual [file normalize [file join dir.link linkinside.file foo]] \
[file normalize [file join dir.dir inside.file foo]]
-} {1}
+} ok
test filesystem-1.8 {link normalisation} {hasLinks} {
string equal [file normalize [file join dir.dir linkinside.filefoo]] \
[file normalize [file join dir.link inside.filefoo]]
} {0}
-test filesystem-1.9 {link normalisation} {unix hasLinks} {
+test filesystem-1.9 {link normalisation} -setup {
file delete -force dir.link
+} -constraints {unix hasLinks} -body {
file link dir.link [file nativename dir.dir]
testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
[file normalize [file join dir.link inside.file foo]]
-} {1}
+} -result ok
test filesystem-1.10 {link normalisation: double link} {unix hasLinks} {
file link dir2.link dir.link
testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
[file normalize [file join dir2.link inside.file foo]]
-} {1}
+} ok
makeDirectory dir2.file
test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} {
file link [file join dir2.file dir2.link] [file join .. dir2.link]
testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
[file normalize [file join dir2.file dir2.link inside.file foo]]
-} {1}
+} ok
test filesystem-1.12 {file new native path} {} {
for {set i 0} {$i < 10} {incr i} {
foreach f [lsort [glob -nocomplain -type l *]] {
@@ -198,39 +205,35 @@ test filesystem-1.25 {file normalisation} {win unusedDrive} {
test filesystem-1.25.1 {file normalisation} {win unusedDrive} {
file normalize ${drive}:/./.././..\\..\\a\\bb
} "${drive}:/a/bb"
-test filesystem-1.26 {link normalisation: link and ..} {hasLinks} {
+test filesystem-1.26 {link normalisation: link and ..} -setup {
file delete -force dir2.link
+} -constraints {hasLinks} -body {
set dir [file join dir2 foo bar]
file mkdir $dir
file link dir2.link [file join dir2 foo bar]
- set res [list [file normalize [file join dir2 foo x]] \
- [file normalize [file join dir2.link .. x]]]
- testPathEqual [lindex $res 0] [lindex $res 1]
-} 1
+ testPathEqual [file normalize [file join dir2 foo x]] \
+ [file normalize [file join dir2.link .. x]]
+} -result ok
test filesystem-1.27 {file normalisation: up and down with ..} {
set dir [file join dir2 foo bar]
file mkdir $dir
set dir2 [file join dir2 .. dir2 foo .. foo bar]
- set res [list [file normalize $dir] [file normalize $dir2]]
- set res2 [list [file exists $dir] [file exists $dir2]]
- if {![string equal [lindex $res 0] [lindex $res 1]]} {
- set res "exists: $res2, $res not equal"
- } else {
- set res "ok: $res2"
- }
-} {ok: 1 1}
-test filesystem-1.28 {link normalisation: link with .. and ..} {hasLinks} {
+ list [testPathEqual [file normalize $dir] [file normalize $dir2]] \
+ [file exists $dir] [file exists $dir2]
+} {ok 1 1}
+test filesystem-1.28 {link normalisation: link with .. and ..} -setup {
file delete -force dir2.link
+} -constraints {hasLinks} -body {
set dir [file join dir2 foo bar]
file mkdir $dir
set to [file join dir2 .. dir2 foo .. foo bar]
file link dir2.link $to
- set res [list [file normalize [file join dir2 foo x]] \
- [file normalize [file join dir2.link .. x]]]
- testPathEqual [lindex $res 0] [lindex $res 1]
-} 1
-test filesystem-1.29 {link normalisation: link with ..} {hasLinks} {
+ testPathEqual [file normalize [file join dir2 foo x]] \
+ [file normalize [file join dir2.link .. x]]
+} -result ok
+test filesystem-1.29 {link normalisation: link with ..} -setup {
file delete -force dir2.link
+} -constraints {hasLinks} -body {
set dir [file join dir2 foo bar]
file mkdir $dir
set to [file join dir2 .. dir2 foo .. foo bar]
@@ -240,11 +243,11 @@ test filesystem-1.29 {link normalisation: link with ..} {hasLinks} {
return "$res must not contain '..'"
}
return "ok"
-} {ok}
+} -result {ok}
test filesystem-1.29.1 {link normalisation with two consecutive links} {hasLinks} {
testPathEqual [file normalize [file join dir.link dirinside.link abc]] \
[file normalize [file join dir.dir dirinside.dir abc]]
-} {1}
+} ok
file delete -force dir2.file
file delete -force dir2.link
file delete -force link.file dir.link
@@ -277,208 +280,96 @@ test filesystem-1.33 {link normalisation: link near filesystem root} {testsetpla
if {[testConstraint testsetplatform]} {
testsetplatform $platform
}
-test filesystem-1.34 {file normalisation with '/./'} {
- set res [file normalize /foo/bar/anc/./.tml]
- if {[string first "/./" $res] != -1} {
- set res "normalization of /foo/bar/anc/./.tml is: $res"
- } else {
- set res "ok"
- }
- set res
-} {ok}
-test filesystem-1.35 {file normalisation with '/./'} {
- set res [file normalize /ffo/bar/anc/./foo/.tml]
- if {[string first "/./" $res] != -1 || ([regsub -all "foo" $res "" reg] == 2)} {
- set res "normalization of /ffo/bar/anc/./foo/.tml is: $res"
- } else {
- set res "ok"
- }
- set res
-} {ok}
-test filesystem-1.36 {file normalisation with '/./'} {
- set res [file normalize /foo/bar/anc/././asdasd/.tml]
- if {[string first "/./" $res] != -1 || ([regsub -all "asdasd" $res "" reg] == 2) } {
- set res "normalization of /foo/bar/anc/././asdasd/.tml is: $res"
- } else {
- set res "ok"
- }
- set res
-} {ok}
-test filesystem-1.37 {file normalisation with '/./'} {
+test filesystem-1.34 {file normalisation with '/./'} -body {
+ file normalize /foo/bar/anc/./.tml
+} -match regexp -result {^(?:(?!/\./).)*$}
+test filesystem-1.35a {file normalisation with '/./'} -body {
+ file normalize /ffo/bar/anc/./foo/.tml
+} -match regexp -result {^(?:(?!/\./).)*$}
+test filesystem-1.35b {file normalisation with '/./'} {
+ llength [regexp -all foo [file normalize /ffo/bar/anc/./foo/.tml]]
+} 1
+test filesystem-1.36a {file normalisation with '/./'} -body {
+ file normalize /foo/bar/anc/././asdasd/.tml
+} -match regexp -result {^(?:(?!/\./).)*$}
+test filesystem-1.36b {file normalisation with '/./'} {
+ llength [regexp -all asdasd [file normalize /foo/bar/anc/././asdasd/.tml]]
+} 1
+test filesystem-1.37 {file normalisation with '/./'} -body {
set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....."
- set res [file norm $fname]
- if {[string first "//" $res] != -1} {
- set res "normalization of $fname is: $res"
- } else {
- set res "ok"
- }
- set res
-} {ok}
-test filesystem-1.38 {file normalisation with volume relative} \
- {win moreThanOneDrive} {
- set path "[string range [lindex $drives 0] 0 1]foo"
+ file norm $fname
+} -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$}
+test filesystem-1.38 {file normalisation with volume relative} -setup {
set dir [pwd]
+} -constraints {win moreThanOneDrive} -body {
+ set path "[string range [lindex $drives 0] 0 1]foo"
cd [lindex $drives 1]
- set res [file norm $path]
+ file norm $path
+} -cleanup {
cd $dir
- set res
-} "[lindex $drives 0]foo"
-test filesystem-1.39 {file normalisation with volume relative} {win} {
- set drv C:/
- set dir [lindex [glob -type d -dir $drv *] 0]
+} -result "[lindex $drives 0]foo"
+test filesystem-1.39 {file normalisation with volume relative} -setup {
set old [pwd]
- cd $dir
- set res [file norm [string range $drv 0 1]]
+} -constraints {win} -body {
+ set drv C:/
+ cd [lindex [glob -type d -dir $drv *] 0]
+ file norm [string range $drv 0 1]
+} -cleanup {
cd $old
- if {[string index $res end] eq "/"} {
- set res "Bad normalized path: $res"
- } else {
- set res "ok"
- }
-} {ok}
+} -match regexp -result {.*[^/]}
test filesystem-1.40 {file normalisation with repeated separators} {
- set a [file norm foo////bar]
- set b [file norm foo/bar]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm foo////bar] [file norm foo/bar]
+} ok
test filesystem-1.41 {file normalisation with repeated separators} {win} {
- set a [file norm foo\\\\\\bar]
- set b [file norm foo/bar]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm foo\\\\\\bar] [file norm foo/bar]
+} ok
test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /xxx/..]
- set b [file norm /]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /xxx/..] [file norm /]
+} ok
test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /xxx/../]
- set b [file norm /]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /xxx/../] [file norm /]
+} ok
test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /xxx/foo/../..]
- set b [file norm /]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /xxx/foo/../..] [file norm /]
+} ok
test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /xxx/foo/../../]
- set b [file norm /]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /xxx/foo/../../] [file norm /]
+} ok
test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /xxx/foo/../../bar]
- set b [file norm /bar]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /xxx/foo/../../bar] [file norm /bar]
+} ok
test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /xxx/../../bar]
- set b [file norm /bar]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /xxx/../../bar] [file norm /bar]
+} ok
test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /xxx/../bar]
- set b [file norm /bar]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /xxx/../bar] [file norm /bar]
+} ok
test filesystem-1.47 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /..]
- set b [file norm /]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /..] [file norm /]
+} ok
test filesystem-1.48 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /../]
- set b [file norm /]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /../] [file norm /]
+} ok
test filesystem-1.49 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /.]
- set b [file norm /]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /.] [file norm /]
+} ok
test filesystem-1.50 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /./]
- set b [file norm /]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /./] [file norm /]
+} ok
test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /../..]
- set b [file norm /]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /../..] [file norm /]
+} ok
test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} {
- set a [file norm /../../]
- set b [file norm /]
- if {![string equal $a $b]} {
- set res "Paths should be equal: $a , $b"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [file norm /../../] [file norm /]
+} ok
test filesystem-2.0 {new native path} {unix} {
foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
catch {file readlink $f}
}
# If we reach here we've succeeded. We used to crash above.
- expr 1
-} {1}
+ return ok
+} ok
# Make sure the testfilesystem hasn't been registered.
if {[testConstraint testfilesystem]} {
@@ -511,28 +402,28 @@ test filesystem-4.0 {testfilesystem} -constraints testfilesystem -body {
set filesystemReport {}
file exists foo
testfilesystem 0
- set filesystemReport
+ return $filesystemReport
} -match glob -result {*{access foo}}
test filesystem-4.1 {testfilesystem} -constraints testfilesystem -body {
testfilesystem 1
set filesystemReport {}
catch {file stat foo bar}
testfilesystem 0
- set filesystemReport
+ return $filesystemReport
} -match glob -result {*{stat foo}}
test filesystem-4.2 {testfilesystem} -constraints testfilesystem -body {
testfilesystem 1
set filesystemReport {}
catch {file lstat foo bar}
testfilesystem 0
- set filesystemReport
+ return $filesystemReport
} -match glob -result {*{lstat foo}}
test filesystem-4.3 {testfilesystem} -constraints testfilesystem -body {
testfilesystem 1
set filesystemReport {}
catch {glob *}
testfilesystem 0
- set filesystemReport
+ return $filesystemReport
} -match glob -result {*{matchindirectory *}*}
test filesystem-5.1 {cache and ~} -constraints testfilesystem -setup {
@@ -593,21 +484,21 @@ test filesystem-6.22 {empty file name} {file pathtype ""} relative
test filesystem-6.23 {empty file name} {file readable ""} 0
test filesystem-6.24 {empty file name} -returnCodes error -body {
file readlink ""
-} -result {could not readlink "": no such file or directory}
+} -result {could not read link "": no such file or directory}
test filesystem-6.25 {empty file name} -returnCodes error -body {
file rename "" ""
} -result {error renaming "": no such file or directory}
test filesystem-6.26 {empty file name} {file rootname ""} {}
test filesystem-6.27 {empty file name} -returnCodes error -body {
file separator ""
-} -result {Unrecognised path}
+} -result {unrecognised path}
test filesystem-6.28 {empty file name} -returnCodes error -body {
file size ""
} -result {could not read "": no such file or directory}
test filesystem-6.29 {empty file name} {file split ""} {}
test filesystem-6.30 {empty file name} -returnCodes error -body {
file system ""
-} -result {Unrecognised path}
+} -result {unrecognised path}
test filesystem-6.31 {empty file name} {file tail ""} {}
test filesystem-6.32 {empty file name} -returnCodes error -body {
file type ""
@@ -621,13 +512,12 @@ if {[testConstraint testfilesystem]} {
test filesystem-7.1.1 {load from vfs} -setup {
set dir [pwd]
-} -constraints {win testsimplefilesystem} -body {
+} -constraints {win testsimplefilesystem loaddll} -body {
# This may cause a crash on exit
- cd [file dirname [info nameof]]
- set dde [lindex [glob *dde*[info sharedlib]] 0]
+ cd [file dirname $::ddelib]
testsimplefilesystem 1
# This loads dde via a complex copy-to-temp operation
- load simplefs:/$dde dde
+ load simplefs:/[file tail $::ddelib] dde
testsimplefilesystem 0
return ok
# The real result of this test is what happens when Tcl exits.
@@ -636,14 +526,13 @@ test filesystem-7.1.1 {load from vfs} -setup {
} -result ok
test filesystem-7.1.2 {load from vfs, and then unload again} -setup {
set dir [pwd]
-} -constraints {win testsimplefilesystem} -body {
+} -constraints {win testsimplefilesystem loaddll} -body {
# This may cause a crash on exit
- cd [file dirname [info nameof]]
- set reg [lindex [glob tclreg*[info sharedlib]] 0]
+ cd [file dirname $::reglib]
testsimplefilesystem 1
# This loads reg via a complex copy-to-temp operation
- load simplefs:/$reg Registry
- unload simplefs:/$reg
+ load simplefs:/[file tail $::reglib] Registry
+ unload simplefs:/[file tail $::reglib]
testsimplefilesystem 0
return ok
# The real result of this test is what happens when Tcl exits.
@@ -1040,8 +929,12 @@ test filesystem-9.9 {path objects and glob and file tail and tilde} -setup {
# ----------------------------------------------------------------------
+test filesystem-10.1 {Bug 3414754} {
+ string match */ [file join [pwd] foo/]
+} 0
+
cleanupTests
-unset -nocomplain drive
+unset -nocomplain drive drives
}
namespace delete ::tcl::test::fileSystem
return
diff --git a/tests/for-old.test b/tests/for-old.test
index db63a16..a11a791 100644
--- a/tests/for-old.test
+++ b/tests/for-old.test
@@ -11,8 +11,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: for-old.test,v 1.6 2004/05/19 12:25:30 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/for.test b/tests/for.test
index 04aed84..ff4dc0e 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -8,8 +8,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: for.test,v 1.17 2008/11/17 08:11:45 ferrieux Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
diff --git a/tests/foreach.test b/tests/foreach.test
index 4042b3c..6c69b29 100644
--- a/tests/foreach.test
+++ b/tests/foreach.test
@@ -9,8 +9,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: foreach.test,v 1.15 2009/06/24 15:17:40 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -268,6 +266,15 @@ test foreach-10.1 {foreach: [Bug 1671087]} -setup {
rename demo {}
} -result {}
+test foreach-11.1 {error then dereference loop var (dev bug)} {
+ catch { foreach a 0 b {1 2 3} { error x } }
+ set a
+} 0
+test foreach-11.2 {error then dereference loop var (dev bug)} {
+ catch { foreach a 0 b {1 2 3} { incr a $b; error x } }
+ set a
+} 1
+
# cleanup
catch {unset a}
catch {unset x}
diff --git a/tests/format.test b/tests/format.test
index 54d9ffb..27eac31 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -9,8 +9,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: format.test,v 1.30 2010/01/18 09:31:02 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -551,10 +549,7 @@ test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} {
list [format %08x $a] [expr {$a == $b}]
} {aaaaaaab 1}
-test format-19.1 {
- regression test - tcl-core message by Brian Griffin on
- 26 0ctober 2004
-} -body {
+test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body {
set x 0x8fedc654
list [expr { ~ $x }] [format %08x [expr { ~$x }]]
} -match regexp -result {-2414724693 f*701239ab}
@@ -571,7 +566,7 @@ test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body {
format %s $x
# After this, obj in $x should be a dict with a non-NULL bytes field
tcl::unsupported::representation $x
-} -match glob -result {value is a dict with *, string representation "*".}
+} -match glob -result {value is a dict with *, string representation "*"}
# cleanup
catch {unset a}
diff --git a/tests/get.test b/tests/get.test
index 112632f..d51ec6d 100644
--- a/tests/get.test
+++ b/tests/get.test
@@ -9,14 +9,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: get.test,v 1.12 2005/08/08 14:08:05 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testgetint [llength [info commands testgetint]]
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
diff --git a/tests/history.test b/tests/history.test
index 3f02aa0..c562796 100644
--- a/tests/history.test
+++ b/tests/history.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: history.test,v 1.7 2009/07/25 21:51:02 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/http.test b/tests/http.test
index d879e45..9861e0e 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: http.test,v 1.55 2009/11/18 21:04:32 nijtmans Exp $
package require tcltest 2
namespace import -force ::tcltest::*
@@ -53,14 +51,13 @@ if {![file exists $httpdFile]} {
set removeHttpd 1
}
-if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
- set httpthread [testthread create "
- source [list $httpdFile]
- testthread wait
- "]
- testthread send $httpthread [list set port $port]
- testthread send $httpthread [list set bindata $bindata]
- testthread send $httpthread {httpd_init $port}
+catch {package require Thread 2.7-}
+if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
+ set httpthread [thread::create -preserved]
+ thread::send $httpthread [list source $httpdFile]
+ thread::send $httpthread [list set port $port]
+ thread::send $httpthread [list set bindata $bindata]
+ thread::send $httpthread {httpd_init $port}
puts "Running httpd in thread $httpthread"
} else {
if {![file exists $httpdFile]} {
@@ -138,6 +135,7 @@ set fullurl http://user:pass@[info hostname]:$port/a/b/c
set binurl //[info hostname]:$port/binary
set posturl //[info hostname]:$port/post
set badposturl //[info hostname]:$port/droppost
+set ipv6url http://\[::1\]:$port/
test http-3.4 {http::geturl} -body {
set token [http::geturl $url]
http::data $token
@@ -367,6 +365,46 @@ test http-3.26 {http::meta} -setup {
http::cleanup $token
unset -nocomplain m token
} -result {Content-Length Content-Type Date X-Check}
+test http-3.27 {http::geturl: -headers override -type} -body {
+ set token [http::geturl $url/headers -type "text/plain" -query dummy \
+ -headers [list "Content-Type" "text/plain;charset=utf-8"]]
+ http::data $token
+} -cleanup {
+ http::cleanup $token
+} -match regexp -result {(?n)Accept \*/\*
+Host .*
+User-Agent .*
+Connection close
+Content-Type {text/plain;charset=utf-8}
+Accept-Encoding .*
+Content-Length 5}
+test http-3.28 {http::geturl: -headers override -type default} -body {
+ set token [http::geturl $url/headers -query dummy \
+ -headers [list "Content-Type" "text/plain;charset=utf-8"]]
+ http::data $token
+} -cleanup {
+ http::cleanup $token
+} -match regexp -result {(?n)Accept \*/\*
+Host .*
+User-Agent .*
+Connection close
+Content-Type {text/plain;charset=utf-8}
+Accept-Encoding .*
+Content-Length 5}
+test http-3.29 "http::geturl $ipv6url" -body {
+ # We only want to see if the URL gets parsed correctly. This is
+ # the case if http::geturl succeeds or returns a socket related
+ # error. If the parsing is wrong, we'll get a parse error.
+ # It'd be better to separate the URL parser from http::geturl, so
+ # that it can be tested without also trying to make a connection.
+ set error [catch {http::geturl $ipv6url -validate 1} token]
+ if {$error && [string match "couldn't open socket: *" $token]} {
+ set error 0
+ }
+ set error
+} -cleanup {
+ catch { http::cleanup $token }
+} -result 0
test http-4.1 {http::Event} -body {
set token [http::geturl $url -keepalive 0]
@@ -523,7 +561,7 @@ test http-4.15 {http::Event} -body {
http::status $token
# error codes vary among platforms.
} -cleanup {
- http::cleanup $token
+ catch {http::cleanup $token}
} -returnCodes 1 -match glob -result "couldn't open socket*"
test http-5.1 {http::formatQuery} {
@@ -532,17 +570,17 @@ test http-5.1 {http::formatQuery} {
# test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5
test http-5.3 {http::formatQuery} {
http::formatQuery lines "line1\nline2\nline3"
-} {lines=line1%0d%0aline2%0d%0aline3}
+} {lines=line1%0D%0Aline2%0D%0Aline3}
test http-5.4 {http::formatQuery} {
http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
-} {name1=~bwelch&name2=%c2%a1%c2%a2%c2%a2}
+} {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2}
test http-5.5 {http::formatQuery} {
set enc [http::config -urlencoding]
http::config -urlencoding iso8859-1
set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2]
http::config -urlencoding $enc
set res
-} {name1=~bwelch&name2=%a1%a2%a2}
+} {name1=~bwelch&name2=%A1%A2%A2}
test http-6.1 {http::ProxyRequired} -body {
http::config -proxyhost [info hostname] -proxyport $port
@@ -560,12 +598,12 @@ test http-6.1 {http::ProxyRequired} -body {
test http-7.1 {http::mapReply} {
http::mapReply "abc\$\[\]\"\\()\}\{"
-} {abc%24%5b%5d%22%5c%28%29%7d%7b}
+} {abc%24%5B%5D%22%5C%28%29%7D%7B}
test http-7.2 {http::mapReply} {
# RFC 2718 specifies that we pass urlencoding on utf-8 chars by default,
# so make sure this gets converted to utf-8 then urlencoded.
http::mapReply "\u2208"
-} {%e2%88%88}
+} {%E2%88%88}
test http-7.3 {http::formatQuery} -setup {
set enc [http::config -urlencoding]
} -returnCodes error -body {
@@ -584,7 +622,7 @@ test http-7.4 {http::formatQuery} -setup {
http::mapReply "\u2208"
} -cleanup {
http::config -urlencoding $enc
-} -result {%3f}
+} -result {%3F}
# cleanup
catch {unset url}
@@ -592,9 +630,7 @@ catch {unset badurl}
catch {unset port}
catch {unset data}
if {[info exists httpthread]} {
- testthread send -async $httpthread {
- testthread exit
- }
+ thread::release $httpthread
} else {
close $listen
}
diff --git a/tests/http11.test b/tests/http11.test
index 0cecaa1..230ce5a 100644
--- a/tests/http11.test
+++ b/tests/http11.test
@@ -62,7 +62,7 @@ proc meta {tok {key ""}} {
proc check_crc {tok args} {
set crc [meta $tok x-crc32]
- if {[llength $args]} {set data [lindex $args 0]} else {set data [http::data $tok]}
+ set data [expr {[llength $args] ? [lindex $args 0] : [http::data $tok]}]
set chk [format %x [zlib crc32 $data]]
if {$crc ne $chk} {
return "crc32 mismatch: $crc ne $chk"
diff --git a/tests/httpd b/tests/httpd
index 93ee08a..f810797 100644
--- a/tests/httpd
+++ b/tests/httpd
@@ -7,8 +7,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# SCCS: @(#) httpd 1.2 98/02/20 14:51:59
#set httpLog 1
@@ -177,6 +175,14 @@ proc httpdRespond { sock } {
set html "Got [string length $data(query)] bytes"
set type text/plain
}
+ *headers* {
+ set html ""
+ set type text/plain
+ foreach {key value} $data(meta) {
+ append html [list $key $value] "\n"
+ }
+ set html [string trim $html]
+ }
default {
set type text/html
diff --git a/tests/httpold.test b/tests/httpold.test
index fe7c607..aeba311 100644
--- a/tests/httpold.test
+++ b/tests/httpold.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: httpold.test,v 1.12 2004/05/19 12:44:27 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/if-old.test b/tests/if-old.test
index 3a850b9..fbcf56c 100644
--- a/tests/if-old.test
+++ b/tests/if-old.test
@@ -12,8 +12,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: if-old.test,v 1.6 2003/03/27 13:19:15 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/if.test b/tests/if.test
index 59fb24a..040364a 100644
--- a/tests/if.test
+++ b/tests/if.test
@@ -9,8 +9,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: if.test,v 1.13 2009/10/29 15:51:50 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
diff --git a/tests/incr-old.test b/tests/incr-old.test
index 96c68b7..ed457cf 100644
--- a/tests/incr-old.test
+++ b/tests/incr-old.test
@@ -12,8 +12,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: incr-old.test,v 1.10 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
diff --git a/tests/incr.test b/tests/incr.test
index c5a41ad..9243be0 100644
--- a/tests/incr.test
+++ b/tests/incr.test
@@ -1,53 +1,56 @@
# Commands covered: incr
#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
#
# Copyright (c) 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.
-#
-# RCS: @(#) $Id: incr.test,v 1.16 2007/12/13 15:26:06 dgp Exp $
+# 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
namespace import -force ::tcltest::*
}
+unset -nocomplain x i
+proc readonly varName {
+ upvar 1 $varName var
+ trace add variable var write \
+ {apply {{args} {error "variable is read-only"}}}
+}
+
# Basic "incr" operation.
-catch {unset x}
-catch {unset i}
-
-test incr-1.1 {TclCompileIncrCmd: missing variable name} {
- list [catch {incr} msg] $msg
-} {1 {wrong # args: should be "incr varName ?increment?"}}
+test incr-1.1 {TclCompileIncrCmd: missing variable name} -returnCodes error -body {
+ incr
+} -result {wrong # args: should be "incr varName ?increment?"}
test incr-1.2 {TclCompileIncrCmd: simple variable name} {
set i 10
list [incr i] $i
} {11 11}
-test incr-1.3 {TclCompileIncrCmd: error compiling variable name} {
+test incr-1.3 {TclCompileIncrCmd: error compiling variable name} -body {
set i 10
- catch {incr "i"xxx} msg
- set msg
-} {extra characters after close-quote}
+ incr "i"xxx
+} -returnCodes error -result {extra characters after close-quote}
test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} {
set i 17
list [incr "i"] $i
} {18 18}
-test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} {
- catch {unset {a simple var}}
+test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} -setup {
+ unset -nocomplain {a simple var}
+} -body {
set {a simple var} 27
list [incr {a simple var}] ${a simple var}
-} {28 28}
-test incr-1.6 {TclCompileIncrCmd: simple array variable name} {
- catch {unset a}
+} -result {28 28}
+test incr-1.6 {TclCompileIncrCmd: simple array variable name} -setup {
+ unset -nocomplain a
+} -body {
set a(foo) 37
list [incr a(foo)] $a(foo)
-} {38 38}
+} -result {38 38}
test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} {
set x "i"
set i 77
@@ -58,7 +61,6 @@ test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} {
set i 77
list [incr [set x] +2] $i
} {79 79}
-
test incr-1.9 {TclCompileIncrCmd: increment given} {
set i 10
list [incr i +07] $i
@@ -67,7 +69,6 @@ test incr-1.10 {TclCompileIncrCmd: no increment given} {
set i 10
list [incr i] $i
} {11 11}
-
test incr-1.11 {TclCompileIncrCmd: simple global name} {
proc p {} {
global i
@@ -149,22 +150,23 @@ test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} {
}
260locals
} {1}
-test incr-1.15 {TclCompileIncrCmd: variable is array} {
- catch {unset a}
+test incr-1.15 {TclCompileIncrCmd: variable is array} -setup {
+ unset -nocomplain a
+} -body {
set a(foo) 27
- set x [incr a(foo) 11]
- catch {unset a}
- set x
-} 38
-test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} {
- catch {unset a}
+ incr a(foo) 11
+} -cleanup {
+ unset -nocomplain a
+} -result 38
+test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} -setup {
+ unset -nocomplain a
+} -body {
set i 5
set a(foo5) 27
- set x [incr a(foo$i) 11]
- catch {unset a}
- set x
-} 38
-
+ incr a(foo$i) 11
+} -cleanup {
+ unset -nocomplain a
+} -result 38
test incr-1.17 {TclCompileIncrCmd: increment given, simple int} {
set i 5
incr i 123
@@ -175,8 +177,8 @@ test incr-1.18 {TclCompileIncrCmd: increment given, simple int} {
} -95
test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} -body {
set i 5
- catch {incr i [set]} msg
- set ::errorInfo
+ catch {incr i [set]} -> opts
+ dict get $opts -errorinfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -196,19 +198,14 @@ test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
set i 25
incr i 0o00012345 ;# an octal literal
} 5374
-test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
+test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} -body {
set i 25
- catch {incr i 1a} msg
- set msg
-} {expected integer but got "1a"}
-
-test incr-1.25 {TclCompileIncrCmd: too many arguments} {
+ incr i 1a
+} -returnCodes error -result {expected integer but got "1a"}
+test incr-1.25 {TclCompileIncrCmd: too many arguments} -body {
set i 10
- catch {incr i 10 20} msg
- set msg
-} {wrong # args: should be "incr varName ?increment?"}
-
-
+ incr i 10 20
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test incr-1.26 {TclCompileIncrCmd: runtime error, bad variable name} {
unset -nocomplain {"foo}
incr {"foo}
@@ -219,69 +216,68 @@ test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} -body {
while *ing
"set"*}}
test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} -body {
- proc readonly args {error "variable is read-only"}
set x 123
- trace var x w readonly
+ readonly x
list [catch {incr x 1} msg] $msg $::errorInfo
-} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
+} -match glob -cleanup {
+ unset -nocomplain x
+} -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
*
"incr x 1"}}
-catch {unset x}
-test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
+test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} -body {
set x " - "
- list [catch {incr x 1} msg] $msg
-} {1 {expected integer but got " - "}}
-
-test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} {
+ incr x 1
+} -returnCodes error -result {expected integer but got " - "}
+test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} -setup {
catch {unset array}
+} -body {
set array(\$foo) 4
incr {array($foo)}
-} 5
-
+} -result 5
+
# Check "incr" and computed command names.
+unset -nocomplain x i
test incr-2.0 {incr and computed command names} {
set i 5
set z incr
$z i -1
- set i
+ return $i
} 4
-catch {unset x}
-catch {unset i}
-
-test incr-2.1 {incr command (not compiled): missing variable name} {
+test incr-2.1 {incr command (not compiled): missing variable name} -body {
set z incr
- list [catch {$z} msg] $msg
-} {1 {wrong # args: should be "incr varName ?increment?"}}
+ $z
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test incr-2.2 {incr command (not compiled): simple variable name} {
set z incr
set i 10
list [$z i] $i
} {11 11}
-test incr-2.3 {incr command (not compiled): error compiling variable name} {
+test incr-2.3 {incr command (not compiled): error compiling variable name} -body {
set z incr
set i 10
- catch {$z "i"xxx} msg
- set msg
-} {extra characters after close-quote}
+ $z "i"xxx
+} -returnCodes error -result {extra characters after close-quote}
test incr-2.4 {incr command (not compiled): simple variable name in quotes} {
set z incr
set i 17
list [$z "i"] $i
} {18 18}
-test incr-2.5 {incr command (not compiled): simple variable name in braces} {
+test incr-2.5 {incr command (not compiled): simple variable name in braces} -setup {
+ unset -nocomplain {a simple var}
+} -body {
set z incr
- catch {unset {a simple var}}
set {a simple var} 27
list [$z {a simple var}] ${a simple var}
-} {28 28}
-test incr-2.6 {incr command (not compiled): simple array variable name} {
+} -result {28 28}
+test incr-2.6 {incr command (not compiled): simple array variable name} -setup {
+ unset -nocomplain a
+} -body {
set z incr
- catch {unset a}
set a(foo) 37
list [$z a(foo)] $a(foo)
-} {38 38}
+} -result {38 38}
test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} {
set z incr
set x "i"
@@ -294,7 +290,6 @@ test incr-2.8 {incr command (not compiled): non-simple (computed) variable name}
set i 77
list [$z [set x] +2] $i
} {79 79}
-
test incr-2.9 {incr command (not compiled): increment given} {
set z incr
set i 10
@@ -305,7 +300,6 @@ test incr-2.10 {incr command (not compiled): no increment given} {
set i 10
list [$z i] $i
} {11 11}
-
test incr-2.11 {incr command (not compiled): simple global name} {
proc p {} {
set z incr
@@ -391,24 +385,25 @@ test incr-2.14 {incr command (not compiled): simple local name, >255 locals} {
}
260locals
} {1}
-test incr-2.15 {incr command (not compiled): variable is array} {
+test incr-2.15 {incr command (not compiled): variable is array} -setup {
+ unset -nocomplain a
+} -body {
set z incr
- catch {unset a}
set a(foo) 27
- set x [$z a(foo) 11]
- catch {unset a}
- set x
-} 38
-test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} {
+ $z a(foo) 11
+} -cleanup {
+ unset -nocomplain a
+} -result 38
+test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} -setup {
+ unset -nocomplain a
+} -body {
set z incr
- catch {unset a}
set i 5
set a(foo5) 27
- set x [$z a(foo$i) 11]
- catch {unset a}
- set x
-} 38
-
+ $z a(foo$i) 11
+} -cleanup {
+ unset -nocomplain a
+} -result 38
test incr-2.17 {incr command (not compiled): increment given, simple int} {
set z incr
set i 5
@@ -422,8 +417,8 @@ test incr-2.18 {incr command (not compiled): increment given, simple int} {
test incr-2.19 {incr command (not compiled): increment given, but erroneous} -body {
set z incr
set i 5
- catch {$z i [set]} msg
- set ::errorInfo
+ catch {$z i [set]} -> opts
+ dict get $opts -errorinfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -447,26 +442,22 @@ test incr-2.23 {incr command (not compiled): increment given, formatted int != i
set i 25
$z i 0o00012345 ;# an octal literal
} 5374
-test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
+test incr-2.24 {incr command (not compiled): increment given, formatted int != int} -body {
set z incr
set i 25
- catch {$z i 1a} msg
- set msg
-} {expected integer but got "1a"}
-
-test incr-2.25 {incr command (not compiled): too many arguments} {
+ $z i 1a
+} -returnCodes error -result {expected integer but got "1a"}
+test incr-2.25 {incr command (not compiled): too many arguments} -body {
set z incr
set i 10
- catch {$z i 10 20} msg
- set msg
-} {wrong # args: should be "incr varName ?increment?"}
-
-
-test incr-2.26 {incr command (not compiled): runtime error, bad variable name} {
+ $z i 10 20
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
+test incr-2.26 {incr command (not compiled): runtime error, bad variable name} -setup {
unset -nocomplain {"foo}
+} -body {
set z incr
$z {"foo}
-} 1
+} -result 1
test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -body {
set z incr
list [catch {$z [set]} msg] $msg $::errorInfo
@@ -475,20 +466,20 @@ test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -
"set"*}}
test incr-2.28 {incr command (not compiled): runtime error, readonly variable} -body {
set z incr
- proc readonly args {error "variable is read-only"}
set x 123
- trace var x w readonly
+ readonly x
list [catch {$z x 1} msg] $msg $::errorInfo
-} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
+} -match glob -cleanup {
+ unset -nocomplain x
+} -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
*
"$z x 1"}}
-catch {unset x}
-test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
+test incr-2.29 {incr command (not compiled): runtime error, bad variable value} -body {
set z incr
set x " - "
- list [catch {$z x 1} msg] $msg
-} {1 {expected integer but got " - "}}
+ $z x 1
+} -returnCodes error -result {expected integer but got " - "}
test incr-2.30 {incr command (not compiled): bad increment} {
set z incr
set x 0
@@ -520,7 +511,12 @@ test incr-4.1 {increment non-existing array element [Bug 1445454]} -body {
} -cleanup {
rename x {}
} -result 1
-
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/indexObj.test b/tests/indexObj.test
index 495af3c..646cb02 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -1,22 +1,24 @@
# This file is a Tcl script to test out the the procedures in file
-# tkIndexObj.c, which implement indexed table lookups. The tests here
-# are organized in the standard fashion for Tcl tests.
+# tkIndexObj.c, which implement indexed table lookups. The tests here are
+# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 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.
-#
-# RCS: @(#) $Id: indexObj.test,v 1.17 2008/07/21 21:25:22 nijtmans Exp $
+# 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
+ package require tcltest 2
namespace import -force ::tcltest::*
}
-testConstraint testindexobj [llength [info commands testindexobj]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+testConstraint testindexobj [llength [info commands testindexobj]]
+testConstraint testparseargs [llength [info commands testparseargs]]
+
test indexObj-1.1 {exact match} testindexobj {
testindexobj 1 1 xyz abc def xyz alm
} {2}
@@ -130,6 +132,31 @@ test indexObj-6.4 {Tcl_GetIndexFromObjStruct} testindexobj {
testgetindexfromobjstruct $x 1
} "wrong # args: should be \"testgetindexfromobjstruct c 1\""
+test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs {
+ testparseargs
+} {0 1 testparseargs}
+test indexObj-7.2 {Tcl_ParseArgsObjv} testparseargs {
+ testparseargs -bool
+} {1 1 testparseargs}
+test indexObj-7.3 {Tcl_ParseArgsObjv} testparseargs {
+ testparseargs -bool bar
+} {1 2 {testparseargs bar}}
+test indexObj-7.4 {Tcl_ParseArgsObjv} testparseargs {
+ testparseargs bar
+} {0 2 {testparseargs bar}}
+test indexObj-7.5 {Tcl_ParseArgsObjv} -constraints testparseargs -body {
+ testparseargs -help
+} -returnCodes error -result {Command-specific options:
+ -bool: booltest
+ --: Marks the end of the options
+ -help: Print summary of command-line options and abort}
+test indexObj-7.6 {Tcl_ParseArgsObjv} testparseargs {
+ testparseargs -- -bool -help
+} {0 3 {testparseargs -bool -help}}
+test indexObj-7.7 {Tcl_ParseArgsObjv memory management} testparseargs {
+ testparseargs 1 2 3 4 5 6 7 8 9 0 -bool 1 2 3 4 5 6 7 8 9 0
+} {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0}}
+
# cleanup
::tcltest::cleanupTests
return
diff --git a/tests/info.test b/tests/info.test
index fd126a7..5078e11 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -13,13 +13,16 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: info.test,v 1.78 2010/08/03 20:15:53 andreas_kupries Exp $
+# DO NOT DELETE THIS LINE
if {{::tcltest} ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.
@@ -215,14 +218,14 @@ test info-6.9 {info default option} -returnCodes error -setup {
set a(0) 88
proc t1 {a b} {}
info default t1 a a
-} -returnCodes error -result {couldn't store default value in variable "a"}
+} -returnCodes error -result {can't set "a": variable is array}
test info-6.10 {info default option} -setup {
catch {unset a}
} -cleanup {unset a} -body {
set a(0) 88
proc t1 {{a 18} b} {}
info default t1 a a
-} -returnCodes error -result {couldn't store default value in variable "a"}
+} -returnCodes error -result {can't set "a": variable is array}
test info-6.11 {info default option} {
catch {namespace delete test_ns_info2}
namespace eval test_ns_info2 {
@@ -231,7 +234,6 @@ test info-6.11 {info default option} {
}
} {0 {} 1 27}
-
test info-7.1 {info exists option} -body {
set value foo
info exists value
@@ -690,14 +692,12 @@ test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
##
# ### ### ### ######### ######### #########
## info frame
-
## Helper
# For the more complex results we cut the file name down to remove path
# dependencies, and we use only part of the first line of the reported
# command. The latter is required because otherwise the whole test case may
# appear in some results, but the result is part of the testcase. An infinite
# string would be required to describe that. The cutting-down breaks this.
-
proc reduce {frame} {
set pos [lsearch -exact $frame cmd]
incr pos
@@ -714,7 +714,9 @@ proc reduce {frame} {
}
set frame
}
-
+proc subinterp {} { interp create sub ; interp debug sub -frame 1;
+ interp eval sub [list proc reduce [info args reduce] [info body reduce]]
+}
## Helper
# Generate a stacktrace from the current location to top. This code
# not only depends on the exact location of things, but also on the
@@ -731,8 +733,6 @@ proc etrace {} {
return $res
}
-##
-
test info-22.0 {info frame, levels} {!singleTestInterp} {
info frame
} 7
@@ -763,7 +763,7 @@ test info-22.7 {info frame, global, absolute} {!singleTestInterp} {
} {type source line 761 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolute\}\ \{!singleTestInter level 0}
test info-22.8 {info frame, basic trace} -match glob -body {
join [lrange [etrace] 0 2] \n
-} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
+} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 765 file info.test cmd etrace proc ::tcltest::RunTest}
* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}
unset -nocomplain msg
@@ -803,7 +803,7 @@ test info-23.5 {eval'd info frame, dynamic} -cleanup {unset script} -body {
test info-23.6 {eval'd info frame, trace} -match glob -cleanup {unset script} -body {
set script {etrace}
join [lrange [eval $script] 0 2] \n
-} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
+} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
* {type source line 805 file info.test cmd {eval $script} proc ::tcltest::RunTest}}
@@ -1318,7 +1318,7 @@ test info-37.0 {eval pure list, single line} -match glob -body {
}]
eval $cmd
return $res
-} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
+} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 2 cmd etrace proc ::tcltest::RunTest}
* {type eval line 1 cmd foreac proc ::tcltest::RunTest}} -cleanup {unset foo cmd res b c}
@@ -1359,18 +1359,18 @@ test info-38.1 {location information for uplevel, dv, direct-var} -match glob -b
etrace
}
join [lrange [uplevel \#0 $script] 0 2] \n
-} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
+} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::tcltest::RunTest}
* {type source line 1361 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}} -cleanup {unset script y}
-test info-38.2 {location information for uplevel, dl, direct-literal} -match glob -body {
- join [lrange [uplevel \#0 {
- set y DL.
- etrace
- }] 0 2] \n
-} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type source line 1369 file info.test cmd etrace proc ::tcltest::RunTest}
-* {type source line 1367 file info.test cmd uplevel\\ \\\\ proc ::tcltest::RunTest}} -cleanup {unset y}
+# 38.2 moved to bottom to not disturb other tests with the necessary changes to this one.
+
+
+
+
+
+
+
test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match glob -body {
set script {
@@ -1378,41 +1378,41 @@ test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match g
etrace
}
join [lrange [control y $script] 0 3] \n
-} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
+} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::control}
* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1380 file info.test cmd {control y $script} proc ::tcltest::RunTest}} -cleanup {unset script y}
-test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -match glob -body {
- join [lrange [control y {
- set y DPL
- etrace
- }] 0 3] \n
-} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type source line 1389 file info.test cmd etrace proc ::control}
-* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
-* {type source line 1387 file info.test cmd control proc ::tcltest::RunTest}} -cleanup {unset y}
+# 38.4 moved to bottom to not disturb other tests with the necessary changes to this one.
+
+
+
+
+
+
+
+
test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glob -body {
join [lrange [datav] 0 4] \n
-} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
+} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::control}
* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1353 file info.test cmd {control y $script} proc ::datav level 1}
* {type source line 1397 file info.test cmd datav proc ::tcltest::RunTest}}
-test info-38.6 {location information for uplevel, ppl, proc-proc-literal} -match glob -body {
- join [lrange [datal] 0 4] \n
-} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type source line 1344 file info.test cmd etrace proc ::control}
-* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
-* {type source line 1342 file info.test cmd control proc ::datal level 1}
-* {type source line 1405 file info.test cmd datal proc ::tcltest::RunTest}}
+# 38.6 moved to bottom to not disturb other tests with the necessary changes to this one.
+
+
+
+
+
+
testConstraint testevalex [llength [info commands testevalex]]
test info-38.7 {location information for arg substitution} -constraints testevalex -match glob -body {
join [lrange [testevalex {return -level 0 [etrace]}] 0 3] \n
-} -result {* {type source line 728 file info.test cmd {info frame \$level} proc ::etrace level 0}
+} -result {* {type source line 730 file info.test cmd {info frame \$level} proc ::etrace level 0}
* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
* {type source line 1414 file info.test cmd {testevalex {return -level 0 \[etrace]}} proc ::tcltest::RunTest}
* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}
@@ -1543,18 +1543,18 @@ test info-30.12 {bs+nl in computed word, nested eval} -body {
} -cleanup {unset res x} -result { type source line 1541 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.13 {bs+nl in literal words, uplevel script, with nested words} -body {
- uplevel #0 {
+ subinterp ; set res [interp eval sub { uplevel #0 {
if {1} \
{
set ::res \
[reduce [info frame 0]];# line 1550
}
}
- return $res
-} -cleanup {unset res} -result {type source line 1550 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+ set res }] ; interp delete sub ; set res
+} -cleanup {unset res} -result {type source line 1550 file info.test cmd {info frame 0} level 0}
test info-30.14 {bs+nl, literal word, uplevel through proc} {
- proc abra {script} {
+ subinterp ; set res [interp eval sub { proc abra {script} {
uplevel 1 $script
}
set res [abra {
@@ -1562,7 +1562,7 @@ test info-30.14 {bs+nl, literal word, uplevel through proc} {
[reduce [info frame 0]]";# line 1562
}]
rename abra {}
- set res
+ set res }] ; interp delete sub ; set res
} { type source line 1562 file info.test cmd {info frame 0} proc ::abra}
test info-30.15 {bs+nl in literal words, nested proc body, compiled} {
@@ -1826,7 +1826,7 @@ test info-30.46 {TIP 280 for compiled [subst]} {
} YES
test info-30.47 {TIP 280 for compiled [subst]} {
unset -nocomplain a
- set a(\n1831) YES; set a(\n1830) 1830; set a(\n1832) 1832
+ set a(\n1831) YES; set a(\n1830) 1830; set a(\n1832) 1832
subst {$a(
[dict get [info frame 0] line])} ; # 1831
} YES
@@ -1879,6 +1879,89 @@ test info-39.1 {location information not confused by literal sharing, bug 293308
type source line 1859 file info.test cmd print_one proc ::test_info_frame level 1}
# -------------------------------------------------------------------------
+# Tests moved to the end to not disturb other tests and their locations.
+
+test info-38.6 {location information for uplevel, ppl, proc-proc-literal} -match glob -setup {subinterp} -body {
+ interp eval sub {
+ proc etrace {} {
+ set res {}
+ set level [info frame]
+ while {$level} {
+ lappend res [list $level [reduce [info frame $level]]]
+ incr level -1
+ }
+ return $res
+ }
+ proc control {vv script} {
+ upvar 1 $vv var
+ return [uplevel 1 $script]
+ }
+ proc datal {} {
+ control y {
+ set y PPL
+ etrace
+ }
+ }
+ join [lrange [datal] 0 4] \n
+ }
+} -result {* {type source line 1890 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1902 file info.test cmd etrace proc ::control}
+* {type source line 1897 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1900 file info.test cmd control proc ::datal level 1}
+* {type source line 1905 file info.test cmd datal level 2}} -cleanup {interp delete sub}
+
+test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -match glob -setup {subinterp} -body {
+ interp eval sub {
+ proc etrace {} {
+ set res {}
+ set level [info frame]
+ while {$level} {
+ lappend res [list $level [reduce [info frame $level]]]
+ incr level -1
+ }
+ return $res
+ }
+ proc control {vv script} {
+ upvar 1 $vv var
+ return [uplevel 1 $script]
+ }
+ join [lrange [control y {
+ set y DPL
+ etrace
+ }] 0 3] \n
+ }
+} -result {* {type source line 1919 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1930 file info.test cmd etrace proc ::control}
+* {type source line 1926 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1928 file info.test cmd control level 1}} -cleanup {interp delete sub}
+
+test info-38.2 {location information for uplevel, dl, direct-literal} -match glob -setup {subinterp} -body {
+ interp eval sub {
+ proc etrace {} {
+ set res {}
+ set level [info frame]
+ while {$level} {
+ lappend res [list $level [reduce [info frame $level]]]
+ incr level -1
+ }
+ return $res
+ }
+ join [lrange [uplevel \#0 {
+ set y DL.
+ etrace
+ }] 0 2] \n
+ }
+} -result {* {type source line 1944 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1951 file info.test cmd etrace level 1}
+* {type source line 1949 file info.test cmd uplevel\\ \\\\ level 1}} -cleanup {interp delete sub}
+
+# This test at the end of this file _only_ to avoid disturbing above line
+# numbers. It _belongs_ after info-9.12
+test info-9.13 {info level option, value in global context} -body {
+ uplevel #0 {info level 2}
+} -returnCodes error -result {bad level "2"}
+
+# -------------------------------------------------------------------------
unset -nocomplain res
# cleanup
diff --git a/tests/init.test b/tests/init.test
index 9c16ee3..41b8624 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -9,11 +9,9 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: init.test,v 1.22 2010/04/05 19:44:45 ferrieux Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.3.4
namespace import -force ::tcltest::*
}
@@ -52,28 +50,28 @@ test init-1.8 {auto_qualify - multiple colons 2} {
# places where auto_loading occur (before loading the indexes files and after)
set testInterp [interp create]
-interp eval $testInterp [list set argv $argv]
-interp eval $testInterp [list package require tcltest]
-interp eval $testInterp [list namespace import -force ::tcltest::*]
-
+tcltest::loadIntoSlaveInterpreter $testInterp {*}$argv
interp eval $testInterp {
+ namespace import -force ::tcltest::*
+ customMatch pairwise {apply {{mode pair} {
+ if {[llength $pair] != 2} {error "need a pair of values to check"}
+ string $mode [lindex $pair 0] [lindex $pair 1]
+ }}}
-auto_reset
-catch {rename parray {}}
+ auto_reset
+ catch {rename parray {}}
-test init-2.0 {load parray - stage 1} {
- set ret [catch {parray} error]
+test init-2.0 {load parray - stage 1} -body {
+ parray
+} -returnCodes error -cleanup {
rename parray {} ;# remove it, for the next test - that should not fail.
- list $ret $error
-} {1 {wrong # args: should be "parray a ?pattern?"}}
-test init-2.1 {load parray - stage 2} {
- set ret [catch {parray} error]
- list $ret $error
-} {1 {wrong # args: should be "parray a ?pattern?"}}
+} -result {wrong # args: should be "parray a ?pattern?"}
+test init-2.1 {load parray - stage 2} -body {
+ parray
+} -returnCodes error -result {wrong # args: should be "parray a ?pattern?"}
auto_reset
catch {rename ::safe::setLogCmd {}}
-#unset auto_index(::safe::setLogCmd)
-#unset auto_oldpath
+#unset -nocomplain auto_index(::safe::setLogCmd) auto_oldpath
test init-2.2 {load ::safe::setLogCmd - stage 1} {
::safe::setLogCmd
rename ::safe::setLogCmd {} ;# should not fail
@@ -107,30 +105,30 @@ test init-2.8 {load tcl::HistAdd} -setup {
catch {rename ::tcl::HistAdd {}}
} -body {
# 3 ':' on purpose
- list [catch {tcl:::HistAdd} error] $error
-} -cleanup {
+ tcl:::HistAdd
+} -returnCodes error -cleanup {
rename ::tcl::HistAdd {}
-} -result {1 {wrong # args: should be "tcl:::HistAdd event ?exec?"}}
-
+} -result {wrong # args: should be "tcl:::HistAdd event ?exec?"}
+
test init-3.0 {random stuff in the auto_index, should still work} {
set auto_index(foo:::bar::blah) {
namespace eval foo {namespace eval bar {proc blah {} {return 1}}}
}
foo:::bar::blah
} 1
-
+
# Tests that compare the error stack trace generated when autoloading with
# that generated when no autoloading is necessary. Ideally they should be the
# same.
set count 0
foreach arg [subst -nocommands -novariables {
- c
- {argument
+ c
+ {argument
which spans
multiple lines}
- {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
- {argument which spans multiple lines
+ {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
+ {argument which spans multiple lines
and is long enough to be truncated and
" <- includes a false lead in the prune point search
and must be longer still to force truncation}
@@ -139,37 +137,37 @@ foreach arg [subst -nocommands -novariables {
error stack cannot be uniquely determined.
foo bar foo
"}
- {contrived example: rare circumstance
+ {contrived example: rare circumstance
where the point at which to prune the
error stack cannot be uniquely determined.
foo bar
"}
- {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
- }] {
+ {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
+ }] { ;# emacs needs -> "
- test init-4.$count.0 {::errorInfo produced by [unknown]} {
+ test init-4.$count.0 {::errorInfo produced by [unknown]} -setup {
auto_reset
+ } -body {
catch {parray a b $arg}
set first $::errorInfo
catch {parray a b $arg}
- set second $::errorInfo
- string equal $first $second
- } 1
- test init-4.$count.1 {::errorInfo produced by [unknown]} {
+ list $first $::errorInfo
+ } -match pairwise -result equal
+ test init-4.$count.1 {::errorInfo produced by [unknown]} -setup {
auto_reset
+ } -body {
namespace eval junk [list array set $arg [list 1 2 3 4]]
trace variable ::junk::$arg r \
"[list error [subst {Variable \"$arg\" is write-only}]] ;# "
catch {parray ::junk::$arg}
set first $::errorInfo
catch {parray ::junk::$arg}
- set second $::errorInfo
- string equal $first $second
- } 1
+ list $first $::errorInfo
+ } -match pairwise -result equal
incr count
}
-
+
test init-5.0 {return options passed through ::unknown} -setup {
catch {rename xxx {}}
set ::auto_index(::xxx) {proc ::xxx {} {
diff --git a/tests/interp.test b/tests/interp.test
index 45254ad..0af9887 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -9,17 +9,18 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: interp.test,v 1.68 2009/12/29 14:55:42 dkf Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2.1
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testinterpdelete [llength [info commands testinterpdelete]]
-set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source unload}
+set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source 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:tempfile tcl:file:type tcl:file:volumes tcl:file:writable unload}
foreach i [interp slaves] {
interp delete $i
@@ -31,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, 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, 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
} ""
@@ -49,13 +50,13 @@ test interp-1.6 {options for interp command} -returnCodes error -body {
} -result {wrong # args: should be "interp slaves ?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, 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, 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, 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, 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, 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, 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"}
@@ -147,7 +148,7 @@ test interp-3.8 {testing interp exists and interp slaves} -body {
} -returnCodes error -result {wrong # args: should be "interp slaves ?path?"}
test interp-3.9 {testing interp exists and interp slaves} {
interp create {a a2} -safe
- expr {[lsearch [interp slaves a] a2] >= 0}
+ expr {"a2" in [interp slaves a]}
} 1
test interp-3.10 {testing interp exists and interp slaves} {
interp exists {a a2}
@@ -174,7 +175,7 @@ test interp-4.5 {testing interp delete} {
interp create a
interp create {a x1}
interp delete {a x1}
- expr {[lsearch [interp slaves a] x1] >= 0}
+ expr {"x1" in [interp slaves a]}
} 0
test interp-4.6 {testing interp delete} {
interp create c1
@@ -586,7 +587,6 @@ test interp-14.10 {testing interp-alias: error messages} -setup {
invoked from within
"a 1"}
-
# part 15: testing file sharing
test interp-15.1 {testing file sharing} {
catch {interp delete z}
@@ -667,8 +667,7 @@ test interp-15.8 {testing file transferring} -body {
# Torture tests for interpreter deletion order
#
proc kill {} {interp delete xxx}
-
-test interp-15.9 {testing deletion order} {
+test interp-16.0 {testing deletion order} {
catch {interp delete xxx}
interp create xxx
xxx alias kill kill
@@ -1607,67 +1606,73 @@ test interp-21.1 {interp hidden} {
test interp-21.2 {interp hidden} {
interp hidden
} ""
-test interp-21.3 {interp hidden vs interp hide, interp expose} {
+test interp-21.3 {interp hidden vs interp hide, interp expose} -setup {
set l ""
+} -body {
lappend l [interp hidden]
interp hide {} pwd
lappend l [interp hidden]
interp expose {} pwd
lappend l [interp hidden]
- set l
-} {{} pwd {}}
-test interp-21.4 {interp hidden} {
+} -result {{} pwd {}}
+test interp-21.4 {interp hidden} -setup {
catch {interp delete a}
+} -body {
interp create a
- set l [interp hidden a]
+ interp hidden a
+} -cleanup {
interp delete a
- set l
-} ""
-test interp-21.5 {interp hidden} {
+} -result ""
+test interp-21.5 {interp hidden} -setup {
catch {interp delete a}
+} -body {
interp create -safe a
- set l [lsort [interp hidden a]]
+ lsort [interp hidden a]
+} -cleanup {
interp delete a
- set l
-} $hidden_cmds
-test interp-21.6 {interp hidden vs interp hide, interp expose} {
+} -result $hidden_cmds
+test interp-21.6 {interp hidden vs interp hide, interp expose} -setup {
catch {interp delete a}
- interp create a
set l ""
+} -body {
+ interp create a
lappend l [interp hidden a]
interp hide a pwd
lappend l [interp hidden a]
interp expose a pwd
lappend l [interp hidden a]
+} -cleanup {
interp delete a
- set l
-} {{} pwd {}}
-test interp-21.7 {interp hidden} {
+} -result {{} pwd {}}
+test interp-21.7 {interp hidden} -setup {
catch {interp delete a}
+} -body {
interp create a
- set l [a hidden]
+ a hidden
+} -cleanup {
interp delete a
- set l
-} ""
-test interp-21.8 {interp hidden} {
+} -result ""
+test interp-21.8 {interp hidden} -setup {
catch {interp delete a}
+} -body {
interp create a -safe
- set l [lsort [a hidden]]
+ lsort [a hidden]
+} -cleanup {
interp delete a
- set l
-} $hidden_cmds
-test interp-21.9 {interp hidden vs interp hide, interp expose} {
+} -result $hidden_cmds
+test interp-21.9 {interp hidden vs interp hide, interp expose} -setup {
catch {interp delete a}
- interp create a
set l ""
+} -body {
+ interp create a
lappend l [a hidden]
a hide pwd
lappend l [a hidden]
a expose pwd
lappend l [a hidden]
+} -cleanup {
interp delete a
- set l
-} {{} pwd {}}
+} -result {{} pwd {}}
test interp-22.1 {testing interp marktrusted} {
catch {interp delete a}
@@ -1767,183 +1772,161 @@ test interp-22.9 {testing interp marktrusted} {
set l
} {1 1 1 0 0}
-test interp-23.1 {testing hiding vs aliases} {
+test interp-23.1 {testing hiding vs aliases: unsafe interp} -setup {
catch {interp delete a}
- interp create a
set l ""
+} -body {
+ interp create a
lappend l [interp hidden a]
a alias bar bar
- lappend l [interp aliases a]
- lappend l [interp hidden a]
+ lappend l [interp aliases a] [interp hidden a]
a hide bar
- lappend l [interp aliases a]
- lappend l [interp hidden a]
+ lappend l [interp aliases a] [interp hidden a]
a alias bar {}
- lappend l [interp aliases a]
- lappend l [interp hidden a]
+ lappend l [interp aliases a] [interp hidden a]
+} -cleanup {
interp delete a
- set l
-} {{} bar {} bar bar {} {}}
-test interp-23.2 {testing hiding vs aliases} {unixOrPc} {
+} -result {{} bar {} bar bar {} {}}
+test interp-23.2 {testing hiding vs aliases: safe interp} -setup {
catch {interp delete a}
- interp create a -safe
set l ""
+} -constraints {unixOrPc} -body {
+ interp create a -safe
lappend l [lsort [interp hidden a]]
a alias bar bar
- lappend l [lsort [interp aliases a]]
- lappend l [lsort [interp hidden a]]
+ lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
a hide bar
- lappend l [lsort [interp aliases a]]
- lappend l [lsort [interp hidden a]]
+ lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
a alias bar {}
- lappend l [lsort [interp aliases a]]
- lappend l [lsort [interp hidden a]]
+ lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
+} -cleanup {
interp delete a
- set l
-} {{cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload}}
+} -result [list $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} [lsort [concat $hidden_cmds bar]] {::tcl::mathfunc::max ::tcl::mathfunc::min clock} $hidden_cmds]
-test interp-24.1 {result resetting on error} {
+test interp-24.1 {result resetting on error} -setup {
catch {interp delete a}
+} -body {
interp create a
- proc foo args {error $args}
- interp alias a foo {} foo
- set l [interp eval a {
- set l {}
- lappend l [catch {foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {foo 3 4 5} msg]
- lappend l $msg
- set l
- }]
+ interp alias a foo {} apply {args {error $args}}
+ interp eval a {
+ lappend l [catch {foo 1 2 3} msg] $msg
+ lappend l [catch {foo 3 4 5} msg] $msg
+ }
+} -cleanup {
interp delete a
- rename foo {}
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.2 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.2 {result resetting on error} -setup {
catch {interp delete a}
+} -body {
interp create a -safe
- proc foo args {error $args}
- interp alias a foo {} foo
- set l [interp eval a {
- set l {}
- lappend l [catch {foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {foo 3 4 5} msg]
- lappend l $msg
- set l
- }]
+ interp alias a foo {} apply {args {error $args}}
+ interp eval a {
+ lappend l [catch {foo 1 2 3} msg] $msg
+ lappend l [catch {foo 3 4 5} msg] $msg
+ }
+} -cleanup {
interp delete a
- rename foo {}
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.3 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.3 {result resetting on error} -setup {
catch {interp delete a}
+} -body {
interp create a
interp create {a b}
interp eval a {
proc foo args {error $args}
}
interp alias {a b} foo a foo
- set l [interp eval {a b} {
- set l {}
- lappend l [catch {foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {foo 3 4 5} msg]
- lappend l $msg
- set l
- }]
+ interp eval {a b} {
+ lappend l [catch {foo 1 2 3} msg] $msg
+ lappend l [catch {foo 3 4 5} msg] $msg
+ }
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.4 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.4 {result resetting on error} -setup {
catch {interp delete a}
+} -body {
interp create a -safe
interp create {a b}
interp eval a {
proc foo args {error $args}
}
interp alias {a b} foo a foo
- set l [interp eval {a b} {
- set l {}
+ interp eval {a b} {
lappend l [catch {foo 1 2 3} msg]
lappend l $msg
lappend l [catch {foo 3 4 5} msg]
lappend l $msg
- set l
- }]
+ }
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.5 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.5 {result resetting on error} -setup {
catch {interp delete a}
catch {interp delete b}
+} -body {
interp create a
interp create b
interp eval a {
proc foo args {error $args}
}
interp alias b foo a foo
- set l [interp eval b {
- set l {}
- lappend l [catch {foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {foo 3 4 5} msg]
- lappend l $msg
- set l
- }]
+ interp eval b {
+ lappend l [catch {foo 1 2 3} msg] $msg
+ lappend l [catch {foo 3 4 5} msg] $msg
+ }
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.6 {result resetting on error} {
+ interp delete b
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.6 {result resetting on error} -setup {
catch {interp delete a}
catch {interp delete b}
+} -body {
interp create a -safe
interp create b -safe
interp eval a {
proc foo args {error $args}
}
interp alias b foo a foo
- set l [interp eval b {
- set l {}
- lappend l [catch {foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {foo 3 4 5} msg]
- lappend l $msg
- set l
- }]
+ interp eval b {
+ lappend l [catch {foo 1 2 3} msg] $msg
+ lappend l [catch {foo 3 4 5} msg] $msg
+ }
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.7 {result resetting on error} {
+ interp delete b
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.7 {result resetting on error} -setup {
catch {interp delete a}
+ set l {}
+} -body {
interp create a
interp eval a {
proc foo args {error $args}
}
- set l {}
- lappend l [catch {interp eval a foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {interp eval a foo 3 4 5} msg]
- lappend l $msg
+ lappend l [catch {interp eval a foo 1 2 3} msg] $msg
+ lappend l [catch {interp eval a foo 3 4 5} msg] $msg
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.8 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.8 {result resetting on error} -setup {
catch {interp delete a}
+ set l {}
+} -body {
interp create a -safe
interp eval a {
proc foo args {error $args}
}
- set l {}
- lappend l [catch {interp eval a foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {interp eval a foo 3 4 5} msg]
- lappend l $msg
+ lappend l [catch {interp eval a foo 1 2 3} msg] $msg
+ lappend l [catch {interp eval a foo 3 4 5} msg] $msg
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.9 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.9 {result resetting on error} -setup {
catch {interp delete a}
+ set l {}
+} -body {
interp create a
interp create {a b}
interp eval {a b} {
@@ -1954,16 +1937,15 @@ test interp-24.9 {result resetting on error} {
eval interp eval b foo $args
}
}
- set l {}
- lappend l [catch {interp eval a foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {interp eval a foo 3 4 5} msg]
- lappend l $msg
+ lappend l [catch {interp eval a foo 1 2 3} msg] $msg
+ lappend l [catch {interp eval a foo 3 4 5} msg] $msg
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.10 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.10 {result resetting on error} -setup {
catch {interp delete a}
+ set l {}
+} -body {
interp create a -safe
interp create {a b}
interp eval {a b} {
@@ -1974,16 +1956,14 @@ test interp-24.10 {result resetting on error} {
eval interp eval b foo $args
}
}
- set l {}
- lappend l [catch {interp eval a foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {interp eval a foo 3 4 5} msg]
- lappend l $msg
+ lappend l [catch {interp eval a foo 1 2 3} msg] $msg
+ lappend l [catch {interp eval a foo 3 4 5} msg] $msg
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.11 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.11 {result resetting on error} -setup {
catch {interp delete a}
+} -body {
interp create a
interp create {a b}
interp eval {a b} {
@@ -1991,20 +1971,17 @@ test interp-24.11 {result resetting on error} {
}
interp eval a {
proc foo args {
- set l {}
- lappend l [catch {eval interp eval b foo $args} msg]
- lappend l $msg
- lappend l [catch {eval interp eval b foo $args} msg]
- lappend l $msg
- set l
+ lappend l [catch {eval interp eval b foo $args} msg] $msg
+ lappend l [catch {eval interp eval b foo $args} msg] $msg
}
}
- set l [interp eval a foo 1 2 3]
+ interp eval a foo 1 2 3
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {1 2 3}}
-test interp-24.12 {result resetting on error} {
+} -result {1 {1 2 3} 1 {1 2 3}}
+test interp-24.12 {result resetting on error} -setup {
catch {interp delete a}
+} -body {
interp create a -safe
interp create {a b}
interp eval {a b} {
@@ -2012,27 +1989,22 @@ test interp-24.12 {result resetting on error} {
}
interp eval a {
proc foo args {
- set l {}
- lappend l [catch {eval interp eval b foo $args} msg]
- lappend l $msg
- lappend l [catch {eval interp eval b foo $args} msg]
- lappend l $msg
- set l
+ lappend l [catch {eval interp eval b foo $args} msg] $msg
+ lappend l [catch {eval interp eval b foo $args} msg] $msg
}
}
- set l [interp eval a foo 1 2 3]
+ interp eval a foo 1 2 3
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {1 2 3}}
+} -result {1 {1 2 3} 1 {1 2 3}}
-unset hidden_cmds
-
-test interp-25.1 {testing aliasing of string commands} {
+test interp-25.1 {testing aliasing of string commands} -setup {
catch {interp delete a}
+} -body {
interp create a
a alias exec foo ;# Relies on exec being a string command!
interp delete a
-} ""
+} -result ""
#
# Interps result transmission
@@ -2357,17 +2329,17 @@ test interp-28.1 {getting fooled by slave's namespace ?} -setup {
} -result {}
test interp-28.2 {master's nsName cache should not cross} -setup {
set i [interp create]
+ $i eval {proc filter lst {lsearch -all -inline -not $lst "::tcl"}}
} -body {
$i eval {
set x {namespace children ::}
set y [list namespace children ::]
- namespace delete {*}[{*}$y]
+ namespace delete {*}[filter [{*}$y]]
set j [interp create]
- $j eval {namespace delete {*}[namespace children ::]}
+ $j alias filter filter
+ $j eval {namespace delete {*}[filter [namespace children ::]]}
namespace eval foo {}
- set res [list [eval $x] [eval $y] [$j eval $x] [$j eval $y]]
- interp delete $j
- set res
+ list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]]
}
} -cleanup {
interp delete $i
@@ -3058,7 +3030,7 @@ test interp-31.1 {alias invocation scope} {
myNewSet a $value
return $a
}
- catch {unset a}
+ unset -nocomplain a
set result [testMyNewSet "ok"]
rename testMyNewSet {}
rename mySet {}
@@ -3526,6 +3498,13 @@ test interp-35.22 {interp time limits normalize milliseconds} -body {
} -cleanup {
interp delete $i
} -result {2 500}
+# Bug 3398794
+test interp-35.23 {interp command limits can't touch current interp} -body {
+ interp limit {} commands -value 10
+} -returnCodes error -result {limits on current interpreter inaccessible}
+test interp-35.24 {interp time limits can't touch current interp} -body {
+ interp limit {} time -seconds 2
+} -returnCodes error -result {limits on current interpreter inaccessible}
test interp-36.1 {interp bgerror syntax} -body {
interp bgerror
@@ -3580,7 +3559,7 @@ test interp-36.7 {SlaveBgerror sets error handler of slave [1999035]} -setup {
set result
} -cleanup {
variable result {}
- unset result
+ unset -nocomplain result
interp delete slave
} -result foo
@@ -3593,11 +3572,55 @@ test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup {
lappend result [interp eval a {expr min(5,2,3)*max(7,13,11)}]
lappend result [interp eval {a b} {expr min(5,2,3)*max(7,13,11)}]
} -cleanup {
- unset result
+ unset -nocomplain result
interp delete a
} -result {26 26}
+
+test interp-38.1 {interp debug one-way switch} -setup {
+ catch {interp delete a}
+ interp create a
+ interp debug a -frame 1
+} -body {
+ # TIP #3xx interp debug frame is a one-way switch
+ interp debug a -frame 0
+} -cleanup {
+ interp delete a
+} -result {1}
+test interp-38.2 {interp debug env var} -setup {
+ catch {interp delete a}
+ set ::env(TCL_INTERP_DEBUG_FRAME) 1
+ interp create a
+} -body {
+ interp debug a
+} -cleanup {
+ unset -nocomplain ::env(TCL_INTERP_DEBUG_FRAME)
+ interp delete a
+} -result {-frame 1}
+test interp-38.3 {interp debug wrong args} -body {
+ interp debug
+} -returnCodes {
+ error
+} -result {wrong # args: should be "interp debug path ?-frame ?bool??"}
+test interp-38.4 {interp debug basic setup} -body {
+ interp debug {}
+} -result {-frame 0}
+test interp-38.5 {interp debug basic setup} -body {
+ interp debug {} -f
+} -result {0}
+test interp-38.6 {interp debug basic setup} -body {
+ interp debug -frames
+} -returnCodes error -result {could not find interpreter "-frames"}
+test interp-38.7 {interp debug basic setup} -body {
+ interp debug {} -frames
+} -returnCodes error -result {bad debug option "-frames": must be -frame}
+test interp-38.8 {interp debug basic setup} -body {
+ interp debug {} -frame 0 bogus
+} -returnCodes {
+ error
+} -result {wrong # args: should be "interp debug path ?-frame ?bool??"}
# cleanup
+unset -nocomplain hidden_cmds
foreach i [interp slaves] {
interp delete $i
}
diff --git a/tests/io.test b/tests/io.test
index c69bff9..0688c14 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -12,13 +12,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: io.test,v 1.96 2010/02/07 08:03:11 dkf Exp $
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
return
}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
namespace eval ::tcl::test::io {
namespace import ::tcltest::*
@@ -39,7 +41,7 @@ testConstraint fcopy [llength [info commands fcopy]]
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
-testConstraint testthread [llength [info commands testthread]]
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
@@ -2088,6 +2090,8 @@ set path(pipe) [makeFile {} pipe]
set path(output) [makeFile {} output]
test io-27.6 {FlushChannel, async flushing, async close} \
{stdio asyncPipeClose openpipe} {
+ # 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)
file delete $path(output)
set f [open $path(pipe) w]
@@ -2647,6 +2651,8 @@ test io-29.30 {Tcl_WriteChars, crlf mode} {
file size $path(test1)
} 25
test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
+ # 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)
file delete $path(output)
set f [open $path(pipe) w]
@@ -2688,6 +2694,8 @@ test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
} ok
test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
{stdio asyncPipeClose openpipe} {
+ # 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)
file delete $path(output)
set f [open $path(pipe) w]
@@ -2738,6 +2746,26 @@ test io-29.33 {Tcl_Flush, implicit flush on exit} {exec} {
close $f
set r
} "hello\nbye\nstrange\n"
+set path(script2) [makeFile {} script2]
+test io-29.33b {TIP#398, no implicit flush of nonblocking on exit} {exec} {
+ set f [open $path(script) w]
+ puts $f {
+ fconfigure stdout -blocking 0
+ puts -nonewline stdout [string repeat A 655360]
+ flush stdout
+ }
+ close $f
+ set f [open $path(script2) w]
+ puts $f {after 2000}
+ close $f
+ set t1 [clock milliseconds]
+ set ff [open "|[list [interpreter] $path(script2)]" w]
+ catch {unset ::env(TCL_FLUSH_NONBLOCKING_ON_EXIT)}
+ exec [interpreter] $path(script) >@ $ff
+ set t2 [clock milliseconds]
+ close $ff
+ expr {($t2-$t1)/2000 ? $t2-$t1 : 0}
+} 0
test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} {
variable c 0
variable x running
@@ -3858,7 +3886,7 @@ test io-32.3 {Tcl_Read, negative byte count} {
set l [list [catch {read $f -1} msg] $msg]
close $f
set l
-} {1 {bad argument "-1": should be "nonewline"}}
+} {1 {expected non-negative integer but got "-1"}}
test io-32.4 {Tcl_Read, positive byte count} {
set f [open $path(longfile) r]
set x [read $f 1024]
@@ -5207,16 +5235,16 @@ test io-40.1 {POSIX open access modes: RDWR} {
} {zzy abzzy}
test io-40.2 {POSIX open access modes: CREAT} {unix} {
file delete $path(test3)
- set f [open $path(test3) {WRONLY CREAT} 0600]
+ set f [open $path(test3) {WRONLY CREAT} 0o600]
file stat $path(test3) stats
- set x [format "0%o" [expr $stats(mode)&0o777]]
+ set x [format "0o%o" [expr $stats(mode)&0o777]]
puts $f "line 1"
close $f
set f [open $path(test3) r]
lappend x [gets $f]
close $f
set x
-} {0600 {line 1}}
+} {0o600 {line 1}}
test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
# This test only works if your umask is 2, like ouster's.
file delete $path(test3)
@@ -7007,6 +7035,44 @@ test io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof}
removeFile foo
removeFile bar
} -result {1 sync/OK {CMD 0}}
+test io-53.8b {CopyData: async callback and -size 0} -setup {
+ # copy progress callback. errors out intentionally
+ proc ::cmd args {
+ lappend ::RES "CMD $args"
+ set ::forever has-been-reached
+ return
+ }
+ # Files we use for our channels
+ set foo [makeFile ashgdfashdgfasdhgfasdhgf foo]
+ set bar [makeFile {} bar]
+ # 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 {
+ set ::RES {}
+ # Run the copy. Should not invoke -command now.
+ fcopy $f $g -size 0 -command ::cmd
+ # Check that -command was not called synchronously
+ lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}]
+ # Now let the async part happen. Should capture the eof in cmd
+ # If not break the event loop via timer.
+ set token [after 1000 {
+ lappend ::RES {cmd/FAIL timeout}
+ set ::forever has-been-reached
+ }]
+ vwait ::forever
+ catch {after cancel $token}
+ # Report
+ set ::RES
+} -cleanup {
+ close $f
+ close $g
+ catch {unset ::RES}
+ catch {unset ::forever}
+ rename ::cmd {}
+ removeFile foo
+ removeFile bar
+} -result {sync/OK {CMD 0}}
test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
set out [makeFile {} out]
set err [makeFile {} err]
@@ -7399,7 +7465,7 @@ test io-59.1 {Thread reference of channels} {testmainthread testchannel} {
# More complicated tests (like that the reference changes as a
# channel is moved from thread to thread) can be done only in the
# extension which fully implements the moving of channels between
- # threads, i.e. 'Threads'. Or we have to extend [testthread] as well.
+ # threads, i.e. 'Threads'.
set f [open $path(longfile) r]
set result [testchannel mthread $f]
@@ -7491,25 +7557,7 @@ test io-70.0 {Cutting & Splicing channels} {testchannel} {
} {0 1 0}
-# Duplicate of code in "thread.test". Find a better way of doing this
-# without duplication. Maybe placement into a proc which transforms to
-# nop after the first call, and placement of its defintion in a
-# central location.
-
-if {[testConstraint testthread]} {
- testthread errorproc ThreadError
-
- proc ThreadError {id info} {
- global threadError
- set threadError $info
- }
-
- proc ThreadNullError {id info} {
- # ignore
- }
-}
-
-test io-70.1 {Transfer channel} {testchannel testthread} {
+test io-70.1 {Transfer channel} {testchannel thread} {
set f [makeFile {... dummy ...} cutsplice]
set c [open $f r]
@@ -7518,16 +7566,17 @@ test io-70.1 {Transfer channel} {testchannel testthread} {
testchannel cut $c
lappend res [catch {seek $c 0 start}]
- set tid [testthread create]
- testthread send $tid [list set c $c]
- lappend res [testthread send $tid {
+ set tid [thread::create -preserved]
+ thread::send $tid [list set c $c]
+ thread::send $tid {load {} Tcltest}
+ lappend res [thread::send $tid {
testchannel splice $c
set res [catch {seek $c 0 start}]
close $c
set res
}]
- tcltest::threadReap
+ thread::release $tid
removeFile cutsplice
set res
@@ -7742,7 +7791,7 @@ test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} -setup {
# ### ### ### ######### ######### #########
# cleanup
-foreach file [list fooBar longfile script output test1 pipe my_script \
+foreach file [list fooBar longfile script script2 output test1 pipe my_script \
test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
removeFile $file
}
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 920238c..03242be 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -12,18 +12,19 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: ioCmd.test,v 1.53 2010/08/03 20:06:47 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Custom constraints used in this file
testConstraint fcopy [llength [info commands fcopy]]
testConstraint testchannel [llength [info commands testchannel]]
-testConstraint testthread [llength [info commands testthread]]
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
#----------------------------------------------------------------------
@@ -35,7 +36,7 @@ test iocmd-1.2 {puts command} {
} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
test iocmd-1.3 {puts command} {
list [catch {puts froboz -nonewline kablooie} msg] $msg
-} {1 {bad argument "kablooie": should be "nonewline"}}
+} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
test iocmd-1.4 {puts command} {
list [catch {puts froboz hello} msg] $msg
} {1 {can not find channel named "froboz"}}
@@ -138,7 +139,7 @@ test iocmd-4.8 {read command with incorrect combination of arguments} {
} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} {TCL WRONGARGS}}
test iocmd-4.9 {read command} {
list [catch {read stdin foo} msg] $msg $::errorCode
-} {1 {bad argument "foo": should be "nonewline"} NONE}
+} {1 {expected non-negative integer but got "foo"} {TCL VALUE NUMBER}}
test iocmd-4.10 {read command} {
list [catch {read file107} msg] $msg $::errorCode
} {1 {can not find channel named "file107"} {TCL LOOKUP CHANNEL file107}}
@@ -156,7 +157,7 @@ test iocmd-4.12 {read command} -setup {
list [catch {read $f 12z} msg] $msg $::errorCode
} -cleanup {
close $f
-} -result {1 {expected integer but got "12z"} {TCL VALUE NUMBER}}
+} -result {1 {expected non-negative integer but got "12z"} {TCL VALUE NUMBER}}
test iocmd-5.1 {seek command} -returnCodes error -body {
seek
@@ -388,13 +389,13 @@ test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
set f [open $path(test4) w]
close $f
list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode
-} {1 {can't write input to command: standard input was redirected} NONE}
+} {1 {can't write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode
-} {1 {can't read output from command: standard output was redirected} NONE}
+} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
-} {1 {can't read output from command: standard output was redirected} NONE}
+} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.4 {I/O to command pipelines} unixOrPc {
list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode
} {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}}
@@ -1993,7 +1994,6 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
# response.
interp eval $idb [list set chan $chan]
- interp eval $idb [list set mid $tcltest::mainThread]
set res [interp eval $idb {
# wait a bit, give the main thread the time to start its event
# loop to wait for the response from B
@@ -2030,23 +2030,6 @@ test iocmd-32.2 {delete interp of reflected chan} {
## forwarding, and gaps due to tests not applicable to forwarding are
## left to keep this asociation.
-# Duplicate of code in "thread.test". Find a better way of doing this
-# without duplication. Maybe placement into a proc which transforms to
-# nop after the first call, and placement of its defintion in a
-# central location.
-
-if {[testConstraint testthread]} {
- testthread errorproc ThreadError
-
- proc ThreadError {id info} {
- global threadError
- set threadError $info
- }
- proc ThreadNullError {id info} {
- # ignore
- }
-}
-
# ### ### ### ######### ######### #########
## Helper command. Runs a script in a separate thread and returns the
## result. A channel is transfered into the thread as well, and list of
@@ -2055,7 +2038,8 @@ if {[testConstraint testthread]} {
proc inthread {chan script args} {
# Test thread.
- set tid [testthread create]
+ set tid [thread::create -preserved]
+ thread::send $tid {load {} Tcltest}
# Init thread configuration.
# - Listed variables
@@ -2064,22 +2048,23 @@ proc inthread {chan script args} {
foreach v $args {
upvar 1 $v x
- testthread send $tid [list set $v $x]
+ thread::send $tid [list set $v $x]
+
}
- testthread send $tid [list set mid $tcltest::mainThread]
- testthread send $tid {
+ thread::send $tid [list set mid [thread::id]]
+ thread::send $tid {
proc note {item} {global notes; lappend notes $item}
proc notes {} {global notes; return $notes}
proc noteOpts opts {global notes; lappend notes [dict merge {
-code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
} $opts]}
}
- testthread send $tid [list proc s {} [list uplevel 1 $script]]; # (*)
+ thread::send $tid [list proc s {} [list uplevel 1 $script]]; # (*)
# Transfer channel (cut/splice aka detach/attach)
testchannel cut $chan
- testthread send $tid [list testchannel splice $chan]
+ thread::send $tid [list testchannel splice $chan]
# Run test script, also run local event loop!
# The local event loop waits for the result to come back.
@@ -2087,15 +2072,15 @@ proc inthread {chan script args} {
# operations.
set ::tres ""
- testthread send -async $tid {
+ thread::send -async $tid {
after 500
catch {s} res; # This runs the script, 's' was defined at (*)
- testthread send -async $mid [list set ::tres $res]
+ thread::send -async $mid [list set ::tres $res]
}
vwait ::tres
# Remove test thread, and return the captured result.
- tcltest::threadReap
+ thread::release $tid
return $::tres
}
@@ -2116,7 +2101,7 @@ test iocmd.tf-22.2 {chan finalize, for close} -match glob -body {
note [info command foo]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo}
+} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo}
test iocmd.tf-22.3 {chan finalize, for close, error, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -code error 5}
@@ -2129,7 +2114,7 @@ test iocmd.tf-22.3 {chan finalize, for close, error, close error} -match glob -b
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}}
+} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}}
test iocmd.tf-22.4 {chan finalize, for close, error, close errror} -match glob -body {
set res {}
proc foo {args} {track; oninit; error FOO}
@@ -2140,7 +2125,7 @@ test iocmd.tf-22.4 {chan finalize, for close, error, close errror} -match glob -
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO}
+} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO}
test iocmd.tf-22.5 {chan finalize, for close, arbitrary result} -match glob -body {
set res {}
proc foo {args} {track; oninit; return SOMETHING}
@@ -2151,7 +2136,7 @@ test iocmd.tf-22.5 {chan finalize, for close, arbitrary result} -match glob -bod
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}}
+} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}}
test iocmd.tf-22.6 {chan finalize, for close, break, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -code 3}
@@ -2163,7 +2148,7 @@ test iocmd.tf-22.6 {chan finalize, for close, break, close error} -match glob -b
rename foo {}
set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-22.7 {chan finalize, for close, continue, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -code 4}
@@ -2175,7 +2160,7 @@ test iocmd.tf-22.7 {chan finalize, for close, continue, close error} -match glob
rename foo {}
set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-22.8 {chan finalize, for close, custom code, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -code 777 BANG}
@@ -2187,7 +2172,7 @@ test iocmd.tf-22.8 {chan finalize, for close, custom code, close error} -match g
rename foo {}
set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
@@ -2199,7 +2184,7 @@ test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match
rename foo {}
set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
# --- === *** ###########################
# method read
@@ -2218,7 +2203,7 @@ test iocmd.tf-23.1 {chan read, regular data return} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
+} -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body {
set res {}
proc foo {args} {
@@ -2233,7 +2218,7 @@ test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{read rc* 4096} 1 {read delivered more than requested}}
+} -constraints {testchannel thread} -result {{read rc* 4096} 1 {read delivered more than requested}}
test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body {
set res {}
proc foo {args} {
@@ -2247,7 +2232,7 @@ test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {1 {channel "rc*" wasn't opened for reading}}
+} -constraints {testchannel thread} -result {1 {channel "rc*" wasn't opened for reading}}
test iocmd.tf-23.4 {chan read, error return} -match glob -body {
set res {}
proc foo {args} {
@@ -2263,7 +2248,7 @@ test iocmd.tf-23.4 {chan read, error return} -match glob -body {
rename foo {}
set res
} -result {{read rc* 4096} 1 BOOM!} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-23.5 {chan read, break return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -2279,7 +2264,7 @@ test iocmd.tf-23.5 {chan read, break return is error} -match glob -body {
rename foo {}
set res
} -result {{read rc* 4096} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -2295,7 +2280,7 @@ test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body {
rename foo {}
set res
} -result {{read rc* 4096} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -2311,7 +2296,7 @@ test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body {
rename foo {}
set res
} -result {{read rc* 4096} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
set res {}
proc foo {args} {
@@ -2327,7 +2312,7 @@ test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
rename foo {}
set res
} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup {
set res {}
proc foo {args} {
@@ -2347,7 +2332,7 @@ test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup {
rename foo {}
unset res
} -result {{read rc* 4096} {} 1} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
set res {}
proc foo {args} {
@@ -2367,7 +2352,7 @@ test iocmd.tf-23.10 {chan read, EAGAIN means no data, yet no eof either} -match
rename foo {}
unset res
} -result {{read rc* 4096} {} 0} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
# --- === *** ###########################
# method write
@@ -2387,7 +2372,7 @@ test iocmd.tf-24.1 {chan write, regular write} -match glob -body {
} c
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{write rc* snarf} 5}
+} -constraints {testchannel thread} -result {{write rc* snarf} 5}
test iocmd.tf-24.2 {chan write, ack partial writes} -match glob -body {
set res {}
proc foo {args} {
@@ -2404,7 +2389,7 @@ test iocmd.tf-24.2 {chan write, ack partial writes} -match glob -body {
} c
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8}
+} -constraints {testchannel thread} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8}
test iocmd.tf-24.3 {chan write, failed write} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; note -1; return -1}
@@ -2415,7 +2400,7 @@ test iocmd.tf-24.3 {chan write, failed write} -match glob -body {
} c
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{write rc* snarfsnarfsnarf} -1}
+} -constraints {testchannel thread} -result {{write rc* snarfsnarfsnarf} -1}
test iocmd.tf-24.4 {chan write, non-writable channel} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
@@ -2428,7 +2413,7 @@ test iocmd.tf-24.4 {chan write, non-writable channel} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {1 {channel "rc*" wasn't opened for writing}}
+} -constraints {testchannel thread} -result {1 {channel "rc*" wasn't opened for writing}}
test iocmd.tf-24.5 {chan write, bad result, more written than data} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return 10000}
@@ -2441,7 +2426,7 @@ test iocmd.tf-24.5 {chan write, bad result, more written than data} -match glob
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{write rc* snarf} 1 {write wrote more than requested}}
+} -constraints {testchannel thread} -result {{write rc* snarf} 1 {write wrote more than requested}}
test iocmd.tf-24.6 {chan write, zero writes} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return 0}
@@ -2454,7 +2439,7 @@ test iocmd.tf-24.6 {chan write, zero writes} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{write rc* snarf} 1 {write wrote more than requested}}
+} -constraints {testchannel thread} -result {{write rc* snarf} 1 {write wrote more than requested}}
test iocmd.tf-24.7 {chan write, failed write, error return} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code error BOOM!}
@@ -2468,7 +2453,7 @@ test iocmd.tf-24.7 {chan write, failed write, error return} -match glob -body {
rename foo {}
set res
} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-24.8 {chan write, failed write, error return} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; error BOOM!}
@@ -2482,7 +2467,7 @@ test iocmd.tf-24.8 {chan write, failed write, error return} -match glob -body {
rename foo {}
set res
} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-24.9 {chan write, failed write, break return is error} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code break BOOM!}
@@ -2496,7 +2481,7 @@ test iocmd.tf-24.9 {chan write, failed write, break return is error} -match glob
rename foo {}
set res
} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-24.10 {chan write, failed write, continue return is error} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code continue BOOM!}
@@ -2510,7 +2495,7 @@ test iocmd.tf-24.10 {chan write, failed write, continue return is error} -match
rename foo {}
set res
} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-24.11 {chan write, failed write, custom return is error} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!}
@@ -2524,7 +2509,7 @@ test iocmd.tf-24.11 {chan write, failed write, custom return is error} -match gl
rename foo {}
set res
} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-24.12 {chan write, failed write, non-numeric return is error} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return BANG}
@@ -2538,7 +2523,7 @@ test iocmd.tf-24.12 {chan write, failed write, non-numeric return is error} -mat
rename foo {}
set res
} -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!}
@@ -2553,7 +2538,7 @@ test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -bo
rename foo {}
set res
} -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-24.14 {chan write, no EAGAIN means that writing is allowed at this time, bug 2936225} -match glob -setup {
set res {}
proc foo {args} {
@@ -2572,7 +2557,7 @@ test iocmd.tf-24.14 {chan write, no EAGAIN means that writing is allowed at this
rename foo {}
unset res
} -result {{write rc* ABC} {}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-24.15 {chan write, EAGAIN means that writing is not allowed at this time, bug 2936225} -match glob -setup {
set res {}
proc foo {args} {
@@ -2592,10 +2577,161 @@ test iocmd.tf-24.15 {chan write, EAGAIN means that writing is not allowed at thi
} c]
set res
} -cleanup {
+ proc foo {args} {onfinal; set ::done-24.15 1; return 3}
+ after 1000 {set ::done-24.15 2}
+ vwait done-24.15
rename foo {}
unset res
} -result {{write rc* ABC} {watch rc* write} {}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
+
+test iocmd.tf-24.16 {chan write, note the background flush setup by close due to the EAGAIN leaving data in buffers.} -match glob -setup {
+ set res {}
+ proc foo {args} {
+ oninit; onfinal; track
+ # Note: The EAGAIN signals that the channel cannot accept
+ # write requests right now, this in turn causes the IO core to
+ # request the generation of writable events (see expected
+ # result below, and compare to case 24.14 above).
+ error EAGAIN
+ }
+ set c [chan create {r w} foo]
+} -body {
+ notes [inthread $c {
+ note [puts -nonewline $c ABC ; flush $c]
+ close $c
+ notes
+ } c]
+ # Replace handler with all-tracking one which doesn't error.
+ # This will tell us if a write-due-flush is there.
+ proc foo {args} { onfinal; note BG ; track ; set ::endbody-24.16 1}
+ # Flush (sic!) the event-queue to capture the write from a
+ # BG-flush.
+ after 1000 {set ::endbody-24.16 2}
+ vwait endbody-24.16
+ set res
+} -cleanup {
+ proc foo {args} {onfinal; set ::done-24.16 1; return 3}
+ after 1000 {set ::done-24.16 2}
+ vwait done-24.16
+ rename foo {}
+ unset res
+} -result {{write rc* ABC} {watch rc* write} {} BG {write rc* ABC}} \
+ -constraints {testchannel thread}
+
+test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
+ -constraints {testchannel thread} -setup {
+ # This test exposes how the execution of postevent in the handler thread causes
+ # a crash if we are not properly injecting the events into the owning thread instead.
+ # With the injection the test will simply complete without crash.
+
+ set beat 10000
+ set drive 999
+ set data ...---...
+
+ proc LOG {text} {
+ #puts stderr "[thread::id]: $text"
+ return
+ }
+
+ proc POST {hi} {
+ LOG "-> [info level 0]"
+ chan postevent $hi read
+ LOG "<- [info level 0]"
+
+ set ::timer [after $::drive [info level 0]]
+ return
+ }
+
+ proc HANDLER {op ch args} {
+ lappend ::res [lrange [info level 0] 1 end]
+ LOG "-> [info level 0]"
+ set ret {}
+ switch -glob -- $op {
+ init* {set ret {initialize finalize watch read}}
+ watch {
+ set l [lindex $args 0]
+ if {[llength $l]} {
+ set ::timer [after $::drive [list POST $ch]]
+ } else {
+ after cancel $::timer
+ }
+ }
+ finalize {
+ catch { after cancel $::timer }
+ after 500 {set ::forever now}
+ }
+ read {
+ set ret $::data
+ set ::data {} ; # Next is EOF.
+ }
+ }
+ LOG "<- [info level 0] : $ret"
+ return $ret
+ }
+} -body {
+ LOG BEGIN
+ set ch [chan create {read} HANDLER]
+
+ set tid [thread::create {
+ proc LOG {text} {
+ #puts stderr "\t\t\t\t\t\t[thread::id]: $text"
+ return
+ }
+ LOG THREAD-STARTED
+ load {} Tcltest
+ proc bgerror s {
+ LOG BGERROR:$s
+ }
+ vwait forever
+ LOG THREAD-DONE
+ }]
+
+ testchannel cut $ch
+ thread::send $tid [list set thech $ch]
+ thread::send $tid [list set beat $beat]
+ thread::send -async $tid {
+ LOG SPLICE-BEG
+ testchannel splice $thech
+ LOG SPLICE-END
+ proc PROCESS {ch} {
+ LOG "-> [info level 0]"
+ if {[eof $ch]} {
+ close $ch
+ set ::done 1
+ set c <<EOF>>
+ } else {
+ set c [read $ch 1]
+ }
+ LOG "GOTCHAR: $c"
+ LOG "<- [info level 0]"
+ }
+ LOG THREAD-FILEEVENT
+ fconfigure $thech -translation binary -blocking 0
+ fileevent $thech readable [list PROCESS $thech]
+ LOG THREAD-NOEVENT-LOOP
+ set done 0
+ while {!$done} {
+ after $beat
+ LOG THREAD-HEARTBEAT
+ update
+ }
+ LOG THREAD-LOOP-DONE
+ thread::exit
+ }
+
+ LOG MAIN_WAITING
+ vwait forever
+ LOG MAIN_DONE
+
+ set res
+} -cleanup {
+ rename LOG {}
+ rename POST {}
+ rename HANDLER {}
+ unset beat drive data forever res tid ch
+} -match glob \
+ -result {{initialize rc* read} {watch rc* read} {read rc* 4096} {watch rc* {}} {watch rc* read} {read rc* 4096} {watch rc* {}} {finalize rc*}}
# --- === *** ###########################
# method cgetall
@@ -2611,7 +2747,7 @@ test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} \
+} -constraints {testchannel thread} \
-result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body {
set res {}
@@ -2624,7 +2760,7 @@ test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} \
+} -constraints {testchannel thread} \
-result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body {
set res {}
@@ -2640,7 +2776,7 @@ test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} \
+} -constraints {testchannel thread} \
-result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}}
test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
set res {}
@@ -2657,7 +2793,7 @@ test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length}
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}}
+} -constraints {testchannel thread} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}}
test iocmd.tf-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body {
set res {}
proc foo {args} {
@@ -2673,7 +2809,7 @@ test iocmd.tf-25.5 {chan configure, cgetall, bad result, not a list} -match glob
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{cgetall rc*} 1 {unmatched open brace in list}}
+} -constraints {testchannel thread} -result {{cgetall rc*} 1 {unmatched open brace in list}}
test iocmd.tf-25.6 {chan configure, cgetall, error return} -match glob -body {
set res {}
proc foo {args} {
@@ -2689,7 +2825,7 @@ test iocmd.tf-25.6 {chan configure, cgetall, error return} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{cgetall rc*} 1 BOOM!}
+} -constraints {testchannel thread} -result {{cgetall rc*} 1 BOOM!}
test iocmd.tf-25.7 {chan configure, cgetall, break return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -2706,7 +2842,7 @@ test iocmd.tf-25.7 {chan configure, cgetall, break return is error} -match glob
rename foo {}
set res
} -result {{cgetall rc*} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-25.8 {chan configure, cgetall, continue return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -2723,7 +2859,7 @@ test iocmd.tf-25.8 {chan configure, cgetall, continue return is error} -match gl
rename foo {}
set res
} -result {{cgetall rc*} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-25.9 {chan configure, cgetall, custom return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -2740,7 +2876,7 @@ test iocmd.tf-25.9 {chan configure, cgetall, custom return is error} -match glob
rename foo {}
set res
} -result {{cgetall rc*} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
set res {}
proc foo {args} {
@@ -2758,7 +2894,7 @@ test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -bod
rename foo {}
set res
} -result {{cgetall rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cgetall"*}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
# --- === *** ###########################
# method configure
@@ -2776,7 +2912,7 @@ test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{}}
+} -constraints {testchannel thread} -result {{}}
test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body {
set res {}
proc foo {args} {
@@ -2792,7 +2928,7 @@ test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{configure rc* -rc-foo bar} 1 BOOM!}
+} -constraints {testchannel thread} -result {{configure rc* -rc-foo bar} 1 BOOM!}
test iocmd.tf-26.3 {chan configure, set option, ok return} -match glob -body {
set res {}
proc foo {args} {oninit configure; onfinal; track; return}
@@ -2804,7 +2940,7 @@ test iocmd.tf-26.3 {chan configure, set option, ok return} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{configure rc* -rc-foo bar} {}}
+} -constraints {testchannel thread} -result {{configure rc* -rc-foo bar} {}}
test iocmd.tf-26.4 {chan configure, set option, break return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -2821,7 +2957,7 @@ test iocmd.tf-26.4 {chan configure, set option, break return is error} -match gl
rename foo {}
set res
} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-26.5 {chan configure, set option, continue return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -2838,7 +2974,7 @@ test iocmd.tf-26.5 {chan configure, set option, continue return is error} -match
rename foo {}
set res
} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-26.6 {chan configure, set option, custom return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -2855,7 +2991,7 @@ test iocmd.tf-26.6 {chan configure, set option, custom return is error} -match g
rename foo {}
set res
} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -body {
set res {}
proc foo {args} {
@@ -2873,7 +3009,7 @@ test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -b
rename foo {}
set res
} -result {{configure rc* -rc-foo bar} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "configure"*}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
# --- === *** ###########################
# method cget
@@ -2889,7 +3025,7 @@ test iocmd.tf-27.1 {chan configure, get option, ok return} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{cget rc* -rc-foo} foo}
+} -constraints {testchannel thread} -result {{cget rc* -rc-foo} foo}
test iocmd.tf-27.2 {chan configure, get option, error return} -match glob -body {
set res {}
proc foo {args} {
@@ -2905,7 +3041,7 @@ test iocmd.tf-27.2 {chan configure, get option, error return} -match glob -body
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{cget rc* -rc-foo} 1 BOOM!}
+} -constraints {testchannel thread} -result {{cget rc* -rc-foo} 1 BOOM!}
test iocmd.tf-27.3 {chan configure, get option, break return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -2922,7 +3058,7 @@ test iocmd.tf-27.3 {chan configure, get option, break return is error} -match gl
rename foo {}
set res
} -result {{cget rc* -rc-foo} 1 BOOM!} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-27.4 {chan configure, get option, continue return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -2939,7 +3075,7 @@ test iocmd.tf-27.4 {chan configure, get option, continue return is error} -match
rename foo {}
set res
} -result {{cget rc* -rc-foo} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-27.5 {chan configure, get option, custom return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -2956,7 +3092,7 @@ test iocmd.tf-27.5 {chan configure, get option, custom return is error} -match g
rename foo {}
set res
} -result {{cget rc* -rc-foo} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -body {
set res {}
proc foo {args} {
@@ -2974,7 +3110,7 @@ test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -b
rename foo {}
set res
} -result {{cget rc* -rc-foo} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cget"*}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
# --- === *** ###########################
# method seek
@@ -2991,7 +3127,7 @@ test iocmd.tf-28.1 {chan tell, not supported by handler} -match glob -body {
rename foo {}
set res
} -result {-1} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.2 {chan tell, error return} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
@@ -3005,7 +3141,7 @@ test iocmd.tf-28.2 {chan tell, error return} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 current} 1 BOOM!} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.3 {chan tell, break return is error} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
@@ -3019,7 +3155,7 @@ test iocmd.tf-28.3 {chan tell, break return is error} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 current} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.4 {chan tell, continue return is error} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
@@ -3033,7 +3169,7 @@ test iocmd.tf-28.4 {chan tell, continue return is error} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 current} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.5 {chan tell, custom return is error} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!}
@@ -3047,7 +3183,7 @@ test iocmd.tf-28.5 {chan tell, custom return is error} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 current} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.6 {chan tell, level is ignored} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG}
@@ -3062,7 +3198,7 @@ test iocmd.tf-28.6 {chan tell, level is ignored} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 current} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.7 {chan tell, regular return} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return 88}
@@ -3075,7 +3211,7 @@ test iocmd.tf-28.7 {chan tell, regular return} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 current} 88} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.8 {chan tell, negative return} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -1}
@@ -3089,7 +3225,7 @@ test iocmd.tf-28.8 {chan tell, negative return} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 current} 1 {Tried to seek before origin}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.9 {chan tell, string return} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return BOGUS}
@@ -3103,7 +3239,7 @@ test iocmd.tf-28.9 {chan tell, string return} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.10 {chan seek, not supported by handler} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
@@ -3117,7 +3253,7 @@ test iocmd.tf-28.10 {chan seek, not supported by handler} -match glob -body {
rename foo {}
set res
} -result {1 {error during seek on "rc*": invalid argument}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.11 {chan seek, error return} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
@@ -3131,7 +3267,7 @@ test iocmd.tf-28.11 {chan seek, error return} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 start} 1 BOOM!} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.12 {chan seek, break return is error} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
@@ -3145,7 +3281,7 @@ test iocmd.tf-28.12 {chan seek, break return is error} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 start} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.13 {chan seek, continue return is error} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
@@ -3159,7 +3295,7 @@ test iocmd.tf-28.13 {chan seek, continue return is error} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 start} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.14 {chan seek, custom return is error} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!}
@@ -3173,7 +3309,7 @@ test iocmd.tf-28.14 {chan seek, custom return is error} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 start} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.15 {chan seek, level is ignored} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG}
@@ -3188,7 +3324,7 @@ test iocmd.tf-28.15 {chan seek, level is ignored} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 start} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.16 {chan seek, bogus return, negative location} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -45}
@@ -3202,7 +3338,7 @@ test iocmd.tf-28.16 {chan seek, bogus return, negative location} -match glob -bo
rename foo {}
set res
} -result {{seek rc* 0 start} 1 {Tried to seek before origin}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.17 {chan seek, bogus return, string return} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return BOGUS}
@@ -3216,7 +3352,7 @@ test iocmd.tf-28.17 {chan seek, bogus return, string return} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-28.18 {chan seek, ok result} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return 23}
@@ -3229,7 +3365,7 @@ test iocmd.tf-28.18 {chan seek, ok result} -match glob -body {
rename foo {}
set res
} -result {{seek rc* 0 current} {}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
foreach {testname code} {
iocmd.tf-28.19.0 start
iocmd.tf-28.19.1 current
@@ -3247,7 +3383,7 @@ foreach {testname code} {
rename foo {}
set res
} -result [list [list seek rc* 0 $code] {}] \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
}
# --- === *** ###########################
@@ -3265,7 +3401,7 @@ test iocmd.tf-29.1 {chan blocking, no handler support} -match glob -body {
rename foo {}
set res
} -result {1} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-29.2 {chan blocking, no handler support} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
@@ -3279,7 +3415,7 @@ test iocmd.tf-29.2 {chan blocking, no handler support} -match glob -body {
rename foo {}
set res
} -result {{} 0} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-29.3 {chan blocking, retrieval, handler support} -match glob -body {
set res {}
proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return}
@@ -3292,7 +3428,7 @@ test iocmd.tf-29.3 {chan blocking, retrieval, handler support} -match glob -body
rename foo {}
set res
} -result {1} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-29.4 {chan blocking, resetting, handler support} -match glob -body {
set res {}
proc foo {args} {oninit blocking; onfinal; track; return}
@@ -3306,7 +3442,7 @@ test iocmd.tf-29.4 {chan blocking, resetting, handler support} -match glob -body
rename foo {}
set res
} -result {{blocking rc* 0} {} 0} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-29.5 {chan blocking, setting, handler support} -match glob -body {
set res {}
proc foo {args} {oninit blocking; onfinal; track; return}
@@ -3320,7 +3456,7 @@ test iocmd.tf-29.5 {chan blocking, setting, handler support} -match glob -body {
rename foo {}
set res
} -result {{blocking rc* 1} {} 1} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-29.6 {chan blocking, error return} -match glob -body {
set res {}
proc foo {args} {oninit blocking; onfinal; track; error BOOM!}
@@ -3335,7 +3471,7 @@ test iocmd.tf-29.6 {chan blocking, error return} -match glob -body {
rename foo {}
set res
} -result {{blocking rc* 0} 1 BOOM!} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-29.7 {chan blocking, break return is error} -match glob -body {
set res {}
proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!}
@@ -3349,7 +3485,7 @@ test iocmd.tf-29.7 {chan blocking, break return is error} -match glob -body {
rename foo {}
set res
} -result {{blocking rc* 0} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-29.8 {chan blocking, continue return is error} -match glob -body {
set res {}
proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!}
@@ -3363,7 +3499,7 @@ test iocmd.tf-29.8 {chan blocking, continue return is error} -match glob -body {
rename foo {}
set res
} -result {{blocking rc* 0} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-29.9 {chan blocking, custom return is error} -match glob -body {
set res {}
proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!}
@@ -3377,7 +3513,7 @@ test iocmd.tf-29.9 {chan blocking, custom return is error} -match glob -body {
rename foo {}
set res
} -result {{blocking rc* 0} 1 *bad code*} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-29.10 {chan blocking, level is ignored} -match glob -body {
set res {}
proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG}
@@ -3392,7 +3528,7 @@ test iocmd.tf-29.10 {chan blocking, level is ignored} -match glob -body {
rename foo {}
set res
} -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
test iocmd.tf-29.11 {chan blocking, regular return ok, value ignored} -match glob -body {
set res {}
proc foo {args} {oninit blocking; onfinal; track; return BOGUS}
@@ -3406,7 +3542,7 @@ test iocmd.tf-29.11 {chan blocking, regular return ok, value ignored} -match glo
rename foo {}
set res
} -result {{blocking rc* 0} 0 {}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
# --- === *** ###########################
# method watch
@@ -3422,7 +3558,7 @@ test iocmd.tf-30.1 {chan watch, read interest, some return} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{watch rc* read} {watch rc* {}} {}}
+} -constraints {testchannel thread} -result {{watch rc* read} {watch rc* {}} {}}
test iocmd.tf-30.2 {chan watch, write interest, error return} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED}
@@ -3435,7 +3571,7 @@ test iocmd.tf-30.2 {chan watch, write interest, error return} -match glob -body
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} -result {{watch rc* write} {watch rc* {}} {} {}}
+} -constraints {testchannel thread} -result {{watch rc* write} {watch rc* {}} {} {}}
test iocmd.tf-30.3 {chan watch, accumulated interests} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return}
@@ -3450,7 +3586,7 @@ test iocmd.tf-30.3 {chan watch, accumulated interests} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} \
+} -constraints {testchannel thread} \
-result {{watch rc* write} {watch rc* {read write}} {watch rc* read} {watch rc* {}} {} {} {} {}}
test iocmd.tf-30.4 {chan watch, unchanged interest not forwarded} -match glob -body {
set res {}
@@ -3465,7 +3601,7 @@ test iocmd.tf-30.4 {chan watch, unchanged interest not forwarded} -match glob -b
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} \
+} -constraints {testchannel thread} \
-result {{watch rc* write} {watch rc* {read write}} {watch rc* write} {watch rc* {}} {} {} {}}
# --- === *** ###########################
@@ -3485,7 +3621,7 @@ test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel testthread} \
+} -constraints {testchannel thread} \
-result {{can not find reflected channel named "rc*"}}
# --- === *** ###########################
@@ -3496,12 +3632,15 @@ test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body {
test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body {
#puts <<$tcltest::mainThread>>main
- set tida [testthread create];#puts <<$tida>>
- set tidb [testthread create];#puts <<$tidb>>
+ set tida [thread::create -preserved];#puts <<$tida>>
+ thread::send $tida {load {} Tcltest}
+
+ set tidb [thread::create -preserved];#puts <<$tidb>>
+ thread::send $tidb {load {} Tcltest}
# Set up channel in thread
- testthread send $tida $helperscript
- set chan [testthread send $tida {
+ thread::send $tida $helperscript
+ set chan [thread::send $tida {
proc foo {args} {oninit seek; onfinal; track; return}
set chan [chan create {r w} foo]
fconfigure $chan -buffering none
@@ -3509,67 +3648,82 @@ test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body {
}]
# Move channel to 2nd thread.
- testthread send $tida [list testchannel cut $chan]
- testthread send $tidb [list testchannel splice $chan]
+ thread::send $tida [list testchannel cut $chan]
+ thread::send $tidb [list testchannel splice $chan]
# Kill origin thread, then access channel from 2nd thread.
- testthread send -async $tida {testthread exit}
- after 100
+ thread::release $tida
set res {}
- lappend res [catch {testthread send $tidb [list puts $chan shoo]} msg] $msg
+ lappend res [catch {thread::send $tidb [list puts $chan shoo]} msg] $msg
- lappend res [catch {testthread send $tidb [list tell $chan]} msg] $msg
- lappend res [catch {testthread send $tidb [list seek $chan 1]} msg] $msg
- lappend res [catch {testthread send $tidb [list gets $chan]} msg] $msg
- lappend res [catch {testthread send $tidb [list close $chan]} msg] $msg
- tcltest::threadReap
+ lappend res [catch {thread::send $tidb [list tell $chan]} msg] $msg
+ lappend res [catch {thread::send $tidb [list seek $chan 1]} msg] $msg
+ lappend res [catch {thread::send $tidb [list gets $chan]} msg] $msg
+ lappend res [catch {thread::send $tidb [list close $chan]} msg] $msg
+ thread::release $tidb
set res
-} -constraints {testchannel testthread} \
+} -constraints {testchannel thread} \
-result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
+
+# The test iocmd.tf-32.1 unavoidably exhibits a memory leak. We are testing
+# the ability of the reflected channel system to react to the situation where
+# the thread in which the driver routines runs exits during driver operations.
+# In this case, thread exit handlers signal back to the owner thread so that the
+# channel operation does not hang. There's no way to test this without actually
+# exiting a thread in mid-operation, and that action is unavoidably leaky (which
+# is why [thread::exit] is advised against).
+#
+# Use constraints to skip this test while valgrinding so this expected leak
+# doesn't prevent a finding of "leak-free".
+#
+testConstraint notValgrind [expr {![testConstraint valgrind]}]
test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body {
#puts <<$tcltest::mainThread>>main
- set tida [testthread create];#puts <<$tida>>
- set tidb [testthread create];#puts <<$tidb>>
+ set tida [thread::create -preserved];#puts <<$tida>>
+ thread::send $tida {load {} Tcltest}
+ set tidb [thread::create -preserved];#puts <<$tidb>>
+ thread::send $tidb {load {} Tcltest}
# Set up channel in thread
- set chan [testthread send $tida $helperscript]
- set chan [testthread send $tida {
+ thread::send $tida $helperscript
+ set chan [thread::send $tida {
proc foo {args} {
oninit; onfinal; track;
# destroy thread during channel access
- testthread exit
- return}
+ thread::exit
+ }
set chan [chan create {r w} foo]
fconfigure $chan -buffering none
set chan
}]
# Move channel to 2nd thread.
- testthread send $tida [list testchannel cut $chan]
- testthread send $tidb [list testchannel splice $chan]
+ thread::send $tida [list testchannel cut $chan]
+ thread::send $tidb [list testchannel splice $chan]
# Run access from thread B, wait for response from A (A is not
# using event loop at this point, so the event pile up in the
# queue.
- testthread send $tidb [list set chan $chan]
- testthread send $tidb [list set mid $tcltest::mainThread]
- testthread send -async $tidb {
+ thread::send $tidb [list set chan $chan]
+ thread::send $tidb [list set mid [thread::id]]
+ thread::send -async $tidb {
# wait a bit, give the main thread the time to start its event
# loop to wait for the response from B
after 2000
catch { puts $chan shoo } res
- testthread send -async $mid [list set ::res $res]
+ thread::send -async $mid [list set ::res $res]
}
vwait ::res
- tcltest::threadReap
+ catch {thread::release $tida}
+ thread::release $tidb
set res
-} -constraints {testchannel testthread} \
+} -constraints {testchannel thread notValgrind} \
-result {Owner lost}
# ### ### ### ######### ######### #########
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index 8932874..5a8874c 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -10,29 +10,30 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: ioTrans.test,v 1.9 2010/08/04 16:49:02 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Custom constraints used in this file
-testConstraint testchannel [llength [info commands testchannel]]
-testConstraint testthread [llength [info commands testthread]]
+testConstraint testchannel [llength [info commands testchannel]]
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
# testchannel cut|splice Both needed to test the reflection in threads.
-# testthread send
+# thread::send
#----------------------------------------------------------------------
# ### ### ### ######### ######### #########
## Testing the reflected transformation.
-# Helper commands to record the arguments to handler methods. Stored
-# in a script so that the tests needing this code do not need their
-# own copy but can access this variable.
+# Helper commands to record the arguments to handler methods. Stored in a
+# script so that the tests needing this code do not need their own copy but
+# can access this variable.
set helperscript {
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -40,69 +41,61 @@ set helperscript {
namespace import -force ::tcltest::*
}
- proc note {item} {global res; lappend res $item; return}
- #proc note {item} {global res; lappend res $item; puts $item ; flush stdout ; return}
- proc track {} {upvar args item; note $item; return}
- proc notes {items} {foreach i $items {note $i}}
-
- # Use to prevent *'s in pattern to match beyond the expected end
- # of the recording.
- proc endnote {} {note |}
-
- # This forces the return options to be in the order that the test
- # expects!
- proc noteOpts opts {global res; lappend res [dict merge {
+ # This forces the return options to be in the order that the test expects!
+ variable optorder {
-code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
- } $opts]; return}
+ -errorstack !?!
+ }
+ proc noteOpts opts {
+ variable optorder
+ lappend ::res [dict merge $optorder $opts]
+ }
# Helper command, canned result for 'initialize' method. Gets the
- # optional methods as arguments. Use return features to post the
- # result higher up.
+ # optional methods as arguments. Use return features to post the result
+ # higher up.
- proc init {args} {
- lappend args initialize finalize read write
- return -code return $args
- }
- proc oninit {args} {
+ proc handle.initialize {args} {
upvar args hargs
- if {[lindex $hargs 0] ne "initialize"} {return}
- lappend args initialize finalize read write
- return -code return $args
+ if {[lindex $hargs 0] eq "initialize"} {
+ return -code return [list {*}$args initialize finalize read write]
+ }
}
- proc onfinal {} {
+ proc handle.finalize {} {
upvar args hargs
- if {[lindex $hargs 0] ne "finalize"} {return}
- return -code return ""
+ if {[lindex $hargs 0] eq "finalize"} {
+ return -code return ""
+ }
}
- proc onread {} {
+ proc handle.read {} {
upvar args hargs
- if {[lindex $hargs 0] ne "read"} {return}
- return -code return "@"
+ if {[lindex $hargs 0] eq "read"} {
+ return -code return "@"
+ }
}
- proc ondrain {} {
+ proc handle.drain {} {
upvar args hargs
- if {[lindex $hargs 0] ne "drain"} {return}
- return -code return "<>"
+ if {[lindex $hargs 0] eq "drain"} {
+ return -code return "<>"
+ }
}
- proc onclear {} {
+ proc handle.clear {} {
upvar args hargs
- if {[lindex $hargs 0] ne "clear"} {return}
- return -code return ""
+ if {[lindex $hargs 0] eq "clear"} {
+ return -code return ""
+ }
}
proc tempchan {{mode r+}} {
- global tempchan
- set tempchan [open [makeFile {test data} tempchanfile] $mode]
- return $tempchan
+ global tempchan
+ return [set tempchan [open [makeFile {test data} tempchanfile] $mode]]
}
-
proc tempdone {} {
global tempchan
catch {close $tempchan}
removeFile tempchanfile
return
}
-
proc tempview {} { viewFile tempchanfile }
}
@@ -110,379 +103,456 @@ set helperscript {
eval $helperscript
#puts <<[file channels]>>
-
+
# ### ### ### ######### ######### #########
-test iortrans-1.0 {chan, wrong#args} {
- catch {chan} msg
- set msg
-} {wrong # args: should be "chan subcommand ?arg ...?"}
-test iortrans-1.1 {chan, unknown method} -body {
+test iortrans-1.0 {chan, wrong#args} -returnCodes error -body {
+ chan
+} -result {wrong # args: should be "chan subcommand ?arg ...?"}
+test iortrans-1.1 {chan, unknown method} -returnCodes error -body {
chan foo
-} -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": must be*}
+} -match glob -result {unknown or ambiguous subcommand "foo": must be*}
# --- --- --- --------- --------- ---------
# chan push, and method "initalize"
-test iortrans-2.0 {chan push, wrong#args, not enough} {
- catch {chan push} msg
- set msg
-} {wrong # args: should be "chan push channel cmdprefix"}
-test iortrans-2.1 {chan push, wrong#args, too many} {
- catch {chan push a b c} msg
- set msg
-} {wrong # args: should be "chan push channel cmdprefix"}
-test iortrans-2.2 {chan push, invalid channel} {
+test iortrans-2.0 {chan push, wrong#args, not enough} -returnCodes error -body {
+ chan push
+} -result {wrong # args: should be "chan push channel cmdprefix"}
+test iortrans-2.1 {chan push, wrong#args, too many} -returnCodes error -body {
+ chan push a b c
+} -result {wrong # args: should be "chan push channel cmdprefix"}
+test iortrans-2.2 {chan push, invalid channel} -setup {
proc foo {} {}
- catch {chan push {} foo} msg
+} -returnCodes error -body {
+ chan push {} foo
+} -cleanup {
rename foo {}
- set msg
-} {can not find channel named ""}
-test iortrans-2.3 {chan push, bad handler, not a list} {
- catch {chan push [tempchan] "foo \{"} msg
+} -result {can not find channel named ""}
+test iortrans-2.3 {chan push, bad handler, not a list} -body {
+ chan push [tempchan] "foo \{"
+} -returnCodes error -cleanup {
tempdone
- set msg
-} {unmatched open brace in list}
-test iortrans-2.4 {chan push, bad handler, not a command} {
- catch {chan push [tempchan] foo} msg
+} -result {unmatched open brace in list}
+test iortrans-2.4 {chan push, bad handler, not a command} -body {
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
tempdone
- set msg
-} {invalid command name "foo"}
-test iortrans-2.5 {chan push, initialize failed, bad signature} {
+} -result {invalid command name "foo"}
+test iortrans-2.5 {chan push, initialize failed, bad signature} -body {
proc foo {} {}
- catch {chan push [tempchan] foo} msg
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
tempdone
rename foo {}
- set msg
-} {wrong # args: should be "foo"}
-test iortrans-2.6 {chan push, initialize failed, bad signature} {
+} -result {wrong # args: should be "foo"}
+test iortrans-2.6 {chan push, initialize failed, bad signature} -body {
proc foo {} {}
- catch {chan push [tempchan] ::foo} msg
+ chan push [tempchan] ::foo
+} -returnCodes error -cleanup {
tempdone
rename foo {}
- set msg
-} {wrong # args: should be "::foo"}
+} -result {wrong # args: should be "::foo"}
test iortrans-2.7 {chan push, initialize failed, bad result, not a list} -body {
proc foo {args} {return "\{"}
- catch {chan push [tempchan] foo} msg
+ catch {chan push [tempchan] foo}
+ return $::errorInfo
+} -cleanup {
tempdone
rename foo {}
- set ::errorInfo
} -match glob -result {chan handler "foo initialize" returned non-list: *}
test iortrans-2.8 {chan push, initialize failed, bad result, not a list} -body {
proc foo {args} {return \{\{\}}
- catch {chan push [tempchan] foo} msg
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
tempdone
rename foo {}
- set msg
} -match glob -result {chan handler "foo initialize" returned non-list: *}
test iortrans-2.9 {chan push, initialize failed, bad result, empty list} -body {
proc foo {args} {}
- catch {chan push [tempchan] foo} msg
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
tempdone
rename foo {}
- set msg
} -match glob -result {*all required methods*}
test iortrans-2.10 {chan push, initialize failed, bad result, bogus method name} -body {
proc foo {args} {return 1}
- catch {chan push [tempchan] foo} msg
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
tempdone
rename foo {}
- set msg
} -match glob -result {*bad method "1": must be *}
test iortrans-2.11 {chan push, initialize failed, bad result, bogus method name} -body {
proc foo {args} {return {a b c}}
- catch {chan push [tempchan] foo} msg
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
tempdone
rename foo {}
- set msg
} -match glob -result {*bad method "c": must be *}
test iortrans-2.12 {chan push, initialize failed, bad result, required methods missing} -body {
# Required: initialize, and finalize.
proc foo {args} {return {initialize}}
- catch {chan push [tempchan] foo} msg
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
tempdone
rename foo {}
- set msg
} -match glob -result {*all required methods*}
test iortrans-2.13 {chan push, initialize failed, bad result, illegal method name} -body {
proc foo {args} {return {initialize finalize BOGUS}}
- catch {chan push [tempchan] foo} msg
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
tempdone
rename foo {}
- set msg
} -match glob -result {*returned bad method "BOGUS": must be clear, drain, finalize, flush, initialize, limit?, read, or write}
test iortrans-2.14 {chan push, initialize failed, bad result, mode/handler mismatch} -body {
proc foo {args} {return {initialize finalize}}
- catch {chan push [tempchan] foo} msg
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
tempdone
rename foo {}
- set msg
-} -match glob -result {*makes the channel inacessible}
+} -match glob -result {*makes the channel inaccessible}
# iortrans-2.15 event/watch methods elimimated, removed these tests.
# iortrans-2.16
test iortrans-2.17 {chan push, initialize failed, bad result, drain/read mismatch} -body {
proc foo {args} {return {initialize finalize drain write}}
- catch {chan push [tempchan] foo} msg
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
tempdone
rename foo {}
- set msg
} -match glob -result {*supports "drain" but not "read"}
test iortrans-2.18 {chan push, initialize failed, bad result, flush/write mismatch} -body {
proc foo {args} {return {initialize finalize flush read}}
- catch {chan push [tempchan] foo} msg
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
tempdone
rename foo {}
- set msg
} -match glob -result {*supports "flush" but not "write"}
-test iortrans-2.19 {chan push, initialize ok, creates channel} -match glob -body {
+test iortrans-2.19 {chan push, initialize ok, creates channel} -setup {
+ set res {}
+} -match glob -body {
proc foo {args} {
- global res
+ global res
lappend res $args
if {[lindex $args 0] ne "initialize"} {return}
return {initialize finalize drain flush read write}
}
- set res {}
lappend res [file channel rt*]
lappend res [chan push [tempchan] foo]
lappend res [close [lindex $res end]]
lappend res [file channel rt*]
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{} {initialize rt* {read write}} file* {drain rt*} {flush rt*} {finalize rt*} {} {}}
-test iortrans-2.20 {chan push, init failure -> no channel, no finalize} -match glob -body {
+test iortrans-2.20 {chan push, init failure -> no channel, no finalize} -setup {
+ set res {}
+} -match glob -body {
proc foo {args} {
- global res
+ global res
lappend res $args
- return {}
+ return
}
- set res {}
lappend res [file channel rt*]
- lappend res [catch {chan push [tempchan] foo} msg]
- lappend res $msg
+ lappend res [catch {chan push [tempchan] foo} msg] $msg
lappend res [file channel rt*]
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{} {initialize rt* {read write}} 1 {*all required methods*} {}}
# --- --- --- --------- --------- ---------
# method finalize (via close)
-# General note: file channels rt* finds the transform channel, however
-# the name reported will be that of the underlying base driver, fileXX
-# here. This actually allows us to see if the whole channel is gone,
-# or only the transformation, but not the base.
+# General note: file channels rt* finds the transform channel, however the
+# name reported will be that of the underlying base driver, fileXX here. This
+# actually allows us to see if the whole channel is gone, or only the
+# transformation, but not the base.
-test iortrans-3.1 {chan finalize, handler destruction has no effect on channel} -match glob -body {
+test iortrans-3.1 {chan finalize, handler destruction has no effect on channel} -setup {
set res {}
- proc foo {args} {track; oninit; return}
- note [set c [chan push [tempchan] foo]]
+} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return
+ }
+ lappend res [set c [chan push [tempchan] foo]]
rename foo {}
- note [file channels file*]
- note [file channels rt*]
- note [catch {close $c} msg]; note $msg
- note [file channels file*]
- note [file channels rt*]
- set res
+ lappend res [file channels file*]
+ lappend res [file channels rt*]
+ lappend res [catch {close $c} msg] $msg
+ lappend res [file channels file*]
+ lappend res [file channels rt*]
+} -cleanup {
+ tempdone
} -result {{initialize rt* {read write}} file* file* {} 1 {invalid command name "foo"} {} {}}
-test iortrans-3.2 {chan finalize, for close} -match glob -body {
+test iortrans-3.2 {chan finalize, for close} -setup {
set res {}
- proc foo {args} {track; oninit; return {}}
- note [set c [chan push [tempchan] foo]]
+} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return
+ }
+ lappend res [set c [chan push [tempchan] foo]]
close $c
# Close deleted the channel.
- note [file channels rt*]
+ lappend res [file channels rt*]
# Channel destruction does not kill handler command!
- note [info command foo]
+ lappend res [info command foo]
+} -cleanup {
rename foo {}
- set res
+ tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} {} foo}
-test iortrans-3.3 {chan finalize, for close, error, close error} -match glob -body {
+test iortrans-3.3 {chan finalize, for close, error, close error} -setup {
set res {}
- proc foo {args} {track; oninit; return -code error 5}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg]; note $msg
+} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return -code error 5
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res [catch {close $c} msg] $msg
# Channel is gone despite error.
- note [file channels rt*]
+ lappend res [file channels rt*]
+} -cleanup {
rename foo {}
- set res
+ tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}}
-test iortrans-3.4 {chan finalize, for close, error, close error} -match glob -body {
+test iortrans-3.4 {chan finalize, for close, error, close error} -setup {
set res {}
- proc foo {args} {track; oninit; error FOO}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg]; note $msg; note $::errorInfo
+} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ error FOO
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res [catch {close $c} msg] $msg $::errorInfo
+} -cleanup {
rename foo {}
- set res
+ tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO {FOO
*"close $c"}}
-test iortrans-3.5 {chan finalize, for close, arbitrary result, ignored} -match glob -body {
+test iortrans-3.5 {chan finalize, for close, arbitrary result, ignored} -setup {
set res {}
- proc foo {args} {track; oninit; return SOMETHING}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg]; note $msg
+} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return SOMETHING
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res [catch {close $c} msg] $msg
+} -cleanup {
rename foo {}
- set res
+ tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}}
-test iortrans-3.6 {chan finalize, for close, break, close error} -match glob -body {
+test iortrans-3.6 {chan finalize, for close, break, close error} -setup {
set res {}
- proc foo {args} {track; oninit; return -code 3}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg]; note $msg
+} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return -code 3
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res [catch {close $c} msg] $msg
+} -cleanup {
rename foo {}
- set res
+ tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
-test iortrans-3.7 {chan finalize, for close, continue, close error} -match glob -body {
+test iortrans-3.7 {chan finalize, for close, continue, close error} -setup {
set res {}
- proc foo {args} {track; oninit; return -code 4}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg]; note $msg
+} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return -code 4
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res [catch {close $c} msg] $msg
+} -cleanup {
rename foo {}
- set res
+ tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
-test iortrans-3.8 {chan finalize, for close, custom code, close error} -match glob -body {
+test iortrans-3.8 {chan finalize, for close, custom code, close error} -setup {
set res {}
- proc foo {args} {track; oninit; return -code 777 BANG}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg]; note $msg
+} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return -code 777 BANG
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res [catch {close $c} msg] $msg
+} -cleanup {
rename foo {}
- set res
+ tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
-test iortrans-3.9 {chan finalize, for close, ignore level, close error} -match glob -setup {
+test iortrans-3.9 {chan finalize, for close, ignore level, close error} -setup {
set res {}
} -body {
- proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg opt]; note $msg; noteOpts $opt
- return $res
-} -cleanup {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return -level 5 -code 777 BANG
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res [catch {close $c} msg opt] $msg
+ noteOpts $opt
+} -match glob -cleanup {
rename foo {}
+ tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}
# --- === *** ###########################
# method read (via read)
-test iortrans-4.1 {chan read, transform call and return} -match glob -body {
+test iortrans-4.1 {chan read, transform call and return} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
return snarf
}
set c [chan push [tempchan] foo]
- note [read $c 10]
+ lappend res [read $c 10]
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{read rt* {test data
}} snarf}
-test iortrans-4.2 {chan read, for non-readable channel} -match glob -body {
+test iortrans-4.2 {chan read, for non-readable channel} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit; onfinal; track; note MUST_NOT_HAPPEN
+ handle.initialize
+ handle.finalize
+ lappend ::res $args MUST_NOT_HAPPEN
}
set c [chan push [tempchan w] foo]
- note [catch {read $c 2} msg]; note $msg
+ lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {1 {channel "file*" wasn't opened for reading}}
-test iortrans-4.3 {chan read, error return} -match glob -body {
+test iortrans-4.3 {chan read, error return} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
return -code error BOOM!
}
set c [chan push [tempchan] foo]
- note [catch {read $c 2} msg]; note $msg
+ lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{read rt* {test data
}} 1 BOOM!}
-test iortrans-4.4 {chan read, break return is error} -match glob -body {
+test iortrans-4.4 {chan read, break return is error} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
return -code break BOOM!
}
set c [chan push [tempchan] foo]
- note [catch {read $c 2} msg]; note $msg
+ lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{read rt* {test data
}} 1 *bad code*}
-test iortrans-4.5 {chan read, continue return is error} -match glob -body {
+test iortrans-4.5 {chan read, continue return is error} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
return -code continue BOOM!
}
set c [chan push [tempchan] foo]
- note [catch {read $c 2} msg]; note $msg
+ lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{read rt* {test data
}} 1 *bad code*}
-test iortrans-4.6 {chan read, custom return is error} -match glob -body {
+test iortrans-4.6 {chan read, custom return is error} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
return -code 777 BOOM!
}
set c [chan push [tempchan] foo]
- note [catch {read $c 2} msg]; note $msg
+ lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{read rt* {test data
}} 1 *bad code*}
-test iortrans-4.7 {chan read, level is squashed} -match glob -body {
+test iortrans-4.7 {chan read, level is squashed} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
return -level 55 -code 777 BOOM!
}
set c [chan push [tempchan] foo]
- note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
+ lappend res [catch {read $c 2} msg opt] $msg
+ noteOpts $opt
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{read rt* {test data
}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
-test iortrans-4.8 {chan read, read, bug 2921116} -match glob -setup {
+test iortrans-4.8 {chan read, read, bug 2921116} -setup {
set res {}
+} -match glob -body {
proc foo {fd args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
# Kill and recreate transform while it is operating
- chan pop $fd
+ chan pop $fd
chan push $fd [list foo $fd]
}
set c [chan push [set c [tempchan]] [list foo $c]]
-} -body {
- note [read $c]
- #note [gets $c]
- set res
+ lappend res [read $c]
+ #lappend res [gets $c]
} -cleanup {
tempdone
rename foo {}
} -result {{read rt* {test data
}} file*}
-test iortrans-4.9 {chan read, gets, bug 2921116} -match glob -setup {
+test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
set res {}
+} -match glob -body {
proc foo {fd args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
# Kill and recreate transform while it is operating
- chan pop $fd
+ chan pop $fd
chan push $fd [list foo $fd]
}
set c [chan push [set c [tempchan]] [list foo $c]]
-} -body {
- note [gets $c]
- set res
+ lappend res [gets $c]
} -cleanup {
tempdone
rename foo {}
@@ -492,127 +562,207 @@ test iortrans-4.9 {chan read, gets, bug 2921116} -match glob -setup {
# --- === *** ###########################
# method write (via puts)
-test iortrans-5.1 {chan write, regular write} -match glob -body {
+test iortrans-5.1 {chan write, regular write} -setup {
set res {}
- proc foo {args} { oninit; onfinal; track ; return transformresult }
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return transformresult
+ }
set c [chan push [tempchan] foo]
- puts -nonewline $c snarf; flush $c
+ puts -nonewline $c snarf
+ flush $c
close $c
- note [tempview]
+ lappend res [tempview]
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{write rt* snarf} transformresult}
-test iortrans-5.2 {chan write, no write is ok, no change to file} -match glob -body {
+test iortrans-5.2 {chan write, no write is ok, no change to file} -setup {
set res {}
- proc foo {args} { oninit; onfinal; track ; return {} }
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return
+ }
set c [chan push [tempchan] foo]
- puts -nonewline $c snarfsnarfsnarf; flush $c
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
close $c
- note [tempview];# This has to show the original data, as nothing was written
+ lappend res [tempview]; # This has to show the original data, as nothing was written
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{write rt* snarfsnarfsnarf} {test data}}
-test iortrans-5.3 {chan write, failed write} -match glob -body {
+test iortrans-5.3 {chan write, failed write} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; return -code error FAIL!}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code error FAIL!
+ }
set c [chan push [tempchan] foo]
puts -nonewline $c snarfsnarfsnarf
- note [catch {flush $c} msg] ; note $msg
+ lappend res [catch {flush $c} msg] $msg
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{write rt* snarfsnarfsnarf} 1 FAIL!}
-test iortrans-5.4 {chan write, non-writable channel} -match glob -body {
+test iortrans-5.4 {chan write, non-writable channel} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args MUST_NOT_HAPPEN
+ return
+ }
set c [chan push [tempchan r] foo]
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]; note $msg
+ lappend res [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+} -cleanup {
close $c
tempdone
rename foo {}
- set res
} -result {1 {channel "file*" wasn't opened for writing}}
-test iortrans-5.5 {chan write, failed write, error return} -match glob -body {
+test iortrans-5.5 {chan write, failed write, error return} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; return -code error BOOM!}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code error BOOM!
+ }
set c [chan push [tempchan] foo]
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
- note $msg
+ lappend res [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
-test iortrans-5.6 {chan write, failed write, error return} -match glob -body {
+test iortrans-5.6 {chan write, failed write, error return} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; error BOOM!}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ error BOOM!
+ }
set c [chan push [tempchan] foo]
- notes [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
- note $msg
+ lappend res {*}[catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
-test iortrans-5.7 {chan write, failed write, break return is error} -match glob -body {
+test iortrans-5.7 {chan write, failed write, break return is error} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; return -code break BOOM!}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code break BOOM!
+ }
set c [chan push [tempchan] foo]
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
- note $msg
+ lappend res [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
-test iortrans-5.8 {chan write, failed write, continue return is error} -match glob -body {
+test iortrans-5.8 {chan write, failed write, continue return is error} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; return -code continue BOOM!}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code continue BOOM!
+ }
set c [chan push [tempchan] foo]
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
- note $msg
+ lappend res [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
-test iortrans-5.9 {chan write, failed write, custom return is error} -match glob -body {
+test iortrans-5.9 {chan write, failed write, custom return is error} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code 777 BOOM!
+ }
set c [chan push [tempchan] foo]
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
- note $msg
+ lappend res [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
-test iortrans-5.10 {chan write, failed write, level is ignored} -match glob -body {
+test iortrans-5.10 {chan write, failed write, level is ignored} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -level 55 -code 777 BOOM!
+ }
set c [chan push [tempchan] foo]
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
- note $msg
+ lappend res [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg opt] $msg
noteOpts $opt
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline * -errorinfo *bad code*subcommand "write"*}}
test iortrans-5.11 {chan write, bug 2921116} -match glob -setup {
set res {}
set level 0
+} -body {
proc foo {fd args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
# pop - invokes flush - invokes 'foo write' - infinite recursion - stop it
global level
- if {$level} { return "" }
+ if {$level} {
+ return
+ }
incr level
# Kill and recreate transform while it is operating
- chan pop $fd
+ chan pop $fd
chan push $fd [list foo $fd]
}
set c [chan push [set c [tempchan]] [list foo $c]]
-} -body {
- note [puts -nonewline $c abcdef]
- note [flush $c]
- set res
+ lappend res [puts -nonewline $c abcdef]
+ lappend res [flush $c]
} -cleanup {
tempdone
rename foo {}
@@ -621,85 +771,110 @@ test iortrans-5.11 {chan write, bug 2921116} -match glob -setup {
# --- === *** ###########################
# method limit?, drain (via read)
-test iortrans-6.1 {chan read, read limits} -match glob -body {
+test iortrans-6.1 {chan read, read limits} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit limit?; onfinal; track ; onread
+ handle.initialize limit?
+ handle.finalize
+ lappend ::res $args
+ handle.read
return 6
}
set c [chan push [tempchan] foo]
- note [read $c 10]
+ lappend res [read $c 10]
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{limit? rt*} {read rt* {test d}} {limit? rt*} {read rt* {ata
}} {limit? rt*} @@}
-test iortrans-6.2 {chan read, read transform drain on eof} -match glob -body {
+test iortrans-6.2 {chan read, read transform drain on eof} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit drain; onfinal; track ; onread ; ondrain
+ handle.initialize drain
+ handle.finalize
+ lappend ::res $args
+ handle.read
+ handle.drain
return
}
set c [chan push [tempchan] foo]
- note [read $c]
- note [close $c]
+ lappend res [read $c]
+ lappend res [close $c]
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{read rt* {test data
}} {drain rt*} @<> {}}
# --- === *** ###########################
# method clear (via puts, seek)
-test iortrans-7.1 {chan write, write clears read buffers} -match glob -body {
+test iortrans-7.1 {chan write, write clears read buffers} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit clear; onfinal; track ; onclear
+ handle.initialize clear
+ handle.finalize
+ lappend ::res $args
+ handle.clear
return transformresult
}
set c [chan push [tempchan] foo]
- puts -nonewline $c snarf; flush $c
+ puts -nonewline $c snarf
+ flush $c
+ return $res
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{clear rt*} {write rt* snarf}}
-test iortrans-7.2 {seek clears read buffers} -match glob -body {
+test iortrans-7.2 {seek clears read buffers} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit clear; onfinal; track
+ handle.initialize clear
+ handle.finalize
+ lappend ::res $args
return
}
set c [chan push [tempchan] foo]
seek $c 2
+ return $res
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{clear rt*}}
-test iortrans-7.3 {clear, any result is ignored} -match glob -body {
+test iortrans-7.3 {clear, any result is ignored} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit clear; onfinal; track
+ handle.initialize clear
+ handle.finalize
+ lappend ::res $args
return -code error "X"
}
set c [chan push [tempchan] foo]
seek $c 2
+ return $res
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{clear rt*}}
test iortrans-7.4 {chan clear, bug 2921116} -match glob -setup {
set res {}
+} -body {
proc foo {fd args} {
- oninit clear; onfinal; track
+ handle.initialize clear
+ handle.finalize
+ lappend ::res $args
# Kill and recreate transform while it is operating
- chan pop $fd
+ chan pop $fd
chan push $fd [list foo $fd]
}
set c [chan push [set c [tempchan]] [list foo $c]]
-} -body {
seek $c 2
- set res
+ return $res
} -cleanup {
tempdone
rename foo {}
@@ -708,47 +883,53 @@ test iortrans-7.4 {chan clear, bug 2921116} -match glob -setup {
# --- === *** ###########################
# method flush (via seek, close)
-test iortrans-8.1 {seek flushes write buffers, ignores data} -match glob -body {
+test iortrans-8.1 {seek flushes write buffers, ignores data} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit flush; onfinal; track
+ handle.initialize flush
+ handle.finalize
+ lappend ::res $args
return X
}
set c [chan push [tempchan] foo]
# Flush, no writing
seek $c 2
# The close flushes again, this modifies the file!
- note | ; note [close $c] ; note |
- note [tempview]
+ lappend res |
+ lappend res [close $c] | [tempview]
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{flush rt*} | {flush rt*} {} | {teXt data}}
-
-test iortrans-8.2 {close flushes write buffers, writes data} -match glob -body {
+test iortrans-8.2 {close flushes write buffers, writes data} -setup {
set res {}
+} -match glob -body {
proc foo {args} {
- oninit flush; track ; onfinal
+ handle.initialize flush
+ lappend ::res $args
+ handle.finalize
return .flushed.
}
set c [chan push [tempchan] foo]
close $c
- note [tempview]
+ lappend res [tempview]
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{flush rt*} {finalize rt*} .flushed.}
-
test iortrans-8.3 {chan flush, bug 2921116} -match glob -setup {
set res {}
+} -body {
proc foo {fd args} {
- oninit flush; onfinal; track
+ handle.initialize flush
+ handle.finalize
+ lappend ::res $args
# Kill and recreate transform while it is operating
- chan pop $fd
+ chan pop $fd
chan push $fd [list foo $fd]
}
set c [chan push [set c [tempchan]] [list foo $c]]
-} -body {
seek $c 2
set res
} -cleanup {
@@ -763,157 +944,132 @@ test iortrans-8.3 {chan flush, bug 2921116} -match glob -setup {
# method event - removed from TIP (rev 1.12+)
# --- === *** ###########################
-# 'Pull the rug' tests. Create channel in a interpreter A, move to
-# other interpreter B, destroy the origin interpreter (A) before or
-# during access from B. Must not crash, must return proper errors.
-
-test iortrans-11.0 {origin interpreter of moved transform gone} -match glob -body {
-
- set ida [interp create];#puts <<$ida>>
- set idb [interp create];#puts <<$idb>>
-
+# 'Pull the rug' tests. Create channel in a interpreter A, move to other
+# interpreter B, destroy the origin interpreter (A) before or during access
+# from B. Must not crash, must return proper errors.
+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
load {} Tcltest $ida
load {} Tcltest $idb
-
+} -constraints {testchannel} -match glob -body {
# Set up channel and transform in interpreter
interp eval $ida $helperscript
interp eval $ida [list ::variable tempchan [tempchan]]
interp transfer {} $::tempchan $ida
set chan [interp eval $ida {
variable tempchan
- proc foo {args} {oninit clear drain flush limit? read write; onfinal; track; return}
+ proc foo {args} {
+ handle.initialize clear drain flush limit? read write
+ handle.finalize
+ lappend ::res $args
+ return
+ }
set chan [chan push $tempchan foo]
fconfigure $chan -buffering none
set chan
}]
-
# Move channel to 2nd interpreter, transform goes with it.
- interp eval $ida [list testchannel cut $chan]
+ interp eval $ida [list testchannel cut $chan]
interp eval $idb [list testchannel splice $chan]
-
# Kill origin interpreter, then access channel from 2nd interpreter.
interp delete $ida
-
- set res {}
- lappend res [catch {interp eval $idb [list puts $chan shoo]} msg] $msg
- lappend res [catch {interp eval $idb [list tell $chan]} msg] $msg
- lappend res [catch {interp eval $idb [list seek $chan 1]} msg] $msg
- lappend res [catch {interp eval $idb [list gets $chan]} msg] $msg
- lappend res [catch {interp eval $idb [list close $chan]} msg] $msg
+ set res {}
+ lappend res \
+ [catch {interp eval $idb [list puts $chan shoo]} msg] $msg \
+ [catch {interp eval $idb [list tell $chan]} msg] $msg \
+ [catch {interp eval $idb [list seek $chan 1]} msg] $msg \
+ [catch {interp eval $idb [list gets $chan]} msg] $msg \
+ [catch {interp eval $idb [list close $chan]} msg] $msg
#lappend res [interp eval $ida {set res}]
# actions: clear|write|clear|write|clear|flush|limit?|drain|flush
+ # The 'tell' is ok, as it passed through the transform to the base channel
+ # without invoking the transform handler.
+} -cleanup {
tempdone
- set res
- # The 'tell' is ok, as it passed through the transform to the base
- # channel without invoking the transform handler.
-} -constraints {testchannel} \
- -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
-
-test iortrans-11.1 {origin interpreter of moved transform destroyed during access} -match glob -body {
-
- set ida [interp create];#puts <<$ida>>
- set idb [interp create];#puts <<$idb>>
-
+} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
+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
load {} Tcltest $ida
load {} Tcltest $idb
-
+} -constraints {testchannel impossible} -match glob -body {
# Set up channel in thread
set chan [interp eval $ida $helperscript]
set chan [interp eval $ida {
proc foo {args} {
- oninit clear drain flush limit? read write; onfinal; track;
- # destroy interpreter during channel access
- # Actually not possible for an interp to destroy itself.
+ handle.initialize clear drain flush limit? read write
+ handle.finalize
+ lappend ::res $args
+ # Destroy interpreter during channel access. Actually not
+ # possible for an interp to destroy itself.
interp delete {}
return}
set chan [chan push [tempchan] foo]
fconfigure $chan -buffering none
set chan
}]
-
# Move channel to 2nd thread, transform goes with it.
- interp eval $ida [list testchannel cut $chan]
+ interp eval $ida [list testchannel cut $chan]
interp eval $idb [list testchannel splice $chan]
-
- # Run access from interpreter B, this will give us a synchronous
- # response.
-
+ # Run access from interpreter B, this will give us a synchronous response.
interp eval $idb [list set chan $chan]
interp eval $idb [list set mid $tcltest::mainThread]
set res [interp eval $idb {
- # wait a bit, give the main thread the time to start its event
- # loop to wait for the response from B
- after 2000
+ # Wait a bit, give the main thread the time to start its event loop to
+ # wait for the response from B
+ after 50
catch { puts $chan shoo } res
set res
}]
+} -cleanup {
tempdone
- set res
-} -constraints {testchannel impossible} \
- -result {Owner lost}
-
-
-test iortrans-11.2 {delete interp of reflected transform} -body {
+} -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
-
+} -constraints {testchannel} -body {
# Get base channel into the slave
set c [tempchan]
testchannel cut $c
interp eval slave [list testchannel splice $c]
interp eval slave [list set c $c]
-
slave eval {
- proc no-op args {}
- proc driver {c sub args} {return {initialize finalize read write}}
+ proc no-op args {}
+ proc driver {c sub args} {
+ return {initialize finalize read write}
+ }
set t [chan push $c [list driver $c]]
- chan event $c readable no-op
+ chan event $c readable no-op
}
interp delete slave
-} -result {} -constraints {testchannel}
-
+} -cleanup {
+ tempdone
+} -result {}
+
# ### ### ### ######### ######### #########
-## Same tests as above, but exercising the code forwarding and
-## receiving driver operations to the originator thread.
+## Same tests as above, but exercising the code forwarding and receiving
+## driver operations to the originator thread.
-# -*- tcl -*-
# ### ### ### ######### ######### #########
## Testing the reflected channel (Thread forwarding).
#
-## The id numbers refer to the original test without thread
-## forwarding, and gaps due to tests not applicable to forwarding are
-## left to keep this association.
-
-# Duplicate of code in "thread.test", and "ioCmd.test". Find a better
-# way of doing this without duplication. Maybe placement into a proc
-# which transforms to nop after the first call, and placement of its
-# defintion in a central location.
-
-if {[testConstraint testthread]} {
- testthread errorproc ThreadError
-
- proc ThreadError {id info} {
- global threadError
- set threadError $info
- }
- proc ThreadNullError {id info} {
- # ignore
- }
-}
+## The id numbers refer to the original test without thread forwarding, and
+## gaps due to tests not applicable to forwarding are left to keep this
+## association.
# ### ### ### ######### ######### #########
-## Helper command. Runs a script in a separate thread and returns the
-## result. A channel is transfered into the thread as well, and a list
-## of configuation variables
+## Helper command. Runs a script in a separate thread and returns the result.
+## A channel is transfered into the thread as well, and a list of configuation
+## variables
proc inthread {chan script args} {
# Test thread.
-
- set tid [testthread create]
+ set tid [thread::create -preserved]
+ thread::send $tid {load {} Tcltest}
# Init thread configuration.
# - Listed variables
@@ -922,491 +1078,619 @@ proc inthread {chan script args} {
foreach v $args {
upvar 1 $v x
- testthread send $tid [list set $v $x]
+ thread::send $tid [list set $v $x]
}
- testthread send $tid [list set mid $tcltest::mainThread]
- testthread send $tid {
- proc note {item} {global notes; lappend notes $item}
- proc notes {} {global notes; return $notes}
- proc noteOpts opts {global notes; lappend notes [dict merge {
- -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
- } $opts]}
+ thread::send $tid [list set mid [thread::id]]
+ thread::send $tid {
+ proc notes {} {
+ return $::notes
+ }
+ proc noteOpts opts {
+ lappend ::notes [dict merge {
+ -code !?! -level !?! -errorcode !?! -errorline !?!
+ -errorinfo !?! -errorstack !?!
+ } $opts]
+ }
}
- testthread send $tid [list proc s {} [list uplevel 1 $script]]; # (*)
+ thread::send $tid [list proc s {} [list uplevel 1 $script]]; # (*)
# Transfer channel (cut/splice aka detach/attach)
testchannel cut $chan
- testthread send $tid [list testchannel splice $chan]
+ thread::send $tid [list testchannel splice $chan]
- # Run test script, also run local event loop!
- # The local event loop waits for the result to come back.
- # It is also necessary for the execution of forwarded channel
- # operations.
+ # Run test script, also run local event loop! The local event loop waits
+ # for the result to come back. It is also necessary for the execution of
+ # forwarded channel operations.
set ::tres ""
- testthread send -async $tid {
- after 500
- catch {s} res; # This runs the script, 's' was defined at (*)
- testthread send -async $mid [list set ::tres $res]
+ thread::send -async $tid {
+ after 50
+ catch {s} res; # This runs the script, 's' was defined at (*)
+ thread::send -async $mid [list set ::tres $res]
}
vwait ::tres
# Remove test thread, and return the captured result.
- tcltest::threadReap
+ thread::release $tid
return $::tres
}
# ### ### ### ######### ######### #########
-# ### ### ### ######### ######### #########
-
-test iortrans.tf-3.2 {chan finalize, for close} -match glob -body {
+test iortrans.tf-3.2 {chan finalize, for close} -setup {
set res {}
- proc foo {args} {track; oninit; return {}}
- note [set c [chan push [tempchan] foo]]
- note [inthread $c {
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return {}
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res [inthread $c {
close $c
# Close the deleted the channel.
file channels rt*
} c]
# Channel destruction does not kill handler command!
- note [info command foo]
+ lappend res [info command foo]
+} -cleanup {
rename foo {}
- set res
-} -constraints {testchannel testthread} \
- -result {{initialize rt* {read write}} file* {finalize rt*} {} foo}
-test iortrans.tf-3.3 {chan finalize, for close, error, close error} -match glob -body {
- set res {}
- proc foo {args} {track; oninit; return -code error 5}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg]; note $msg
+} -result {{initialize rt* {read write}} file* {finalize rt*} {} foo}
+test iortrans.tf-3.3 {chan finalize, for close, error, close error} -setup {
+ set res {}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return -code error 5
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {close $c} msg] $msg
# Channel is gone despite error.
- note [file channels rt*]
+ lappend notes [file channels rt*]
notes
} c]
+} -cleanup {
rename foo {}
- set res
-} -constraints {testchannel testthread} \
- -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}}
-test iortrans.tf-3.4 {chan finalize, for close, error, close errror} -match glob -body {
- set res {}
- proc foo {args} {track; oninit; error FOO}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg]; note $msg
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}}
+test iortrans.tf-3.4 {chan finalize, for close, error, close errror} -setup {
+ set res {}
+} -constraints {testchannel thread} -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ error FOO
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {close $c} msg] $msg
notes
} c]
+} -match glob -cleanup {
rename foo {}
- set res
-} -constraints {testchannel testthread} \
- -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO}
-test iortrans.tf-3.5 {chan finalize, for close, arbitrary result} -match glob -body {
- set res {}
- proc foo {args} {track; oninit; return SOMETHING}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg]; note $msg
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO}
+test iortrans.tf-3.5 {chan finalize, for close, arbitrary result} -setup {
+ set res {}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return SOMETHING
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {close $c} msg] $msg
notes
} c]
+} -cleanup {
rename foo {}
- set res
-} -constraints {testchannel testthread} \
- -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}}
-test iortrans.tf-3.6 {chan finalize, for close, break, close error} -match glob -body {
- set res {}
- proc foo {args} {track; oninit; return -code 3}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg]; note $msg
+} -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}}
+test iortrans.tf-3.6 {chan finalize, for close, break, close error} -setup {
+ set res {}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return -code 3
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {close $c} msg] $msg
notes
} c]
+} -cleanup {
rename foo {}
- set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*} \
- -constraints {testchannel testthread}
-
-
-test iortrans.tf-3.7 {chan finalize, for close, continue, close error} -match glob -body {
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+test iortrans.tf-3.7 {chan finalize, for close, continue, close error} -setup {
set res {}
- proc foo {args} {track; oninit; return -code 4}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg]; note $msg
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return -code 4
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {close $c} msg] $msg
notes
} c]
+} -cleanup {
rename foo {}
- set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*} \
- -constraints {testchannel testthread}
-test iortrans.tf-3.8 {chan finalize, for close, custom code, close error} -match glob -body {
- set res {}
- proc foo {args} {track; oninit; return -code 777 BANG}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg]; note $msg
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+test iortrans.tf-3.8 {chan finalize, for close, custom code, close error} -setup {
+ set res {}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return -code 777 BANG
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {close $c} msg] $msg
notes
} c]
+} -cleanup {
rename foo {}
- set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*} \
- -constraints {testchannel testthread}
-test iortrans.tf-3.9 {chan finalize, for close, ignore level, close error} -match glob -body {
- set res {}
- proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg opt]; note $msg; noteOpts $opt
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+test iortrans.tf-3.9 {chan finalize, for close, ignore level, close error} -setup {
+ set res {}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return -level 5 -code 777 BANG
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {close $c} msg opt] $msg
+ noteOpts $opt
notes
} c]
+} -cleanup {
rename foo {}
- set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} \
- -constraints {testchannel testthread}
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}
# --- === *** ###########################
# method read
-test iortrans.tf-4.1 {chan read, transform call and return} -match glob -body {
+test iortrans.tf-4.1 {chan read, transform call and return} -setup {
set res {}
+} -constraints {testchannel thread} -body {
proc foo {args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
return snarf
}
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [read $c 10]
+ lappend res {*}[inthread $c {
+ lappend notes [read $c 10]
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -constraints {testchannel testthread} -result {{read rt* {test data
+} -match glob -result {{read rt* {test data
}} snarf}
-
-test iortrans.tf-4.2 {chan read, for non-readable channel} -match glob -body {
+test iortrans.tf-4.2 {chan read, for non-readable channel} -setup {
set res {}
+} -constraints {testchannel thread} -body {
proc foo {args} {
- oninit; onfinal; track; note MUST_NOT_HAPPEN
+ handle.initialize
+ handle.finalize
+ lappend ::res $args MUST_NOT_HAPPEN
}
set c [chan push [tempchan w] foo]
- notes [inthread $c {
- note [catch {[read $c 2]} msg]; note $msg
+ lappend res {*}[inthread $c {
+ lappend notes [catch {[read $c 2]} msg] $msg
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -constraints {testchannel testthread} -result {1 {channel "file*" wasn't opened for reading}}
-test iortrans.tf-4.3 {chan read, error return} -match glob -body {
+} -match glob -result {1 {channel "file*" wasn't opened for reading}}
+test iortrans.tf-4.3 {chan read, error return} -setup {
set res {}
+} -constraints {testchannel thread} -body {
proc foo {args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
return -code error BOOM!
}
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {read $c 2} msg]; note $msg
+ lappend res {*}[inthread $c {
+ lappend notes [catch {read $c 2} msg] $msg
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{read rt* {test data
-}} 1 BOOM!} \
- -constraints {testchannel testthread}
-test iortrans.tf-4.4 {chan read, break return is error} -match glob -body {
+} -match glob -result {{read rt* {test data
+}} 1 BOOM!}
+test iortrans.tf-4.4 {chan read, break return is error} -setup {
set res {}
+} -constraints {testchannel thread} -body {
proc foo {args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
return -code break BOOM!
}
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {read $c 2} msg]; note $msg
+ lappend res {*}[inthread $c {
+ lappend notes [catch {read $c 2} msg] $msg
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{read rt* {test data
-}} 1 *bad code*} \
- -constraints {testchannel testthread}
-test iortrans.tf-4.5 {chan read, continue return is error} -match glob -body {
+} -match glob -result {{read rt* {test data
+}} 1 *bad code*}
+test iortrans.tf-4.5 {chan read, continue return is error} -setup {
set res {}
+} -constraints {testchannel thread} -body {
proc foo {args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
return -code continue BOOM!
}
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {read $c 2} msg]; note $msg
+ lappend res {*}[inthread $c {
+ lappend notes [catch {read $c 2} msg] $msg
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{read rt* {test data
-}} 1 *bad code*} \
- -constraints {testchannel testthread}
-test iortrans.tf-4.6 {chan read, custom return is error} -match glob -body {
+} -match glob -result {{read rt* {test data
+}} 1 *bad code*}
+test iortrans.tf-4.6 {chan read, custom return is error} -setup {
set res {}
+} -constraints {testchannel thread} -body {
proc foo {args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
return -code 777 BOOM!
}
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {read $c 2} msg]; note $msg
+ lappend res {*}[inthread $c {
+ lappend notes [catch {read $c 2} msg] $msg
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{read rt* {test data
-}} 1 *bad code*} \
- -constraints {testchannel testthread}
-
-test iortrans.tf-4.7 {chan read, level is squashed} -match glob -body {
+} -match glob -result {{read rt* {test data
+}} 1 *bad code*}
+test iortrans.tf-4.7 {chan read, level is squashed} -setup {
set res {}
+} -constraints {testchannel thread} -body {
proc foo {args} {
- oninit; onfinal; track
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
return -level 55 -code 777 BOOM!
}
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
+ lappend res {*}[inthread $c {
+ lappend notes [catch {read $c 2} msg opt] $msg
+ noteOpts $opt
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{read rt* {test data
-}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \
- -constraints {testchannel testthread}
+} -match glob -result {{read rt* {test data
+}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
# --- === *** ###########################
# method write
-test iortrans.tf-5.1 {chan write, regular write} -match glob -body {
+test iortrans.tf-5.1 {chan write, regular write} -setup {
set res {}
- proc foo {args} { oninit; onfinal; track ; return transformresult }
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return transformresult
+ }
set c [chan push [tempchan] foo]
inthread $c {
- puts -nonewline $c snarf; flush $c
+ puts -nonewline $c snarf
+ flush $c
close $c
} c
- note [tempview]
+ lappend res [tempview]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -constraints {testchannel testthread} -result {{write rt* snarf} transformresult}
-test iortrans.tf-5.2 {chan write, no write is ok, no change to file} -match glob -body {
+} -result {{write rt* snarf} transformresult}
+test iortrans.tf-5.2 {chan write, no write is ok, no change to file} -setup {
set res {}
- proc foo {args} { oninit; onfinal; track ; return {} }
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return
+ }
set c [chan push [tempchan] foo]
inthread $c {
- puts -nonewline $c snarfsnarfsnarf; flush $c
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
close $c
} c
- note [tempview];# This has to show the original data, as nothing was written
+ lappend res [tempview]; # This has to show the original data, as nothing was written
+} -cleanup {
tempdone
rename foo {}
- set res
-} -constraints {testchannel testthread} \
- -result {{write rt* snarfsnarfsnarf} {test data}}
-test iortrans.tf-5.3 {chan write, failed write} -match glob -body {
+} -result {{write rt* snarfsnarfsnarf} {test data}}
+test iortrans.tf-5.3 {chan write, failed write} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; return -code error FAIL!}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code error FAIL!
+ }
set c [chan push [tempchan] foo]
- notes [inthread $c {
+ lappend res {*}[inthread $c {
puts -nonewline $c snarfsnarfsnarf
- note [catch {flush $c} msg]
- note $msg
+ lappend notes [catch {flush $c} msg] $msg
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -constraints {testchannel testthread} \
- -result {{write rt* snarfsnarfsnarf} 1 FAIL!}
-test iortrans.tf-5.4 {chan write, non-writable channel} -match glob -body {
+} -result {{write rt* snarfsnarfsnarf} 1 FAIL!}
+test iortrans.tf-5.4 {chan write, non-writable channel} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args MUST_NOT_HAPPEN
+ return
+ }
set c [chan push [tempchan r] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
- note $msg
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -constraints {testchannel testthread} \
- -result {1 {channel "file*" wasn't opened for writing}}
-test iortrans.tf-5.5 {chan write, failed write, error return} -match glob -body {
+} -result {1 {channel "file*" wasn't opened for writing}}
+test iortrans.tf-5.5 {chan write, failed write, error return} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; return -code error BOOM!}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code error BOOM!
+ }
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
- note $msg
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{write rt* snarfsnarfsnarf} 1 BOOM!} \
- -constraints {testchannel testthread}
-test iortrans.tf-5.6 {chan write, failed write, error return} -match glob -body {
+} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
+test iortrans.tf-5.6 {chan write, failed write, error return} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; error BOOM!}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ error BOOM!
+ }
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
- note $msg
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{write rt* snarfsnarfsnarf} 1 BOOM!} \
- -constraints {testchannel testthread}
-
-
-test iortrans.tf-5.7 {chan write, failed write, break return is error} -match glob -body {
+} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
+test iortrans.tf-5.7 {chan write, failed write, break return is error} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; return -code break BOOM!}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code break BOOM!
+ }
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
- note $msg
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{write rt* snarfsnarfsnarf} 1 *bad code*} \
- -constraints {testchannel testthread}
-test iortrans.tf-5.8 {chan write, failed write, continue return is error} -match glob -body {
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans.tf-5.8 {chan write, failed write, continue return is error} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; return -code continue BOOM!}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code continue BOOM!
+ }
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
- note $msg
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
close $c
notes
} c]
+} -cleanup {
rename foo {}
- set res
-} -result {{write rt* snarfsnarfsnarf} 1 *bad code*} \
- -constraints {testchannel testthread}
-test iortrans.tf-5.9 {chan write, failed write, custom return is error} -match glob -body {
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans.tf-5.9 {chan write, failed write, custom return is error} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!}
+} -constraints {testchannel thread} -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code 777 BOOM!
+ }
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
- note $msg
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{write rt* snarfsnarfsnarf} 1 *bad code*} \
- -constraints {testchannel testthread}
-test iortrans.tf-5.10 {chan write, failed write, level is ignored} -match glob -body {
+} -match glob -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans.tf-5.10 {chan write, failed write, level is ignored} -setup {
set res {}
- proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -level 55 -code 777 BOOM!
+ }
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
- note $msg
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg opt] $msg
noteOpts $opt
close $c
notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}} \
- -constraints {testchannel testthread}
-
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline * -errorinfo *bad code*subcommand "write"*}}
# --- === *** ###########################
# method limit?, drain (via read)
-test iortrans.tf-6.1 {chan read, read limits} -match glob -body {
+test iortrans.tf-6.1 {chan read, read limits} -setup {
set res {}
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
- oninit limit?; onfinal; track ; onread
+ handle.initialize limit?
+ handle.finalize
+ lappend ::res $args
+ handle.read
return 6
}
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [read $c 10]
+ lappend res {*}[inthread $c {
+ lappend notes [read $c 10]
close $c
- set notes
+ notes
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{limit? rt*} {read rt* {test d}} {limit? rt*} {read rt* {ata
-}} {limit? rt*} @@} -constraints {testchannel testthread}
-test iortrans.tf-6.2 {chan read, read transform drain on eof} -match glob -body {
+}} {limit? rt*} @@}
+test iortrans.tf-6.2 {chan read, read transform drain on eof} -setup {
set res {}
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
- oninit drain; onfinal; track ; onread ; ondrain
+ handle.initialize drain
+ handle.finalize
+ lappend ::res $args
+ handle.read
+ handle.drain
return
}
set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [read $c]
- note [close $c]
+ lappend res {*}[inthread $c {
+ lappend notes [read $c]
+ lappend notes [close $c]
} c]
+} -cleanup {
tempdone
rename foo {}
- set res
} -result {{read rt* {test data
-}} {drain rt*} @<> {}} -constraints {testchannel testthread}
+}} {drain rt*} @<> {}}
# --- === *** ###########################
# method clear (via puts, seek)
-test iortrans.tf-7.1 {chan write, write clears read buffers} -match glob -body {
+test iortrans.tf-7.1 {chan write, write clears read buffers} -setup {
set res {}
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
- oninit clear; onfinal; track ; onclear
+ handle.initialize clear
+ handle.finalize
+ lappend ::res $args
+ handle.clear
return transformresult
}
set c [chan push [tempchan] foo]
inthread $c {
- puts -nonewline $c snarf; flush $c
+ puts -nonewline $c snarf
+ flush $c
close $c
} c
+ return $res
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{clear rt*} {write rt* snarf}} -constraints {testchannel testthread}
-test iortrans.tf-7.2 {seek clears read buffers} -match glob -body {
+} -result {{clear rt*} {write rt* snarf}}
+test iortrans.tf-7.2 {seek clears read buffers} -setup {
set res {}
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
- oninit clear; onfinal; track
+ handle.initialize clear
+ handle.finalize
+ lappend ::res $args
return
}
set c [chan push [tempchan] foo]
@@ -1414,14 +1698,18 @@ test iortrans.tf-7.2 {seek clears read buffers} -match glob -body {
seek $c 2
close $c
} c
+ return $res
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{clear rt*}} -constraints {testchannel testthread}
-test iortrans.tf-7.3 {clear, any result is ignored} -match glob -body {
+} -result {{clear rt*}}
+test iortrans.tf-7.3 {clear, any result is ignored} -setup {
set res {}
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
- oninit clear; onfinal; track
+ handle.initialize clear
+ handle.finalize
+ lappend ::res $args
return -code error "X"
}
set c [chan push [tempchan] foo]
@@ -1429,56 +1717,60 @@ test iortrans.tf-7.3 {clear, any result is ignored} -match glob -body {
seek $c 2
close $c
} c
+ return $res
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{clear rt*}} -constraints {testchannel testthread}
+} -result {{clear rt*}}
# --- === *** ###########################
# method flush (via seek, close)
-test iortrans.tf-8.1 {seek flushes write buffers, ignores data} -match glob -body {
+test iortrans.tf-8.1 {seek flushes write buffers, ignores data} -setup {
set res {}
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
- oninit flush; onfinal; track
+ handle.initialize flush
+ handle.finalize
+ lappend ::res $args
return X
}
set c [chan push [tempchan] foo]
- notes [inthread $c {
+ lappend res {*}[inthread $c {
# Flush, no writing
seek $c 2
# The close flushes again, this modifies the file!
- note | ; note [close $c] ; note |
- # NOTE: The flush generated by the close is recorded
- # immediately, the other note's here are defered until after
- # the thread is done. This changes the order of the result a
- # bit from the non-threaded case (The first | moves one to the
- # right). This is an artifact of the 'inthread' framework, not
- # of the transformation itself.
+ lappend notes | [close $c] |
+ # NOTE: The flush generated by the close is recorded immediately, the
+ # other note's here are defered until after the thread is done. This
+ # changes the order of the result a bit from the non-threaded case
+ # (The first | moves one to the right). This is an artifact of the
+ # 'inthread' framework, not of the transformation itself.
notes
} c]
- note [tempview]
+ lappend res [tempview]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{flush rt*} {flush rt*} | {} | {teXt data}} -constraints {testchannel testthread}
-
-test iortrans.tf-8.2 {close flushes write buffers, writes data} -match glob -body {
+} -result {{flush rt*} {flush rt*} | {} | {teXt data}}
+test iortrans.tf-8.2 {close flushes write buffers, writes data} -setup {
set res {}
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
- oninit flush; track ; onfinal
+ handle.initialize flush
+ lappend ::res $args
+ handle.finalize
return .flushed.
}
set c [chan push [tempchan] foo]
inthread $c {
close $c
} c
- note [tempview]
+ lappend res [tempview]
+} -cleanup {
tempdone
rename foo {}
- set res
-} -result {{flush rt*} {finalize rt*} .flushed.} -constraints {testchannel testthread}
-
+} -result {{flush rt*} {finalize rt*} .flushed.}
# --- === *** ###########################
# method watch - removed from TIP (rev 1.12+)
@@ -1487,97 +1779,101 @@ test iortrans.tf-8.2 {close flushes write buffers, writes data} -match glob -bod
# method event - removed from TIP (rev 1.12+)
# --- === *** ###########################
-# 'Pull the rug' tests. Create channel in a thread A, move to other
-# thread B, destroy the origin thread (A) before or during access from
-# B. Must not crash, must return proper errors.
-
-test iortrans.tf-11.0 {origin thread of moved transform gone} -match glob -body {
+# 'Pull the rug' tests. Create channel in a thread A, move to other thread B,
+# destroy the origin thread (A) before or during access from B. Must not
+# crash, must return proper errors.
+test iortrans.tf-11.0 {origin thread of moved transform gone} -setup {
#puts <<$tcltest::mainThread>>main
- set tida [testthread create];#puts <<$tida>>
- set tidb [testthread create];#puts <<$tidb>>
-
+ set tida [thread::create -preserved]; #puts <<$tida>>
+ thread::send $tida {load {} Tcltest}
+ set tidb [thread::create -preserved]; #puts <<$tida>>
+ thread::send $tidb {load {} Tcltest}
+} -constraints {testchannel thread} -match glob -body {
# Set up channel in thread
- testthread send $tida $helperscript
- set chan [testthread send $tida {
- proc foo {args} {oninit clear drain flush limit? read write; onfinal; track; return}
+ thread::send $tida $helperscript
+ thread::send $tidb $helperscript
+ set chan [thread::send $tida {
+ proc foo {args} {
+ handle.initialize clear drain flush limit? read write
+ handle.finalize
+ lappend ::res $args
+ return
+ }
set chan [chan push [tempchan] foo]
fconfigure $chan -buffering none
set chan
}]
# Move channel to 2nd thread, transform goes with it.
- testthread send $tida [list testchannel cut $chan]
- testthread send $tidb [list testchannel splice $chan]
+ thread::send $tida [list testchannel cut $chan]
+ thread::send $tidb [list testchannel splice $chan]
# Kill origin thread, then access channel from 2nd thread.
- testthread send -async $tida {testthread exit}
- after 100
+ thread::release -wait $tida
- set res {}
- lappend res [catch {testthread send $tidb [list puts $chan shoo]} msg] $msg
- lappend res [catch {testthread send $tidb [list tell $chan]} msg] $msg
- lappend res [catch {testthread send $tidb [list seek $chan 1]} msg] $msg
- lappend res [catch {testthread send $tidb [list gets $chan]} msg] $msg
- lappend res [catch {testthread send $tidb [list close $chan]} msg] $msg
- tcltest::threadReap
- tempdone
- set res
+ set res {}
+ lappend res [catch {thread::send $tidb [list puts $chan shoo]} msg] $msg
+ lappend res [catch {thread::send $tidb [list tell $chan]} msg] $msg
+ lappend res [catch {thread::send $tidb [list seek $chan 1]} msg] $msg
+ lappend res [catch {thread::send $tidb [list gets $chan]} msg] $msg
+ lappend res [catch {thread::send $tidb [list close $chan]} msg] $msg
# The 'tell' is ok, as it passed through the transform to the base
# channel without invoking the transform handler.
+} -cleanup {
+ thread::send $tidb tempdone
+ thread::release $tidb
+} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
-} -constraints {testchannel testthread} \
- -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
-
-test iortrans.tf-11.1 {origin thread of moved transform destroyed during access} -match glob -body {
+testConstraint notValgrind [expr {![testConstraint valgrind]}]
+test iortrans.tf-11.1 {origin thread of moved transform destroyed during access} -setup {
#puts <<$tcltest::mainThread>>main
- set tida [testthread create];#puts <<$tida>>
- set tidb [testthread create];#puts <<$tidb>>
-
+ set tida [thread::create -preserved]; #puts <<$tida>>
+ thread::send $tida {load {} Tcltest}
+ set tidb [thread::create -preserved]; #puts <<$tidb>>
+ thread::send $tidb {load {} Tcltest}
+} -constraints {testchannel thread notValgrind} -match glob -body {
# Set up channel in thread
- set chan [testthread send $tida $helperscript]
- set chan [testthread send $tida {
+ thread::send $tida $helperscript
+ thread::send $tidb $helperscript
+ set chan [thread::send $tida {
proc foo {args} {
- oninit clear drain flush limit? read write; onfinal; track;
+ handle.initialize clear drain flush limit? read write
+ handle.finalize
+ lappend ::res $args
# destroy thread during channel access
- testthread exit
- return}
+ thread::exit
+ }
set chan [chan push [tempchan] foo]
fconfigure $chan -buffering none
set chan
}]
# Move channel to 2nd thread, transform goes with it.
- testthread send $tida [list testchannel cut $chan]
- testthread send $tidb [list testchannel splice $chan]
-
- # Run access from thread B, wait for response from A (A is not
- # using event loop at this point, so the event pile up in the
- # queue.
-
- testthread send $tidb [list set chan $chan]
- testthread send $tidb [list set mid $tcltest::mainThread]
- testthread send -async $tidb {
- # wait a bit, give the main thread the time to start its event
- # loop to wait for the response from B
- after 2000
+ thread::send $tida [list testchannel cut $chan]
+ thread::send $tidb [list testchannel splice $chan]
+
+ # Run access from thread B, wait for response from A (A is not using event
+ # loop at this point, so the event pile up in the queue.
+ thread::send $tidb [list set chan $chan]
+ thread::send $tidb [list set mid [thread::id]]
+ thread::send -async $tidb {
+ # Wait a bit, give the main thread the time to start its event loop to
+ # wait for the response from B
+ after 50
catch { puts $chan shoo } res
catch { close $chan }
- testthread send -async $mid [list set ::res $res]
+ thread::send -async $mid [list set ::res $res]
}
vwait ::res
-
- tcltest::threadReap
- tempdone
set res
-} -constraints {testchannel testthread} \
- -result {Owner lost}
-
-# ### ### ### ######### ######### #########
-
+} -cleanup {
+ thread::send $tidb tempdone
+ thread::release $tidb
+} -result {Owner lost}
+
# ### ### ### ######### ######### #########
-rename track {}
cleanupTests
return
diff --git a/tests/iogt.test b/tests/iogt.test
index c45d97d..d4c31d2 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -3,19 +3,21 @@
#
# This file contains a collection of tests for Giot
#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 2000 Ajuba Solutions.
# Copyright (c) 2000 Andreas Kupries.
# All rights reserved.
-#
-# RCS: @(#) $Id: iogt.test,v 1.16 2006/11/03 11:45:34 dkf Exp $
if {[catch {package require tcltest 2.1}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
return
}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
namespace eval ::tcl::test::iogt {
namespace import ::tcltest::*
@@ -38,41 +40,38 @@ set path(__echo_srv__.tcl) [makeFile {
# delay between blocks
# blocksize ...
-set port [lindex $argv 0]
+set port [lindex $argv 0]
set fdelay [lindex $argv 1]
set idelay [lindex $argv 2]
set bsizes [lrange $argv 3 end]
-set c 0
+set c 0
proc newconn {sock rhost rport} {
variable fdelay
variable c
- incr c
- variable c$c
+ incr c
+ namespace upvar [namespace current] c$c conn
#puts stdout "C $sock $rhost $rport / $fdelay" ; flush stdout
- upvar 0 c$c conn
set conn(after) {}
set conn(state) 0
- set conn(size) 0
- set conn(data) ""
+ set conn(size) 0
+ set conn(data) ""
set conn(delay) $fdelay
- fileevent $sock readable [list echoGet $c $sock]
+ fileevent $sock readable [list echoGet $c $sock]
fconfigure $sock -translation binary -buffering none -blocking 0
}
proc echoGet {c sock} {
variable fdelay
- variable c$c
- upvar 0 c$c conn
+ namespace upvar [namespace current] c$c conn
if {[eof $sock]} {
# one-shot echo
exit
}
-
append conn(data) [read $sock]
#puts stdout "G $c $sock $conn(data) <<$conn(data)>>" ; flush stdout
@@ -86,8 +85,7 @@ proc echoPut {c sock} {
variable idelay
variable fdelay
variable bsizes
- variable c$c
- upvar 0 c$c conn
+ namespace upvar [namespace current] c$c conn
if {[string length $conn(data)] == 0} {
#puts stdout "C $c $sock" ; flush stdout
@@ -98,9 +96,7 @@ proc echoPut {c sock} {
return
}
-
set conn(delay) $idelay
-
set n [lindex $bsizes $conn(size)]
#puts stdout "P $c $sock $n >>" ; flush stdout
@@ -109,7 +105,6 @@ proc echoPut {c sock} {
#parray conn
#puts n=<$n>
-
if {[string length $conn(data)] >= $n} {
puts -nonewline $sock [string range $conn(data) 0 $n]
set conn(data) [string range $conn(data) [incr n] end]
@@ -130,40 +125,33 @@ socket -server newconn -myaddr 127.0.0.1 $port
vwait forever
} __echo_srv__.tcl]
-
########################################################################
proc fevent {fdelay idelay blocks script data} {
- # start and initialize an echo server, prepare data
- # transmission, then hand over to the test script.
- # this has to start real transmission via 'flush'.
- # The server is stopped after completion of the test.
+ # Start and initialize an echo server, prepare data transmission, then
+ # hand over to the test script. This has to start real transmission via
+ # 'flush'. The server is stopped after completion of the test.
- # fixed port, not so good. lets hope for the best, for now.
- set port 4000
+ upvar 1 sock sk
- exec tclsh __echo_srv__.tcl \
- $port $fdelay $idelay {*}$blocks >@stdout &
+ # Fixed port, not so good. Lets hope for the best, for now.
+ set port 4000
+ exec tclsh __echo_srv__.tcl $port $fdelay $idelay {*}$blocks >@stdout &
after 500
- #puts stdout "> $port" ; flush stdout
-
- set sk [socket localhost $port]
- fconfigure $sk \
- -blocking 0 \
- -buffering full \
- -buffersize [expr {10+[llength $data]}]
+ #puts stdout "> $port"; flush stdout
+ set sk [socket localhost $port]
+ fconfigure $sk -blocking 0 -buffering full \
+ -buffersize [expr {10+[llength $data]}]
puts -nonewline $sk $data
# The channel is prepared to go off.
- #puts stdout ">>>>>" ; flush stdout
-
- uplevel #0 set sock $sk
- set res [uplevel #0 $script]
+ #puts stdout ">>>>>"; flush stdout
+ set res [uplevel 1 $script]
catch {close $sk}
return $res
}
@@ -173,18 +161,15 @@ proc fevent {fdelay idelay blocks script data} {
proc id {op data} {
switch -- $op {
- create/write -
- create/read -
- delete/write -
- delete/read -
- clear_read {;#ignore}
- flush/write -
- flush/read -
- write -
- read {
+ create/write - create/read - delete/write - delete/read - clear_read {
+ #ignore
+ }
+ flush/write - flush/read - write - read {
return $data
}
- query/maxRead {return -1}
+ query/maxRead {
+ return -1
+ }
}
}
@@ -193,43 +178,34 @@ proc id_optrail {var op data} {
upvar 0 $var trail
lappend trail $op
-
switch -- $op {
- create/write - create/read -
- delete/write - delete/read -
- flush/read -
- clear/read { #ignore }
- flush/write -
- write -
- read {
+ create/write - create/read - delete/write - delete/read -
+ flush/read - clear/read {
+ #ignore
+ }
+ flush/write - write - read {
return $data
}
- query/maxRead {
+ query/maxRead {
return -1
}
- default {
+ default {
lappend trail "error $op"
error $op
}
}
}
-
proc id_fulltrail {var op data} {
- variable $var
- upvar 0 $var trail
+ namespace upvar [namespace current] $var trail
#puts stdout ">> $var $op $data" ; flush stdout
switch -- $op {
- create/write - create/read -
- delete/write - delete/read -
- clear_read {
+ create/write - create/read - delete/write - delete/read - clear_read {
set res *ignored*
}
- flush/write - flush/read -
- write -
- read {
+ flush/write - flush/read - write - read {
set res $data
}
query/maxRead {
@@ -245,18 +221,19 @@ proc id_fulltrail {var op data} {
}
proc counter {var op data} {
- variable $var
- upvar 0 $var n
+ namespace upvar [namespace current] $var n
switch -- $op {
- create/write - create/read -
- delete/write - delete/read -
- clear_read {;#ignore}
- flush/write - flush/read {return {}}
+ create/write - create/read - delete/write - delete/read - clear_read {
+ #ignore
+ }
+ flush/write - flush/read {
+ return {}
+ }
write {
return $data
}
- read {
+ read {
if {$n > 0} {
incr n -[string length $data]
if {$n < 0} {
@@ -271,25 +248,20 @@ proc counter {var op data} {
}
}
-
proc counter_audit {var vtrail op data} {
- variable $var
- variable $vtrail
- upvar 0 $var n $vtrail trail
+ namespace upvar [namespace current] $var n $vtrail trail
switch -- $op {
- create/write - create/read -
- delete/write - delete/read -
- clear_read {
+ create/write - create/read - delete/write - delete/read - clear_read {
set res {}
}
- flush/write - flush/read {
+ flush/write - flush/read {
set res {}
}
write {
set res $data
}
- read {
+ read {
if {$n > 0} {
incr n -[string length $data]
if {$n < 0} {
@@ -307,36 +279,28 @@ proc counter_audit {var vtrail op data} {
return $res
}
-
proc rblocks {var vtrail n op data} {
- variable $var
- variable $vtrail
- upvar 0 $var buf $vtrail trail
+ namespace upvar [namespace current] $var n $vtrail trail
set res {}
switch -- $op {
- create/write - create/read -
- delete/write - delete/read -
- clear_read {
+ create/write - create/read - delete/write - delete/read - clear_read {
set buf {}
}
flush/write {
}
- flush/read {
+ flush/read {
set res $buf
set buf {}
}
- write {
+ write {
set data
}
- read {
+ read {
append buf $data
-
set b [expr {$n * ([string length $buf] / $n)}]
-
append op " $n [string length $buf] :- $b"
-
set res [string range $buf 0 [incr b -1]]
set buf [string range $buf [incr b] end]
#return $res
@@ -350,36 +314,28 @@ proc rblocks {var vtrail n op data} {
return $res
}
-
# --------------------------------------------------------------
# ... and convenience procedures to stack them
proc identity {-attach channel} {
testchannel transform $channel -command [namespace code id]
}
-
proc audit_ops {var -attach channel} {
testchannel transform $channel -command [namespace code [list id_optrail $var]]
}
-
proc audit_flow {var -attach channel} {
testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
}
-
proc stopafter {var n -attach channel} {
- variable $var
- upvar 0 $var vn
+ namespace upvar [namespace current] $var vn
set vn $n
testchannel transform $channel -command [namespace code [list counter $var]]
}
-
proc stopafter_audit {var trail n -attach channel} {
- variable $var
- upvar 0 $var vn
+ namespace upvar [namespace current] $var vn
set vn $n
testchannel transform $channel -command [namespace code [list counter_audit $var $trail]]
}
-
proc rblocks_t {var trail n -attach channel} {
testchannel transform $channel -command [namespace code [list rblocks $var $trail $n]]
}
@@ -389,36 +345,31 @@ proc rblocks_t {var trail n -attach channel} {
proc array_sget {v} {
upvar $v a
-
set res [list]
foreach n [lsort [array names a]] {
lappend res $n $a($n)
}
set res
}
-
proc asort {alist} {
# sort a list of key/value pairs by key, removes duplicates too.
-
- array set a $alist
+ array set a $alist
array_sget a
}
-
+
########################################################################
test iogt-1.1 {stack/unstack} testchannel {
set fh [open $path(dummy) r]
identity -attach $fh
testchannel unstack $fh
- close $fh
+ close $fh
} {}
-
test iogt-1.2 {stack/close} testchannel {
set fh [open $path(dummy) r]
identity -attach $fh
- close $fh
+ close $fh
} {}
-
test iogt-1.3 {stack/unstack, configuration, options} testchannel {
set fh [open $path(dummy) r]
set ca [asort [fconfigure $fh]]
@@ -427,79 +378,53 @@ test iogt-1.3 {stack/unstack, configuration, options} testchannel {
testchannel unstack $fh
set cc [asort [fconfigure $fh]]
close $fh
-
- # With this system none of the buffering, translation and
- # encoding option may change their values with channels
- # stacked upon each other or not.
-
+ # With this system none of the buffering, translation and encoding option
+ # may change their values with channels stacked upon each other or not.
# cb == ca == cc
-
list [string equal $ca $cb] [string equal $cb $cc] [string equal $ca $cc]
} {1 1 1}
-
-test iogt-1.4 {stack/unstack, configuration} testchannel {
+test iogt-1.4 {stack/unstack, configuration} -setup {
set fh [open $path(dummy) r]
+} -constraints testchannel -body {
set ca [asort [fconfigure $fh]]
identity -attach $fh
- fconfigure $fh \
- -buffering line \
- -translation cr \
- -encoding shiftjis
+ fconfigure $fh -buffering line -translation cr -encoding shiftjis
testchannel unstack $fh
set cc [asort [fconfigure $fh]]
-
- set res [list \
- [string equal $ca $cc] \
- [fconfigure $fh -buffering] \
- [fconfigure $fh -translation] \
- [fconfigure $fh -encoding] \
- ]
-
+ list [string equal $ca $cc] [fconfigure $fh -buffering] \
+ [fconfigure $fh -translation] [fconfigure $fh -encoding]
+} -cleanup {
close $fh
- set res
-} {0 line cr shiftjis}
+} -result {0 line cr shiftjis}
-test iogt-2.0 {basic I/O going through transform} testchannel {
- set fin [open $path(dummy) r]
+test iogt-2.0 {basic I/O going through transform} -setup {
+ set fin [open $path(dummy) r]
set fout [open $path(dummyout) w]
-
+} -constraints testchannel -body {
identity -attach $fin
identity -attach $fout
-
fcopy $fin $fout
-
close $fin
close $fout
-
- set fin [open $path(dummy) r]
+ set fin [open $path(dummy) r]
set fout [open $path(dummyout) r]
-
- set res [string equal [set in [read $fin]] [set out [read $fout]]]
- lappend res [string length $in] [string length $out]
-
+ list [string equal [set in [read $fin]] [set out [read $fout]]] \
+ [string length $in] [string length $out]
+} -cleanup {
close $fin
close $fout
-
- set res
-} {1 71 71}
-
-
+} -result {1 71 71}
test iogt-2.1 {basic I/O, operation trail} {testchannel unix} {
- set fin [open $path(dummy) r]
+ set fin [open $path(dummy) r]
set fout [open $path(dummyout) w]
-
- set ain [list] ; set aout [list]
- audit_ops ain -attach $fin
+ set ain [list]; set aout [list]
+ audit_ops ain -attach $fin
audit_ops aout -attach $fout
-
- fconfigure $fin -buffersize 10
+ fconfigure $fin -buffersize 10
fconfigure $fout -buffersize 10
-
fcopy $fin $fout
-
close $fin
close $fout
-
set res "[join $ain \n]\n--------\n[join $aout \n]"
} {create/read
query/maxRead
@@ -533,23 +458,17 @@ write
write
flush/write
delete/write}
-
test iogt-2.2 {basic I/O, data trail} {testchannel unix} {
- set fin [open $path(dummy) r]
+ set fin [open $path(dummy) r]
set fout [open $path(dummyout) w]
-
- set ain [list] ; set aout [list]
- audit_flow ain -attach $fin
+ set ain [list]; set aout [list]
+ audit_flow ain -attach $fin
audit_flow aout -attach $fout
-
- fconfigure $fin -buffersize 10
+ fconfigure $fin -buffersize 10
fconfigure $fout -buffersize 10
-
fcopy $fin $fout
-
close $fin
close $fout
-
set res "[join $ain \n]\n--------\n[join $aout \n]"
} {create/read {} *ignored*
query/maxRead {} -1
@@ -587,24 +506,17 @@ write {
}
flush/write {} {}
delete/write {} *ignored*}
-
-
test iogt-2.3 {basic I/O, mixed trail} {testchannel unix} {
- set fin [open $path(dummy) r]
+ set fin [open $path(dummy) r]
set fout [open $path(dummyout) w]
-
set trail [list]
audit_flow trail -attach $fin
audit_flow trail -attach $fout
-
- fconfigure $fin -buffersize 20
+ fconfigure $fin -buffersize 20
fconfigure $fout -buffersize 10
-
fcopy $fin $fout
-
close $fin
close $fout
-
join $trail \n
} {create/read {} *ignored*
create/write {} *ignored*
@@ -634,110 +546,80 @@ delete/read {} *ignored*
flush/write {} {}
delete/write {} *ignored*}
-
-test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
- {testchannel unknownFailure} {
- # This test to check the validity of aquired Tcl_Channel references is
- # not possible because even a backgrounded fcopy will immediately start
- # to copy data, without waiting for the event loop. This is done only in
- # case of an underflow on the read size!. So stacking transforms after the
+test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup {
+ proc DoneCopy {n {err {}}} {
+ variable copy 1
+ }
+} -constraints {testchannel hangs} -body {
+ # This test to check the validity of aquired Tcl_Channel references is not
+ # possible because even a backgrounded fcopy will immediately start to
+ # copy data, without waiting for the event loop. This is done only in case
+ # of an underflow on the read size!. So stacking transforms after the
# fcopy will miss information, or are not used at all.
#
# I was able to circumvent this by using the echo.tcl server with a big
# delay, causing the fcopy to underflow immediately.
-
- proc DoneCopy {n {err {}}} {
- variable copy ; set copy 1
- }
-
- set fin [open $path(dummy) r]
-
+ set fin [open $path(dummy) r]
fevent 1000 500 {20 20 20 10 1 1} {
close $fin
-
- set fout [open dummyout w]
-
- flush $sock ; # now, or fcopy will error us out
- # But the 1 second delay should be enough to
- # initialize everything else here.
-
+ set fout [open dummyout w]
+ flush $sock; # now, or fcopy will error us out
+ # But the 1 second delay should be enough to initialize everything
+ # else here.
fcopy $sock $fout -command [namespace code DoneCopy]
-
- # transform after fcopy got its handles !
- # They should be still valid for fcopy.
-
+ # Transform after fcopy got its handles! They should be still valid
+ # for fcopy.
set trail [list]
audit_ops trail -attach $fout
-
vwait [namespace which -variable copy]
- } [read $fin] ; # {}
-
+ } [read $fin]; # {}
close $fout
-
- rename DoneCopy {}
-
# Check result of copy.
-
- set fin [open $path(dummy) r]
+ set fin [open $path(dummy) r]
set fout [open $path(dummyout) r]
-
set res [string equal [read $fin] [read $fout]]
-
close $fin
close $fout
-
list $res $trail
-} {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
-
+} -cleanup {
+ rename DoneCopy {}
+} -result {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
-test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} {
- set fin [open $path(dummy) r]
+test iogt-4.0 {fileevent readable, after transform} -setup {
+ set fin [open $path(dummy) r]
set data [read $fin]
close $fin
-
set trail [list]
- set got [list]
-
+ set got [list]
proc Done {args} {
- variable stop
- set stop 1
+ variable stop 1
}
-
- proc Get {sock} {
- variable trail
- variable got
- if {[eof $sock]} {
- Done
- lappend trail "xxxxxxxxxxxxx"
- close $sock
- return
- }
- lappend trail "vvvvvvvvvvvvv"
- lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
- lappend trail "============="
- #puts stdout $__ ; flush stdout
- #read $sock
- }
-
+} -constraints {testchannel hangs} -body {
fevent 1000 500 {20 20 20 10 1} {
- audit_flow trail -attach $sock
- rblocks_t rbuf trail 23 -attach $sock
-
- fileevent $sock readable [list Get $sock]
-
- flush $sock ; # now, or fcopy will error us out
- # But the 1 second delay should be enough to
- # initialize everything else here.
-
+ audit_flow trail -attach $sock
+ rblocks_t rbuf trail 23 -attach $sock
+ fileevent $sock readable [namespace code {
+ if {[eof $sock]} {
+ Done
+ lappend trail "xxxxxxxxxxxxx"
+ close $sock
+ } else {
+ lappend trail "vvvvvvvvvvvvv"
+ lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
+ lappend trail "============="
+ #puts stdout $__; flush stdout
+ #read $sock
+ }
+ }]
+ flush $sock; # Now, or fcopy will error us out
+ # But the 1 second delay should be enough to initialize everything
+ # else here.
vwait [namespace which -variable stop]
} $data
-
-
- rename Done {}
- rename Get {}
-
join [list [join $got \n] ~~~~~~~~ [join $trail \n]] \n
-} {[[]]
+} -cleanup {
+ rename Done {}
+} -result {[[]]
[[abcdefghijklmnopqrstuvw]]
[[xyz0123456789,./?><;'\|]]
[[]]
@@ -818,35 +700,27 @@ rblock | delete/write {} {} | {}
rblock | delete/read {} {} | {}
flush/write {} {}
delete/write {} *ignored*
-delete/read {} *ignored*} ; # catch unescaped quote "
-
+delete/read {} *ignored*}; # catch unescaped quote "
-test iogt-5.0 {EOF simulation} {testchannel unknownFailure} {
- set fin [open $path(dummy) r]
+test iogt-5.0 {EOF simulation} -setup {
+ set fin [open $path(dummy) r]
set fout [open $path(dummyout) w]
-
set trail [list]
-
+} -constraints {testchannel unknownFailure} -result {
audit_flow trail -attach $fin
- stopafter_audit d trail 20 -attach $fin
+ stopafter_audit d trail 20 -attach $fin
audit_flow trail -attach $fout
-
- fconfigure $fin -buffersize 20
+ fconfigure $fin -buffersize 20
fconfigure $fout -buffersize 10
-
- fcopy $fin $fout
+ fcopy $fin $fout
testchannel unstack $fin
-
# now copy the rest in the channel
lappend trail {**after unstack**}
-
fcopy $fin $fout
-
close $fin
close $fout
-
join $trail \n
-} {create/read {} *ignored*
+} -result {create/read {} *ignored*
counter:create/read {} {}
create/write {} *ignored*
counter:query/maxRead {} 20
@@ -880,59 +754,48 @@ delete/write {} *ignored*}
proc constX {op data} {
# replace anything coming in with a same-length string of x'es.
switch -- $op {
- create/write - create/read -
- delete/write - delete/read -
- clear_read {;#ignore}
- flush/write - flush/read -
- write -
- read {
+ create/write - create/read - delete/write - delete/read - clear_read {
+ #ignore
+ }
+ flush/write - flush/read - write - read {
return [string repeat x [string length $data]]
}
- query/maxRead {return -1}
+ query/maxRead {
+ return -1
+ }
}
}
-
proc constx {-attach channel} {
testchannel transform $channel -command [namespace code constX]
}
-test iogt-6.0 {Push back} testchannel {
+test iogt-6.0 {Push back} -constraints testchannel -body {
set f [open $path(dummy) r]
-
# contents of dummy = "abcdefghi..."
- read $f 3 ; # skip behind "abc"
-
+ read $f 3; # skip behind "abc"
constx -attach $f
-
- # expect to get "xxx" from the transform because
- # of unread "def" input to transform which returns "xxx".
+ # expect to get "xxx" from the transform because of unread "def" input to
+ # transform which returns "xxx".
#
- # Actually the IO layer pre-read the whole file and will
- # read "def" directly from the buffer without bothering
- # to consult the newly stacked transformation. This is
- # wrong.
-
- set res [read $f 3]
+ # Actually the IO layer pre-read the whole file and will read "def"
+ # directly from the buffer without bothering to consult the newly stacked
+ # transformation. This is wrong.
+ read $f 3
+} -cleanup {
close $f
- set res
-} {xxx}
-
-test iogt-6.1 {Push back and up} {testchannel knownBug} {
+} -result {xxx}
+test iogt-6.1 {Push back and up} -constraints {testchannel knownBug} -body {
set f [open $path(dummy) r]
-
# contents of dummy = "abcdefghi..."
- read $f 3 ; # skip behind "abc"
-
+ read $f 3; # skip behind "abc"
constx -attach $f
set res [read $f 3]
-
testchannel unstack $f
append res [read $f 3]
+} -cleanup {
close $f
- set res
-} {xxxghi}
-
-
+} -result {xxxghi}
+
# cleanup
foreach file [list dummy dummyout __echo_srv__.tcl] {
removeFile $file
diff --git a/tests/join.test b/tests/join.test
index 0a6da27..4abe233 100644
--- a/tests/join.test
+++ b/tests/join.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: join.test,v 1.7 2009/01/08 16:41:35 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -39,7 +37,7 @@ test join-2.2 {join errors} {
} {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}}
test join-2.3 {join errors} {
list [catch {join "a \{ c" 111} msg] $msg $errorCode
-} {1 {unmatched open brace in list} {TCL VALUE LIST}}
+} {1 {unmatched open brace in list} {TCL VALUE LIST BRACE}}
test join-3.1 {joinString is binary ok} {
string length [join {a b c} a\0b]
diff --git a/tests/lindex.test b/tests/lindex.test
index 1621fda..b86e2e0 100644
--- a/tests/lindex.test
+++ b/tests/lindex.test
@@ -11,14 +11,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: lindex.test,v 1.18 2008/07/13 23:15:22 nijtmans Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
set minus -
testConstraint testevalex [llength [info commands testevalex]]
diff --git a/tests/link.test b/tests/link.test
index 6b87ff5..00e490c 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -1,43 +1,48 @@
# Commands covered: none
#
-# This file contains a collection of tests for Tcl_LinkVar and related
-# library procedures. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for Tcl_LinkVar and related library
+# procedures. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 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.
-#
-# RCS: @(#) $Id: link.test,v 1.17 2007/12/13 15:26:06 dgp Exp $
+# 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
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testlink [llength [info commands testlink]]
foreach i {int real bool string} {
- catch {unset $i}
+ unset -nocomplain $i
}
-test link-1.1 {reading C variables from Tcl} {testlink} {
+
+test link-1.1 {reading C variables from Tcl} -constraints {testlink} -setup {
testlink delete
+} -body {
testlink set 43 1.23 4 - 12341234 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
list $int $real $bool $string $wide
-} {43 1.23 1 NULL 12341234}
-test link-1.2 {reading C variables from Tcl} {testlink} {
+} -result {43 1.23 1 NULL 12341234}
+test link-1.2 {reading C variables from Tcl} -constraints {testlink} -setup {
testlink delete
+} -body {
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set -3 2 0 "A long string with spaces" 43214321 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
list $int $real $bool $string $wide $int $real $bool $string $wide
-} {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}
+} -result {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}
-test link-2.1 {writing C variables from Tcl} {testlink} {
+test link-2.1 {writing C variables from Tcl} -constraints {testlink} -setup {
testlink delete
+} -body {
testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
set int "0o0721"
@@ -55,34 +60,39 @@ test link-2.1 {writing C variables from Tcl} {testlink} {
set float 1.0987654321
set uwide 357357357357
concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
-} {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357}
-test link-2.2 {writing bad values into variables} {testlink} {
+} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357}
+test link-2.2 {writing bad values into variables} -setup {
testlink delete
+} -constraints {testlink} -body {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
list [catch {set int 09a} msg] $msg $int
-} {1 {can't set "int": variable must have integer value} 43}
-test link-2.3 {writing bad values into variables} {testlink} {
+} -result {1 {can't set "int": variable must have integer value} 43}
+test link-2.3 {writing bad values into variables} -setup {
testlink delete
+} -constraints {testlink} -body {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
list [catch {set real 1.x3} msg] $msg $real
-} {1 {can't set "real": variable must have real value} 1.23}
-test link-2.4 {writing bad values into variables} {testlink} {
+} -result {1 {can't set "real": variable must have real value} 1.23}
+test link-2.4 {writing bad values into variables} -setup {
testlink delete
+} -constraints {testlink} -body {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
list [catch {set bool gorp} msg] $msg $bool
-} {1 {can't set "bool": variable must have boolean value} 1}
-test link-2.5 {writing bad values into variables} {testlink} {
+} -result {1 {can't set "bool": variable must have boolean value} 1}
+test link-2.5 {writing bad values into variables} -setup {
testlink delete
+} -constraints {testlink} -body {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
list [catch {set wide gorp} msg] $msg $bool
-} {1 {can't set "wide": variable must have integer value} 1}
+} -result {1 {can't set "wide": variable must have integer value} 1}
-test link-3.1 {read-only variables} {testlink} {
+test link-3.1 {read-only variables} -constraints {testlink} -setup {
testlink delete
+} -body {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 0 1 1 0 0 0 0 0 0 0 0 0 0 0
list [catch {set int 4} msg] $msg $int \
@@ -90,9 +100,10 @@ test link-3.1 {read-only variables} {testlink} {
[catch {set bool no} msg] $msg $bool \
[catch {set string "new value"} msg] $msg $string \
[catch {set wide 12341234} msg] $msg $wide
-} {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678}
-test link-3.2 {read-only variables} {testlink} {
+} -result {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678}
+test link-3.2 {read-only variables} -constraints {testlink} -setup {
testlink delete
+} -body {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 0 0 1 1 0 0 0 0 0 0 0 0 0
list [catch {set int 4} msg] $msg $int \
@@ -100,19 +111,21 @@ test link-3.2 {read-only variables} {testlink} {
[catch {set bool no} msg] $msg $bool \
[catch {set string "new value"} msg] $msg $string\
[catch {set wide 12341234} msg] $msg $wide
-} {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234}
+} -result {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234}
-test link-4.1 {unsetting linked variables} {testlink} {
+test link-4.1 {unsetting linked variables} -constraints {testlink} -setup {
testlink delete
+} -body {
testlink set -6 -2.5 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
unset int real bool string wide
list [catch {set int} msg] $msg [catch {set real} msg] $msg \
[catch {set bool} msg] $msg [catch {set string} msg] $msg \
[catch {set wide} msg] $msg
-} {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
-test link-4.2 {unsetting linked variables} {testlink} {
+} -result {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
+test link-4.2 {unsetting linked variables} -constraints {testlink} -setup {
testlink delete
+} -body {
testlink set -6 -2.1 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
unset int real bool string wide
@@ -122,10 +135,11 @@ test link-4.2 {unsetting linked variables} {testlink} {
set string newValue
set wide 333555
lrange [testlink get] 0 4
-} {102 16.0 1 newValue 333555}
+} -result {102 16.0 1 newValue 333555}
-test link-5.1 {unlinking variables} {testlink} {
+test link-5.1 {unlinking variables} -constraints {testlink} -setup {
testlink delete
+} -body {
testlink set -6 -2.25 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink delete
set int xx1
@@ -143,98 +157,108 @@ test link-5.1 {unlinking variables} {testlink} {
set float dskjfbjfd
set uwide isdfsngs
testlink get
-} {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234}
-test link-5.2 {unlinking variables} {testlink} {
+} -result {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234}
+test link-5.2 {unlinking variables} -constraints {testlink} -setup {
testlink delete
+} -body {
testlink set -6 -2.25 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink delete
testlink set 25 14.7 7 - 999999 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
list $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
-} {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234}
+} -result {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234}
-test link-6.1 {errors in setting up link} {testlink} {
+test link-6.1 {errors in setting up link} -setup {
testlink delete
- catch {unset int}
+ unset -nocomplain int
+} -constraints {testlink} -body {
set int(44) 1
- list [catch {testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1} msg] $msg
-} {1 {can't set "int": variable is array}}
-catch {unset int}
+ testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+} -cleanup {
+ unset -nocomplain int
+} -returnCodes error -result {can't set "int": variable is array}
-test link-7.1 {access to linked variables via upvar} {testlink} {
+test link-7.1 {access to linked variables via upvar} -setup {
+ testlink delete
+} -constraints {testlink} -body {
proc x {} {
upvar int y
unset y
}
- testlink delete
testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
testlink set 14 {} {} {} {} {} {} {} {} {} {} {} {} {}
x
list [catch {set int} msg] $msg
-} {0 14}
-test link-7.2 {access to linked variables via upvar} {testlink} {
+} -result {0 14}
+test link-7.2 {access to linked variables via upvar} -setup {
+ testlink delete
+} -constraints {testlink} -body {
proc x {} {
upvar int y
return [set y]
}
- testlink delete
testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
testlink set 0 {} {} {} {} {} {} {} {} {} {} {} {} {}
set int
testlink set 23 {} {} {} {} {} {} {} {} {} {} {} {} {}
x
list [x] $int
-} {23 23}
-test link-7.3 {access to linked variables via upvar} {testlink} {
+} -result {23 23}
+test link-7.3 {access to linked variables via upvar} -setup {
+ testlink delete
+} -constraints {testlink} -body {
proc x {} {
upvar int y
set y 44
}
- testlink delete
testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
testlink set 11 {} {} {} {} {} {} {} {} {} {} {} {} {}
list [catch x msg] $msg $int
-} {1 {can't set "y": linked variable is read-only} 11}
-test link-7.4 {access to linked variables via upvar} {testlink} {
+} -result {1 {can't set "y": linked variable is read-only} 11}
+test link-7.4 {access to linked variables via upvar} -setup {
+ testlink delete
+} -constraints {testlink} -body {
proc x {} {
upvar int y
set y abc
}
- testlink delete
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set -4 {} {} {} {} {} {} {} {} {} {} {} {} {}
list [catch x msg] $msg $int
-} {1 {can't set "y": variable must have integer value} -4}
-test link-7.5 {access to linked variables via upvar} {testlink} {
+} -result {1 {can't set "y": variable must have integer value} -4}
+test link-7.5 {access to linked variables via upvar} -setup {
+ testlink delete
+} -constraints {testlink} -body {
proc x {} {
upvar real y
set y abc
}
- testlink delete
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set -4 16.75 {} {} {} {} {} {} {} {} {} {} {} {}
list [catch x msg] $msg $real
-} {1 {can't set "y": variable must have real value} 16.75}
-test link-7.6 {access to linked variables via upvar} {testlink} {
+} -result {1 {can't set "y": variable must have real value} 16.75}
+test link-7.6 {access to linked variables via upvar} -setup {
+ testlink delete
+} -constraints {testlink} -body {
proc x {} {
upvar bool y
set y abc
}
- testlink delete
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set -4 16.3 1 {} {} {} {} {} {} {} {} {} {} {}
list [catch x msg] $msg $bool
-} {1 {can't set "y": variable must have boolean value} 1}
-test link-7.7 {access to linked variables via upvar} {testlink} {
+} -result {1 {can't set "y": variable must have boolean value} 1}
+test link-7.7 {access to linked variables via upvar} -setup {
+ testlink delete
+} -constraints {testlink} -body {
proc x {} {
upvar wide y
set y abc
}
- testlink delete
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set -4 16.3 1 {} 778899 {} {} {} {} {} {} {} {} {}
list [catch x msg] $msg $wide
-} {1 {can't set "y": variable must have integer value} 778899}
+} -result {1 {can't set "y": variable must have integer value} 778899}
test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
proc x args {
@@ -247,7 +271,7 @@ test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
trace var int w x
testlink update 32 4.0 3 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
trace vdelete int w x
- set x
+ return $x
} {{int {} w} 32 -2.0 0 xyzzy 995511}
test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
proc x args {
@@ -261,7 +285,7 @@ test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
trace var int w x
testlink update 32 4.0 6 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
trace vdelete int w x
- set x
+ return $x
} {}
test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
@@ -269,13 +293,18 @@ test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {}
} msg] $msg $int
} {0 {} 47}
-
+
catch {testlink set 0 0 0 - 0 0 0 0 0 0 0 0 0 0}
catch {testlink delete}
foreach i {int real bool string wide} {
- catch {unset $i}
+ unset -nocomplain $i
}
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/linsert.test b/tests/linsert.test
index e9c545a..4939e5c 100644
--- a/tests/linsert.test
+++ b/tests/linsert.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: linsert.test,v 1.11 2008/09/29 15:38:32 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/list.test b/tests/list.test
index 0dd2d73..dff5d50 100644
--- a/tests/list.test
+++ b/tests/list.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: list.test,v 1.8 2010/02/12 03:21:32 mdejong Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -127,6 +125,10 @@ test list-3.1 {SetListFromAny and lrange/concat results} {
slowsort {fred julie alex carol bill annie}
} {alex annie bill carol fred julie}
+test list-4.1 {Bug 3173086} {
+ string is list "{[list \\\\\}]}"
+} 1
+
# cleanup
::tcltest::cleanupTests
return
diff --git a/tests/listObj.test b/tests/listObj.test
index 2e8ae17..8b24aa9 100644
--- a/tests/listObj.test
+++ b/tests/listObj.test
@@ -10,14 +10,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: listObj.test,v 1.9 2010/03/18 20:34:48 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testobj [llength [info commands testobj]]
catch {unset x}
@@ -201,4 +202,4 @@ return
# Local Variables:
# mode: tcl
-# End: \ No newline at end of file
+# End:
diff --git a/tests/llength.test b/tests/llength.test
index 1f272f7..169c7ca 100644
--- a/tests/llength.test
+++ b/tests/llength.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: llength.test,v 1.6 2004/05/19 12:23:58 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/lmap.test b/tests/lmap.test
new file mode 100644
index 0000000..7baa77b
--- /dev/null
+++ b/tests/lmap.test
@@ -0,0 +1,464 @@
+# Commands covered: lmap, continue, break
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 2011 Trevor Davel
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: $
+
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2
+ namespace import -force ::tcltest::*
+}
+
+unset -nocomplain a i x
+
+# ----- Non-compiled operation -----------------------------------------------
+
+# Basic "lmap" operation (non-compiled)
+test lmap-1.1 {basic lmap tests} {
+ set a {}
+ lmap i {a b c d} {
+ set a [concat $a $i]
+ }
+} {a {a b} {a b c} {a b c d}}
+test lmap-1.2 {basic lmap tests} {
+ lmap i {a b {{c d} e} {123 {{x}}}} {
+ set i
+ }
+} {a b {{c d} e} {123 {{x}}}}
+test lmap-1.2a {basic lmap tests} {
+ lmap i {a b {{c d} e} {123 {{x}}}} {
+ return -level 0 $i
+ }
+} {a b {{c d} e} {123 {{x}}}}
+test lmap-1.4 {basic lmap tests} -returnCodes error -body {
+ lmap
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.6 {basic lmap tests} -returnCodes error -body {
+ lmap i
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.8 {basic lmap tests} -returnCodes error -body {
+ lmap i j
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.10 {basic lmap tests} -returnCodes error -body {
+ lmap i j k l
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.11 {basic lmap tests} {
+ lmap i {} {
+ set i
+ }
+} {}
+test lmap-1.12 {basic lmap tests} {
+ lmap i {} {
+ return -level 0 x
+ }
+} {}
+test lmap-1.13 {lmap errors} -returnCodes error -body {
+ lmap {{a}{b}} {1 2 3} {}
+} -result {list element in braces followed by "{b}" instead of space}
+test lmap-1.14 {lmap errors} -returnCodes error -body {
+ lmap a {{1 2}3} {}
+} -result {list element in braces followed by "3" instead of space}
+unset -nocomplain a
+test lmap-1.15 {lmap errors} -setup {
+ unset -nocomplain a
+} -body {
+ set a(0) 44
+ list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
+} -result {1 {can't set "a": variable is array} {can't set "a": variable is array
+ (setting lmap loop variable "a")
+ invoked from within
+"lmap a {1 2 3} {}"}}
+test lmap-1.16 {lmap errors} -returnCodes error -body {
+ lmap {} {} {}
+} -result {lmap varlist is empty}
+unset -nocomplain a
+
+# Parallel "lmap" operation (non-compiled)
+test lmap-2.1 {parallel lmap tests} {
+ lmap {a b} {1 2 3 4} {
+ list $b $a
+ }
+} {{2 1} {4 3}}
+test lmap-2.2 {parallel lmap tests} {
+ lmap {a b} {1 2 3 4 5} {
+ list $b $a
+ }
+} {{2 1} {4 3} {{} 5}}
+test lmap-2.3 {parallel lmap tests} {
+ lmap a {1 2 3} b {4 5 6} {
+ list $b $a
+ }
+} {{4 1} {5 2} {6 3}}
+test lmap-2.4 {parallel lmap tests} {
+ lmap a {1 2 3} b {4 5 6 7 8} {
+ list $b $a
+ }
+} {{4 1} {5 2} {6 3} {7 {}} {8 {}}}
+test lmap-2.5 {parallel lmap tests} {
+ lmap {a b} {a b A B aa bb} c {c C cc CC} {
+ list $a $b $c
+ }
+} {{a b c} {A B C} {aa bb cc} {{} {} CC}}
+test lmap-2.6 {parallel lmap tests} {
+ lmap a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
+ list $a$b$c$d$e
+ }
+} {11111 22222 33333}
+test lmap-2.7 {parallel lmap tests} {
+ lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+ set x $a$b$c$d$e
+ }
+} {{1111 2} 222 33 4}
+test lmap-2.8 {parallel lmap tests} {
+ lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+ join [list $a $b $c $d $e] .
+ }
+} {{.1.1.1.1 2} .2.2.2. .3..3. ...4.}
+test lmap-2.9 {lmap only sets vars if repeating loop} {
+ namespace eval ::lmap_test {
+ set rgb {65535 0 0}
+ lmap {r g b} [set rgb] {}
+ set ::x "r=$r, g=$g, b=$b"
+ }
+ namespace delete ::lmap_test
+ set x
+} {r=65535, g=0, b=0}
+test lmap-2.10 {lmap only supports local scalar variables} -setup {
+ unset -nocomplain a
+} -body {
+ lmap {a(3)} {1 2 3 4} {set {a(3)}}
+} -result {1 2 3 4}
+unset -nocomplain a
+
+# "lmap" with "continue" and "break" (non-compiled)
+test lmap-3.1 {continue tests} {
+ lmap i {a b c d} {
+ if {[string compare $i "b"] == 0} continue
+ set i
+ }
+} {a c d}
+test lmap-3.2 {continue tests} {
+ set x 0
+ list [lmap i {a b c d} {
+ incr x
+ if {[string compare $i "b"] != 0} continue
+ set i
+ }] $x
+} {b 4}
+test lmap-3.3 {break tests} {
+ set x 0
+ list [lmap i {a b c d} {
+ incr x
+ if {[string compare $i "c"] == 0} break
+ set i
+ }] $x
+} {{a b} 3}
+# Check for bug similar to #406709
+test lmap-3.4 {break tests} {
+ set a 1
+ lmap b b {list [concat a; break]; incr a}
+ incr a
+} {2}
+
+# ----- Compiled operation ---------------------------------------------------
+
+# Basic "lmap" operation (compiled)
+test lmap-4.1 {basic lmap tests} {
+ apply {{} {
+ set a {}
+ lmap i {a b c d} {
+ set a [concat $a $i]
+ }
+ }}
+} {a {a b} {a b c} {a b c d}}
+test lmap-4.2 {basic lmap tests} {
+ apply {{} {
+ lmap i {a b {{c d} e} {123 {{x}}}} {
+ set i
+ }
+ }}
+} {a b {{c d} e} {123 {{x}}}}
+test lmap-4.2a {basic lmap tests} {
+ apply {{} {
+ lmap i {a b {{c d} e} {123 {{x}}}} {
+ return -level 0 $i
+ }
+ }}
+} {a b {{c d} e} {123 {{x}}}}
+test lmap-4.4 {basic lmap tests} -returnCodes error -body {
+ apply {{} { lmap }}
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.6 {basic lmap tests} -returnCodes error -body {
+ apply {{} { lmap i }}
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.8 {basic lmap tests} -returnCodes error -body {
+ apply {{} { lmap i j }}
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.10 {basic lmap tests} -returnCodes error -body {
+ apply {{} { lmap i j k l }}
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.11 {basic lmap tests} {
+ apply {{} { lmap i {} { set i } }}
+} {}
+test lmap-4.12 {basic lmap tests} {
+ apply {{} { lmap i {} { return -level 0 x } }}
+} {}
+test lmap-4.13 {lmap errors} -returnCodes error -body {
+ apply {{} { lmap {{a}{b}} {1 2 3} {} }}
+} -result {list element in braces followed by "{b}" instead of space}
+test lmap-4.14 {lmap errors} -returnCodes error -body {
+ apply {{} { lmap a {{1 2}3} {} }}
+} -result {list element in braces followed by "3" instead of space}
+unset -nocomplain a
+test lmap-4.15 {lmap errors} {
+ apply {{} {
+ set a(0) 44
+ list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
+ }}
+} {1 {can't set "a": variable is array} {can't set "a": variable is array
+ while executing
+"lmap a {1 2 3} {}"}}
+test lmap-4.16 {lmap errors} -returnCodes error -body {
+ apply {{} {
+ lmap {} {} {}
+ }}
+} -result {lmap varlist is empty}
+unset -nocomplain a
+
+# Parallel "lmap" operation (compiled)
+test lmap-5.1 {parallel lmap tests} {
+ apply {{} {
+ lmap {a b} {1 2 3 4} {
+ list $b $a
+ }
+ }}
+} {{2 1} {4 3}}
+test lmap-5.2 {parallel lmap tests} {
+ apply {{} {
+ lmap {a b} {1 2 3 4 5} {
+ list $b $a
+ }
+ }}
+} {{2 1} {4 3} {{} 5}}
+test lmap-5.3 {parallel lmap tests} {
+ apply {{} {
+ lmap a {1 2 3} b {4 5 6} {
+ list $b $a
+ }
+ }}
+} {{4 1} {5 2} {6 3}}
+test lmap-5.4 {parallel lmap tests} {
+ apply {{} {
+ lmap a {1 2 3} b {4 5 6 7 8} {
+ list $b $a
+ }
+ }}
+} {{4 1} {5 2} {6 3} {7 {}} {8 {}}}
+test lmap-5.5 {parallel lmap tests} {
+ apply {{} {
+ lmap {a b} {a b A B aa bb} c {c C cc CC} {
+ list $a $b $c
+ }
+ }}
+} {{a b c} {A B C} {aa bb cc} {{} {} CC}}
+test lmap-5.6 {parallel lmap tests} {
+ apply {{} {
+ lmap a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
+ list $a$b$c$d$e
+ }
+ }}
+} {11111 22222 33333}
+test lmap-5.7 {parallel lmap tests} {
+ apply {{} {
+ lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+ set x $a$b$c$d$e
+ }
+ }}
+} {{1111 2} 222 33 4}
+test lmap-5.8 {parallel lmap tests} {
+ apply {{} {
+ lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+ join [list $a $b $c $d $e] .
+ }
+ }}
+} {{.1.1.1.1 2} .2.2.2. .3..3. ...4.}
+test lmap-5.9 {lmap only sets vars if repeating loop} {
+ apply {{} {
+ set rgb {65535 0 0}
+ lmap {r g b} [set rgb] {}
+ return "r=$r, g=$g, b=$b"
+ }}
+} {r=65535, g=0, b=0}
+test lmap-5.10 {lmap only supports local scalar variables} {
+ apply {{} {
+ lmap {a(3)} {1 2 3 4} {set {a(3)}}
+ }}
+} {1 2 3 4}
+
+# "lmap" with "continue" and "break" (compiled)
+test lmap-6.1 {continue tests} {
+ apply {{} {
+ lmap i {a b c d} {
+ if {[string compare $i "b"] == 0} continue
+ set i
+ }
+ }}
+} {a c d}
+test lmap-6.2 {continue tests} {
+ apply {{} {
+ list [lmap i {a b c d} {
+ incr x
+ if {[string compare $i "b"] != 0} continue
+ set i
+ }] $x
+ }}
+} {b 4}
+test lmap-6.3 {break tests} {
+ apply {{} {
+ list [lmap i {a b c d} {
+ incr x
+ if {[string compare $i "c"] == 0} break
+ set i
+ }] $x
+ }}
+} {{a b} 3}
+# Check for bug similar to #406709
+test lmap-6.4 {break tests} {
+ apply {{} {
+ set a 1
+ lmap b b {list [concat a; break]; incr a}
+ incr a
+ }}
+} {2}
+
+# ----- Special cases and bugs -----------------------------------------------
+test lmap-7.1 {compiled lmap backward jump works correctly} -setup {
+ unset -nocomplain x
+} -body {
+ array set x {0 zero 1 one 2 two 3 three}
+ lsort [apply {{arrayName} {
+ upvar 1 $arrayName a
+ lmap member [array names a] {
+ list $member [set a($member)]
+ }
+ }} x]
+} -result [lsort {{0 zero} {1 one} {2 two} {3 three}}]
+test lmap-7.2 {noncompiled lmap and shared variable or value list objects that are converted to another type} -setup {
+ unset -nocomplain x
+} -body {
+ lmap {12.0} {a b c} {
+ set x 12.0
+ set x [expr $x + 1]
+ }
+} -result {13.0 13.0 13.0}
+# Test for incorrect "double evaluation" semantics
+test lmap-7.3 {delayed substitution of body} {
+ apply {{} {
+ set a 0
+ lmap a [list 1 2 3] "
+ set x $a
+ "
+ return $x
+ }}
+} {0}
+# Related to "foreach" test for [Bug 1189274]; crash on failure
+test lmap-7.4 {empty list handling} {
+ proc crash {} {
+ rename crash {}
+ set a "x y z"
+ set b ""
+ lmap aa $a bb $b { set x "aa = $aa bb = $bb" }
+ }
+ crash
+} {{aa = x bb = } {aa = y bb = } {aa = z bb = }}
+# Related to [Bug 1671138]; infinite loop with empty var list in bytecompiled
+# version.
+test lmap-7.5 {compiled empty var list} -returnCodes error -body {
+ proc foo {} {
+ lmap {} x {
+ error "reached body"
+ }
+ }
+ foo
+} -cleanup {
+ catch {rename foo ""}
+} -result {lmap varlist is empty}
+test lmap-7.6 {lmap: related to "foreach" [Bug 1671087]} -setup {
+ proc demo {} {
+ set vals {1 2 3 4}
+ trace add variable x write {string length $vals ;# }
+ lmap {x y} $vals {format $y}
+ }
+} -body {
+ demo
+} -cleanup {
+ rename demo {}
+} -result {2 4}
+# Huge lists must not overflow the bytecode interpreter (development bug)
+test lmap-7.7 {huge list non-compiled} {
+ set x [lmap a [lrepeat 1000000 x] { set b y$a }]
+ list $b [llength $x] [string length $x]
+} {yx 1000000 2999999}
+test lmap-7.8 {huge list compiled} {
+ set x [apply {{times} { lmap a [lrepeat $times x] { set b y$a }}} 1000000]
+ list $b [llength $x] [string length $x]
+} {yx 1000000 2999999}
+test lmap-7.9 {error then dereference loop var (dev bug)} {
+ catch { lmap a 0 b {1 2 3} { error x } }
+ set a
+} 0
+test lmap-7.9a {error then dereference loop var (dev bug)} {
+ catch { lmap a 0 b {1 2 3} { incr a $b; error x } }
+ set a
+} 1
+
+# ----- Coroutines -----------------------------------------------------------
+test lmap-8.1 {lmap non-compiled with coroutines} -body {
+ coroutine coro apply {{} {
+ set values [yield [info coroutine]]
+ eval lmap i [list $values] {{ yield $i }}
+ }} ;# returns 'coro'
+ coro {a b c d e f} ;# -> a
+ coro 1 ;# -> b
+ coro 2 ;# -> c
+ coro 3 ;# -> d
+ coro 4 ;# -> e
+ coro 5 ;# -> f
+ list [coro 6] [info commands coro]
+} -cleanup {
+ catch {rename coro ""}
+} -result {{1 2 3 4 5 6} {}}
+test lmap-8.2 {lmap compiled with coroutines} -body {
+ coroutine coro apply {{} {
+ set values [yield [info coroutine]]
+ lmap i $values { yield $i }
+ }} ;# returns 'coro'
+ coro {a b c d e f} ;# -> a
+ coro 1 ;# -> b
+ coro 2 ;# -> c
+ coro 3 ;# -> d
+ coro 4 ;# -> e
+ coro 5 ;# -> f
+ list [coro 6] [info commands coro]
+} -cleanup {
+ catch {rename coro ""}
+} -result {{1 2 3 4 5 6} {}}
+
+# cleanup
+unset -nocomplain a x
+catch {rename foo {}}
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/load.test b/tests/load.test
index 711b919..cded85d 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -9,14 +9,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: load.test,v 1.21 2010/04/02 21:21:06 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Figure out what extension is used for shared libraries on this
# platform.
if {![info exists ext]} {
@@ -46,32 +47,38 @@ testConstraint testsimplefilesystem \
test load-1.1 {basic errors} {} {
list [catch {load} msg] $msg
-} "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}"
+} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}"
test load-1.2 {basic errors} {} {
list [catch {load a b c d} msg] $msg
-} "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}"
+} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}"
test load-1.3 {basic errors} {} {
list [catch {load a b foobar} msg] $msg
} {1 {could not find interpreter "foobar"}}
test load-1.4 {basic errors} {} {
- list [catch {load {}} msg] $msg
+ list [catch {load -global {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.5 {basic errors} {} {
- list [catch {load {} {}} msg] $msg
+ list [catch {load -lazy {} {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.6 {basic errors} {} {
list [catch {load {} Unknown} msg] $msg
} {1 {package "Unknown" isn't loaded statically}}
+test load-1.7 {basic errors} {} {
+ list [catch {load -abc foo} msg] $msg
+} "1 {bad option \"-abc\": must be -global, -lazy, or --}"
+test load-1.8 {basic errors} {} {
+ list [catch {load -global} msg] $msg
+} "1 {couldn't figure out package name for -global}"
test load-2.1 {basic loading, with guess for package name} \
[list $dll $loaded] {
- load [file join $testDir pkga$ext]
+ load -global [file join $testDir pkga$ext]
list [pkga_eq abc def] [lsort [info commands pkga_*]]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
test load-2.2 {loading into a safe interpreter, with package name conversion} \
[list $dll $loaded] {
- load [file join $testDir pkgb$ext] pKgB child
+ load -lazy [file join $testDir pkgb$ext] pKgB child
list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
[catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
@@ -125,7 +132,7 @@ test load-5.1 {file name not specified and no static package: pick default} \
[list $dll $loaded] {
catch {interp delete x}
interp create x
- load [file join $testDir pkga$ext] pkga
+ load -global [file join $testDir pkga$ext] pkga
load {} pkga x
set result [info loaded x]
interp delete x
@@ -181,7 +188,7 @@ test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded]
test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded teststaticpkg] {
load [file join $testDir pkgb$ext] pkgb
list [info loaded {}] [lsort [info commands pkgb_*]]
-} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_sub pkgb_unsafe}]
+} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_demo pkgb_sub pkgb_unsafe}]
interp delete child
test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \
@@ -199,7 +206,7 @@ test load-9.1 {Tcl_StaticPackage, load already-loaded package into another inter
[child1 eval { info loaded {} }] \
[child2 eval { info loaded {} }]
} \
- -result {{{{} Loadninepointone} {{} Tcltest}} {{{} Loadninepointone} {{} Tcltest}}} \
+ -match glob -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}} \
-cleanup { interp delete child1 ; interp delete child2 }
test load-10.1 {load from vfs} \
diff --git a/tests/lrange.test b/tests/lrange.test
index 6f8f88d..17a757e 100644
--- a/tests/lrange.test
+++ b/tests/lrange.test
@@ -10,14 +10,12 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: lrange.test,v 1.12 2009/02/22 17:45:21 ferrieux Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-
+
test lrange-1.1 {range of list elements} {
lrange {a b c d} 1 2
} {b c}
@@ -63,9 +61,11 @@ test lrange-1.14 {range of list elements} {
test lrange-1.15 {range of list elements} {
concat \"[lrange {a b \{\ } 0 2]"
} {"a b \{\ "}
+# emacs highlighting bug workaround --> "
test lrange-1.16 {list element quoting} {
lrange {[append a .b]} 0 end
} {{[append} a .b\]}
+
test lrange-2.1 {error conditions} {
list [catch {lrange a b} msg] $msg
} {1 {wrong # args: should be "lrange list first last"}}
@@ -85,6 +85,16 @@ test lrange-2.6 {error conditions} {
list [catch {lrange "a b c \{ d e" 1 4} msg] $msg
} {1 {unmatched open brace in list}}
+test lrange-3.1 {Bug 3588366: end-offsets before start} {
+ apply {l {
+ lrange $l 0 end-5
+ }} {1 2 3 4 5}
+} {}
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/lrepeat.test b/tests/lrepeat.test
index 7789e2f..788bb9b 100644
--- a/tests/lrepeat.test
+++ b/tests/lrepeat.test
@@ -8,8 +8,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: lrepeat.test,v 1.4 2008/09/28 20:39:08 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -65,7 +63,7 @@ test lrepeat-1.7 {Accept zero repetitions (TIP 323)} {
}
test lrepeat-1.8 {Do not build enormous lists - Bug 2130992} -body {
lrepeat 0x10000000 a b c d e f g h
-} -returnCodes error -result {too many elements in result list}
+} -returnCodes error -match glob -result *
## Okay
test lrepeat-2.1 {normal cases} {
diff --git a/tests/lreplace.test b/tests/lreplace.test
index 59934fb..5f675bc 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: lreplace.test,v 1.10 2008/07/21 22:22:28 nijtmans Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/lsearch.test b/tests/lsearch.test
index 634adda..f36e987 100644
--- a/tests/lsearch.test
+++ b/tests/lsearch.test
@@ -1,23 +1,21 @@
# Commands covered: lsearch
#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 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.
-#
-# RCS: @(#) $Id: lsearch.test,v 1.22 2008/09/29 12:25:21 dkf Exp $
+# 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
namespace import -force ::tcltest::*
}
-
+
set x {abcd bbcd 123 234 345}
test lsearch-1.1 {lsearch command} {
lsearch $x 123
@@ -47,9 +45,9 @@ test lsearch-2.4 {search modes} {
test lsearch-2.5 {search modes} {
lsearch -exact {foo bar cat} bar
} 1
-test lsearch-2.6 {search modes} {
- list [catch {lsearch -regexp {xyz bbcc *bc*} *bc*} msg] $msg
-} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
+test lsearch-2.6 {search modes} -returnCodes error -body {
+ lsearch -regexp {xyz bbcc *bc*} *bc*
+} -result {couldn't compile regular expression pattern: quantifier operand invalid}
test lsearch-2.7 {search modes} {
lsearch -regexp {b.x ^bc xy bcx} ^bc
} 3
@@ -59,9 +57,9 @@ test lsearch-2.8 {search modes} {
test lsearch-2.9 {search modes} {
lsearch -glob {b.x ^bc xy bcx} ^bc
} 1
-test lsearch-2.10 {search modes} {
- list [catch {lsearch -glib {b.x bx xy bcx} b.x} msg] $msg
-} {1 {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
+test lsearch-2.10 {search modes} -returnCodes error -body {
+ lsearch -glib {b.x bx xy bcx} b.x
+} -result {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
test lsearch-2.11 {search modes with -nocase} {
lsearch -exact -nocase {a b c A B C} A
} 0
@@ -81,27 +79,27 @@ test lsearch-2.16 {search modes without -nocase} {
lsearch -regexp {a b c A B C} ^A\$
} 3
-test lsearch-3.1 {lsearch errors} {
- list [catch lsearch msg] $msg
-} {1 {wrong # args: should be "lsearch ?-option value ...? list pattern"}}
-test lsearch-3.2 {lsearch errors} {
- list [catch {lsearch a} msg] $msg
-} {1 {wrong # args: should be "lsearch ?-option value ...? list pattern"}}
-test lsearch-3.3 {lsearch errors} {
- list [catch {lsearch a b c} msg] $msg
-} {1 {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
-test lsearch-3.4 {lsearch errors} {
- list [catch {lsearch a b c d} msg] $msg
-} {1 {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
-test lsearch-3.5 {lsearch errors} {
- list [catch {lsearch "\{" b} msg] $msg
-} {1 {unmatched open brace in list}}
-test lsearch-3.6 {lsearch errors} {
- list [catch {lsearch -index a b} msg] $msg
-} {1 {"-index" option must be followed by list index}}
-test lsearch-3.7 {lsearch errors} {
- list [catch {lsearch -subindices -exact a b} msg] $msg
-} {1 {-subindices cannot be used without -index option}}
+test lsearch-3.1 {lsearch errors} -returnCodes error -body {
+ lsearch
+} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"}
+test lsearch-3.2 {lsearch errors} -returnCodes error -body {
+ lsearch a
+} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"}
+test lsearch-3.3 {lsearch errors} -returnCodes error -body {
+ lsearch a b c
+} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
+test lsearch-3.4 {lsearch errors} -returnCodes error -body {
+ lsearch a b c d
+} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
+test lsearch-3.5 {lsearch errors} -returnCodes error -body {
+ lsearch "\{" b
+} -result {unmatched open brace in list}
+test lsearch-3.6 {lsearch errors} -returnCodes error -body {
+ lsearch -index a b
+} -result {"-index" option must be followed by list index}
+test lsearch-3.7 {lsearch errors} -returnCodes error -body {
+ lsearch -subindices -exact a b
+} -result {-subindices cannot be used without -index option}
test lsearch-4.1 {binary data} {
lsearch -exact [list foo one\000two bar] bar
@@ -300,12 +298,12 @@ test lsearch-10.2 {offset searching} {
test lsearch-10.3 {offset searching} {
lsearch -start end-4 {a b c a b c} a
} 3
-test lsearch-10.4 {offset searching} {
- list [catch {lsearch -start foobar {a b c a b c} a} msg] $msg
-} {1 {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?}}
-test lsearch-10.5 {offset searching} {
- list [catch {lsearch -start 1 2} msg] $msg
-} {1 {missing starting index}}
+test lsearch-10.4 {offset searching} -returnCodes error -body {
+ lsearch -start foobar {a b c a b c} a
+} -result {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?}
+test lsearch-10.5 {offset searching} -returnCodes error -body {
+ lsearch -start 1 2
+} -result {missing starting index}
test lsearch-10.6 {binary search with offset} {
set res {}
for {set i 0} {$i < 100} {incr i} {
@@ -453,15 +451,15 @@ test lsearch-19.5 {lsearch -sunindices option} {
lsearch -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {{0 0 0} {1 0 0}}
-test lsearch-20.1 {lsearch -index option, index larger than sublists} {
- list [catch {lsearch -index 2 {{a c} {a b} {a a}} a} msg] $msg
-} {1 {element 2 missing from sublist "a c"}}
-test lsearch-20.2 {lsearch -index option, malformed index} {
- list [catch {lsearch -index foo {{a c} {a b} {a a}} a} msg] $msg
-} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}}
-test lsearch-20.3 {lsearch -index option, malformed index} {
- list [catch {lsearch -index \{ {{a c} {a b} {a a}} a} msg] $msg
-} {1 {unmatched open brace in list}}
+test lsearch-20.1 {lsearch -index option, index larger than sublists} -body {
+ lsearch -index 2 {{a c} {a b} {a a}} a
+} -returnCodes error -result {element 2 missing from sublist "a c"}
+test lsearch-20.2 {lsearch -index option, malformed index} -body {
+ lsearch -index foo {{a c} {a b} {a a}} a
+} -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}
+test lsearch-20.3 {lsearch -index option, malformed index} -body {
+ lsearch -index \{ {{a c} {a b} {a a}} a
+} -returnCodes error -result {unmatched open brace in list}
test lsearch-21.1 {lsearch shimmering crash} {
set x 0
@@ -511,7 +509,7 @@ test lsearch-22.5 {lsearch -bisect, all equal} {
test lsearch-22.6 {lsearch -sorted, all equal} {
lsearch -sorted -integer {5 5 5 5} 5
} {0}
-
+
# cleanup
catch {unset res}
catch {unset increasingIntegers}
diff --git a/tests/lset.test b/tests/lset.test
index c10f433..1c1300b 100644
--- a/tests/lset.test
+++ b/tests/lset.test
@@ -10,14 +10,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
proc failTrace {name1 name2 op} {
error "trace failed"
}
diff --git a/tests/lsetComp.test b/tests/lsetComp.test
index bc08d78..6846cbf 100755
--- a/tests/lsetComp.test
+++ b/tests/lsetComp.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/macOSXFCmd.test b/tests/macOSXFCmd.test
index 5c87bab..071f11b 100644
--- a/tests/macOSXFCmd.test
+++ b/tests/macOSXFCmd.test
@@ -8,9 +8,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: macOSXFCmd.test,v 1.5 2006/08/18 07:45:31 das Exp $
-#
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/macOSXLoad.test b/tests/macOSXLoad.test
index 6db695e..12c77e0 100644
--- a/tests/macOSXLoad.test
+++ b/tests/macOSXLoad.test
@@ -9,8 +9,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: macOSXLoad.test,v 1.1 2006/12/17 03:47:08 das Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
diff --git a/tests/main.test b/tests/main.test
index 24d1fb5..f1dc7fd 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -1,6 +1,4 @@
# This file contains a collection of tests for generic/tclMain.c.
-#
-# RCS: @(#) $Id: main.test,v 1.22 2007/12/13 15:26:06 dgp Exp $
if {[catch {package require tcltest 2.0.2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -68,8 +66,6 @@ namespace eval ::tcl::test::main {
} -result [list [interpreter] -script 0]\n
test Tcl_Main-1.3 {
- Tcl_Main: encoding of arguments: done by system encoding
- Note the shortcoming explained in Tcl Feature Request 491789
} -constraints {
stdio
} -setup {
@@ -84,10 +80,8 @@ namespace eval ::tcl::test::main {
[encoding convertto [encoding system] \u00c0]]] 0]\n
test Tcl_Main-1.4 {
- Tcl_Main: encoding of arguments: done by system encoding
- Note the shortcoming explained in Tcl Feature Request 491789
} -constraints {
- stdio tempNotWin
+ stdio
} -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} script
catch {set f [open "|[list [interpreter] script \u20ac]" r]}
@@ -100,8 +94,6 @@ namespace eval ::tcl::test::main {
[encoding convertto [encoding system] \u20ac]]] 0]\n
test Tcl_Main-1.5 {
- Tcl_Main: encoding of script name: system encoding loss
- Note the shortcoming explained in Tcl Feature Request 491789
} -constraints {
stdio
} -setup {
@@ -116,10 +108,8 @@ namespace eval ::tcl::test::main {
[encoding convertto [encoding system] \u00c0]]] {} 0]\n
test Tcl_Main-1.6 {
- Tcl_Main: encoding of script name: system encoding loss
- Note the shortcoming explained in Tcl Feature Request 491789
} -constraints {
- stdio tempNotWin
+ stdio
} -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac
catch {set f [open "|[list [interpreter] \u20ac]" r]}
diff --git a/tests/mathop.test b/tests/mathop.test
index b7c4a04..f122b7b 100644
--- a/tests/mathop.test
+++ b/tests/mathop.test
@@ -9,8 +9,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: mathop.test,v 1.14 2010/07/02 20:37:10 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -1094,7 +1092,7 @@ test mathop-24.3 { binary ops, bad values } {
}
foreach op {in ni} {
lappend res [TestOp $op 5 "a b \{ c"]
- lappend exp "unmatched open brace in list TCL VALUE LIST"
+ lappend exp "unmatched open brace in list TCL VALUE LIST BRACE"
}
lappend res [TestOp % 5 0]
lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
diff --git a/tests/misc.test b/tests/misc.test
index 7015c52..6ddc718 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -11,14 +11,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: misc.test,v 1.11 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testhashsystemhash [llength [info commands testhashsystemhash]]
test misc-1.1 {error in variable ref. in command in array reference} {
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 70dc384..1522354 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -11,16 +11,14 @@
#
# Note that after running these tests, entries will be left behind in the
# message catalogs for locales foo, foo_BAR, and foo_BAR_baz.
-#
-# RCS: @(#) $Id: msgcat.test,v 1.21 2008/05/31 23:34:46 das Exp $
package require Tcl 8.2
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
return
}
-if {[catch {package require msgcat 1.4.2}]} {
- puts stderr "Skipping tests in [info script]. No msgcat 1.4.2 found to test."
+if {[catch {package require msgcat 1.5.0}]} {
+ puts stderr "Skipping tests in [info script]. No msgcat 1.5.0 found to test."
return
}
@@ -58,6 +56,13 @@ namespace eval ::msgcat::test {
set result [string tolower \
[msgcat::ConvertLocale $::tcl::mac::locale]]
} else {
+ if {([info sharedlibextension] == ".dll")
+ && ![catch {package require registry}]} {
+ # Windows and Cygwin have other ways to determine the
+ # locale when the environment variables are missing
+ # and the registry package is present
+ continue
+ }
set result c
}
}
@@ -613,6 +618,45 @@ namespace eval ::msgcat::test {
mc "this is a %s" "good test"
} -result "this is a good test"
+ # Tests msgcat-8.*: [mcflset]
+
+ set msgdir1 [makeDirectory msgdir1]
+ makeFile {::msgcat::mcflset k1 v1} l1.msg $msgdir1
+
+ test msgcat-8.1 {mcflset} -setup {
+ variable locale [mclocale]
+ mclocale l1
+ mcload $msgdir1
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mc k1
+ } -result v1
+
+ removeFile l1.msg $msgdir1
+ removeDirectory msgdir1
+
+ set msgdir2 [makeDirectory msgdir2]
+ set msgdir3 [makeDirectory msgdir3]
+ makeFile "::msgcat::mcflset k2 v2 ; ::msgcat::mcload [list $msgdir3]"\
+ l2.msg $msgdir2
+ makeFile {::msgcat::mcflset k3 v3} l2.msg $msgdir3
+
+ # chained mcload
+ test msgcat-8.2 {mcflset} -setup {
+ variable locale [mclocale]
+ mclocale l2
+ mcload $msgdir2
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ return [mc k2][mc k3]
+ } -result v2v3
+
+ removeFile l2.msg $msgdir2
+ removeDirectory msgdir2
+ removeDirectory msgdir3
+
cleanupTests
}
namespace delete ::msgcat::test
diff --git a/tests/namespace-old.test b/tests/namespace-old.test
index 804c233..1d8ba31 100644
--- a/tests/namespace-old.test
+++ b/tests/namespace-old.test
@@ -13,10 +13,8 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: namespace-old.test,v 1.14 2008/12/17 15:39:55 dkf Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2.2
namespace import -force ::tcltest::*
}
@@ -496,8 +494,8 @@ test namespace-old-7.1 {define test namespace} {
}
} {}
test namespace-old-7.2 {uplevel can access namespace call frame} {
- list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] x]>=0}] \
- [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] y]>=0}]
+ list [expr {"x" in [test_ns_uplevel::test_uplevel 1]}] \
+ [expr {"y" in [test_ns_uplevel::test_uplevel 1]}]
} {1 1}
test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
lsort [test_ns_uplevel::test_uplevel 2]
@@ -506,8 +504,8 @@ test namespace-old-7.4 {uplevel can go up to global context} {
expr {[test_ns_uplevel::test_uplevel 3] == [info globals]}
} {1}
test namespace-old-7.5 {absolute call frame references work too} {
- list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] x]>=0}] \
- [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] y]>=0}]
+ list [expr {"x" in [test_ns_uplevel::test_uplevel #2]}] \
+ [expr {"y" in [test_ns_uplevel::test_uplevel #2]}]
} {1 1}
test namespace-old-7.6 {absolute call frame references work too} {
lsort [test_ns_uplevel::test_uplevel #1]
diff --git a/tests/namespace.test b/tests/namespace.test
index c1aef53..1d46bf0 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1,25 +1,24 @@
# Functionality covered: this file contains a collection of tests for the
-# procedures in tclNamesp.c that implement Tcl's basic support for
-# namespaces. Other namespace-related tests appear in variable.test.
+# procedures in tclNamesp.c and tclEnsemble.c that implement Tcl's basic
+# support for namespaces. Other namespace-related tests appear in
+# variable.test.
#
-# Sourcing this file into Tcl runs the tests and generates output for
-# errors. No output means no errors were found.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: namespace.test,v 1.78 2010/01/10 16:51:25 dkf Exp $
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
+# 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::*
testConstraint memory [llength [info commands memory]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
#
# REMARK: the tests for 'namespace upvar' are not done here. They are to be
# found in the file 'upvar.test'.
@@ -27,6 +26,12 @@ testConstraint memory [llength [info commands memory]]
# Clear out any namespaces called test_ns_*
catch {namespace delete {*}[namespace children :: test_ns_*]}
+
+proc fq {ns} {
+ if {[string match ::* $ns]} {return $ns}
+ set current [uplevel 1 {namespace current}]
+ return [string trimright $current :]::[string trimleft $ns :]
+}
test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} {
namespace children :: test_ns_*
@@ -47,7 +52,6 @@ test namespace-2.2 {Tcl_GetCurrentNamespace} {
}
}
lappend l [namespace current]
- set l
} {:: ::test_ns_1 ::test_ns_1::foo ::}
test namespace-3.1 {Tcl_GetGlobalNamespace} {
@@ -594,9 +598,8 @@ test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up onl
namespace eval bar {}
}
namespace eval test_ns_1 {
- set l [list [catch {namespace delete test_ns_2::bar} msg] $msg]
+ list [catch {namespace delete test_ns_2::bar} msg] $msg
}
- set l
} {1 {unknown namespace "test_ns_2::bar" in namespace delete command}}
test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
namespace eval test_ns_1::test_ns_2 {
@@ -815,7 +818,7 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} {
set a 0
namespace eval test_ns_1 set a 1
namespace delete test_ns_1
- set a
+ return $a
} 1
catch {unset a}
catch {unset x}
@@ -837,7 +840,6 @@ test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadow
proc foo {} {return "foo in test_ns_1"}
}
lappend l [test_ns_1::trigger]
- set l
} {{global foo} {foo in test_ns_1}}
test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
namespace eval test_ns_2 {
@@ -858,7 +860,6 @@ test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shado
}
}
lappend l [test_ns_1::trigger]
- set l
} {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
catch {unset l}
catch {rename foo {}}
@@ -890,7 +891,6 @@ test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
namespace delete test_ns_1::test_ns_2
namespace eval test_ns_1::test_ns_2::test_ns_3 {}
lappend l [test_ns_1::foo]
- set l
} {{} ::test_ns_1::test_ns_2::test_ns_3}
test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
@@ -899,7 +899,7 @@ test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body {
namespace wombat {}
-} -returnCodes error -match glob -result {bad option "wombat": must be *}
+} -returnCodes error -match glob -result {unknown or ambiguous subcommand "wombat": must be *}
test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
namespace ch :: test_ns_*
} {}
@@ -937,9 +937,8 @@ test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} {
namespace eval test_ns_1 {}
- namespace children [namespace current] \
- [string trimright [namespace current] :]::test_ns_1
-} [string trimright [namespace current] :]::test_ns_1
+ namespace children [namespace current] [fq test_ns_1]
+} [fq test_ns_1]
test namespace-22.1 {NamespaceCodeCmd, bad args} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -950,11 +949,11 @@ test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} {
namespace eval test_ns_1 {
proc cmd {} {return "test_ns_1::cmd"}
}
- namespace code {namespace inscope ::test_ns_1 cmd}
-} {namespace inscope ::test_ns_1 cmd}
+ namespace code {::namespace inscope ::test_ns_1 cmd}
+} {::namespace inscope ::test_ns_1 cmd}
test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} {
namespace code {namespace inscope ::test_ns_1 cmd}
-} {namespace inscope ::test_ns_1 cmd}
+} {::namespace inscope :: {namespace inscope ::test_ns_1 cmd}}
test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {
namespace code unknown
} {::namespace inscope :: unknown}
@@ -974,6 +973,12 @@ test namespace-22.6 {NamespaceCodeCmd, in other namespace} {
namespace code {set v}
}]
} {42}
+test namespace-22.7 {NamespaceCodeCmd, Bug 3202171} {
+ namespace eval demo {
+ proc namespace args {puts $args}
+ ::namespace code {namespace inscope foo}
+ }
+} [list ::namespace inscope [fq demo] {namespace inscope foo}]
test namespace-23.1 {NamespaceCurrentCmd, bad args} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -1011,7 +1016,7 @@ test namespace-25.1 {NamespaceEvalCmd, bad args} {
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
test namespace-25.2 {NamespaceEvalCmd, bad args} -body {
namespace test_ns_1
-} -returnCodes error -match glob -result {bad option "test_ns_1": must be *}
+} -returnCodes error -match glob -result {unknown or ambiguous subcommand "test_ns_1": must be *}
catch {unset v}
test namespace-25.3 {NamespaceEvalCmd, new namespace} {
set v 123
@@ -1420,16 +1425,17 @@ test namespace-39.3 {NamespaceExistsCmd error} {
list [catch {namespace exists a b} msg] $msg
} {1 {wrong # args: should be "namespace exists name"}}
-test namespace-40.1 {Ignoring namespace proc "unknown"} {
+test namespace-40.1 {Ignoring namespace proc "unknown"} -setup {
rename unknown _unknown
+} -body {
proc unknown args {return global}
namespace eval ns {proc unknown args {return local}}
- set l [list [namespace eval ns aaa bbb] [namespace eval ns aaa]]
+ list [namespace eval ns aaa bbb] [namespace eval ns aaa]
+} -cleanup {
rename unknown {}
rename _unknown unknown
namespace delete ns
- set l
-} {global global}
+} -result {global global}
test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
set res {}
@@ -1447,7 +1453,6 @@ test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
namespace delete ns
set res
} {0 1}
-
test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} {
set res {}
namespace eval ns {}
@@ -1461,19 +1466,16 @@ test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} {
namespace delete ns
set res
} {New proc is called}
-
test namespace-41.3 {Shadowing byte-compiled commands, Bugs: 231259, 729692} {
set res {}
namespace eval ns {
variable b 0
}
-
proc ns::a {i} {
variable b
proc set args {return "New proc is called"}
return [set b $i]
}
-
set res [list [ns::a 1] $ns::b]
namespace delete ns
set res
@@ -1512,18 +1514,18 @@ test namespace-42.3 {ensembles: basic} {
namespace delete ns
lappend result [info command ns::x1]
} {1 2 1 {unknown or ambiguous subcommand "x": must be x1, or x2} ::ns::x1 {}}
-test namespace-42.4 {ensembles: basic} {
+test namespace-42.4 {ensembles: basic} -body {
namespace eval ns {
namespace export y*
proc x1 {} {format 1}
proc x2 {} {format 2}
namespace ensemble create
}
- set result [list [catch {ns x} msg] $msg]
+ list [catch {ns x} msg] $msg
+} -cleanup {
namespace delete ns
- set result
-} {1 {unknown subcommand "x": namespace ::ns does not export any commands}}
-test namespace-42.5 {ensembles: basic} {
+} -result {1 {unknown subcommand "x": namespace ::ns does not export any commands}}
+test namespace-42.5 {ensembles: basic} -body {
namespace eval ns {
namespace export x*
proc x1 {} {format 1}
@@ -1531,11 +1533,11 @@ test namespace-42.5 {ensembles: basic} {
proc x3 {} {format 3}
namespace ensemble create
}
- set result [list [catch {ns x} msg] $msg]
+ list [catch {ns x} msg] $msg
+} -cleanup {
namespace delete ns
- set result
-} {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}}
-test namespace-42.6 {ensembles: nested} {
+} -result {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}}
+test namespace-42.6 {ensembles: nested} -body {
namespace eval ns {
namespace export x*
namespace eval x0 {
@@ -1548,11 +1550,11 @@ test namespace-42.6 {ensembles: nested} {
proc x3 {} {format 3}
namespace ensemble create
}
- set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]]
+ list [ns x0 z] [ns x1] [ns x2] [ns x3]
+} -cleanup {
namespace delete ns
- set result
-} {0 1 2 3}
-test namespace-42.7 {ensembles: nested} {
+} -result {0 1 2 3}
+test namespace-42.7 {ensembles: nested} -body {
namespace eval ns {
namespace export x*
namespace eval x0 {
@@ -1565,10 +1567,10 @@ test namespace-42.7 {ensembles: nested} {
proc x3 {} {format 3}
namespace ensemble create
}
- set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]]
+ list [ns x0 z] [ns x1] [ns x2] [ns x3]
+} -cleanup {
namespace delete ns
- set result
-} {{1 ::ns::x0::z} 1 2 3}
+} -result {{1 ::ns::x0::z} 1 2 3}
test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
proc demo args {}
variable target [list [namespace which demo] x]
@@ -1595,7 +1597,7 @@ test namespace-43.1 {ensembles: dict-driven} {
rename ns {}
lappend result [namespace ensemble exists ns]
} {1 {unknown or ambiguous subcommand "c": must be a, or b} 1 0}
-test namespace-43.2 {ensembles: dict-driven} {
+test namespace-43.2 {ensembles: dict-driven} -body {
namespace eval ns {
namespace export x*
proc x1 {args} {list 1 $args}
@@ -1604,10 +1606,10 @@ test namespace-43.2 {ensembles: dict-driven} {
a ::ns::x1 b ::ns::x2 c {::ns::x1 .} d {::ns::x2 .}
}
}
- set result [list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo]]
+ list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo]
+} -cleanup {
namespace delete ns
- set result
-} {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}}
+} -result {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}}
set SETUP {
namespace eval ns {
namespace export a b
@@ -2481,7 +2483,7 @@ test namespace-51.16 {Bug 1566526} {
test namespace-51.17 {resolution epoch handling: Bug 2898722} -setup {
set result {}
catch {namespace delete ::a}
-} -constraints knownBug -body {
+} -body {
namespace eval ::a {
proc c {} {lappend ::result A}
c
@@ -2518,6 +2520,22 @@ test namespace-51.17 {resolution epoch handling: Bug 2898722} -setup {
catch {rename ::c {}}
unset result
} -result {A 1 . A A . B B . B B . B B . B B . G G}
+test namespace-51.18 {Bug 3185407} -setup {
+ namespace eval ::test_ns_1 {}
+} -body {
+ namespace eval ::test_ns_1 {
+ variable result {}
+ namespace eval ns {proc foo {} {}}
+ namespace eval ns2 {proc foo {} {}}
+ namespace path {ns ns2}
+ variable x foo
+ lappend result [namespace which $x]
+ proc foo {} {}
+ lappend result [namespace which $x]
+ }
+} -cleanup {
+ namespace delete ::test_ns_1
+} -result {::test_ns_1::ns::foo ::test_ns_1::foo}
# TIP 181 - namespace unknown tests
test namespace-52.1 {unknown: default handler ::unknown} {
@@ -2914,7 +2932,7 @@ test namespace-54.1 {leak on namespace deletion} -constraints {memory} \
rename getbytes {}
unset i ns start end
} -result 0
-
+
# cleanup
catch {rename cmd1 {}}
catch {unset l}
diff --git a/tests/notify.test b/tests/notify.test
index 0d80132..d2b9123 100755
--- a/tests/notify.test
+++ b/tests/notify.test
@@ -12,14 +12,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: notify.test,v 1.3 2003/10/06 14:32:22 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testevent [llength [info commands testevent]]
test notify-1.1 {Tcl_QueueEvent and delivery of a single event} \
diff --git a/tests/nre.test b/tests/nre.test
index dcc2180..b8ef2e0 100644
--- a/tests/nre.test
+++ b/tests/nre.test
@@ -8,14 +8,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: nre.test,v 1.12 2010/01/21 17:23:49 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testnrelevels [llength [info commands testnrelevels]]
#
@@ -62,7 +63,7 @@ if {[testConstraint testnrelevels]} {
}
namespace import testnre::*
}
-
+
test nre-1.1 {self-recursive procs} -setup {
proc a i [makebody {a $i}]
} -body {
@@ -163,7 +164,7 @@ test nre-5.1 {[namespace eval] is not recursive} -setup {
namespace delete ::foo
} -constraints {
testnrelevels
-} -result {{0 2 2 2} 0}
+} -result {{0 3 2 2} 0}
test nre-5.2 {[namespace eval] is not recursive} -setup {
namespace eval ::foo {
@@ -176,7 +177,7 @@ test nre-5.2 {[namespace eval] is not recursive} -setup {
namespace delete ::foo
} -constraints {
testnrelevels
-} -result {{0 2 2 2} 0}
+} -result {{0 3 2 2} 0}
test nre-6.1 {[uplevel] is not recursive} -setup {
proc a i [makebody {uplevel 1 [list a $i]}]
@@ -304,7 +305,7 @@ test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
test nre-8.1 {nre and {*}} -body {
# force an expansion that grows the evaluation stack, check that nre
- # adapts the bottomPtr. This crashes on failure.
+ # adapts the TEBCdataPtr. This crashes on failure.
proc inner {} {
set long [lrepeat 1000000 1]
@@ -413,23 +414,24 @@ test nre-oo.5 {really deep calls in oo - forwards} -setup {
# NASTY BUG found by tcllib's interp package
#
-test nre-X.1 {eval in wrong interp} {
+test nre-X.1 {eval in wrong interp} -setup {
set i [interp create]
- set res [$i eval {
+ $i eval {proc filter lst {lsearch -all -inline -not $lst "::tcl"}}
+} -body {
+ $i eval {
set x {namespace children ::}
set y [list namespace children ::]
- namespace delete {*}[{*}$y]
+ namespace delete {*}[filter [{*}$y]]
set j [interp create]
- $j eval {namespace delete {*}[namespace children ::]}
+ $j alias filter filter
+ $j eval {namespace delete {*}[filter [namespace children ::]]}
namespace eval foo {}
- set res [list [eval $x] [eval $y] [$j eval $x] [$j eval $y]]
- interp delete $j
- set res
- }]
+ list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]]
+ }
+} -cleanup {
interp delete $i
- set res
-} {::foo ::foo {} {}}
-
+} -result {::foo ::foo {} {}}
+
# cleanup
::tcltest::cleanupTests
@@ -439,3 +441,8 @@ if {[testConstraint testnrelevels]} {
}
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/obj.test b/tests/obj.test
index f9c0a2d..71a39b4 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -10,14 +10,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: obj.test,v 1.21 2007/12/13 15:26:07 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
diff --git a/tests/oo.test b/tests/oo.test
index 50edb11..5d34077 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -2,16 +2,14 @@
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
-# Copyright (c) 2006-2008 Donal K. Fellows
+# Copyright (c) 2006-2012 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: oo.test,v 1.39 2010/03/24 13:21:11 dkf Exp $
-package require -exact TclOO 0.6.2 ;# Must match value in generic/tclOO.h
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+package require TclOO 1.0
+package require tcltest 2
+if {"::tcltest" in [namespace children]} {
namespace import -force ::tcltest::*
}
@@ -31,15 +29,9 @@ if {[testConstraint memory]} {
return [expr {$end - $tmp}]
}
}
-
-proc initInterpreter name {
- $name eval [list package ifneeded TclOO [package provide TclOO] \
- [package ifneeded TclOO [package provide TclOO]]]
-}
test oo-0.1 {basic test of OO's ability to clean up its initial state} {
interp create t
- initInterpreter t
t eval {
package require TclOO
}
@@ -47,11 +39,11 @@ test oo-0.1 {basic test of OO's ability to clean up its initial state} {
} {}
test oo-0.2 {basic test of OO's ability to clean up its initial state} {
set i [interp create]
- initInterpreter $i
interp eval $i {
package require TclOO
namespace delete ::
}
+ interp delete $i
} {}
test oo-0.3 {basic test of OO's ability to clean up its initial state} -body {
leaktest {
@@ -74,7 +66,6 @@ test oo-0.5 {testing literal leak on interp delete} memory {
} 0
test oo-0.6 {cleaning the core class pair; way #1} -setup {
interp create t
- initInterpreter t
} -body {
t eval {
package require TclOO
@@ -86,7 +77,6 @@ test oo-0.6 {cleaning the core class pair; way #1} -setup {
} -result {0 {} 1 {invalid command name "object"}}
test oo-0.7 {cleaning the core class pair; way #2} -setup {
interp create t
- initInterpreter t
} -body {
t eval {
package require TclOO
@@ -96,6 +86,22 @@ test oo-0.7 {cleaning the core class pair; way #2} -setup {
} -cleanup {
interp delete t
} -result {0 {} 1 {invalid command name "class"}}
+test oo-0.8 {leak in variable management} -setup {
+ oo::class create foo
+} -constraints memory -body {
+ oo::define foo {
+ constructor {} {
+ variable v 0
+ }
+ }
+ leaktest {[foo new] destroy}
+} -cleanup {
+ foo destroy
+} -result 0
+test oo-0.9 {various types of presence of the TclOO package} {
+ list [lsearch -nocase -all -inline [package names] tcloo] \
+ [package present TclOO] [package versions TclOO]
+} [list TclOO $::oo::version $::oo::version]
test oo-1.1 {basic test of OO functionality: no classes} {
set result {}
@@ -125,6 +131,13 @@ test oo-1.4 {basic test of OO functionality} -body {
test oo-1.5 {basic test of OO functionality} -body {
oo::object doesnotexist
} -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new}
+test oo-1.5.1 {basic test of OO functionality} -setup {
+ oo::object create aninstance
+} -returnCodes error -body {
+ aninstance
+} -cleanup {
+ rename aninstance {}
+} -result {wrong # args: should be "aninstance method ?arg ...?"}
test oo-1.6 {basic test of OO functionality} -setup {
oo::object create aninstance
} -body {
@@ -262,7 +275,6 @@ test oo-2.1 {basic test of OO functionality: constructor} -setup {
# This is a bit complex because it needs to run in a sub-interp as
# we're modifying the root object class's constructor
interp create subinterp
- initInterpreter subinterp
subinterp eval {
package require TclOO
}
@@ -325,12 +337,50 @@ test oo-2.6 {OO constructor and tailcall - Bug 2414858} -setup {
} -cleanup {
foo destroy
} -result good
+test oo-2.7 {construction, method calls and ensembles - Bug 3514761} -setup {
+ namespace eval k {}
+} -body {
+ namespace eval k {
+ oo::class create s {
+ constructor {j} {
+ # nothing
+ }
+ }
+ namespace export s
+ namespace ensemble create
+ }
+ k s create X
+} -returnCodes error -cleanup {
+ namespace delete k
+} -result {wrong # args: should be "k s create X j"}
+test oo-2.8 {construction, method calls and ensembles - Bug 3514761} -setup {
+ namespace eval k {}
+} -body {
+ namespace eval k {
+ oo::class create s {
+ constructor {j} {
+ # nothing
+ }
+ }
+ oo::class create t {
+ superclass s
+ constructor args {
+ k next {*}$args
+ }
+ }
+ interp alias {} ::k::next {} ::oo::Helpers::next
+ namespace export t next
+ namespace ensemble create
+ }
+ k t create X
+} -returnCodes error -cleanup {
+ namespace delete k
+} -result {wrong # args: should be "k next j"}
test oo-3.1 {basic test of OO functionality: destructor} -setup {
# This is a bit complex because it needs to run in a sub-interp as we're
# modifying the root object class's constructor
interp create subinterp
- initInterpreter subinterp
subinterp eval {
package require TclOO
}
@@ -351,7 +401,6 @@ test oo-3.2 {basic test of OO functionality: destructor} -setup {
# This is a bit complex because it needs to run in a sub-interp as
# we're modifying the root object class's constructor
interp create subinterp
- initInterpreter subinterp
subinterp eval {
package require TclOO
}
@@ -745,6 +794,148 @@ test oo-6.7 {OO: forward resolution scope is per-object} -setup {
} -cleanup {
fooClass destroy
} -result 1
+test oo-6.8 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
+ oo::class create fooClass
+} -body {
+ oo::define fooClass {
+ forward test my handler
+ method handler {a b c} {}
+ }
+ fooClass create ::foo
+ foo test
+} -returnCodes error -cleanup {
+ fooClass destroy
+} -result {wrong # args: should be "foo test a b c"}
+test oo-6.9 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
+ oo::class create fooClass
+} -body {
+ oo::define fooClass {
+ forward test my handler
+ method handler {a b c} {list $a,$b,$c}
+ }
+ fooClass create ::foo
+ foo test 1 2 3
+} -cleanup {
+ fooClass destroy
+} -result 1,2,3
+test oo-6.10 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
+ oo::class create fooClass
+} -body {
+ oo::define fooClass {
+ forward test my handler
+ method handler {a b c} {list $a,$b,$c}
+ }
+ fooClass create ::foo
+ foo test 1 2
+} -returnCodes error -cleanup {
+ fooClass destroy
+} -result {wrong # args: should be "foo test a b c"}
+test oo-6.11 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
+ oo::object create foo
+} -body {
+ oo::objdefine foo {
+ forward test my handler
+ method handler {a b c} {}
+ }
+ foo test
+} -returnCodes error -cleanup {
+ foo destroy
+} -result {wrong # args: should be "foo test a b c"}
+test oo-6.12 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
+ oo::object create foo
+} -body {
+ oo::objdefine foo {
+ forward test my handler
+ method handler {a b c} {list $a,$b,$c}
+ }
+ foo test 1 2 3
+} -cleanup {
+ foo destroy
+} -result 1,2,3
+test oo-6.13 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
+ oo::object create foo
+} -body {
+ oo::objdefine foo {
+ forward test my handler
+ method handler {a b c} {list $a,$b,$c}
+ }
+ foo test 1 2
+} -returnCodes error -cleanup {
+ foo destroy
+} -result {wrong # args: should be "foo test a b c"}
+test oo-6.14 {Bug 3400658: forwarding and wrongargs rewriting - multistep} -setup {
+ oo::class create fooClass
+} -body {
+ oo::define fooClass {
+ forward test my handler1 p
+ forward handler1 my handler q
+ method handler {a b c} {}
+ }
+ fooClass create ::foo
+ foo test
+} -returnCodes error -cleanup {
+ fooClass destroy
+} -result {wrong # args: should be "foo test c"}
+test oo-6.15 {Bug 3400658: forwarding and wrongargs rewriting - multistep} -setup {
+ oo::class create fooClass
+} -body {
+ oo::define fooClass {
+ forward test my handler1 p
+ forward handler1 my handler q
+ method handler {a b c} {list $a,$b,$c}
+ }
+ fooClass create ::foo
+ foo test 1
+} -cleanup {
+ fooClass destroy
+} -result q,p,1
+test oo-6.16 {Bug 3400658: forwarding and wrongargs rewriting - via alias} -setup {
+ oo::class create fooClass
+} -body {
+ oo::define fooClass {
+ forward test handler1 foo bar
+ forward handler2 my handler x
+ method handler {a b c d} {list $a,$b,$c,$d}
+ export eval
+ }
+ fooClass create ::foo
+ foo eval {
+ interp alias {} [namespace current]::handler1 \
+ {} [namespace current]::my handler2
+ }
+ foo test 1 2 3
+} -returnCodes error -cleanup {
+ fooClass destroy
+} -result {wrong # args: should be "foo test d"}
+test oo-6.17 {Bug 3400658: forwarding and wrongargs rewriting - via ensemble} -setup {
+ oo::class create fooClass
+} -body {
+ oo::define fooClass {
+ forward test handler1 foo bar boo
+ forward handler2 my handler
+ method handler {a b c d} {list $a,$b,$c,$d}
+ export eval
+ }
+ fooClass create ::foo
+ foo eval {
+ namespace ensemble create \
+ -command [namespace current]::handler1 -parameters {p q} \
+ -map [list boo [list [namespace current]::my handler2]]
+ }
+ foo test 1 2 3
+} -returnCodes error -cleanup {
+ fooClass destroy
+} -result {wrong # args: should be "foo test c d"}
+test oo-6.18 {Bug 3408830: more forwarding cases} -setup {
+ oo::class create fooClass
+} -body {
+ oo::define fooClass {
+ forward len string length
+ }
+ [fooClass create foo] len a b
+} -returnCodes error -cleanup {
+ fooClass destroy
+} -result {wrong # args: should be "::foo len string"}
test oo-7.1 {OO: inheritance 101} -setup {
oo::class create superClass
@@ -1505,6 +1696,86 @@ test oo-15.3 {OO: class cloning} {
bar destroy
return $result
} {::foo->::baseline ::foo->::baseline ::bar->::tester ::bar->::tester}
+test oo-15.4 {OO: object cloning - Bug 3474460} -setup {
+ oo::class create ArbitraryClass
+} -body {
+ ArbitraryClass create foo
+ oo::objdefine foo variable a b c
+ oo::copy foo bar
+ info object variable bar
+} -cleanup {
+ ArbitraryClass destroy
+} -result {a b c}
+test oo-15.5 {OO: class cloning - Bug 3474460} -setup {
+ oo::class create ArbitraryClass
+} -body {
+ oo::class create Foo {
+ superclass ArbitraryClass
+ variable a b c
+ }
+ oo::copy Foo Bar
+ info class variable Bar
+} -cleanup {
+ ArbitraryClass destroy
+} -result {a b c}
+test oo-15.6 {OO: object cloning copies namespace contents} -setup {
+ oo::class create ArbitraryClass {export eval}
+} -body {
+ ArbitraryClass create a
+ a eval {proc foo x {
+ variable y
+ return [string repeat $x [incr y]]
+ }}
+ set result [list [a eval {foo 2}] [a eval {foo 3}]]
+ oo::copy a b
+ a eval {rename foo bar}
+ lappend result [b eval {foo 2}] [b eval {foo 3}] [a eval {bar 4}]
+} -cleanup {
+ ArbitraryClass destroy
+} -result {2 33 222 3333 444}
+test oo-15.7 {OO: classes can be cloned anonymously} -setup {
+ oo::class create ArbitraryClassA
+ oo::class create ArbitraryClassB {superclass ArbitraryClassA}
+} -body {
+ info object isa class [oo::copy ArbitraryClassB]
+} -cleanup {
+ ArbitraryClassA destroy
+} -result 1
+test oo-15.8 {OO: intercept object cloning} -setup {
+ oo::class create Foo
+ set result {}
+} -body {
+ oo::define Foo {
+ constructor {msg} {
+ variable v $msg
+ }
+ method <cloned> {from} {
+ next $from
+ lappend ::result cloned $from [self]
+ }
+ method check {} {
+ variable v
+ lappend ::result check [self] $v
+ }
+ }
+ Foo create foo ok
+ oo::copy foo bar
+ foo check
+ bar check
+} -cleanup {
+ Foo destroy
+} -result {cloned ::foo ::bar check ::foo ok check ::bar ok}
+test oo-15.9 {ensemble rewriting must not bleed through oo::copy} -setup {
+ oo::class create Foo
+} -body {
+ oo::define Foo {
+ method <cloned> {a b} {}
+ }
+ interp alias {} Bar {} oo::copy [Foo create foo]
+ Bar bar
+} -returnCodes error -cleanup {
+ Foo destroy
+} -result {wrong # args: should be "::bar <cloned> a b"}
test oo-16.1 {OO: object introspection} -body {
info object
@@ -1514,7 +1785,7 @@ test oo-16.2 {OO: object introspection} -body {
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
test oo-16.3 {OO: object introspection} -body {
info object gorp oo::object
-} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be class, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars}
+} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars}
test oo-16.4 {OO: object introspection} -setup {
oo::class create meta { superclass oo::class }
[meta create instance1] create instance2
@@ -1600,10 +1871,10 @@ test oo-16.11 {OO: object introspection} -setup {
} -body {
oo::define foo method spong {} {...}
oo::objdefine bar method boo {a {b c} args} {the body}
- list [info object methods bar -all] [info object methods bar -all -private]
+ list [lsort [info object methods bar -all]] [lsort [info object methods bar -all -private]]
} -cleanup {
foo destroy
-} -result {{boo destroy spong} {boo destroy eval spong unknown variable varname}}
+} -result {{boo destroy spong} {<cloned> boo destroy eval spong unknown variable varname}}
test oo-16.12 {OO: object introspection} -setup {
oo::object create foo
} -cleanup {
@@ -1636,7 +1907,7 @@ test oo-17.3 {OO: class introspection} -setup {
} -result {"foo" is not a class}
test oo-17.4 {OO: class introspection} -body {
info class gorp oo::object
-} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be constructor, definition, destructor, filters, forward, instances, methods, methodtype, mixins, subclasses, superclasses, or variables}
+} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, destructor, filters, forward, instances, methods, methodtype, mixins, subclasses, superclasses, or variables}
test oo-17.5 {OO: class introspection} -setup {
oo::class create testClass
} -body {
@@ -1684,11 +1955,11 @@ test oo-17.9 {OO: class introspection} -setup {
}
}
oo::define subfoo method boo {a {b c} args} {the body}
- list [info class methods subfoo -all] \
- [info class methods subfoo -all -private]
+ list [lsort [info class methods subfoo -all]] \
+ [lsort [info class methods subfoo -all -private]]
} -cleanup {
foo destroy
-} -result {{bar boo destroy} {bar boo destroy eval unknown variable varname}}
+} -result {{bar boo destroy} {<cloned> bar boo destroy eval unknown variable varname}}
test oo-17.10 {OO: class introspection} -setup {
oo::class create foo
} -cleanup {
@@ -1703,7 +1974,7 @@ test oo-18.1 {OO: define command support} {
} {1 foo {foo
while executing
"error foo"
- (in definition script for object "oo::object" line 1)
+ (in definition script for class "::oo::object" line 1)
invoked from within
"oo::define oo::object {error foo}"}}
test oo-18.2 {OO: define command support} {
@@ -1716,7 +1987,7 @@ test oo-18.3 {OO: define command support} {
} {1 bar {bar
while executing
"error bar"
- (in definition script for object "::foo" line 1)
+ (in definition script for class "::foo" line 1)
invoked from within
"oo::class create foo {error bar}"}}
test oo-18.3a {OO: define command support} {
@@ -1726,7 +1997,7 @@ test oo-18.3a {OO: define command support} {
} {1 bar {bar
while executing
"error bar"
- (in definition script for object "::foo" line 2)
+ (in definition script for class "::foo" line 2)
invoked from within
"oo::class create foo {
error bar
@@ -1744,7 +2015,7 @@ test oo-18.3b {OO: define command support} {
("eval" body line 1)
invoked from within
"eval eval error bar"
- (in definition script for object "::foo" line 2)
+ (in definition script for class "::foo" line 2)
invoked from within
"oo::class create foo {
eval eval error bar
@@ -1799,6 +2070,106 @@ test oo-18.5 {OO: more error traces from the guts} -setup {
(class "::cls" method "eval" line 1)
invoked from within
"obj eval {error bar}"}}
+test oo-18.6 {class construction reference management and errors} -setup {
+ oo::class create super_abc
+} -body {
+ catch {
+oo::class create abc {
+ superclass super_abc
+ ::rename abc ::def
+ ::error foo
+}
+ } msg opt
+ dict get $opt -errorinfo
+} -cleanup {
+ super_abc destroy
+} -result {foo
+ while executing
+"::error foo"
+ (in definition script for class "::def" line 4)
+ invoked from within
+"oo::class create abc {
+ superclass super_abc
+ ::rename abc ::def
+ ::error foo
+}"}
+test oo-18.7 {OO: objdefine command support} -setup {
+ oo::object create ::inst
+} -body {
+ list [catch {oo::objdefine inst {rename ::inst ::INST;error foo}} msg] $msg $errorInfo
+} -cleanup {
+ catch {::inst destroy}
+ catch {::INST destroy}
+} -result {1 foo {foo
+ while executing
+"error foo"
+ (in definition script for object "::INST" line 1)
+ 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}
+} -body {
+ catch {oo::define foo {rename ::foo ::bar; self {error foobar}}} msg opt
+ dict get $opt -errorinfo
+} -cleanup {
+ master destroy
+} -result {foobar
+ while executing
+"error foobar"
+ (in definition script for class object "::bar" line 1)
+ invoked from within
+"self {error foobar}"
+ (in definition script for class "::bar" line 1)
+ 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
+ set c [oo::class create now_this_is_a_very_very_long_class_name_indeed {
+ superclass master
+ }]
+} -body {
+ catch {oo::define $c {error err}} msg opt
+ dict get $opt -errorinfo
+} -cleanup {
+ master destroy
+} -result {err
+ while executing
+"error err"
+ (in definition script for class "::now_this_is_a_very_very_long..." line 1)
+ 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}
+} -body {
+ catch {oo::define foo {self {rename ::foo {}; error foobar}}} msg opt
+ dict get $opt -errorinfo
+} -cleanup {
+ master destroy
+} -result {foobar
+ while executing
+"error foobar"
+ (in definition script for class object "::foo" line 1)
+ invoked from within
+"self {rename ::foo {}; error foobar}"
+ (in definition script for class "::foo" line 1)
+ 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}
+} -body {
+ catch {oo::define foo {rename ::foo {}; self {error foobar}}} msg opt
+ dict get $opt -errorinfo
+} -cleanup {
+ master destroy
+} -result {this command cannot be called when the object has been deleted
+ while executing
+"self {error foobar}"
+ (in definition script for class "::foo" line 1)
+ invoked from within
+"oo::define foo {rename ::foo {}; self {error foobar}}"}
test oo-19.1 {OO: varname method} -setup {
oo::object create inst
@@ -2044,6 +2415,18 @@ test oo-20.15 {OO: variable method use in non-methods [Bug 2903811]} -setup {
apply {{} {fooObj variable x; set x ok; return}}
return [set [fooObj varname x]]
} -result ok
+test oo-20.16 {variable method: leak per instance} -setup {
+ oo::class create foo
+} -constraints memory -body {
+ oo::define foo {
+ constructor {} {
+ set [my variable v] 0
+ }
+ }
+ leaktest {[foo new] destroy}
+} -cleanup {
+ foo destroy
+} -result 0
test oo-21.1 {OO: inheritance ordering} -setup {
oo::class create A
@@ -2210,7 +2593,19 @@ test oo-22.1 {OO and info frame} -setup {
list [i level] [i frames] [dict get [c frame] object]
} -cleanup {
c destroy
-} -result {1 {{type source line * file * cmd {info frame 0} method frames class ::c level 0} {type source line * file * cmd {info frame 0} method frames object ::i level 0}} ::c}
+} -result {1 {{* cmd {info frame 0} method frames class ::c level 0} {* cmd {info frame 0} method frames object ::i level 0}} ::c}
+test oo-22.2 {OO and info frame: Bug 3001438} -setup {
+ oo::class create c
+} -body {
+ oo::define c method test {{x 1}} {
+ if {$x} {my test 0}
+ lsort {q w e r t y u i o p}; # Overwrite the Tcl stack
+ info frame 0
+ }
+ [c new] test
+} -match glob -cleanup {
+ c destroy
+} -result {* cmd {info frame 0} method test class ::c level 0}
# Prove that the issue in [Bug 1865054] isn't an issue any more
test oo-23.1 {Self-like derivation; complex case!} -setup {
@@ -2269,6 +2664,16 @@ test oo-24.2 {unknown method method - Bug 1965063} -setup {
}
obj foo bar
} -result {unknown method "foo": must be destroy, dummy, dummy2 or unknown}
+test oo-24.3 {unknown method method - absent method name} -setup {
+ set o [oo::object new]
+} -cleanup {
+ $o destroy
+} -body {
+ oo::objdefine $o method unknown args {
+ return "unknown: >>$args<<"
+ }
+ list [$o] [$o foobar] [$o foo bar]
+} -result {{unknown: >><<} {unknown: >>foobar<<} {unknown: >>foo bar<<}}
# Probably need a better set of tests, but this is quite difficult to devise
test oo-25.1 {call chain caching} -setup {
@@ -2531,6 +2936,202 @@ test oo-27.11 {variables declaration - no instance var leaks with class resolver
inst1 step
list [inst1 value] [inst2 value]
} -result {3 2}
+test oo-27.12 {variables declaration: leak per instance} -setup {
+ oo::class create foo
+} -constraints memory -body {
+ oo::define foo {
+ variable v
+ constructor {} {
+ set v 0
+ }
+ }
+ leaktest {[foo new] destroy}
+} -cleanup {
+ foo destroy
+} -result 0
+# This test will actually (normally) crash if it fails!
+test oo-27.13 {variables declaration: Bug 3185009: require refcount management} -setup {
+ oo::object create foo
+} -body {
+ oo::objdefine foo {
+ variable x
+ method set v {set x $v}
+ method unset {} {unset x}
+ method exists {} {info exists x}
+ method get {} {return $x}
+ }
+ list [foo exists] [foo set 7] [foo exists] [foo get] [foo unset] \
+ [foo exists] [catch {foo get} msg] $msg
+} -cleanup {
+ 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
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create foo {
+ superclass master
+ variable x
+ variable y
+ method boo {} {
+ return [incr x],[incr y]
+ }
+ }
+ foo create bar
+ list [bar boo] [bar boo]
+} -result {1,1 2,2}
+test oo-27.15 {variables declaration - multiple use} -setup {
+ oo::class create master
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create foo {
+ superclass master
+ variable
+ variable x y
+ method boo {} {
+ return [incr x],[incr y]
+ }
+ }
+ foo create bar
+ list [bar boo] [bar boo]
+} -result {1,1 2,2}
+test oo-27.16 {variables declaration - multiple use} -setup {
+ oo::class create master
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create foo {
+ superclass master
+ variable x
+ variable -clear
+ variable y
+ method boo {} {
+ return [incr x],[incr y]
+ }
+ }
+ foo create bar
+ list [bar boo] [bar boo]
+} -result {1,1 1,2}
+test oo-27.17 {variables declaration - multiple use} -setup {
+ oo::class create master
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create foo {
+ superclass master
+ variable x
+ variable -set y
+ method boo {} {
+ return [incr x],[incr y]
+ }
+ }
+ foo create bar
+ list [bar boo] [bar boo]
+} -result {1,1 1,2}
+test oo-27.18 {variables declaration - multiple use} -setup {
+ oo::class create master
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create foo {
+ superclass master
+ variable x
+ variable -? y
+ method boo {} {
+ return [incr x],[incr y]
+ }
+ }
+ foo create bar
+ list [bar boo] [bar boo]
+} -returnCodes error -match glob -result {unknown method "-?": must be *}
+test oo-27.19 {variables declaration and [info vars]: Bug 2712377} -setup {
+ oo::class create Foo
+ set result {}
+} -body {
+ # This is really a test of problems to do with Tcl's introspection when a
+ # variable resolver is present...
+ oo::define Foo {
+ variable foo bar
+ method setvars {f b} {
+ set foo $f
+ set bar $b
+ }
+ method dump1 {} {
+ lappend ::result <1>
+ foreach v [lsort [info vars *]] {
+ lappend ::result $v=[set $v]
+ }
+ lappend ::result [info locals] [info locals *]
+ }
+ method dump2 {} {
+ lappend ::result <2>
+ foreach v [lsort [info vars *]] {
+ lappend ::result $v=[set $v]
+ }
+ lappend ::result | foo=$foo [info locals] [info locals *]
+ }
+ }
+ Foo create stuff
+ stuff setvars what ever
+ stuff dump1
+ stuff dump2
+ return $result
+} -cleanup {
+ Foo destroy
+} -result {<1> bar=ever foo=what v v <2> bar=ever foo=what | foo=what v v}
+test oo-27.20 {variables declaration and [info vars]: Bug 2712377} -setup {
+ oo::class create Foo
+ set result {}
+} -body {
+ # This is really a test of problems to do with Tcl's introspection when a
+ # variable resolver is present...
+ oo::define Foo {
+ variable foo bar
+ method setvars {f b} {
+ set foo $f
+ set bar $b
+ }
+ method dump1 {} {
+ lappend ::result <1>
+ foreach v [lsort [info vars *o]] {
+ lappend ::result $v=[set $v]
+ }
+ lappend ::result [info locals] [info locals *]
+ }
+ method dump2 {} {
+ lappend ::result <2>
+ foreach v [lsort [info vars *o]] {
+ lappend ::result $v=[set $v]
+ }
+ lappend ::result | foo=$foo [info locals] [info locals *]
+ }
+ }
+ Foo create stuff
+ stuff setvars what ever
+ stuff dump1
+ stuff dump2
+ return $result
+} -cleanup {
+ Foo destroy
+} -result {<1> foo=what v v <2> foo=what | foo=what v v}
+test oo-27.21 {variables declaration uniqueifies: Bug 3396896} -setup {
+ oo::class create Foo
+} -body {
+ oo::define Foo variable v v v t t v t
+ info class variable Foo
+} -cleanup {
+ Foo destroy
+} -result {v t}
+test oo-27.22 {variables declaration uniqueifies: Bug 3396896} -setup {
+ oo::object create foo
+} -body {
+ oo::objdefine foo variable v v v t t v t
+ info object variable foo
+} -cleanup {
+ foo destroy
+} -result {v t}
# A feature that's not supported because the mechanism may change without
# warning, but is supposed to work...
@@ -2578,6 +3179,182 @@ test oo-30.2 {Bug 2903011: deleting an object in a constructor} -setup {
} -returnCodes error -cleanup {
cls destroy
} -result {object deleted in constructor}
+
+test oo-31.1 {Bug 3111059: when objects and coroutines entangle} -setup {
+ oo::class create cls
+} -constraints memory -body {
+ oo::define cls {
+ method justyield {} {
+ yield
+ }
+ constructor {} {
+ coroutine coro my justyield
+ }
+ }
+ list [leaktest {[cls new] destroy}] [info class instances cls]
+} -cleanup {
+ cls destroy
+} -result {0 {}}
+test oo-31.2 {Bug 3111059: when objects and coroutines entangle} -setup {
+ oo::class create cls
+} -constraints memory -body {
+ oo::define cls {
+ method justyield {} {
+ yield
+ }
+ constructor {} {
+ coroutine coro my justyield
+ }
+ destructor {
+ rename coro {}
+ }
+ }
+ list [leaktest {[cls new] destroy}] [info class instances cls]
+} -cleanup {
+ cls destroy
+} -result {0 {}}
+
+oo::class create SampleSlot {
+ superclass oo::Slot
+ constructor {} {
+ variable contents {a b c} ops {}
+ }
+ method contents {} {variable contents; return $contents}
+ method ops {} {variable ops; return $ops}
+ method Get {} {
+ variable contents
+ variable ops
+ lappend ops [info level] Get
+ return $contents
+ }
+ method Set {lst} {
+ variable contents $lst
+ variable ops
+ lappend ops [info level] Set $lst
+ return
+ }
+}
+
+test oo-32.1 {TIP 380: slots - class test} -setup {
+ SampleSlot create sampleSlot
+} -body {
+ list [info level] [sampleSlot contents] [sampleSlot ops]
+} -cleanup {
+ rename sampleSlot {}
+} -result {0 {a b c} {}}
+test oo-32.2 {TIP 380: slots - class test} -setup {
+ SampleSlot create sampleSlot
+} -body {
+ list [info level] [sampleSlot -clear] \
+ [sampleSlot contents] [sampleSlot ops]
+} -cleanup {
+ rename sampleSlot {}
+} -result {0 {} {} {1 Set {}}}
+test oo-32.3 {TIP 380: slots - class test} -setup {
+ SampleSlot create sampleSlot
+} -body {
+ list [info level] [sampleSlot -append g h i] \
+ [sampleSlot contents] [sampleSlot ops]
+} -cleanup {
+ rename sampleSlot {}
+} -result {0 {} {a b c g h i} {1 Get 1 Set {a b c g h i}}}
+test oo-32.4 {TIP 380: slots - class test} -setup {
+ SampleSlot create sampleSlot
+} -body {
+ list [info level] [sampleSlot -set d e f] \
+ [sampleSlot contents] [sampleSlot ops]
+} -cleanup {
+ rename sampleSlot {}
+} -result {0 {} {d e f} {1 Set {d e f}}}
+test oo-32.5 {TIP 380: slots - class test} -setup {
+ SampleSlot create sampleSlot
+} -body {
+ list [info level] [sampleSlot -set d e f] [sampleSlot -append g h i] \
+ [sampleSlot contents] [sampleSlot ops]
+} -cleanup {
+ rename sampleSlot {}
+} -result {0 {} {} {d e f g h i} {1 Set {d e f} 1 Get 1 Set {d e f g h i}}}
+
+test oo-33.1 {TIP 380: slots - defaulting} -setup {
+ set s [SampleSlot new]
+} -body {
+ list [$s x y] [$s contents]
+} -cleanup {
+ rename $s {}
+} -result {{} {a b c x y}}
+test oo-33.2 {TIP 380: slots - defaulting} -setup {
+ set s [SampleSlot new]
+} -body {
+ list [$s destroy; $s unknown] [$s contents]
+} -cleanup {
+ rename $s {}
+} -result {{} {a b c destroy unknown}}
+test oo-33.3 {TIP 380: slots - defaulting} -setup {
+ set s [SampleSlot new]
+} -body {
+ oo::objdefine $s forward --default-operation my -set
+ list [$s destroy; $s unknown] [$s contents] [$s ops]
+} -cleanup {
+ rename $s {}
+} -result {{} unknown {1 Set destroy 1 Set unknown}}
+test oo-33.4 {TIP 380: slots - errors} -setup {
+ set s [SampleSlot new]
+} -body {
+ # Method names beginning with "-" are special to slots
+ $s -grill q
+} -returnCodes error -cleanup {
+ rename $s {}
+} -result {unknown method "-grill": must be -append, -clear, -set, contents or ops}
+
+SampleSlot destroy
+
+test oo-34.1 {TIP 380: slots - presence} -setup {
+ set obj [oo::object new]
+ set result {}
+} -body {
+ oo::define oo::object {
+ ::lappend ::result [::info object class filter]
+ ::lappend ::result [::info object class mixin]
+ ::lappend ::result [::info object class superclass]
+ ::lappend ::result [::info object class variable]
+ }
+ oo::objdefine $obj {
+ ::lappend ::result [::info object class filter]
+ ::lappend ::result [::info object class mixin]
+ ::lappend ::result [::info object class variable]
+ }
+ return $result
+} -cleanup {
+ $obj destroy
+} -result {::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot}
+test oo-34.2 {TIP 380: slots - presence} {
+ lsort [info class instances oo::Slot]
+} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable}
+proc getMethods obj {
+ list [lsort [info object methods $obj -all]] \
+ [lsort [info object methods $obj -private]]
+}
+test oo-34.3 {TIP 380: slots - presence} {
+ getMethods oo::define::filter
+} {{-append -clear -set} {Get Set}}
+test oo-34.4 {TIP 380: slots - presence} {
+ getMethods oo::define::mixin
+} {{-append -clear -set} {--default-operation Get Set}}
+test oo-34.5 {TIP 380: slots - presence} {
+ getMethods oo::define::superclass
+} {{-append -clear -set} {--default-operation Get Set}}
+test oo-34.6 {TIP 380: slots - presence} {
+ getMethods oo::define::variable
+} {{-append -clear -set} {Get Set}}
+test oo-34.7 {TIP 380: slots - presence} {
+ getMethods oo::objdefine::filter
+} {{-append -clear -set} {Get Set}}
+test oo-34.8 {TIP 380: slots - presence} {
+ getMethods oo::objdefine::mixin
+} {{-append -clear -set} {--default-operation Get Set}}
+test oo-34.9 {TIP 380: slots - presence} {
+ getMethods oo::objdefine::variable
+} {{-append -clear -set} {Get Set}}
cleanupTests
return
diff --git a/tests/ooNext2.test b/tests/ooNext2.test
new file mode 100644
index 0000000..d77e8d1
--- /dev/null
+++ b/tests/ooNext2.test
@@ -0,0 +1,788 @@
+# This file contains a collection of tests for Tcl's built-in object system.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright (c) 2006-2011 Donal K. Fellows
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require TclOO 1.0
+package require tcltest 2
+if {"::tcltest" in [namespace children]} {
+ namespace import -force ::tcltest::*
+}
+
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+ proc getbytes {} {
+ set lines [split [memory info] \n]
+ return [lindex $lines 3 3]
+ }
+ proc leaktest {script {iterations 3}} {
+ set end [getbytes]
+ for {set i 0} {$i < $iterations} {incr i} {
+ uplevel 1 $script
+ set tmp $end
+ set end [getbytes]
+ }
+ return [expr {$end - $tmp}]
+ }
+}
+
+test oo-nextto-1.1 {basic nextto functionality} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ method x args {
+ lappend ::result ==A== $args
+ }
+ }
+ oo::class create B {
+ superclass A
+ method x args {
+ lappend ::result ==B== $args
+ nextto A B -> A {*}$args
+ }
+ }
+ oo::class create C {
+ superclass A
+ method x args {
+ lappend ::result ==C== $args
+ nextto A C -> A {*}$args
+ }
+ }
+ oo::class create D {
+ superclass B C
+ method x args {
+ lappend ::result ==D== $args
+ next foo
+ nextto C bar
+ }
+ }
+ set ::result {}
+ [D new] x
+ return $::result
+} -cleanup {
+ root destroy
+} -result {==D== {} ==B== foo ==A== {B -> A foo} ==C== bar ==A== {C -> A bar}}
+test oo-nextto-1.2 {basic nextto functionality} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ method x args {
+ lappend ::result ==A== $args
+ }
+ }
+ oo::class create B {
+ superclass A
+ method x args {
+ lappend ::result ==B== $args
+ nextto A B -> A {*}$args
+ }
+ }
+ oo::class create C {
+ superclass A
+ method x args {
+ lappend ::result ==C== $args
+ nextto A C -> A {*}$args
+ }
+ }
+ oo::class create D {
+ superclass B C
+ method x args {
+ lappend ::result ==D== $args
+ nextto B foo {*}$args
+ nextto C bar {*}$args
+ }
+ }
+ set ::result {}
+ [D new] x 123
+ return $::result
+} -cleanup {
+ root destroy
+} -result {==D== 123 ==B== {foo 123} ==A== {B -> A foo 123} ==C== {bar 123} ==A== {C -> A bar 123}}
+test oo-nextto-1.3 {basic nextto functionality: constructors} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ variable result
+ constructor {a c} {
+ lappend result ==A== a=$a,c=$c
+ }
+ }
+ oo::class create B {
+ superclass root
+ variable result
+ constructor {b} {
+ lappend result ==B== b=$b
+ }
+ }
+ oo::class create C {
+ superclass A B
+ variable result
+ constructor {p q r} {
+ lappend result ==C== p=$p,q=$q,r=$r
+ # Route arguments to superclasses, in non-trival pattern
+ nextto B $q
+ nextto A $p $r
+ }
+ method result {} {return $result}
+ }
+ [C new x y z] result
+} -cleanup {
+ root destroy
+} -result {==C== p=x,q=y,r=z ==B== b=y ==A== a=x,c=z}
+test oo-nextto-1.4 {basic nextto functionality: destructors} -setup {
+ oo::class create root {destructor return}
+} -body {
+ oo::class create A {
+ superclass root
+ destructor {
+ lappend ::result ==A==
+ next
+ }
+ }
+ oo::class create B {
+ superclass root
+ destructor {
+ lappend ::result ==B==
+ next
+ }
+ }
+ oo::class create C {
+ superclass A B
+ destructor {
+ lappend ::result ==C==
+ lappend ::result |
+ nextto B
+ lappend ::result |
+ nextto A
+ lappend ::result |
+ next
+ }
+ }
+ set ::result ""
+ [C new] destroy
+ return $::result
+} -cleanup {
+ root destroy
+} -result {==C== | ==B== | ==A== ==B== | ==A== ==B==}
+
+test oo-nextto-2.1 {errors in nextto} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ method x y {error $y}
+ }
+ oo::class create B {
+ superclass A
+ method x y {nextto A $y}
+ }
+ [B new] x boom
+} -cleanup {
+ root destroy
+} -result boom -returnCodes error
+test oo-nextto-2.2 {errors in nextto} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ method x y {error $y}
+ }
+ oo::class create B {
+ superclass root
+ method x y {nextto A $y}
+ }
+ [B new] x boom
+} -returnCodes error -cleanup {
+ root destroy
+} -result {method has no non-filter implementation by "A"}
+test oo-nextto-2.3 {errors in nextto} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ method x y {nextto $y}
+ }
+ oo::class create B {
+ superclass A
+ method x y {nextto A $y}
+ }
+ [B new] x B
+} -returnCodes error -cleanup {
+ root destroy
+} -result {method implementation by "B" not reachable from here}
+test oo-nextto-2.4 {errors in nextto} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ method x y {nextto $y}
+ }
+ oo::class create B {
+ superclass A
+ method x y {nextto}
+ }
+ [B new] x B
+} -returnCodes error -cleanup {
+ root destroy
+} -result {wrong # args: should be "nextto class ?arg...?"}
+test oo-nextto-2.5 {errors in nextto} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ method x y {nextto $y}
+ }
+ oo::class create B {
+ superclass A
+ method x y {nextto $y $y $y}
+ }
+ [B new] x A
+} -cleanup {
+ root destroy
+} -result {wrong # args: should be "nextto A y"} -returnCodes error
+test oo-nextto-2.6 {errors in nextto} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ method x y {nextto $y}
+ }
+ oo::class create B {
+ superclass A
+ method x y {nextto $y $y $y}
+ }
+ [B new] x [root create notAClass]
+} -cleanup {
+ root destroy
+} -result {"::notAClass" is not a class} -returnCodes error
+test oo-nextto-2.7 {errors in nextto} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ method x y {nextto $y}
+ }
+ oo::class create B {
+ superclass A
+ filter Y
+ method Y args {next {*}$args}
+ }
+ oo::class create C {
+ superclass B
+ method x y {nextto $y $y $y}
+ }
+ [C new] x B
+} -returnCodes error -cleanup {
+ root destroy
+} -result {method has no non-filter implementation by "B"}
+
+test oo-call-1.1 {object call introspection} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ }
+ A create y
+ info object call y x
+} -cleanup {
+ root destroy
+} -result {{method x ::A method}}
+test oo-call-1.2 {object call introspection} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ }
+ oo::class create ::B {
+ superclass A
+ method x {} {}
+ }
+ B create y
+ info object call y x
+} -cleanup {
+ root destroy
+} -result {{method x ::B method} {method x ::A method}}
+test oo-call-1.3 {object call introspection} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ }
+ A create y
+ oo::objdefine y method x {} {}
+ info object call y x
+} -cleanup {
+ root destroy
+} -result {{method x object method} {method x ::A method}}
+test oo-call-1.4 {object object call introspection - unknown} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ }
+ A create y
+ info object call y z
+} -cleanup {
+ root destroy
+} -result {{unknown unknown ::oo::object {core method: "unknown"}}}
+test oo-call-1.5 {object call introspection - filters} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ method y {} {}
+ filter y
+ }
+ A create y
+ info object call y x
+} -cleanup {
+ root destroy
+} -result {{filter y ::A method} {method x ::A method}}
+test oo-call-1.6 {object call introspection - filters} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ method y {} {}
+ filter y
+ }
+ oo::class create ::B {
+ superclass A
+ method x {} {}
+ }
+ B create y
+ info object call y x
+} -cleanup {
+ root destroy
+} -result {{filter y ::A method} {method x ::B method} {method x ::A method}}
+test oo-call-1.7 {object call introspection - filters} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ method y {} {}
+ filter y
+ }
+ oo::class create ::B {
+ superclass A
+ method x {} {}
+ method y {} {}
+ }
+ B create y
+ info object call y x
+} -cleanup {
+ root destroy
+} -result {{filter y ::B method} {filter y ::A method} {method x ::B method} {method x ::A method}}
+test oo-call-1.8 {object call introspection - filters} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ method y {} {}
+ filter y
+ }
+ oo::class create ::B {
+ superclass A
+ method x {} {}
+ method y {} {}
+ method z {} {}
+ filter z
+ }
+ B create y
+ info object call y x
+} -cleanup {
+ root destroy
+} -result {{filter z ::B method} {filter y ::B method} {filter y ::A method} {method x ::B method} {method x ::A method}}
+test oo-call-1.9 {object call introspection - filters} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ method y {} {}
+ filter y
+ }
+ oo::class create ::B {
+ superclass A
+ method x {} {}
+ method y {} {}
+ method z {} {}
+ filter z
+ }
+ B create y
+ info object call y y
+} -cleanup {
+ root destroy
+} -result {{filter z ::B method} {filter y ::B method} {filter y ::A method} {method y ::B method} {method y ::A method}}
+test oo-call-1.10 {object call introspection - filters + unknown} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method y {} {}
+ filter y
+ }
+ oo::class create ::B {
+ superclass A
+ method y {} {}
+ method unknown {} {}
+ }
+ B create y
+ info object call y x
+} -cleanup {
+ root destroy
+} -result {{filter y ::B method} {filter y ::A method} {unknown unknown ::B method} {unknown unknown ::oo::object {core method: "unknown"}}}
+test oo-call-1.11 {object call introspection - filters + unknown} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method y {} {}
+ filter y
+ }
+ A create y
+ oo::objdefine y method unknown {} {}
+ info object call y x
+} -cleanup {
+ root destroy
+} -result {{filter y ::A method} {unknown unknown object method} {unknown unknown ::oo::object {core method: "unknown"}}}
+test oo-call-1.12 {object call introspection - filters + unknown} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method y {} {}
+ }
+ A create y
+ oo::objdefine y {
+ method unknown {} {}
+ filter y
+ }
+ info object call y x
+} -cleanup {
+ root destroy
+} -result {{filter y ::A method} {unknown unknown object method} {unknown unknown ::oo::object {core method: "unknown"}}}
+test oo-call-1.13 {object call introspection - filters + unknown} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method y {} {}
+ }
+ A create y
+ oo::objdefine y {
+ method unknown {} {}
+ method x {} {}
+ filter y
+ }
+ info object call y x
+} -cleanup {
+ root destroy
+} -result {{filter y ::A method} {method x object method}}
+test oo-call-1.14 {object call introspection - errors} -body {
+ info object call
+} -returnCodes error -result {wrong # args: should be "info object call objName methodName"}
+test oo-call-1.15 {object call introspection - errors} -body {
+ info object call a
+} -returnCodes error -result {wrong # args: should be "info object call objName methodName"}
+test oo-call-1.16 {object call introspection - errors} -body {
+ info object call a b c
+} -returnCodes error -result {wrong # args: should be "info object call objName methodName"}
+test oo-call-1.17 {object call introspection - errors} -body {
+ info object call notanobject x
+} -returnCodes error -result {notanobject does not refer to an object}
+test oo-call-1.18 {object call introspection - memory leaks} -body {
+ leaktest {
+ info object call oo::object destroy
+ }
+} -constraints memory -result 0
+test oo-call-1.19 {object call introspection - memory leaks} -setup {
+ oo::class create leaktester { method foo {} {dummy} }
+} -body {
+ leaktest {
+ set lt [leaktester new]
+ oo::objdefine $lt method foobar {} {dummy}
+ list [info object call $lt destroy] \
+ [info object call $lt foo] \
+ [info object call $lt bar] \
+ [info object call $lt foobar] \
+ [$lt destroy]
+ }
+} -cleanup {
+ leaktester destroy
+} -constraints memory -result 0
+
+test oo-call-2.1 {class call introspection} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ }
+ info class call A x
+} -cleanup {
+ root destroy
+} -result {{method x ::A method}}
+test oo-call-2.2 {class call introspection} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ }
+ oo::class create ::B {
+ superclass A
+ method x {} {}
+ }
+ list [info class call A x] [info class call B x]
+} -cleanup {
+ root destroy
+} -result {{{method x ::A method}} {{method x ::B method} {method x ::A method}}}
+test oo-call-2.3 {class call introspection} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ }
+ oo::class create ::B {
+ superclass A
+ method x {} {}
+ }
+ oo::class create ::C {
+ superclass A
+ method x {} {}
+ }
+ oo::class create ::D {
+ superclass C B
+ method x {} {}
+ }
+ info class call D x
+} -cleanup {
+ root destroy
+} -result {{method x ::D method} {method x ::C method} {method x ::B method} {method x ::A method}}
+test oo-call-2.4 {class call introspection - mixin} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ }
+ oo::class create ::B {
+ superclass A
+ method x {} {}
+ }
+ oo::class create ::C {
+ superclass A
+ method x {} {}
+ }
+ oo::class create ::D {
+ superclass C
+ mixin B
+ method x {} {}
+ }
+ info class call D x
+} -cleanup {
+ root destroy
+} -result {{method x ::B method} {method x ::D method} {method x ::C method} {method x ::A method}}
+test oo-call-2.5 {class call introspection - mixin + filter} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ }
+ oo::class create ::B {
+ superclass A
+ method x {} {}
+ method y {} {}
+ filter y
+ }
+ oo::class create ::C {
+ superclass A
+ method x {} {}
+ method y {} {}
+ }
+ oo::class create ::D {
+ superclass C
+ mixin B
+ method x {} {}
+ }
+ info class call D x
+} -cleanup {
+ root destroy
+} -result {{filter y ::B method} {filter y ::C method} {method x ::B method} {method x ::D method} {method x ::C method} {method x ::A method}}
+test oo-call-2.6 {class call introspection - mixin + filter + unknown} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ method unknown {} {}
+ }
+ oo::class create ::B {
+ superclass A
+ method x {} {}
+ method y {} {}
+ filter y
+ }
+ oo::class create ::C {
+ superclass A
+ method x {} {}
+ method y {} {}
+ }
+ oo::class create ::D {
+ superclass C
+ mixin B
+ method x {} {}
+ method unknown {} {}
+ }
+ info class call D z
+} -cleanup {
+ root destroy
+} -result {{filter y ::B method} {filter y ::C method} {unknown unknown ::D method} {unknown unknown ::A method} {unknown unknown ::oo::object {core method: "unknown"}}}
+test oo-call-2.7 {class call introspection - mixin + filter + unknown} -setup {
+ oo::class create root
+} -body {
+ oo::class create ::A {
+ superclass root
+ method x {} {}
+ }
+ oo::class create ::B {
+ superclass A
+ method x {} {}
+ filter x
+ }
+ info class call B x
+} -cleanup {
+ root destroy
+} -result {{filter x ::B method} {filter x ::A method} {method x ::B method} {method x ::A method}}
+test oo-call-2.8 {class call introspection - errors} -body {
+ info class call
+} -returnCodes error -result {wrong # args: should be "info class call className methodName"}
+test oo-call-2.9 {class call introspection - errors} -body {
+ info class call a
+} -returnCodes error -result {wrong # args: should be "info class call className methodName"}
+test oo-call-2.10 {class call introspection - errors} -body {
+ info class call a b c
+} -returnCodes error -result {wrong # args: should be "info class call className methodName"}
+test oo-call-2.11 {class call introspection - errors} -body {
+ info class call notaclass x
+} -returnCodes error -result {notaclass does not refer to an object}
+test oo-call-2.12 {class call introspection - errors} -setup {
+ oo::class create root
+} -body {
+ root create notaclass
+ info class call notaclass x
+} -returnCodes error -cleanup {
+ root destroy
+} -result {"notaclass" is not a class}
+test oo-call-2.13 {class call introspection - memory leaks} -body {
+ leaktest {
+ info class call oo::class destroy
+ }
+} -constraints memory -result 0
+test oo-call-2.14 {class call introspection - memory leaks} -body {
+ leaktest {
+ oo::class create leaktester { method foo {} {dummy} }
+ [leaktester new] destroy
+ list [info class call leaktester destroy] \
+ [info class call leaktester foo] \
+ [info class call leaktester bar] \
+ [leaktester destroy]
+ }
+} -constraints memory -result 0
+
+test oo-call-3.1 {current call introspection} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ method x {} {lappend ::result [self call]}
+ }
+ oo::class create B {
+ superclass A
+ method x {} {lappend ::result [self call];next}
+ }
+ B create y
+ oo::objdefine y method x {} {lappend ::result [self call];next}
+ set ::result {}
+ y x
+} -cleanup {
+ root destroy
+} -result {{{{method x object method} {method x ::B method} {method x ::A method}} 0} {{{method x object method} {method x ::B method} {method x ::A method}} 1} {{{method x object method} {method x ::B method} {method x ::A method}} 2}}
+test oo-call-3.2 {current call introspection} -setup {
+ oo::class create root
+} -constraints memory -body {
+ oo::class create A {
+ superclass root
+ method x {} {self call}
+ }
+ oo::class create B {
+ superclass A
+ method x {} {self call;next}
+ }
+ B create y
+ oo::objdefine y method x {} {self call;next}
+ leaktest {
+ y x
+ }
+} -cleanup {
+ root destroy
+} -result 0
+test oo-call-3.3 {current call introspection: in constructors} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ constructor {} {lappend ::result [self call]}
+ }
+ oo::class create B {
+ superclass A
+ constructor {} {lappend ::result [self call]; next}
+ }
+ set ::result {}
+ [B new] destroy
+ return $::result
+} -cleanup {
+ root destroy
+} -result {{{{method <constructor> ::B method} {method <constructor> ::A method}} 0} {{{method <constructor> ::B method} {method <constructor> ::A method}} 1}}
+test oo-call-3.4 {current call introspection: in destructors} -setup {
+ oo::class create root
+} -body {
+ oo::class create A {
+ superclass root
+ destructor {lappend ::result [self call]}
+ }
+ oo::class create B {
+ superclass A
+ destructor {lappend ::result [self call]; next}
+ }
+ set ::result {}
+ [B new] destroy
+ return $::result
+} -cleanup {
+ root destroy
+} -result {{{{method <destructor> ::B method} {method <destructor> ::A method}} 0} {{{method <destructor> ::B method} {method <destructor> ::A method}} 1}}
+
+cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/opt.test b/tests/opt.test
index 53e6711..2732d40 100644
--- a/tests/opt.test
+++ b/tests/opt.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: opt.test,v 1.11 2010/05/27 09:18:12 nijtmans Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/package.test b/tests/package.test
index eb24e99..da778f1 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -1,38 +1,51 @@
-# This file contains tests for the ::package::* commands.
+# This file contains tests for the package and ::pkg::* commands.
# Note that the tests are limited to Tcl scripts only, there are no shared
# libraries against which to test.
#
-# Sourcing this file into Tcl runs the tests and generates output for
-# errors. No output means no errors were found.
+# 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.
-# All rights reserved.
+# Copyright (c) 2011 Donal K. Fellows
#
-# RCS: @(#) $Id: package.test,v 1.3 2000/04/10 17:19:02 ericm Exp $
+# 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.3.3
namespace import -force ::tcltest::*
}
-test package-1.1 {pkg::create gives error on insufficient args} {
- catch {::pkg::create}
-} 1
-test package-1.2 {pkg::create gives error on bad args} {
- catch {::pkg::create -foo bar -bar baz -baz boo}
-} 1
-test package-1.3 {pkg::create gives error on no value given} {
- catch {::pkg::create -name foo -version 1.0 -source test.tcl -load}
-} 1
-test package-1.4 {pkg::create gives error on no name given} {
- catch {::pkg::create -version 1.0 -source test.tcl -load foo.so}
-} 1
-test package-1.5 {pkg::create gives error on no version given} {
- catch {::pkg::create -name foo -source test.tcl -load foo.so}
-} 1
-test package-1.6 {pkg::create gives error on no source or load options} {
- catch {::pkg::create -name foo -version 1.0 -version 2.0}
-} 1
+# Do all this in a slave interp to avoid garbaging the package list
+set i [interp create]
+tcltest::loadIntoSlaveInterpreter $i {*}$argv
+interp eval $i {
+namespace import -force ::tcltest::*
+package forget {*}[package names]
+set oldPkgUnknown [package unknown]
+package unknown {}
+set oldPath $auto_path
+set auto_path ""
+
+test package-1.1 {pkg::create gives error on insufficient args} -body {
+ ::pkg::create
+} -returnCodes error -match glob -result {wrong # args: should be "*"}
+test package-1.2 {pkg::create gives error on bad args} -body {
+ ::pkg::create -foo bar -bar baz -baz boo
+} -returnCodes error -match glob -result {unknown option "bar": *}
+test package-1.3 {pkg::create gives error on no value given} -body {
+ ::pkg::create -name foo -version 1.0 -source test.tcl -load
+} -returnCodes error -match glob -result {value for "-load" missing: *}
+test package-1.4 {pkg::create gives error on no name given} -body {
+ ::pkg::create -version 1.0 -source test.tcl -load foo.so
+} -returnCodes error -match glob -result {value for "-name" missing: *}
+test package-1.5 {pkg::create gives error on no version given} -body {
+ ::pkg::create -name foo -source test.tcl -load foo.so
+} -returnCodes error -match glob -result {value for "-version" missing: *}
+test package-1.6 {pkg::create gives error on no source or load options} -body {
+ ::pkg::create -name foo -version 1.0 -version 2.0
+} -returnCodes error -result {at least one of -load and -source must be given}
test package-1.7 {pkg::create gives correct output for 1 direct source} {
::pkg::create -name foo -version 1.0 -source test.tcl
} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]}
@@ -67,5 +80,1200 @@ test package-1.16 {pkg::create gives correct output for 1 direct, 1 lazy} {
-source {test2.tcl {foo bar}}
} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]\n[list tclPkgSetup $dir foo 1.0 {{test2.tcl source {foo bar}}}]}
+test package-2.1 {Tcl_PkgProvide procedure} {
+ package forget t
+ package provide t 2.3
+} {}
+test package-2.2 {Tcl_PkgProvide procedure} -returnCodes error -setup {
+ package forget t
+} -body {
+ package provide t 2.3
+ package provide t 2.2
+} -result {conflicting versions provided for package "t": 2.3, then 2.2}
+test package-2.3 {Tcl_PkgProvide procedure} -returnCodes error -setup {
+ package forget t
+} -body {
+ package provide t 2.3
+ package provide t 2.4
+} -result {conflicting versions provided for package "t": 2.3, then 2.4}
+test package-2.4 {Tcl_PkgProvide procedure} -returnCodes error -setup {
+ package forget t
+} -body {
+ package provide t 2.3
+ package provide t 3.3
+} -result {conflicting versions provided for package "t": 2.3, then 3.3}
+test package-2.5 {Tcl_PkgProvide procedure} -setup {
+ package forget t
+} -body {
+ package provide t 2.3
+ package provide t 2.3
+} -result {}
+test package-2.6 {Tcl_PkgProvide procedure} {
+ package forget t
+ package provide t 2.3a1
+} {}
+
+set n 0
+foreach v {
+ 2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1
+ 2b4a1 2b3b2
+} {
+ test package-2.7.$n {Tcl_PkgProvide procedure} -setup {
+ package forget t
+ } -returnCodes error -body "
+ package provide t $v
+ " -result "expected version number but got \"$v\""
+ incr n
+}
+
+test package-3.1 {Tcl_PkgRequire procedure, picking best version} -setup {
+ package forget t
+ set x xxx
+} -body {
+ foreach i {1.4 3.4 2.3 2.4 2.2} {
+ package ifneeded t $i "set x $i; package provide t $i"
+ }
+ package require t
+ return $x
+} -result {3.4}
+test package-3.2 {Tcl_PkgRequire procedure, picking best version} -setup {
+ package forget t
+ set x xxx
+} -body {
+ foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} {
+ package ifneeded t $i "set x $i; package provide t $i"
+ }
+ package require t
+ return $x
+} -result {3.5}
+test package-3.3 {Tcl_PkgRequire procedure, picking best version} -setup {
+ package forget t
+ set x xxx
+} -body {
+ foreach i {3.5 2.1 2.3} {
+ package ifneeded t $i "set x $i; package provide t $i"
+ }
+ package require t 2.2
+ return $x
+} -result {2.3}
+test package-3.4 {Tcl_PkgRequire procedure, picking best version} -setup {
+ package forget t
+ set x xxx
+} -body {
+ foreach i {1.4 3.4 2.3 2.4 2.2} {
+ package ifneeded t $i "set x $i; package provide t $i"
+ }
+ package require -exact t 2.3
+ return $x
+} -result {2.3}
+test package-3.5 {Tcl_PkgRequire procedure, picking best version} -setup {
+ package forget t
+ set x xxx
+} -body {
+ foreach i {1.4 3.4 2.3 2.4 2.2} {
+ package ifneeded t $i "set x $i; package provide t $i"
+ }
+ package require t 2.1
+ return $x
+} -result {2.4}
+test package-3.6 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
+ package forget t
+} -returnCodes error -body {
+ package unknown {}
+ foreach i {1.4 3.4 2.3 2.4 2.2} {
+ package ifneeded t $i "set x $i"
+ }
+ package require t 2.5
+} -result {can't find package t 2.5}
+test package-3.7 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
+ package forget t
+} -returnCodes error -body {
+ package unknown {}
+ foreach i {1.4 3.4 2.3 2.4 2.2} {
+ package ifneeded t $i "set x $i"
+ }
+ package require t 4.1
+} -result {can't find package t 4.1}
+test package-3.8 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
+ package forget t
+} -returnCodes error -body {
+ package unknown {}
+ foreach i {1.4 3.4 2.3 2.4 2.2} {
+ package ifneeded t $i "set x $i"
+ }
+ package require -exact t 1.3
+} -result {can't find package t exactly 1.3}
+test package-3.9 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
+ package forget t
+} -returnCodes error -body {
+ package unknown {}
+ package require t
+} -result {can't find package t}
+test package-3.10 {Tcl_PkgRequire procedure, error in ifneeded script} -setup {
+ package forget t
+} -body {
+ package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
+ list [catch {package require t 2.1} msg] $msg $::errorInfo
+} -match glob -result {1 {ifneeded test} {ifneeded test
+ while executing
+"error "ifneeded test""
+ ("package ifneeded*" script)
+ invoked from within
+"package require t 2.1"}}
+test package-3.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -setup {
+ package forget t
+ set x xxx
+} -body {
+ package ifneeded t 2.1 "set x invoked"
+ list [catch {package require t 2.1} msg] $msg $x
+} -match glob -result {1 * invoked}
+test package-3.12 {Tcl_PkgRequire procedure, self-deleting script} -setup {
+ package forget t
+ set x xxx
+} -body {
+ package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
+ package require t 1.2
+ return $x
+} -result {1.2}
+test package-3.13 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
+ package forget t
+ set x xxx
+} -body {
+ proc pkgUnknown args {
+ # args = name requirement
+ # requirement = v-v (for exact version)
+ global x
+ set x $args
+ package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0]
+ }
+ foreach i {1.4 3.4 2.3 2.4 2.2} {
+ package ifneeded t $i "set x $i"
+ }
+ package unknown pkgUnknown
+ package require -exact t 1.5
+ return $x
+} -cleanup {
+ package unknown {}
+} -result {t 1.5-1.5}
+test package-3.14 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
+ package forget t
+ set x xxx
+} -body {
+ proc pkgUnknown args {
+ package ifneeded t 1.2 "set x loaded; package provide t 1.2"
+ }
+ package unknown pkgUnknown
+ list [package require t] $x
+} -cleanup {
+ package unknown {}
+} -result {1.2 loaded}
+test package-3.15 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
+ package forget {a b}
+ package unknown pkgUnknown
+ set x xxx
+} -body {
+ proc pkgUnknown args {
+ global x
+ set x $args
+ package provide [lindex $args 0] 2.0
+ }
+ package require {a b}
+ return $x
+} -cleanup {
+ package unknown {}
+} -result {{a b} 0-}
+test package-3.16 {Tcl_PkgRequire procedure, "package unknown" error} -setup {
+ package forget t
+} -body {
+ proc pkgUnknown args {
+ error "testing package unknown"
+ }
+ package unknown pkgUnknown
+ list [catch {package require t} msg] $msg $::errorInfo
+} -cleanup {
+ package unknown {}
+} -result {1 {testing package unknown} {testing package unknown
+ while executing
+"error "testing package unknown""
+ (procedure "pkgUnknown" line 2)
+ invoked from within
+"pkgUnknown t 0-"
+ ("package unknown" script)
+ invoked from within
+"package require t"}}
+test package-3.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} -setup {
+ package forget t
+ set x xxx
+} -body {
+ proc pkgUnknown args {
+ global x
+ set x $args
+ }
+ foreach i {1.4 3.4 2.3 2.4 2.2} {
+ package ifneeded t $i "set x $i"
+ }
+ package unknown pkgUnknown
+ list [catch {package require -exact t 1.5} msg] $msg $x
+} -cleanup {
+ package unknown {}
+} -result {1 {can't find package t exactly 1.5} {t 1.5-1.5}}
+test package-3.18 {Tcl_PkgRequire procedure, version checks} -setup {
+ package forget t
+} -body {
+ package provide t 2.3
+ package require t
+} -result {2.3}
+test package-3.19 {Tcl_PkgRequire procedure, version checks} -setup {
+ package forget t
+} -body {
+ package provide t 2.3
+ package require t 2.1
+} -result {2.3}
+test package-3.20 {Tcl_PkgRequire procedure, version checks} -setup {
+ package forget t
+} -body {
+ package provide t 2.3
+ package require t 2.3
+} -result {2.3}
+test package-3.21 {Tcl_PkgRequire procedure, version checks} -setup {
+ package forget t
+} -returnCodes error -body {
+ package provide t 2.3
+ package require t 2.4
+} -result {version conflict for package "t": have 2.3, need 2.4}
+test package-3.22 {Tcl_PkgRequire procedure, version checks} -setup {
+ package forget t
+} -returnCodes error -body {
+ package provide t 2.3
+ package require t 1.2
+} -result {version conflict for package "t": have 2.3, need 1.2}
+test package-3.23 {Tcl_PkgRequire procedure, version checks} -setup {
+ package forget t
+} -body {
+ package provide t 2.3
+ package require -exact t 2.3
+} -result {2.3}
+test package-3.24 {Tcl_PkgRequire procedure, version checks} -setup {
+ package forget t
+} -returnCodes error -body {
+ package provide t 2.3
+ package require -exact t 2.2
+} -result {version conflict for package "t": have 2.3, need exactly 2.2}
+test package-3.25 {Tcl_PkgRequire procedure, error in ifneeded script} -setup {
+ package forget t
+} -body {
+ package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI}
+ list [catch {package require t 2.1} msg] $msg $::errorInfo
+} -match glob -result {1 {ifneeded test} {EI
+ ("package ifneeded*" script)
+ invoked from within
+"package require t 2.1"}}
+test package-3.26 {Tcl_PkgRequire procedure, error in ifneeded script} -setup {
+ package forget t
+} -body {
+ package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}}
+ list [catch {package require t 2.1} msg] $msg $::errorInfo
+} -match glob -result {1 {ifneeded test} {EI
+ ("foreach" body line 1)
+ invoked from within
+"foreach x 1 {error "ifneeded test" EI}"
+ ("package ifneeded*" script)
+ invoked from within
+"package require t 2.1"}}
+test package-3.27 {Tcl_PkgRequire: circular dependency} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {package require foo 1}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result {circular package dependency:*}
+test package-3.28 {Tcl_PkgRequire: circular dependency} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {package require foo 2}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result {circular package dependency:*}
+test package-3.29 {Tcl_PkgRequire: circular dependency} -setup {
+ package forget foo
+ package forget bar
+} -body {
+ package ifneeded foo 1 {package require bar 1; package provide foo 1}
+ package ifneeded bar 1 {package require foo 1; package provide bar 1}
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package forget bar
+} -returnCodes error -match glob -result {circular package dependency:*}
+test package-3.30 {Tcl_PkgRequire: circular dependency} -setup {
+ package forget foo
+ package forget bar
+} -body {
+ package ifneeded foo 1 {package require bar 1; package provide foo 1}
+ package ifneeded foo 2 {package provide foo 2}
+ package ifneeded bar 1 {package require foo 2; package provide bar 1}
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package forget bar
+} -returnCodes error -match glob -result {circular package dependency:*}
+test package-3.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {package provide foo 1; error foo}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result foo
+test package-3.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {package provide foo 1; error foo}
+ catch {package require foo 1}
+ package provide foo
+} -cleanup {
+ package forget foo
+} -result {}
+test package-3.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {package provide foo 2}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test package-3.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {package provide foo 1.1}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test package-3.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1.1 {package provide foo 1}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test package-3.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1.1 {package provide foo 1}
+ package require foo 1.1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test package-3.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test package-3.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {break}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob \
+-result {attempt to provide package * failed: bad return code:*}
+test package-3.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {continue}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob \
+-result {attempt to provide package * failed: bad return code:*}
+test package-3.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {return}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob \
+-result {attempt to provide package * failed: bad return code:*}
+test package-3.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {return -level 0 -code 10}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob \
+-result {attempt to provide package * failed: bad return code:*}
+test package-3.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+ set saveUnknown [package unknown]
+ package unknown {package provide foo 2 ;#}
+} -body {
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package unknown $saveUnknown
+} -returnCodes error -match glob -result *
+test package-3.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+ set saveUnknown [package unknown]
+ package unknown {break ;#}
+} -body {
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package unknown $saveUnknown
+} -returnCodes error -match glob -result {bad return code:*}
+test package-3.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+ set saveUnknown [package unknown]
+ package unknown {continue ;#}
+} -body {
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package unknown $saveUnknown
+} -returnCodes error -match glob -result {bad return code:*}
+test package-3.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+ set saveUnknown [package unknown]
+ package unknown {return ;#}
+} -body {
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package unknown $saveUnknown
+} -returnCodes error -match glob -result {bad return code:*}
+test package-3.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+ set saveUnknown [package unknown]
+ package unknown {return -level 0 -code 10 ;#}
+} -body {
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package unknown $saveUnknown
+} -returnCodes error -match glob -result {bad return code:*}
+test package-3.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup {
+ package provide demo 1.2.3
+} -body {
+ package require -exact demo 1.2
+} -returnCodes error -cleanup {
+ package forget demo
+} -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
+test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -setup {
+ package forget t
+ set x xxx
+} -body {
+ foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
+ package ifneeded t $i "set x $i; package provide t $i"
+ }
+ package require t
+ return $x
+} -result {3.4}
+test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup {
+ package forget t
+ set x xxx
+} -body {
+ foreach i {1.2b1 1.2 1.3a2 1.3} {
+ package ifneeded t $i "set x $i; package provide t $i"
+ }
+ package require t
+ return $x
+} -result {1.3}
+test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup {
+ package forget t
+ set x xxx
+} -body {
+ foreach i {1.2b1 1.2 1.3 1.3a2} {
+ package ifneeded t $i "set x $i; package provide t $i"
+ }
+ package require t
+ return $x
+} -result {1.3}
+
+test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body {
+ package
+} -result {wrong # args: should be "package option ?arg ...?"}
+test package-4.2 {Tcl_PackageCmd procedure, "forget" option} {
+ package forget {*}[package names]
+ package names
+} {}
+test package-4.3 {Tcl_PackageCmd procedure, "forget" option} {
+ package forget {*}[package names]
+ package forget foo
+} {}
+test package-4.4 {Tcl_PackageCmd procedure, "forget" option} -setup {
+ package forget {*}[package names]
+ set result {}
+} -body {
+ package ifneeded t 1.1 {first script}
+ package ifneeded t 2.3 {second script}
+ package ifneeded x 1.4 {x's script}
+ lappend result [lsort [package names]] [package versions t]
+ package forget t
+ lappend result [lsort [package names]] [package versions t]
+} -result {{t x} {1.1 2.3} x {}}
+test package-4.5 {Tcl_PackageCmd procedure, "forget" option} -setup {
+ package forget {*}[package names]
+} -body {
+ package ifneeded a 1.1 {first script}
+ package ifneeded b 2.3 {second script}
+ package ifneeded c 1.4 {third script}
+ package forget
+ set result [list [lsort [package names]]]
+ package forget a c
+ lappend result [lsort [package names]]
+} -result {{a b c} b}
+test package-4.5.1 {Tcl_PackageCmd procedure, "forget" option} -body {
+ # Test for Bug 415273
+ package ifneeded a 1 "I should have been forgotten"
+ package forget no-such-package a
+ package ifneeded a 1
+} -cleanup {
+ package forget a
+} -result {}
+test package-4.6 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
+ package ifneeded a
+} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"}
+test package-4.7 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
+ package ifneeded a b c d
+} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"}
+test package-4.8 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
+ package ifneeded t xyz
+} -returnCodes error -result {expected version number but got "xyz"}
+test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} {
+ package forget {*}[package names]
+ list [package ifneeded foo 1.1] [package names]
+} {{} {}}
+test package-4.10 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
+ package forget t
+} -body {
+ package ifneeded t 1.4 "script for t 1.4"
+ list [package names] [package ifneeded t 1.4] [package versions t]
+} -result {t {script for t 1.4} 1.4}
+test package-4.11 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
+ package forget t
+} -body {
+ package ifneeded t 1.4 "script for t 1.4"
+ list [package ifneeded t 1.5] [package names] [package versions t]
+} -result {{} t 1.4}
+test package-4.12 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
+ package forget t
+} -body {
+ package ifneeded t 1.4 "script for t 1.4"
+ package ifneeded t 1.4 "second script for t 1.4"
+ list [package ifneeded t 1.4] [package names] [package versions t]
+} -result {{second script for t 1.4} t 1.4}
+test package-4.13 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
+ package forget t
+} -body {
+ package ifneeded t 1.4 "script for t 1.4"
+ package ifneeded t 1.2 "second script"
+ package ifneeded t 3.1 "last script"
+ list [package ifneeded t 1.2] [package versions t]
+} -result {{second script} {1.4 1.2 3.1}}
+test package-4.14 {Tcl_PackageCmd procedure, "names" option} -body {
+ package names a
+} -returnCodes error -result {wrong # args: should be "package names"}
+test package-4.15 {Tcl_PackageCmd procedure, "names" option} {
+ package forget {*}[package names]
+ package names
+} {}
+test package-4.16 {Tcl_PackageCmd procedure, "names" option} -setup {
+ package forget {*}[package names]
+} -body {
+ package ifneeded x 1.2 {dummy}
+ package provide x 1.3
+ package provide y 2.4
+ catch {package require z 47.16}
+ lsort [package names]
+} -result {x y}
+test package-4.17 {Tcl_PackageCmd procedure, "provide" option} -body {
+ package provide
+} -returnCodes error -result {wrong # args: should be "package provide package ?version?"}
+test package-4.18 {Tcl_PackageCmd procedure, "provide" option} -body {
+ package provide a b c
+} -returnCodes error -result {wrong # args: should be "package provide package ?version?"}
+test package-4.19 {Tcl_PackageCmd procedure, "provide" option} -setup {
+ package forget t
+} -body {
+ package provide t
+} -result {}
+test package-4.20 {Tcl_PackageCmd procedure, "provide" option} -setup {
+ package forget t
+} -body {
+ package provide t 2.3
+ package provide t
+} -result {2.3}
+test package-4.21 {Tcl_PackageCmd procedure, "provide" option} -setup {
+ package forget t
+} -returnCodes error -body {
+ package provide t a.b
+} -result {expected version number but got "a.b"}
+test package-4.22 {Tcl_PackageCmd procedure, "require" option} -returnCodes error -body {
+ package require
+} -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"}
+test package-4.24 {Tcl_PackageCmd procedure, "require" option} -body {
+ package require -exact a b c
+ # Exact syntax: -exact name version
+ # name ?requirement ...?
+} -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"}
+test package-4.26 {Tcl_PackageCmd procedure, "require" option} -body {
+ package require x a.b
+} -returnCodes error -result {expected version number but got "a.b"}
+test package-4.27 {Tcl_PackageCmd procedure, "require" option} -body {
+ package require -exact x a.b
+} -returnCodes error -result {expected version number but got "a.b"}
+test package-4.28 {Tcl_PackageCmd procedure, "require" option} -body {
+ package require -exact x
+} -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"}
+test package-4.29 {Tcl_PackageCmd procedure, "require" option} -body {
+ package require -exact
+} -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"}
+test package-4.30 {Tcl_PackageCmd procedure, "require" option} -setup {
+ package forget t
+} -body {
+ package provide t 2.3
+ package require t 2.1
+} -result {2.3}
+test package-4.31 {Tcl_PackageCmd procedure, "require" option} -setup {
+ package forget t
+} -body {
+ package require t
+} -returnCodes error -result {can't find package t}
+test package-4.32 {Tcl_PackageCmd procedure, "require" option} -setup {
+ package forget t
+} -body {
+ package ifneeded t 2.3 "error {synthetic error}"
+ package require t 2.3
+} -returnCodes error -result {synthetic error}
+test package-4.33 {Tcl_PackageCmd procedure, "unknown" option} -body {
+ package unknown a b
+} -returnCodes error -result {wrong # args: should be "package unknown ?command?"}
+test package-4.34 {Tcl_PackageCmd procedure, "unknown" option} {
+ package unknown "test script"
+ package unknown
+} {test script}
+test package-4.35 {Tcl_PackageCmd procedure, "unknown" option} {
+ package unknown "test script"
+ package unknown {}
+ package unknown
+} {}
+test package-4.36 {Tcl_PackageCmd procedure, "vcompare" option} -body {
+ package vcompare a
+} -returnCodes error -result {wrong # args: should be "package vcompare version1 version2"}
+test package-4.37 {Tcl_PackageCmd procedure, "vcompare" option} -body {
+ package vcompare a b c
+} -returnCodes error -result {wrong # args: should be "package vcompare version1 version2"}
+test package-4.38 {Tcl_PackageCmd procedure, "vcompare" option} -body {
+ package vcompare x.y 3.4
+} -returnCodes error -result {expected version number but got "x.y"}
+test package-4.39 {Tcl_PackageCmd procedure, "vcompare" option} -body {
+ package vcompare 2.1 a.b
+} -returnCodes error -result {expected version number but got "a.b"}
+test package-4.40 {Tcl_PackageCmd procedure, "vcompare" option} {
+ package vc 2.1 2.3
+} {-1}
+test package-4.41 {Tcl_PackageCmd procedure, "vcompare" option} {
+ package vc 2.2.4 2.2.4
+} {0}
+test package-4.42 {Tcl_PackageCmd procedure, "versions" option} -body {
+ package versions
+} -returnCodes error -result {wrong # args: should be "package versions package"}
+test package-4.43 {Tcl_PackageCmd procedure, "versions" option} -body {
+ package versions a b
+} -returnCodes error -result {wrong # args: should be "package versions package"}
+test package-4.44 {Tcl_PackageCmd procedure, "versions" option} -body {
+ package forget t
+ package versions t
+} -result {}
+test package-4.45 {Tcl_PackageCmd procedure, "versions" option} -setup {
+ package forget t
+} -body {
+ package provide t 2.3
+ package versions t
+} -result {}
+test package-4.46 {Tcl_PackageCmd procedure, "versions" option} -setup {
+ package forget t
+} -body {
+ package ifneeded t 2.3 x
+ package ifneeded t 2.4 y
+ package versions t
+} -result {2.3 2.4}
+test package-4.47 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
+ package vsatisfies a
+} -returnCodes error -result {wrong # args: should be "package vsatisfies version ?requirement ...?"}
+test package-4.49 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
+ package vsatisfies x.y 3.4
+} -returnCodes error -result {expected version number but got "x.y"}
+test package-4.50 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
+ package vcompare 2.1 a.b
+} -returnCodes error -result {expected version number but got "a.b"}
+test package-4.51 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+ package vs 2.3 2.1
+} {1}
+test package-4.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+ package vs 2.3 1.2
+} {0}
+test package-4.53 {Tcl_PackageCmd procedure, "versions" option} -body {
+ package foo
+} -returnCodes error -result {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}
+test package-4.54 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
+ package vsatisfies 2.1 2.1-3.2-4.5
+} -returnCodes error -result {expected versionMin-versionMax but got "2.1-3.2-4.5"}
+test package-4.55 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
+ package vsatisfies 2.1 3.2-x.y
+} -returnCodes error -result {expected version number but got "x.y"}
+test package-4.56 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
+ package vsatisfies 2.1 x.y-3.2
+} -returnCodes error -result {expected version number but got "x.y"}
+
+# No tests for FindPackage; can't think up anything detectable errors.
+
+test package-5.1 {TclFreePackageInfo procedure} {
+ interp create slave
+ slave 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
+} {}
+test package-5.2 {TclFreePackageInfo procedure} -body {
+ interp create foo
+ foo eval {
+ package ifneeded t 2.3 x
+ package ifneeded t 2.4 y
+ package ifneeded x 3.1 z
+ package provide q 4.3
+ }
+ foo alias z kill
+ proc kill {} {
+ interp delete foo
+ }
+ foo eval package require x 3.1
+} -returnCodes error -match glob -result *
+
+test package-6.1 {CheckVersion procedure} {
+ package vcompare 1 2.1
+} -1
+test package-6.2 {CheckVersion procedure} -body {
+ package vcompare .1 2.1
+} -returnCodes error -result {expected version number but got ".1"}
+test package-6.3 {CheckVersion procedure} -body {
+ package vcompare 111.2a.3 2.1
+} -returnCodes error -result {expected version number but got "111.2a.3"}
+test package-6.4 {CheckVersion procedure} -body {
+ package vcompare 1.2.3. 2.1
+} -returnCodes error -result {expected version number but got "1.2.3."}
+test package-6.5 {CheckVersion procedure} -body {
+ package vcompare 1.2..3 2.1
+} -returnCodes error -result {expected version number but got "1.2..3"}
+
+test package-7.1 {ComparePkgVersions procedure} {
+ package vcompare 1.23 1.22
+} {1}
+test package-7.2 {ComparePkgVersions procedure} {
+ package vcompare 1.22.1.2.3 1.22.1.2.3
+} {0}
+test package-7.3 {ComparePkgVersions procedure} {
+ package vcompare 1.21 1.22
+} {-1}
+test package-7.4 {ComparePkgVersions procedure} {
+ package vcompare 1.21 1.21.2
+} {-1}
+test package-7.5 {ComparePkgVersions procedure} {
+ package vcompare 1.21.1 1.21
+} {1}
+test package-7.6 {ComparePkgVersions procedure} {
+ package vsatisfies 1.21.1 1.21
+} {1}
+test package-7.7 {ComparePkgVersions procedure} {
+ package vsatisfies 2.22.3 1.21
+} {0}
+test package-7.8 {ComparePkgVersions procedure} {
+ package vsatisfies 1 1
+} {1}
+test package-7.9 {ComparePkgVersions procedure} {
+ package vsatisfies 2 1
+} {0}
+
+test package-8.1 {Tcl_PkgPresent procedure, any version} -setup {
+ package forget t
+} -body {
+ package provide t 2.4
+ package present t
+} -result {2.4}
+test package-8.2 {Tcl_PkgPresent procedure, correct version} -setup {
+ package forget t
+} -body {
+ package provide t 2.4
+ package present t 2.4
+} -result {2.4}
+test package-8.3 {Tcl_PkgPresent procedure, satisfying version} -setup {
+ package forget t
+} -body {
+ package provide t 2.4
+ package present t 2.0
+} -result {2.4}
+test package-8.4 {Tcl_PkgPresent procedure, not satisfying version} -setup {
+ package forget t
+} -returnCodes error -body {
+ package provide t 2.4
+ package present t 2.6
+} -result {version conflict for package "t": have 2.4, need 2.6}
+test package-8.5 {Tcl_PkgPresent procedure, not satisfying version} -setup {
+ package forget t
+} -returnCodes error -body {
+ package provide t 2.4
+ package present t 1.0
+} -result {version conflict for package "t": have 2.4, need 1.0}
+test package-8.6 {Tcl_PkgPresent procedure, exact version} -setup {
+ package forget t
+} -body {
+ package provide t 2.4
+ package present -exact t 2.4
+} -result {2.4}
+test package-8.7 {Tcl_PkgPresent procedure, not exact version} -setup {
+ package forget t
+} -returnCodes error -body {
+ package provide t 2.4
+ package present -exact t 2.3
+} -result {version conflict for package "t": have 2.4, need exactly 2.3}
+test package-8.8 {Tcl_PkgPresent procedure, unknown package} -body {
+ package forget t
+ package present t
+} -returnCodes error -result {package t is not present}
+test package-8.9 {Tcl_PkgPresent procedure, unknown package} -body {
+ package forget t
+ package present t 2.4
+} -returnCodes error -result {package t 2.4 is not present}
+test package-8.10 {Tcl_PkgPresent procedure, unknown package} -body {
+ package forget t
+ package present -exact t 2.4
+} -returnCodes error -result {package t 2.4 is not present}
+test package-8.11 {Tcl_PackageCmd procedure, "present" option} -body {
+ package present
+} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"}
+test package-8.12 {Tcl_PackageCmd procedure, "present" option} -body {
+ package present a b c
+} -returnCodes error -result {expected version number but got "b"}
+test package-8.13 {Tcl_PackageCmd procedure, "present" option} -body {
+ package present -exact a b c
+} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"}
+test package-8.14 {Tcl_PackageCmd procedure, "present" option} -body {
+ package present -bs a b
+} -returnCodes error -result {expected version number but got "a"}
+test package-8.15 {Tcl_PackageCmd procedure, "present" option} -body {
+ package present x a.b
+} -returnCodes error -result {expected version number but got "a.b"}
+test package-8.16 {Tcl_PackageCmd procedure, "present" option} -body {
+ package present -exact x a.b
+} -returnCodes error -result {expected version number but got "a.b"}
+test package-8.17 {Tcl_PackageCmd procedure, "present" option} -body {
+ package present -exact x
+} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"}
+test package-8.18 {Tcl_PackageCmd procedure, "present" option} -body {
+ package present -exact
+} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"}
+
+set n 0
+foreach {r p vs vc} {
+ 8.5a0 8.5a5 1 -1
+ 8.5a0 8.5b1 1 -1
+ 8.5a0 8.5.1 1 -1
+ 8.5a0 8.6a0 1 -1
+ 8.5a0 8.6b0 1 -1
+ 8.5a0 8.6.0 1 -1
+ 8.5a6 8.5a5 0 1
+ 8.5a6 8.5b1 1 -1
+ 8.5a6 8.5.1 1 -1
+ 8.5a6 8.6a0 1 -1
+ 8.5a6 8.6b0 1 -1
+ 8.5a6 8.6.0 1 -1
+ 8.5b0 8.5a5 0 1
+ 8.5b0 8.5b1 1 -1
+ 8.5b0 8.5.1 1 -1
+ 8.5b0 8.6a0 1 -1
+ 8.5b0 8.6b0 1 -1
+ 8.5b0 8.6.0 1 -1
+ 8.5b2 8.5a5 0 1
+ 8.5b2 8.5b1 0 1
+ 8.5b2 8.5.1 1 -1
+ 8.5b2 8.6a0 1 -1
+ 8.5b2 8.6b0 1 -1
+ 8.5b2 8.6.0 1 -1
+ 8.5 8.5a5 1 1
+ 8.5 8.5b1 1 1
+ 8.5 8.5.1 1 -1
+ 8.5 8.6a0 1 -1
+ 8.5 8.6b0 1 -1
+ 8.5 8.6.0 1 -1
+ 8.5.0 8.5a5 0 1
+ 8.5.0 8.5b1 0 1
+ 8.5.0 8.5.1 1 -1
+ 8.5.0 8.6a0 1 -1
+ 8.5.0 8.6b0 1 -1
+ 8.5.0 8.6.0 1 -1
+ 10 8 0 1
+ 8 10 0 -1
+ 0.0.1.2 0.1.2 1 -1
+} {
+ test package-9.$n {package vsatisfies} {
+ package vsatisfies $p $r
+ } $vs
+ test package-10.$n {package vcompare} {
+ package vcompare $r $p
+ } $vc
+ incr n
+}
+
+test package-11.0.0 {package vcompare at 32bit boundary} {
+ package vcompare [expr {1<<31}] [expr {(1<<31)-1}]
+} 1
+
+# Note: It is correct that the result of the very first test, i.e. "5.0 5.0a0"
+# is 1, i.e. that version 5.0a0 satisfies a 5.0 requirement.
+
+# The requirement "5.0" internally translates first to "5.0-6", and then to
+# its final form of "5.0a0-6a0". These translations are explicitly specified
+# by the TIP (Search for "padded/extended internally with 'a0'"). This was
+# done intentionally for exactly the tested case, that an alpha package can
+# satisfy a requirement for the regular package. An example would be a package
+# FOO requiring Tcl 8.X for its operation. It can be used with Tcl 8.Xa0.
+# Without our translation that would not be possible.
+
+set n 0
+foreach {required provided satisfied} {
+ 5.0 5.0a0 1
+ 5.0a0 5.0 1
+
+ 8.5a0- 8.5a5 1
+ 8.5a0- 8.5b1 1
+ 8.5a0- 8.5.1 1
+ 8.5a0- 8.6a0 1
+ 8.5a0- 8.6b0 1
+ 8.5a0- 8.6.0 1
+ 8.5a6- 8.5a5 0
+ 8.5a6- 8.5b1 1
+ 8.5a6- 8.5.1 1
+ 8.5a6- 8.6a0 1
+ 8.5a6- 8.6b0 1
+ 8.5a6- 8.6.0 1
+ 8.5b0- 8.5a5 0
+ 8.5b0- 8.5b1 1
+ 8.5b0- 8.5.1 1
+ 8.5b0- 8.6a0 1
+ 8.5b0- 8.6b0 1
+ 8.5b0- 8.6.0 1
+ 8.5b2- 8.5a5 0
+ 8.5b2- 8.5b1 0
+ 8.5b2- 8.5.1 1
+ 8.5b2- 8.6a0 1
+ 8.5b2- 8.6b0 1
+ 8.5b2- 8.6.0 1
+ 8.5- 8.5a5 1
+ 8.5- 8.5b1 1
+ 8.5- 8.5.1 1
+ 8.5- 8.6a0 1
+ 8.5- 8.6b0 1
+ 8.5- 8.6.0 1
+ 8.5.0- 8.5a5 0
+ 8.5.0- 8.5b1 0
+ 8.5.0- 8.5.1 1
+ 8.5.0- 8.6a0 1
+ 8.5.0- 8.6b0 1
+ 8.5.0- 8.6.0 1
+ 8.5a0-7 8.5a5 0
+ 8.5a0-7 8.5b1 0
+ 8.5a0-7 8.5.1 0
+ 8.5a0-7 8.6a0 0
+ 8.5a0-7 8.6b0 0
+ 8.5a0-7 8.6.0 0
+ 8.5a6-7 8.5a5 0
+ 8.5a6-7 8.5b1 0
+ 8.5a6-7 8.5.1 0
+ 8.5a6-7 8.6a0 0
+ 8.5a6-7 8.6b0 0
+ 8.5a6-7 8.6.0 0
+ 8.5b0-7 8.5a5 0
+ 8.5b0-7 8.5b1 0
+ 8.5b0-7 8.5.1 0
+ 8.5b0-7 8.6a0 0
+ 8.5b0-7 8.6b0 0
+ 8.5b0-7 8.6.0 0
+ 8.5b2-7 8.5a5 0
+ 8.5b2-7 8.5b1 0
+ 8.5b2-7 8.5.1 0
+ 8.5b2-7 8.6a0 0
+ 8.5b2-7 8.6b0 0
+ 8.5b2-7 8.6.0 0
+ 8.5-7 8.5a5 0
+ 8.5-7 8.5b1 0
+ 8.5-7 8.5.1 0
+ 8.5-7 8.6a0 0
+ 8.5-7 8.6b0 0
+ 8.5-7 8.6.0 0
+ 8.5.0-7 8.5a5 0
+ 8.5.0-7 8.5b1 0
+ 8.5.0-7 8.5.1 0
+ 8.5.0-7 8.6a0 0
+ 8.5.0-7 8.6b0 0
+ 8.5.0-7 8.6.0 0
+ 8.5a0-8.6.1 8.5a5 1
+ 8.5a0-8.6.1 8.5b1 1
+ 8.5a0-8.6.1 8.5.1 1
+ 8.5a0-8.6.1 8.6a0 1
+ 8.5a0-8.6.1 8.6b0 1
+ 8.5a0-8.6.1 8.6.0 1
+ 8.5a6-8.6.1 8.5a5 0
+ 8.5a6-8.6.1 8.5b1 1
+ 8.5a6-8.6.1 8.5.1 1
+ 8.5a6-8.6.1 8.6a0 1
+ 8.5a6-8.6.1 8.6b0 1
+ 8.5a6-8.6.1 8.6.0 1
+ 8.5b0-8.6.1 8.5a5 0
+ 8.5b0-8.6.1 8.5b1 1
+ 8.5b0-8.6.1 8.5.1 1
+ 8.5b0-8.6.1 8.6a0 1
+ 8.5b0-8.6.1 8.6b0 1
+ 8.5b0-8.6.1 8.6.0 1
+ 8.5b2-8.6.1 8.5a5 0
+ 8.5b2-8.6.1 8.5b1 0
+ 8.5b2-8.6.1 8.5.1 1
+ 8.5b2-8.6.1 8.6a0 1
+ 8.5b2-8.6.1 8.6b0 1
+ 8.5b2-8.6.1 8.6.0 1
+ 8.5-8.6.1 8.5a5 1
+ 8.5-8.6.1 8.5b1 1
+ 8.5-8.6.1 8.5.1 1
+ 8.5-8.6.1 8.6a0 1
+ 8.5-8.6.1 8.6b0 1
+ 8.5-8.6.1 8.6.0 1
+ 8.5.0-8.6.1 8.5a5 0
+ 8.5.0-8.6.1 8.5b1 0
+ 8.5.0-8.6.1 8.5.1 1
+ 8.5.0-8.6.1 8.6a0 1
+ 8.5.0-8.6.1 8.6b0 1
+ 8.5.0-8.6.1 8.6.0 1
+ 8.5a0-8.5a0 8.5a0 1
+ 8.5a0-8.5a0 8.5b1 0
+ 8.5a0-8.5a0 8.4 0
+ 8.5b0-8.5b0 8.5a5 0
+ 8.5b0-8.5b0 8.5b0 1
+ 8.5b0-8.5b0 8.5.1 0
+ 8.5-8.5 8.5a5 0
+ 8.5-8.5 8.5b1 0
+ 8.5-8.5 8.5 1
+ 8.5-8.5 8.5.1 0
+ 8.5.0-8.5.0 8.5a5 0
+ 8.5.0-8.5.0 8.5b1 0
+ 8.5.0-8.5.0 8.5.0 1
+ 8.5.0-8.5.0 8.5.1 0
+ 8.5.0-8.5.0 8.6a0 0
+ 8.5.0-8.5.0 8.6b0 0
+ 8.5.0-8.5.0 8.6.0 0
+ 8.2 9 0
+ 8.2- 9 1
+ 8.2-8.5 9 0
+ 8.2-9.1 9 1
+
+ 8.5-8.5 8.5b1 0
+ 8.5a0-8.5 8.5b1 0
+ 8.5a0-8.5.1 8.5b1 1
+
+ 8.5-8.5 8.5 1
+ 8.5.0-8.5.0 8.5 1
+ 8.5a0-8.5.0 8.5 0
+} {
+ test package-11.$n "package vsatisfies $provided $required" {
+ package vsatisfies $provided $required
+ } $satisfied
+ incr n
+}
+
+test package-12.0 "package vsatisfies multiple" {
+ # yes no
+ package vsatisfies 8.4 8.4 7.3
+} 1
+test package-12.1 "package vsatisfies multiple" {
+ # no yes
+ package vsatisfies 8.4 7.3 8.4
+} 1
+test package-12.2 "package vsatisfies multiple" {
+ # yes yes
+ package vsatisfies 8.4.2 8.4 8.4.1
+} 1
+test package-12.3 "package vsatisfies multiple" {
+ # no no
+ package vsatisfies 8.4 7.3 6.1
+} 0
+
+proc prefer {args} {
+ set ip [interp create]
+ try {
+ lappend res [$ip eval {package prefer}]
+ foreach mode $args {
+ lappend res [$ip eval [list package prefer $mode]]
+ }
+ return $res
+ } finally {
+ interp delete $ip
+ }
+}
+
+test package-13.0 {package prefer defaults} {
+ prefer
+} stable
+test package-13.1 {package prefer defaults} -body {
+ set ::env(TCL_PKG_PREFER_LATEST) stable ;# value not relevant!
+ prefer
+} -cleanup {
+ unset -nocomplain ::env(TCL_PKG_PREFER_LATEST)
+} -result latest
+
+test package-14.0 {wrong\#args} -returnCodes error -body {
+ package prefer foo bar
+} -result {wrong # args: should be "package prefer ?latest|stable?"}
+test package-14.1 {bogus argument} -returnCodes error -body {
+ package prefer foo
+} -result {bad preference "foo": must be latest or stable}
+
+test package-15.0 {set, keep} {package prefer stable} stable
+test package-15.1 {set stable, keep} {prefer stable} {stable stable}
+test package-15.2 {set latest, change} {prefer latest} {stable latest}
+test package-15.3 {set latest, keep} {
+ prefer latest latest
+} {stable latest latest}
+test package-15.4 {set stable, rejected} {
+ prefer latest stable
+} {stable latest latest}
+
+rename prefer {}
+
+set auto_path $oldPath
+package unknown $oldPkgUnknown
+
+cleanupTests
+}
+
+# cleanup
+interp delete $i
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/parse.test b/tests/parse.test
index b83d20e..0f76d64 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -7,8 +7,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: parse.test,v 1.39 2009/09/17 17:58:10 dgp Exp $
if {[catch {package require tcltest 2.0.2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -18,6 +16,9 @@ if {[catch {package require tcltest 2.0.2}]} {
namespace eval ::tcl::test::parse {
namespace import ::tcltest::*
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testparser [llength [info commands testparser]]
testConstraint testevalobjv [llength [info commands testevalobjv]]
testConstraint testevalex [llength [info commands testevalex]]
@@ -235,6 +236,12 @@ test parse-5.28 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser {
test parse-5.29 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser {
testparser {{*}{a \n b}} 0
} {- {{*}{a \n b}} 1 expand {{*}{a \n b}} 1 text {a \n b} 0 {}}
+test parse-5.30 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser {
+ testparser {{*}"a b"} 0
+} {- {{*}"a b"} 2 simple a 1 text a 0 simple b 1 text b 0 {}}
+test parse-5.31 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser {
+ testparser {{*}"a \n b"} 0
+} {- {{*}"a \n b"} 1 expand {{*}"a \n b"} 3 text {a } 0 backslash {\n} 0 text { b} 0 {}}
test parse-6.1 {ParseTokens procedure, empty word} testparser {
testparser {""} 0
@@ -1045,6 +1052,44 @@ test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} emptyTest {
# Test no longer valid in Tcl 8.6
} {}
+test parse-20.1 {TclParseBackslash: truncated escape} testparser {
+ testparser {\u12345} 1
+} {- \\ 1 simple \\ 1 text \\ 0 u12345}
+test parse-20.2 {TclParseBackslash: truncated escape} testparser {
+ testparser {\u12345} 2
+} {- {\u} 1 word {\u} 1 backslash {\u} 0 12345}
+test parse-20.3 {TclParseBackslash: truncated escape} testparser {
+ testparser {\u12345} 3
+} {- {\u1} 1 word {\u1} 1 backslash {\u1} 0 2345}
+test parse-20.4 {TclParseBackslash: truncated escape} testparser {
+ testparser {\u12345} 4
+} {- {\u12} 1 word {\u12} 1 backslash {\u12} 0 345}
+test parse-20.5 {TclParseBackslash: truncated escape} testparser {
+ testparser {\u12345} 5
+} {- {\u123} 1 word {\u123} 1 backslash {\u123} 0 45}
+test parse-20.6 {TclParseBackslash: truncated escape} testparser {
+ testparser {\u12345} 6
+} {- {\u1234} 1 word {\u1234} 1 backslash {\u1234} 0 5}
+test parse-20.7 {TclParseBackslash: truncated escape} testparser {
+ testparser {\u12345} 7
+} {- {\u12345} 1 word {\u12345} 2 backslash {\u1234} 0 text 5 0 {}}
+
+test parse-20.8 {TclParseBackslash: truncated escape} testparser {
+ testparser {\x12X} 1
+} {- \\ 1 simple \\ 1 text \\ 0 x12X}
+test parse-20.9 {TclParseBackslash: truncated escape} testparser {
+ testparser {\x12X} 2
+} {- {\x} 1 word {\x} 1 backslash {\x} 0 12X}
+test parse-20.10 {TclParseBackslash: truncated escape} testparser {
+ testparser {\x12X} 3
+} {- {\x1} 1 word {\x1} 1 backslash {\x1} 0 2X}
+test parse-20.11 {TclParseBackslash: truncated escape} testparser {
+ testparser {\x12X} 4
+} {- {\x12} 1 word {\x12} 1 backslash {\x12} 0 X}
+test parse-20.12 {TclParseBackslash: truncated escape} testparser {
+ testparser {\x12X} 5
+} {- {\x12X} 1 word {\x12X} 2 backslash {\x12} 0 text X 0 {}}
+
cleanupTests
}
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index 0f62b91..7910974 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.test
@@ -7,14 +7,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: parseExpr.test,v 1.29 2007/12/13 15:26:07 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Note that the Tcl expression parser (tclCompExpr.c) does not check
# the semantic validity of the expressions it parses. It does not check,
# for example, that a math function actually exists, or that the operands
@@ -999,6 +1000,72 @@ test parseExpr-21.63 {error message} -body {
} -returnCodes error -result "missing close-brace
in expression \"...12345678901234567890*\[\{abcdefghijklmnopqrstuv...\""
+test parseExpr-22.1 {Bug 3401704} -constraints testexprparser -body {
+ testexprparser 2a() 1
+} -result {- {} 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-22.2 {Bug 3401704} -constraints testexprparser -body {
+ testexprparser nana() 3
+} -result {- {} 0 subexpr nan 1 text nan 0 {}}
+test parseExpr-22.3 {Bug 3401704} -constraints testexprparser -body {
+ testexprparser 2a() -1
+} -result {- {} 0 subexpr 2a() 1 operator 2a 0 {}}
+test parseExpr-22.4 {Bug 3401704} -constraints testexprparser -body {
+ testexprparser nana() -1
+} -result {- {} 0 subexpr nana() 1 operator nana 0 {}}
+test parseExpr-22.5 {Bug 3401704} -constraints testexprparser -body {
+ testexprparser nan9() -1
+} -result {- {} 0 subexpr nan9() 1 operator nan9 0 {}}
+test parseExpr-22.6 {Bug 3401704} -constraints testexprparser -body {
+ testexprparser 2_() -1
+} -result {- {} 0 subexpr 2_() 1 operator 2_ 0 {}}
+test parseExpr-22.7 {Bug 3401704} -constraints testexprparser -body {
+ testexprparser nan_() -1
+} -result {- {} 0 subexpr nan_() 1 operator nan_ 0 {}}
+test parseExpr-22.8 {Bug 3401704} -constraints testexprparser -body {
+ catch {testexprparser nan!() -1} m o
+ dict get $o -errorcode
+} -result {TCL PARSE EXPR MISSING}
+test parseExpr-22.9 {Bug 3401704} -constraints testexprparser -body {
+ testexprparser 1e3_() -1
+} -result {- {} 0 subexpr 1e3_() 1 operator 1e3_ 0 {}}
+test parseExpr-22.10 {Bug 3401704} -constraints testexprparser -body {
+ catch {testexprparser 1.3_() -1} m o
+ dict get $o -errorcode
+} -result {TCL PARSE EXPR BADCHAR}
+test parseExpr-22.11 {Bug 3401704} -constraints testexprparser -body {
+ catch {testexprparser 1e-3_() -1} m o
+ dict get $o -errorcode
+} -result {TCL PARSE EXPR BADCHAR}
+test parseExpr-22.12 {Bug 3401704} -constraints testexprparser -body {
+ catch {testexprparser naneq() -1} m o
+ dict get $o -errorcode
+} -result {TCL PARSE EXPR EMPTY}
+test parseExpr-22.13 {Bug 3401704} -constraints testexprparser -body {
+ testexprparser naner() -1
+} -result {- {} 0 subexpr naner() 1 operator naner 0 {}}
+
+test parseExpr-22.14 {Bug 3401704} -constraints testexprparser -body {
+ catch {testexprparser 08 -1} m o
+ dict get $o -errorcode
+} -result {TCL PARSE EXPR BADNUMBER OCTAL}
+test parseExpr-22.15 {Bug 3401704} -constraints testexprparser -body {
+ catch {testexprparser 0o8 -1} m o
+ dict get $o -errorcode
+} -result {TCL PARSE EXPR BADNUMBER OCTAL}
+test parseExpr-22.16 {Bug 3401704} -constraints testexprparser -body {
+ catch {testexprparser 0o08 -1} m o
+ dict get $o -errorcode
+} -result {TCL PARSE EXPR BADNUMBER OCTAL}
+test parseExpr-22.17 {Bug 3401704} -constraints testexprparser -body {
+ catch {testexprparser 0b2 -1} m o
+ dict get $o -errorcode
+} -result {TCL PARSE EXPR BADNUMBER BINARY}
+test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body {
+ catch {testexprparser 0b02 -1} m o
+ dict get $o -errorcode
+} -result {TCL PARSE EXPR BADNUMBER BINARY}
+
+
# cleanup
::tcltest::cleanupTests
return
diff --git a/tests/parseOld.test b/tests/parseOld.test
index 9cc90fe..0edcbf0 100644
--- a/tests/parseOld.test
+++ b/tests/parseOld.test
@@ -12,14 +12,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: parseOld.test,v 1.14 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testwordend [llength [info commands testwordend]]
# Save the argv value for restoration later
diff --git a/tests/pid.test b/tests/pid.test
index 9734d51..d21dbaa 100644
--- a/tests/pid.test
+++ b/tests/pid.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: pid.test,v 1.12 2004/05/19 22:06:07 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
diff --git a/tests/pkg.test b/tests/pkg.test
deleted file mode 100644
index 4f92d4c..0000000
--- a/tests/pkg.test
+++ /dev/null
@@ -1,1222 +0,0 @@
-# -*- tcl -*-
-# Commands covered: pkg
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. 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.
-#
-# RCS: @(#) $Id: pkg.test,v 1.31 2008/07/19 22:50:39 nijtmans Exp $
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
-
-# Do all this in a slave interp to avoid garbaging the
-# package list
-set i [interp create]
-interp eval $i [list set argv $argv]
-interp eval $i [list package require tcltest 2]
-interp eval $i [list namespace import -force ::tcltest::*]
-interp eval $i {
-
-package forget {*}[package names]
-set oldPkgUnknown [package unknown]
-package unknown {}
-set oldPath $auto_path
-set auto_path ""
-
-test pkg-1.1 {Tcl_PkgProvide procedure} {
- package forget t
- package provide t 2.3
-} {}
-test pkg-1.2 {Tcl_PkgProvide procedure} {
- package forget t
- package provide t 2.3
- list [catch {package provide t 2.2} msg] $msg
-} {1 {conflicting versions provided for package "t": 2.3, then 2.2}}
-test pkg-1.3 {Tcl_PkgProvide procedure} {
- package forget t
- package provide t 2.3
- list [catch {package provide t 2.4} msg] $msg
-} {1 {conflicting versions provided for package "t": 2.3, then 2.4}}
-test pkg-1.4 {Tcl_PkgProvide procedure} {
- package forget t
- package provide t 2.3
- list [catch {package provide t 3.3} msg] $msg
-} {1 {conflicting versions provided for package "t": 2.3, then 3.3}}
-test pkg-1.5 {Tcl_PkgProvide procedure} {
- package forget t
- package provide t 2.3
- package provide t 2.3
-} {}
-
-test pkg-1.6 {Tcl_PkgProvide procedure} {
- package forget t
- package provide t 2.3a1
-} {}
-
-set n 0
-foreach v {
- 2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1
- 2b4a1 2b3b2
-} {
- test pkg-1.7.$n {Tcl_PkgProvide procedure} {
- package forget t
- list [catch {package provide t $v} msg] $msg
- } [list 1 "expected version number but got \"$v\""]
- incr n
-}
-
-test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} {
- package forget t
- foreach i {1.4 3.4 2.3 2.4 2.2} {
- package ifneeded t $i "set x $i; package provide t $i"
- }
- set x xxx
- package require t
- set x
-} {3.4}
-test pkg-2.2 {Tcl_PkgRequire procedure, picking best version} {
- package forget t
- foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} {
- package ifneeded t $i "set x $i; package provide t $i"
- }
- set x xxx
- package require t
- set x
-} {3.5}
-test pkg-2.3 {Tcl_PkgRequire procedure, picking best version} {
- package forget t
- foreach i {3.5 2.1 2.3} {
- package ifneeded t $i "set x $i; package provide t $i"
- }
- set x xxx
- package require t 2.2
- set x
-} {2.3}
-test pkg-2.4 {Tcl_PkgRequire procedure, picking best version} {
- package forget t
- foreach i {1.4 3.4 2.3 2.4 2.2} {
- package ifneeded t $i "set x $i; package provide t $i"
- }
- set x xxx
- package require -exact t 2.3
- set x
-} {2.3}
-test pkg-2.5 {Tcl_PkgRequire procedure, picking best version} {
- package forget t
- foreach i {1.4 3.4 2.3 2.4 2.2} {
- package ifneeded t $i "set x $i; package provide t $i"
- }
- set x xxx
- package require t 2.1
- set x
-} {2.4}
-test pkg-2.6 {Tcl_PkgRequire procedure, can't find suitable version} {
- package forget t
- package unknown {}
- foreach i {1.4 3.4 2.3 2.4 2.2} {
- package ifneeded t $i "set x $i"
- }
- list [catch {package require t 2.5} msg] $msg
-} {1 {can't find package t 2.5}}
-test pkg-2.7 {Tcl_PkgRequire procedure, can't find suitable version} {
- package forget t
- package unknown {}
- foreach i {1.4 3.4 2.3 2.4 2.2} {
- package ifneeded t $i "set x $i"
- }
- list [catch {package require t 4.1} msg] $msg
-} {1 {can't find package t 4.1}}
-test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} {
- package forget t
- package unknown {}
- foreach i {1.4 3.4 2.3 2.4 2.2} {
- package ifneeded t $i "set x $i"
- }
- list [catch {package require -exact t 1.3} msg] $msg
-} {1 {can't find package t exactly 1.3}}
-test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} {
- package forget t
- package unknown {}
- list [catch {package require t} msg] $msg
-} {1 {can't find package t}}
-test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
- package forget t
- package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
- list [catch {package require t 2.1} msg] $msg $::errorInfo
-} -match glob -result {1 {ifneeded test} {ifneeded test
- while executing
-"error "ifneeded test""
- ("package ifneeded*" script)
- invoked from within
-"package require t 2.1"}}
-test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -body {
- package forget t
- package ifneeded t 2.1 "set x invoked"
- set x xxx
- list [catch {package require t 2.1} msg] $msg $x
-} -match glob -result {1 * invoked}
-test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} {
- package forget t
- package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
- set x xxx
- package require t 1.2
- set x
-} {1.2}
-test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} {
- proc pkgUnknown args {
- # args = name requirement
- # requirement = v-v (for exact version)
- global x
- set x $args
- package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0]
- }
- package forget t
- foreach i {1.4 3.4 2.3 2.4 2.2} {
- package ifneeded t $i "set x $i"
- }
- package unknown pkgUnknown
- set x xxx
- package require -exact t 1.5
- package unknown {}
- set x
-} {t 1.5-1.5}
-test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} {
- proc pkgUnknown args {
- package ifneeded t 1.2 "set x loaded; package provide t 1.2"
- }
- package forget t
- package unknown pkgUnknown
- set x xxx
- set result [list [package require t] $x]
- package unknown {}
- set result
-} {1.2 loaded}
-test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} {
- proc pkgUnknown args {
- global x
- set x $args
- package provide [lindex $args 0] 2.0
- }
- package forget {a b}
- package unknown pkgUnknown
- set x xxx
- package require {a b}
- package unknown {}
- set x
-} {{a b} 0-}
-test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} {
- proc pkgUnknown args {
- error "testing package unknown"
- }
- package forget t
- package unknown pkgUnknown
- set result [list [catch {package require t} msg] $msg $::errorInfo]
- package unknown {}
- set result
-} {1 {testing package unknown} {testing package unknown
- while executing
-"error "testing package unknown""
- (procedure "pkgUnknown" line 2)
- invoked from within
-"pkgUnknown t 0-"
- ("package unknown" script)
- invoked from within
-"package require t"}}
-test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} {
- proc pkgUnknown args {
- global x
- set x $args
- }
- package forget t
- foreach i {1.4 3.4 2.3 2.4 2.2} {
- package ifneeded t $i "set x $i"
- }
- package unknown pkgUnknown
- set x xxx
- set result [list [catch {package require -exact t 1.5} msg] $msg $x]
- package unknown {}
- set result
-} {1 {can't find package t exactly 1.5} {t 1.5-1.5}}
-test pkg-2.18 {Tcl_PkgRequire procedure, version checks} {
- package forget t
- package provide t 2.3
- package require t
-} {2.3}
-test pkg-2.19 {Tcl_PkgRequire procedure, version checks} {
- package forget t
- package provide t 2.3
- package require t 2.1
-} {2.3}
-test pkg-2.20 {Tcl_PkgRequire procedure, version checks} {
- package forget t
- package provide t 2.3
- package require t 2.3
-} {2.3}
-test pkg-2.21 {Tcl_PkgRequire procedure, version checks} {
- package forget t
- package provide t 2.3
- list [catch {package require t 2.4} msg] $msg
-} {1 {version conflict for package "t": have 2.3, need 2.4}}
-test pkg-2.22 {Tcl_PkgRequire procedure, version checks} {
- package forget t
- package provide t 2.3
- list [catch {package require t 1.2} msg] $msg
-} {1 {version conflict for package "t": have 2.3, need 1.2}}
-test pkg-2.23 {Tcl_PkgRequire procedure, version checks} {
- package forget t
- package provide t 2.3
- package require -exact t 2.3
-} {2.3}
-test pkg-2.24 {Tcl_PkgRequire procedure, version checks} {
- package forget t
- package provide t 2.3
- list [catch {package require -exact t 2.2} msg] $msg
-} {1 {version conflict for package "t": have 2.3, need exactly 2.2}}
-test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
- package forget t
- package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI}
- list [catch {package require t 2.1} msg] $msg $::errorInfo
-} -match glob -result {1 {ifneeded test} {EI
- ("package ifneeded*" script)
- invoked from within
-"package require t 2.1"}}
-test pkg-2.26 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
- package forget t
- package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}}
- list [catch {package require t 2.1} msg] $msg $::errorInfo
-} -match glob -result {1 {ifneeded test} {EI
- ("foreach" body line 1)
- invoked from within
-"foreach x 1 {error "ifneeded test" EI}"
- ("package ifneeded*" script)
- invoked from within
-"package require t 2.1"}}
-test pkg-2.27 {Tcl_PkgRequire: circular dependency} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1 {package require foo 1}
- package require foo 1
-} -cleanup {
- package forget foo
-} -returnCodes error -match glob -result {circular package dependency:*}
-test pkg-2.28 {Tcl_PkgRequire: circular dependency} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1 {package require foo 2}
- package require foo 1
-} -cleanup {
- package forget foo
-} -returnCodes error -match glob -result {circular package dependency:*}
-test pkg-2.29 {Tcl_PkgRequire: circular dependency} -setup {
- package forget foo
- package forget bar
-} -body {
- package ifneeded foo 1 {package require bar 1; package provide foo 1}
- package ifneeded bar 1 {package require foo 1; package provide bar 1}
- package require foo 1
-} -cleanup {
- package forget foo
- package forget bar
-} -returnCodes error -match glob -result {circular package dependency:*}
-test pkg-2.30 {Tcl_PkgRequire: circular dependency} -setup {
- package forget foo
- package forget bar
-} -body {
- package ifneeded foo 1 {package require bar 1; package provide foo 1}
- package ifneeded foo 2 {package provide foo 2}
- package ifneeded bar 1 {package require foo 2; package provide bar 1}
- package require foo 1
-} -cleanup {
- package forget foo
- package forget bar
-} -returnCodes error -match glob -result {circular package dependency:*}
-test pkg-2.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1 {package provide foo 1; error foo}
- package require foo 1
-} -cleanup {
- package forget foo
-} -returnCodes error -match glob -result foo
-test pkg-2.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1 {package provide foo 1; error foo}
- catch {package require foo 1}
- package provide foo
-} -cleanup {
- package forget foo
-} -result {}
-test pkg-2.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1 {package provide foo 2}
- package require foo 1
-} -cleanup {
- package forget foo
-} -returnCodes error -match glob -result {attempt to provide package * failed:*}
-test pkg-2.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1 {package provide foo 1.1}
- package require foo 1
-} -cleanup {
- package forget foo
-} -returnCodes error -match glob -result {attempt to provide package * failed:*}
-test pkg-2.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1.1 {package provide foo 1}
- package require foo 1
-} -cleanup {
- package forget foo
-} -returnCodes error -match glob -result {attempt to provide package * failed:*}
-test pkg-2.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1.1 {package provide foo 1}
- package require foo 1.1
-} -cleanup {
- package forget foo
-} -returnCodes error -match glob -result {attempt to provide package * failed:*}
-test pkg-2.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1 {}
- package require foo 1
-} -cleanup {
- package forget foo
-} -returnCodes error -match glob -result {attempt to provide package * failed:*}
-test pkg-2.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1 {break}
- package require foo 1
-} -cleanup {
- package forget foo
-} -returnCodes error -match glob \
--result {attempt to provide package * failed: bad return code:*}
-test pkg-2.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1 {continue}
- package require foo 1
-} -cleanup {
- package forget foo
-} -returnCodes error -match glob \
--result {attempt to provide package * failed: bad return code:*}
-test pkg-2.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1 {return}
- package require foo 1
-} -cleanup {
- package forget foo
-} -returnCodes error -match glob \
--result {attempt to provide package * failed: bad return code:*}
-test pkg-2.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
-} -body {
- package ifneeded foo 1 {return -level 0 -code 10}
- package require foo 1
-} -cleanup {
- package forget foo
-} -returnCodes error -match glob \
--result {attempt to provide package * failed: bad return code:*}
-test pkg-2.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
- set saveUnknown [package unknown]
- package unknown {package provide foo 2 ;#}
-} -body {
- package require foo 1
-} -cleanup {
- package forget foo
- package unknown $saveUnknown
-} -returnCodes error -match glob -result *
-test pkg-2.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
- set saveUnknown [package unknown]
- package unknown {break ;#}
-} -body {
- package require foo 1
-} -cleanup {
- package forget foo
- package unknown $saveUnknown
-} -returnCodes error -match glob -result {bad return code:*}
-test pkg-2.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
- set saveUnknown [package unknown]
- package unknown {continue ;#}
-} -body {
- package require foo 1
-} -cleanup {
- package forget foo
- package unknown $saveUnknown
-} -returnCodes error -match glob -result {bad return code:*}
-test pkg-2.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
- set saveUnknown [package unknown]
- package unknown {return ;#}
-} -body {
- package require foo 1
-} -cleanup {
- package forget foo
- package unknown $saveUnknown
-} -returnCodes error -match glob -result {bad return code:*}
-test pkg-2.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
- package forget foo
- set saveUnknown [package unknown]
- package unknown {return -level 0 -code 10 ;#}
-} -body {
- package require foo 1
-} -cleanup {
- package forget foo
- package unknown $saveUnknown
-} -returnCodes error -match glob -result {bad return code:*}
-test pkg-2.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup {
- package provide demo 1.2.3
-} -body {
- package require -exact demo 1.2
-} -cleanup {
- package forget demo
-} -returnCodes error -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
-
-
-test pkg-2.50 {Tcl_PkgRequire procedure, picking best stable version} {
- package forget t
- foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
- package ifneeded t $i "set x $i; package provide t $i"
- }
- set x xxx
- package require t
- set x
-} {3.4}
-
-test pkg-2.51 {Tcl_PkgRequire procedure, picking best stable version} {
- package forget t
- foreach i {1.2b1 1.2 1.3a2 1.3} {
- package ifneeded t $i "set x $i; package provide t $i"
- }
- set x xxx
- package require t
- set x
-} {1.3}
-
-test pkg-2.52 {Tcl_PkgRequire procedure, picking best stable version} {
- package forget t
- foreach i {1.2b1 1.2 1.3 1.3a2} {
- package ifneeded t $i "set x $i; package provide t $i"
- }
- set x xxx
- package require t
- set x
-} {1.3}
-
-
-
-test pkg-3.1 {Tcl_PackageCmd procedure} {
- list [catch {package} msg] $msg
-} {1 {wrong # args: should be "package option ?arg ...?"}}
-test pkg-3.2 {Tcl_PackageCmd procedure, "forget" option} {
- foreach i [package names] {
- package forget $i
- }
- package names
-} {}
-test pkg-3.3 {Tcl_PackageCmd procedure, "forget" option} {
- foreach i [package names] {
- package forget $i
- }
- package forget foo
-} {}
-test pkg-3.4 {Tcl_PackageCmd procedure, "forget" option} {
- foreach i [package names] {
- package forget $i
- }
- package ifneeded t 1.1 {first script}
- package ifneeded t 2.3 {second script}
- package ifneeded x 1.4 {x's script}
- set result {}
- lappend result [lsort [package names]] [package versions t]
- package forget t
- lappend result [lsort [package names]] [package versions t]
-} {{t x} {1.1 2.3} x {}}
-test pkg-3.5 {Tcl_PackageCmd procedure, "forget" option} {
- foreach i [package names] {
- package forget $i
- }
- package ifneeded a 1.1 {first script}
- package ifneeded b 2.3 {second script}
- package ifneeded c 1.4 {third script}
- package forget
- set result [list [lsort [package names]]]
- package forget a c
- lappend result [lsort [package names]]
-} {{a b c} b}
-test pkg-3.5.1 {Tcl_PackageCmd procedure, "forget" option} {
- # Test for Bug 415273
- package ifneeded a 1 "I should have been forgotten"
- package forget no-such-package a
- set x [package ifneeded a 1]
- package forget a
- set x
-} {}
-test pkg-3.6 {Tcl_PackageCmd procedure, "ifneeded" option} {
- list [catch {package ifneeded a} msg] $msg
-} {1 {wrong # args: should be "package ifneeded package version ?script?"}}
-test pkg-3.7 {Tcl_PackageCmd procedure, "ifneeded" option} {
- list [catch {package ifneeded a b c d} msg] $msg
-} {1 {wrong # args: should be "package ifneeded package version ?script?"}}
-test pkg-3.8 {Tcl_PackageCmd procedure, "ifneeded" option} {
- list [catch {package ifneeded t xyz} msg] $msg
-} {1 {expected version number but got "xyz"}}
-test pkg-3.9 {Tcl_PackageCmd procedure, "ifneeded" option} {
- foreach i [package names] {
- package forget $i
- }
- list [package ifneeded foo 1.1] [package names]
-} {{} {}}
-test pkg-3.10 {Tcl_PackageCmd procedure, "ifneeded" option} {
- package forget t
- package ifneeded t 1.4 "script for t 1.4"
- list [package names] [package ifneeded t 1.4] [package versions t]
-} {t {script for t 1.4} 1.4}
-test pkg-3.11 {Tcl_PackageCmd procedure, "ifneeded" option} {
- package forget t
- package ifneeded t 1.4 "script for t 1.4"
- list [package ifneeded t 1.5] [package names] [package versions t]
-} {{} t 1.4}
-test pkg-3.12 {Tcl_PackageCmd procedure, "ifneeded" option} {
- package forget t
- package ifneeded t 1.4 "script for t 1.4"
- package ifneeded t 1.4 "second script for t 1.4"
- list [package ifneeded t 1.4] [package names] [package versions t]
-} {{second script for t 1.4} t 1.4}
-test pkg-3.13 {Tcl_PackageCmd procedure, "ifneeded" option} {
- package forget t
- package ifneeded t 1.4 "script for t 1.4"
- package ifneeded t 1.2 "second script"
- package ifneeded t 3.1 "last script"
- list [package ifneeded t 1.2] [package versions t]
-} {{second script} {1.4 1.2 3.1}}
-test pkg-3.14 {Tcl_PackageCmd procedure, "names" option} {
- list [catch {package names a} msg] $msg
-} {1 {wrong # args: should be "package names"}}
-test pkg-3.15 {Tcl_PackageCmd procedure, "names" option} {
- foreach i [package names] {
- package forget $i
- }
- package names
-} {}
-test pkg-3.16 {Tcl_PackageCmd procedure, "names" option} {
- foreach i [package names] {
- package forget $i
- }
- package ifneeded x 1.2 {dummy}
- package provide x 1.3
- package provide y 2.4
- catch {package require z 47.16}
- lsort [package names]
-} {x y}
-test pkg-3.17 {Tcl_PackageCmd procedure, "provide" option} {
- list [catch {package provide} msg] $msg
-} {1 {wrong # args: should be "package provide package ?version?"}}
-test pkg-3.18 {Tcl_PackageCmd procedure, "provide" option} {
- list [catch {package provide a b c} msg] $msg
-} {1 {wrong # args: should be "package provide package ?version?"}}
-test pkg-3.19 {Tcl_PackageCmd procedure, "provide" option} {
- package forget t
- package provide t
-} {}
-test pkg-3.20 {Tcl_PackageCmd procedure, "provide" option} {
- package forget t
- package provide t 2.3
- package provide t
-} {2.3}
-test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} {
- package forget t
- list [catch {package provide t a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} {
- list [catch {package require} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?requirement ...?"}}
-
-test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} {
- list [catch {package require -exact a b c} msg] $msg
- # Exact syntax: -exact name version
- # name ?requirement ...?
-} {1 {wrong # args: should be "package require ?-exact? package ?requirement ...?"}}
-
-test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} {
- list [catch {package require x a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} {
- list [catch {package require -exact x a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} {
- list [catch {package require -exact x} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?requirement ...?"}}
-test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} {
- list [catch {package require -exact} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?requirement ...?"}}
-test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} {
- package forget t
- package provide t 2.3
- package require t 2.1
-} {2.3}
-test pkg-3.31 {Tcl_PackageCmd procedure, "require" option} {
- package forget t
- list [catch {package require t} msg] $msg
-} {1 {can't find package t}}
-test pkg-3.32 {Tcl_PackageCmd procedure, "require" option} {
- package forget t
- package ifneeded t 2.3 "error {synthetic error}"
- list [catch {package require t 2.3} msg] $msg
-} {1 {synthetic error}}
-test pkg-3.33 {Tcl_PackageCmd procedure, "unknown" option} {
- list [catch {package unknown a b} msg] $msg
-} {1 {wrong # args: should be "package unknown ?command?"}}
-test pkg-3.34 {Tcl_PackageCmd procedure, "unknown" option} {
- package unknown "test script"
- package unknown
-} {test script}
-test pkg-3.35 {Tcl_PackageCmd procedure, "unknown" option} {
- package unknown "test script"
- package unknown {}
- package unknown
-} {}
-test pkg-3.36 {Tcl_PackageCmd procedure, "vcompare" option} {
- list [catch {package vcompare a} msg] $msg
-} {1 {wrong # args: should be "package vcompare version1 version2"}}
-test pkg-3.37 {Tcl_PackageCmd procedure, "vcompare" option} {
- list [catch {package vcompare a b c} msg] $msg
-} {1 {wrong # args: should be "package vcompare version1 version2"}}
-test pkg-3.38 {Tcl_PackageCmd procedure, "vcompare" option} {
- list [catch {package vcompare x.y 3.4} msg] $msg
-} {1 {expected version number but got "x.y"}}
-test pkg-3.39 {Tcl_PackageCmd procedure, "vcompare" option} {
- list [catch {package vcompare 2.1 a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-3.40 {Tcl_PackageCmd procedure, "vcompare" option} {
- package vc 2.1 2.3
-} {-1}
-test pkg-3.41 {Tcl_PackageCmd procedure, "vcompare" option} {
- package vc 2.2.4 2.2.4
-} {0}
-test pkg-3.42 {Tcl_PackageCmd procedure, "versions" option} {
- list [catch {package versions} msg] $msg
-} {1 {wrong # args: should be "package versions package"}}
-test pkg-3.43 {Tcl_PackageCmd procedure, "versions" option} {
- list [catch {package versions a b} msg] $msg
-} {1 {wrong # args: should be "package versions package"}}
-test pkg-3.44 {Tcl_PackageCmd procedure, "versions" option} {
- package forget t
- package versions t
-} {}
-test pkg-3.45 {Tcl_PackageCmd procedure, "versions" option} {
- package forget t
- package provide t 2.3
- package versions t
-} {}
-test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} {
- package forget t
- package ifneeded t 2.3 x
- package ifneeded t 2.4 y
- package versions t
-} {2.3 2.4}
-test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} {
- list [catch {package vsatisfies a} msg] $msg
-} {1 {wrong # args: should be "package vsatisfies version ?requirement ...?"}}
-
-test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} {
- list [catch {package vsatisfies x.y 3.4} msg] $msg
-} {1 {expected version number but got "x.y"}}
-test pkg-3.50 {Tcl_PackageCmd procedure, "vsatisfies" option} {
- list [catch {package vcompare 2.1 a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} {
- package vs 2.3 2.1
-} {1}
-test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
- package vs 2.3 1.2
-} {0}
-test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} {
- list [catch {package foo} msg] $msg
-} {1 {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}}
-
-test pkg-3.54 {Tcl_PackageCmd procedure, "vsatisfies" option} {
- list [catch {package vsatisfies 2.1 2.1-3.2-4.5} msg] $msg
-} {1 {expected versionMin-versionMax but got "2.1-3.2-4.5"}}
-
-test pkg-3.55 {Tcl_PackageCmd procedure, "vsatisfies" option} {
- list [catch {package vsatisfies 2.1 3.2-x.y} msg] $msg
-} {1 {expected version number but got "x.y"}}
-
-test pkg-3.56 {Tcl_PackageCmd procedure, "vsatisfies" option} {
- list [catch {package vsatisfies 2.1 x.y-3.2} msg] $msg
-} {1 {expected version number but got "x.y"}}
-
-
-# No tests for FindPackage; can't think up anything detectable
-# errors.
-
-test pkg-4.1 {TclFreePackageInfo procedure} {
- interp create foo
- foo 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 foo
-} {}
-test pkg-4.2 {TclFreePackageInfo procedure} -body {
- interp create foo
- foo eval {
- package ifneeded t 2.3 x
- package ifneeded t 2.4 y
- package ifneeded x 3.1 z
- package provide q 4.3
- }
- foo alias z kill
- proc kill {} {
- interp delete foo
- }
- foo eval package require x 3.1
-} -returnCodes error -match glob -result *
-
-test pkg-5.1 {CheckVersion procedure} {
- list [catch {package vcompare 1 2.1} msg] $msg
-} {0 -1}
-test pkg-5.2 {CheckVersion procedure} {
- list [catch {package vcompare .1 2.1} msg] $msg
-} {1 {expected version number but got ".1"}}
-test pkg-5.3 {CheckVersion procedure} {
- list [catch {package vcompare 111.2a.3 2.1} msg] $msg
-} {1 {expected version number but got "111.2a.3"}}
-test pkg-5.4 {CheckVersion procedure} {
- list [catch {package vcompare 1.2.3. 2.1} msg] $msg
-} {1 {expected version number but got "1.2.3."}}
-test pkg-5.5 {CheckVersion procedure} {
- list [catch {package vcompare 1.2..3 2.1} msg] $msg
-} {1 {expected version number but got "1.2..3"}}
-
-test pkg-6.1 {ComparePkgVersions procedure} {
- package vcompare 1.23 1.22
-} {1}
-test pkg-6.2 {ComparePkgVersions procedure} {
- package vcompare 1.22.1.2.3 1.22.1.2.3
-} {0}
-test pkg-6.3 {ComparePkgVersions procedure} {
- package vcompare 1.21 1.22
-} {-1}
-test pkg-6.4 {ComparePkgVersions procedure} {
- package vcompare 1.21 1.21.2
-} {-1}
-test pkg-6.5 {ComparePkgVersions procedure} {
- package vcompare 1.21.1 1.21
-} {1}
-test pkg-6.6 {ComparePkgVersions procedure} {
- package vsatisfies 1.21.1 1.21
-} {1}
-test pkg-6.7 {ComparePkgVersions procedure} {
- package vsatisfies 2.22.3 1.21
-} {0}
-test pkg-6.8 {ComparePkgVersions procedure} {
- package vsatisfies 1 1
-} {1}
-test pkg-6.9 {ComparePkgVersions procedure} {
- package vsatisfies 2 1
-} {0}
-
-test pkg-7.1 {Tcl_PkgPresent procedure, any version} {
- package forget t
- package provide t 2.4
- package present t
-} {2.4}
-test pkg-7.2 {Tcl_PkgPresent procedure, correct version} {
- package forget t
- package provide t 2.4
- package present t 2.4
-} {2.4}
-test pkg-7.3 {Tcl_PkgPresent procedure, satisfying version} {
- package forget t
- package provide t 2.4
- package present t 2.0
-} {2.4}
-test pkg-7.4 {Tcl_PkgPresent procedure, not satisfying version} {
- package forget t
- package provide t 2.4
- list [catch {package present t 2.6} msg] $msg
-} {1 {version conflict for package "t": have 2.4, need 2.6}}
-test pkg-7.5 {Tcl_PkgPresent procedure, not satisfying version} {
- package forget t
- package provide t 2.4
- list [catch {package present t 1.0} msg] $msg
-} {1 {version conflict for package "t": have 2.4, need 1.0}}
-test pkg-7.6 {Tcl_PkgPresent procedure, exact version} {
- package forget t
- package provide t 2.4
- package present -exact t 2.4
-} {2.4}
-test pkg-7.7 {Tcl_PkgPresent procedure, not exact version} {
- package forget t
- package provide t 2.4
- list [catch {package present -exact t 2.3} msg] $msg
-} {1 {version conflict for package "t": have 2.4, need exactly 2.3}}
-test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} {
- package forget t
- list [catch {package present t} msg] $msg
-} {1 {package t is not present}}
-test pkg-7.9 {Tcl_PkgPresent procedure, unknown package} {
- package forget t
- list [catch {package present t 2.4} msg] $msg
-} {1 {package t 2.4 is not present}}
-test pkg-7.10 {Tcl_PkgPresent procedure, unknown package} {
- package forget t
- list [catch {package present -exact t 2.4} msg] $msg
-} {1 {package t 2.4 is not present}}
-test pkg-7.11 {Tcl_PackageCmd procedure, "present" option} {
- list [catch {package present} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?requirement ...?"}}
-test pkg-7.12 {Tcl_PackageCmd procedure, "present" option} {
- list [catch {package present a b c} msg] $msg
-} {1 {expected version number but got "b"}}
-test pkg-7.13 {Tcl_PackageCmd procedure, "present" option} {
- list [catch {package present -exact a b c} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?requirement ...?"}}
-test pkg-7.14 {Tcl_PackageCmd procedure, "present" option} {
- list [catch {package present -bs a b} msg] $msg
-} {1 {expected version number but got "a"}}
-test pkg-7.15 {Tcl_PackageCmd procedure, "present" option} {
- list [catch {package present x a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-7.16 {Tcl_PackageCmd procedure, "present" option} {
- list [catch {package present -exact x a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-7.17 {Tcl_PackageCmd procedure, "present" option} {
- list [catch {package present -exact x} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?requirement ...?"}}
-test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} {
- list [catch {package present -exact} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?requirement ...?"}}
-
-
-
-
-set n 0
-foreach {r p vs vc} {
- 8.5a0 8.5a5 1 -1
- 8.5a0 8.5b1 1 -1
- 8.5a0 8.5.1 1 -1
- 8.5a0 8.6a0 1 -1
- 8.5a0 8.6b0 1 -1
- 8.5a0 8.6.0 1 -1
- 8.5a6 8.5a5 0 1
- 8.5a6 8.5b1 1 -1
- 8.5a6 8.5.1 1 -1
- 8.5a6 8.6a0 1 -1
- 8.5a6 8.6b0 1 -1
- 8.5a6 8.6.0 1 -1
- 8.5b0 8.5a5 0 1
- 8.5b0 8.5b1 1 -1
- 8.5b0 8.5.1 1 -1
- 8.5b0 8.6a0 1 -1
- 8.5b0 8.6b0 1 -1
- 8.5b0 8.6.0 1 -1
- 8.5b2 8.5a5 0 1
- 8.5b2 8.5b1 0 1
- 8.5b2 8.5.1 1 -1
- 8.5b2 8.6a0 1 -1
- 8.5b2 8.6b0 1 -1
- 8.5b2 8.6.0 1 -1
- 8.5 8.5a5 1 1
- 8.5 8.5b1 1 1
- 8.5 8.5.1 1 -1
- 8.5 8.6a0 1 -1
- 8.5 8.6b0 1 -1
- 8.5 8.6.0 1 -1
- 8.5.0 8.5a5 0 1
- 8.5.0 8.5b1 0 1
- 8.5.0 8.5.1 1 -1
- 8.5.0 8.6a0 1 -1
- 8.5.0 8.6b0 1 -1
- 8.5.0 8.6.0 1 -1
- 10 8 0 1
- 8 10 0 -1
- 0.0.1.2 0.1.2 1 -1
-} {
- test package-vsatisfies-1.$n {package vsatisfies} {
- package vsatisfies $p $r
- } $vs
-
- test package-vcompare-1.$n {package vcompare} {
- package vcompare $r $p
- } $vc
-
- incr n
-}
-
-test package-vcompare-2.0 {package vcompare at 32bit boundary} {
- package vcompare [expr {1<<31}] [expr {(1<<31)-1}]
-} 1
-
-# Note: It is correct that the result of the very first test,
-# i.e. "5.0 5.0a0" is 1, i.e. that version 5.0a0 satisfies a 5.0
-# requirement.
-
-# The requirement "5.0" internally translates first to "5.0-6", and
-# then to its final form of "5.0a0-6a0". These translations are
-# explicitly specified by the TIP (Search for "padded/extended
-# internally with 'a0'"). This was done intentionally for exactly the
-# tested case, that an alpha package can satisfy a requirement for the
-# regular package. An example would be a package FOO requiring Tcl 8.X
-# for its operation. It can be used with Tcl 8.Xa0. Without our
-# translation that would not be possible.
-
-set n 0
-foreach {required provided satisfied} {
- 5.0 5.0a0 1
- 5.0a0 5.0 1
-
- 8.5a0- 8.5a5 1
- 8.5a0- 8.5b1 1
- 8.5a0- 8.5.1 1
- 8.5a0- 8.6a0 1
- 8.5a0- 8.6b0 1
- 8.5a0- 8.6.0 1
- 8.5a6- 8.5a5 0
- 8.5a6- 8.5b1 1
- 8.5a6- 8.5.1 1
- 8.5a6- 8.6a0 1
- 8.5a6- 8.6b0 1
- 8.5a6- 8.6.0 1
- 8.5b0- 8.5a5 0
- 8.5b0- 8.5b1 1
- 8.5b0- 8.5.1 1
- 8.5b0- 8.6a0 1
- 8.5b0- 8.6b0 1
- 8.5b0- 8.6.0 1
- 8.5b2- 8.5a5 0
- 8.5b2- 8.5b1 0
- 8.5b2- 8.5.1 1
- 8.5b2- 8.6a0 1
- 8.5b2- 8.6b0 1
- 8.5b2- 8.6.0 1
- 8.5- 8.5a5 1
- 8.5- 8.5b1 1
- 8.5- 8.5.1 1
- 8.5- 8.6a0 1
- 8.5- 8.6b0 1
- 8.5- 8.6.0 1
- 8.5.0- 8.5a5 0
- 8.5.0- 8.5b1 0
- 8.5.0- 8.5.1 1
- 8.5.0- 8.6a0 1
- 8.5.0- 8.6b0 1
- 8.5.0- 8.6.0 1
- 8.5a0-7 8.5a5 0
- 8.5a0-7 8.5b1 0
- 8.5a0-7 8.5.1 0
- 8.5a0-7 8.6a0 0
- 8.5a0-7 8.6b0 0
- 8.5a0-7 8.6.0 0
- 8.5a6-7 8.5a5 0
- 8.5a6-7 8.5b1 0
- 8.5a6-7 8.5.1 0
- 8.5a6-7 8.6a0 0
- 8.5a6-7 8.6b0 0
- 8.5a6-7 8.6.0 0
- 8.5b0-7 8.5a5 0
- 8.5b0-7 8.5b1 0
- 8.5b0-7 8.5.1 0
- 8.5b0-7 8.6a0 0
- 8.5b0-7 8.6b0 0
- 8.5b0-7 8.6.0 0
- 8.5b2-7 8.5a5 0
- 8.5b2-7 8.5b1 0
- 8.5b2-7 8.5.1 0
- 8.5b2-7 8.6a0 0
- 8.5b2-7 8.6b0 0
- 8.5b2-7 8.6.0 0
- 8.5-7 8.5a5 0
- 8.5-7 8.5b1 0
- 8.5-7 8.5.1 0
- 8.5-7 8.6a0 0
- 8.5-7 8.6b0 0
- 8.5-7 8.6.0 0
- 8.5.0-7 8.5a5 0
- 8.5.0-7 8.5b1 0
- 8.5.0-7 8.5.1 0
- 8.5.0-7 8.6a0 0
- 8.5.0-7 8.6b0 0
- 8.5.0-7 8.6.0 0
- 8.5a0-8.6.1 8.5a5 1
- 8.5a0-8.6.1 8.5b1 1
- 8.5a0-8.6.1 8.5.1 1
- 8.5a0-8.6.1 8.6a0 1
- 8.5a0-8.6.1 8.6b0 1
- 8.5a0-8.6.1 8.6.0 1
- 8.5a6-8.6.1 8.5a5 0
- 8.5a6-8.6.1 8.5b1 1
- 8.5a6-8.6.1 8.5.1 1
- 8.5a6-8.6.1 8.6a0 1
- 8.5a6-8.6.1 8.6b0 1
- 8.5a6-8.6.1 8.6.0 1
- 8.5b0-8.6.1 8.5a5 0
- 8.5b0-8.6.1 8.5b1 1
- 8.5b0-8.6.1 8.5.1 1
- 8.5b0-8.6.1 8.6a0 1
- 8.5b0-8.6.1 8.6b0 1
- 8.5b0-8.6.1 8.6.0 1
- 8.5b2-8.6.1 8.5a5 0
- 8.5b2-8.6.1 8.5b1 0
- 8.5b2-8.6.1 8.5.1 1
- 8.5b2-8.6.1 8.6a0 1
- 8.5b2-8.6.1 8.6b0 1
- 8.5b2-8.6.1 8.6.0 1
- 8.5-8.6.1 8.5a5 1
- 8.5-8.6.1 8.5b1 1
- 8.5-8.6.1 8.5.1 1
- 8.5-8.6.1 8.6a0 1
- 8.5-8.6.1 8.6b0 1
- 8.5-8.6.1 8.6.0 1
- 8.5.0-8.6.1 8.5a5 0
- 8.5.0-8.6.1 8.5b1 0
- 8.5.0-8.6.1 8.5.1 1
- 8.5.0-8.6.1 8.6a0 1
- 8.5.0-8.6.1 8.6b0 1
- 8.5.0-8.6.1 8.6.0 1
- 8.5a0-8.5a0 8.5a0 1
- 8.5a0-8.5a0 8.5b1 0
- 8.5a0-8.5a0 8.4 0
- 8.5b0-8.5b0 8.5a5 0
- 8.5b0-8.5b0 8.5b0 1
- 8.5b0-8.5b0 8.5.1 0
- 8.5-8.5 8.5a5 0
- 8.5-8.5 8.5b1 0
- 8.5-8.5 8.5 1
- 8.5-8.5 8.5.1 0
- 8.5.0-8.5.0 8.5a5 0
- 8.5.0-8.5.0 8.5b1 0
- 8.5.0-8.5.0 8.5.0 1
- 8.5.0-8.5.0 8.5.1 0
- 8.5.0-8.5.0 8.6a0 0
- 8.5.0-8.5.0 8.6b0 0
- 8.5.0-8.5.0 8.6.0 0
- 8.2 9 0
- 8.2- 9 1
- 8.2-8.5 9 0
- 8.2-9.1 9 1
-
- 8.5-8.5 8.5b1 0
- 8.5a0-8.5 8.5b1 0
- 8.5a0-8.5.1 8.5b1 1
-
- 8.5-8.5 8.5 1
- 8.5.0-8.5.0 8.5 1
- 8.5a0-8.5.0 8.5 0
-
-} {
- test package-vsatisfies-2.$n "package vsatisfies $provided $required" {
- package vsatisfies $provided $required
- } $satisfied
- incr n
-}
-
-test package-vsatisfies-3.0 "package vsatisfies multiple" {
- # yes no
- package vsatisfies 8.4 8.4 7.3
-} 1
-
-test package-vsatisfies-3.1 "package vsatisfies multiple" {
- # no yes
- package vsatisfies 8.4 7.3 8.4
-} 1
-
-test package-vsatisfies-3.2 "package vsatisfies multiple" {
- # yes yes
- package vsatisfies 8.4.2 8.4 8.4.1
-} 1
-
-test package-vsatisfies-3.3 "package vsatisfies multiple" {
- # no no
- package vsatisfies 8.4 7.3 6.1
-} 0
-
-
-proc prefer {args} {
- set ip [interp create]
- lappend res [$ip eval {package prefer}]
- foreach mode $args {
- lappend res [$ip eval [list package prefer $mode]]
- }
- interp delete $ip
- return $res
-}
-
-test package-prefer-1.0 {default} {
- prefer
-} stable
-
-test package-prefer-1.1 {default} {
- set ::env(TCL_PKG_PREFER_LATEST) stable ; # value not relevant!
- set res [prefer]
- unset ::env(TCL_PKG_PREFER_LATEST)
- set res
-} latest
-
-test package-prefer-2.0 {wrong\#args} {
- catch {package prefer foo bar} msg
- set msg
-} {wrong # args: should be "package prefer ?latest|stable?"}
-
-test package-prefer-2.1 {bogus argument} {
- catch {package prefer foo} msg
- set msg
-} {bad preference "foo": must be latest or stable}
-
-test package-prefer-3.0 {set, keep} {
- package prefer stable
-} stable
-
-test package-prefer-3.1 {set stable, keep} {
- prefer stable
-} {stable stable}
-
-test package-prefer-3.2 {set latest, change} {
- prefer latest
-} {stable latest}
-
-test package-prefer-3.3 {set latest, keep} {
- prefer latest latest
-} {stable latest latest}
-
-test package-prefer-3.4 {set stable, rejected} {
- prefer latest stable
-} {stable latest latest}
-
-rename prefer {}
-
-
-set auto_path $oldPath
-package unknown $oldPkgUnknown
-concat
-
-cleanupTests
-}
-
-# cleanup
-interp delete $i
-::tcltest::cleanupTests
-return
diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test
index 0db6533..0fe394e 100644
--- a/tests/pkgMkIndex.test
+++ b/tests/pkgMkIndex.test
@@ -2,13 +2,11 @@
# Note that the tests are limited to Tcl scripts only, there are no shared
# libraries against which to test.
#
-# Sourcing this file into Tcl runs the tests and generates output for
-# errors. No output means no errors were found.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
-#
-# RCS: @(#) $Id: pkgMkIndex.test,v 1.29 2006/11/03 00:34:53 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -17,7 +15,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
set fullPkgPath [makeDirectory pkg]
-
namespace eval pkgtest {
# Namespace for procs we can discard
}
@@ -27,8 +24,8 @@ namespace eval pkgtest {
# Parse an argument list.
#
# Arguments:
-# <flags> (optional) arguments starting with a dash are collected
-# as options to pkg_mkIndex and passed to pkg_mkIndex.
+# <flags> (optional) arguments starting with a dash are collected as
+# options to pkg_mkIndex and passed to pkg_mkIndex.
# dirPath the directory to index
# pattern0 pattern to index
# ... pattern to index
@@ -130,13 +127,13 @@ proc pkgtest::parseIndex { filePath } {
# pkgtest::createIndex --
#
-# Runs pkg_mkIndex for the given directory and set of patterns.
-# This procedure deletes any pkgIndex.tcl file in the target directory,
-# then runs pkg_mkIndex.
+# Runs pkg_mkIndex for the given directory and set of patterns. This
+# procedure deletes any pkgIndex.tcl file in the target directory, then runs
+# pkg_mkIndex.
#
# Arguments:
-# <flags> (optional) arguments starting with a dash are collected
-# as options to pkg_mkIndex and passed to pkg_mkIndex.
+# <flags> (optional) arguments starting with a dash are collected as
+# options to pkg_mkIndex and passed to pkg_mkIndex.
# dirPath the directory to index
# pattern0 pattern to index
# ... pattern to index
@@ -194,11 +191,9 @@ proc makePkgList { inList } {
lappend l $s
}
}
-
source {
set l $v
}
-
default {
error "can't handle $k $v"
}
@@ -215,8 +210,8 @@ proc makePkgList { inList } {
# Runs pkg_mkIndex, parses the generated index file.
#
# Arguments:
-# <flags> (optional) arguments starting with a dash are collected
-# as options to pkg_mkIndex and passed to pkg_mkIndex.
+# <flags> (optional) arguments starting with a dash are collected as
+# options to pkg_mkIndex and passed to pkg_mkIndex.
# dirPath the directory to index
# pattern0 pattern to index
# ... pattern to index
@@ -226,8 +221,7 @@ proc makePkgList { inList } {
# Returns a two element list:
# 0: 1 if the procedure encountered an error, 0 otherwise.
# 1: if no error, this is the parsed generated index file, in the format
-# returned by pkgtest::parseIndex.
-# If error, this is the error result.
+# returned by pkgtest::parseIndex. If error, this is the error result.
proc pkgtest::runCreatedIndex {rv args} {
if {[lindex $rv 0] == 0} {
@@ -251,9 +245,9 @@ proc pkgtest::runIndex { args } {
set rv [createIndex {*}$args]
return [runCreatedIndex $rv {*}$args]
}
-
-# If there is no match to the patterns, make sure the directory hasn't
-# changed on us
+
+# If there is no match to the patterns, make sure the directory hasn't changed
+# on us
test pkgMkIndex-1.1 {nothing matches pattern - current dir is the same} {
list [pkgtest::runIndex -lazy $fullPkgPath nomatch.tcl] [pwd]
@@ -314,8 +308,8 @@ removeFile [file join pkg global.tcl]
makeFile {
# This package is required by pkg1.
-# This package is split into two files, to test packages that are split
-# over multiple files.
+# This package is split into two files, to test packages that are split over
+# multiple files.
package provide pkg2 1.0
namespace eval pkg2 {
namespace export p2-1
@@ -327,8 +321,8 @@ proc pkg2::p2-1 { num } {
makeFile {
# This package is required by pkg1.
-# This package is split into two files, to test packages that are split
-# over multiple files.
+# This package is split into two files, to test packages that are split over
+# multiple files.
package provide pkg2 1.0
namespace eval pkg2 {
namespace export p2-2
@@ -347,8 +341,8 @@ test pkgMkIndex-4.2 {split package - direct loading} {
} "0 {{pkg2:1.0 {[list source [file join $fullPkgPath pkg2_a.tcl]]
[list source [file join $fullPkgPath pkg2_b.tcl]]}}}"
-# Add the direct1 directory to auto_path, so that the direct1 package
-# can be found.
+# Add the direct1 directory to auto_path, so that the direct1 package can be
+# found.
set direct1 [makeDirectory direct1]
lappend auto_path $direct1
makeFile {
@@ -367,9 +361,9 @@ proc direct1::pd2 { stg } {
pkg_mkIndex -direct $direct1 direct1.tcl
makeFile {
-# Does a package require of direct1, whose pkgIndex.tcl entry
-# is created above with option -direct. This tests that pkg_mkIndex
-# can handle code that is sourced in pkgIndex.tcl files.
+# Does a package require of direct1, whose pkgIndex.tcl entry is created
+# above with option -direct. This tests that pkg_mkIndex can handle code
+# that is sourced in pkgIndex.tcl files.
package require direct1
package provide std 1.0
namespace eval std {
@@ -393,9 +387,9 @@ removeDirectory direct1
removeFile [file join pkg std.tcl]
makeFile {
-# This package requires pkg3, but it does
-# not use any of pkg3's procs in the code that is executed by the file
-# (i.e. references to pkg3's procs are in the proc bodies only).
+# This package requires pkg3, but it does not use any of pkg3's procs in the
+# code that is executed by the file (i.e. references to pkg3's procs are in
+# the proc bodies only).
package require pkg3 1.0
package provide pkg1 1.0
namespace eval pkg1 {
@@ -433,8 +427,8 @@ test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} {
removeFile [file join pkg pkg1.tcl]
makeFile {
-# This package requires pkg3, and it calls
-# a pkg3 proc in the code that is executed by the file
+# This package requires pkg3, and it calls a pkg3 proc in the code that is
+# executed by the file
package require pkg3 1.0
package provide pkg4 1.0
namespace eval pkg4 {
@@ -462,9 +456,8 @@ removeFile [file join pkg pkg4.tcl]
removeFile [file join pkg pkg3.tcl]
makeFile {
-# This package requires pkg2, and it calls
-# a pkg2 proc in the code that is executed by the file.
-# Pkg2 is a split package.
+# This package requires pkg2, and it calls a pkg2 proc in the code that is
+# executed by the file. Pkg2 is a split package.
package require pkg2 1.0
package provide pkg5 1.0
namespace eval pkg5 {
@@ -496,9 +489,9 @@ removeFile [file join pkg pkg2_a.tcl]
removeFile [file join pkg pkg2_b.tcl]
makeFile {
-# This package requires circ2, and circ2
-# requires circ3, which in turn requires circ1.
-# In case of cirularities, pkg_mkIndex should give up when it gets stuck.
+# This package requires circ2, and circ2 requires circ3, which in turn
+# requires circ1. In case of cirularities, pkg_mkIndex should give up when
+# it gets stuck.
package require circ2 1.0
package provide circ1 1.0
namespace eval circ1 {
@@ -519,8 +512,8 @@ proc circ1::c1-4 {} {
} [file join pkg circ1.tcl]
makeFile {
-# This package is required by circ1, and
-# requires circ3. Circ3, in turn, requires circ1 to give us a circularity.
+# This package is required by circ1, and requires circ3. Circ3, in turn,
+# requires circ1 to give us a circularity.
package require circ3 1.0
package provide circ2 1.0
namespace eval circ2 {
@@ -535,8 +528,8 @@ proc circ2::c2-2 { num } {
} [file join pkg circ2.tcl]
makeFile {
-# This package is required by circ2, and in
-# turn requires circ1. This closes the circularity.
+# This package is required by circ2, and in turn requires circ1. This closes
+# the circularity.
package require circ1 1.0
package provide circ3 1.0
namespace eval circ3 {
@@ -577,22 +570,23 @@ proc pkga_neq { x } {
testConstraint exec [llength [info commands ::exec]]
test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] {
- # Do all [load]ing of shared libraries in another process, so
- # we can delete the file and not get stuck because we're holding
- # a reference to it.
+ # Do all [load]ing of shared libraries in another process, so we can
+ # delete the file and not get stuck because we're holding a reference to
+ # it.
set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]
exec [interpreter] << $cmd
pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl
} "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] {
- # Do all [load]ing of shared libraries in another process, so
- # we can delete the file and not get stuck because we're holding
- # a reference to it.
+ # Do all [load]ing of shared libraries in another process, so we can
+ # delete the file and not get stuck because we're holding a reference to
+ # it.
#
# This test depends on context from prior test, so repeat it.
- set script "[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]\n"
- append script \
- "[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]"
+ set script \
+ "[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]"
+ append script \n \
+ "[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]"
exec [interpreter] << $script
pkgtest::runCreatedIndex {0 {}} -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension]
} {0 {}}
@@ -625,9 +619,8 @@ test pkgMkIndex-11.1 {conflicting namespace imports} {
removeFile [file join pkg import.tcl]
-# Verify that the auto load list generated is correct even when there
-# is a proc name conflict between two namespaces (ie, ::foo::baz and
-# ::bar::baz)
+# Verify that the auto load list generated is correct even when there is a
+# proc name conflict between two namespaces (ie, ::foo::baz and ::bar::baz)
makeFile {
package provide football 1.0
@@ -692,7 +685,7 @@ test pkgMkIndex-14.5 {tcl::Pkg::CompareExtension} {unix} {
test pkgMkIndex-14.6 {tcl::Pkg::CompareExtension} {unix} {
tcl::Pkg::CompareExtension foo.so.1.2.bar .so
} 0
-
+
# cleanup
removeDirectory pkg
@@ -701,3 +694,7 @@ namespace delete pkgtest
::tcltest::cleanupTests
return
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/platform.test b/tests/platform.test
index fd9ed66..aab7c78 100644
--- a/tests/platform.test
+++ b/tests/platform.test
@@ -8,15 +8,16 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#)
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-testConstraint testWinCPUID [llength [info commands testwincpuid]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testCPUID [llength [info commands testcpuid]]
test platform-1.1 {TclpSetVariables: tcl_platform} {
interp create i
@@ -38,12 +39,12 @@ test platform-2.1 {tcl_platform(wordSize) indicates size of native word} {
list [expr {$result < 0}] [expr {$result ^ int($result - 1)}]
} {1 -1}
-# On Windows, test that the CPU ID works
+# On Windows/UNIX, test that the CPU ID works
-test platform-3.1 {CPU ID on Windows } \
- -constraints testWinCPUID \
+test platform-3.1 {CPU ID on Windows/UNIX} \
+ -constraints testCPUID \
-body {
- set cpudata [testwincpuid 0]
+ set cpudata [testcpuid 0]
binary format iii \
[lindex $cpudata 1] \
[lindex $cpudata 3] \
diff --git a/tests/proc-old.test b/tests/proc-old.test
index 6a95528..e45cf5c 100644
--- a/tests/proc-old.test
+++ b/tests/proc-old.test
@@ -13,8 +13,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: proc-old.test,v 1.18 2010/03/31 10:29:22 nijtmans Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/proc.test b/tests/proc.test
index 789c671..e06720e 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -1,40 +1,34 @@
-# This file contains tests for the tclProc.c source file. Tests appear in
-# the same order as the C code that they test. The set of tests is
-# currently incomplete since it includes only new tests, in particular
-# tests for code changed for the addition of Tcl namespaces. Other
-# procedure-related tests appear in other test files such as proc-old.test.
+# This file contains tests for the tclProc.c source file. Tests appear in the
+# same order as the C code that they test. The set of tests is currently
+# incomplete since it includes only new tests, in particular tests for code
+# changed for the addition of Tcl namespaces. Other procedure-related tests
+# appear in other test files such as proc-old.test.
#
-# Sourcing this file into Tcl runs the tests and generates output for
-# errors. No output means no errors were found.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
#
# Copyright (c) 1997 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.
-#
-# RCS: @(#) $Id: proc.test,v 1.21 2009/10/29 17:21:48 dgp Exp $
+# 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
namespace import -force ::tcltest::*
}
-if {[catch {package require procbodytest}]} {
- testConstraint procbodytest 0
-} else {
- testConstraint procbodytest 1
-}
-
-testConstraint memory [llength [info commands memory]]
+testConstraint procbodytest [expr {![catch {package require procbodytest}]}]
+testConstraint memory [llength [info commands memory]]
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename {} ""}
catch {unset msg}
-
-test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} {
+
+test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1 {
namespace eval baz {}
}
@@ -44,23 +38,26 @@ test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any}
list [test_ns_1::baz::p] \
[namespace eval test_ns_1 {baz::p}] \
[info commands test_ns_1::baz::*]
-} {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p}
-test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} {
+} -result {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p}
+test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
- list [catch {proc test_ns_1::baz::p {} {}} msg] $msg
-} {1 {can't create procedure "test_ns_1::baz::p": unknown namespace}}
-test proc-1.3 {Tcl_ProcObjCmd, empty proc name} {
+} -returnCodes error -body {
+ proc test_ns_1::baz::p {} {}
+} -result {can't create procedure "test_ns_1::baz::p": unknown namespace}
+test proc-1.3 {Tcl_ProcObjCmd, empty proc name} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
proc :: {} {
return "empty called"
}
list [::] \
[info body {}]
-} {{empty called} {
+} -result {{empty called} {
return "empty called"
}}
-test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} {
+test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1 {
namespace eval baz {
proc p {} {
@@ -70,9 +67,10 @@ test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} {
}
list [test_ns_1::baz::p] \
[info commands test_ns_1::baz::*]
-} {{p in ::test_ns_1::baz} ::test_ns_1::baz::p}
-test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace} {
+} -result {{p in ::test_ns_1::baz} ::test_ns_1::baz::p}
+test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1::baz {}
namespace eval test_ns_1 {
proc baz::p {} {
@@ -82,9 +80,10 @@ test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace
list [test_ns_1::baz::p] \
[info commands test_ns_1::baz::*] \
[namespace eval test_ns_1::baz {namespace which p}]
-} {{p in ::test_ns_1::baz} ::test_ns_1::baz::p ::test_ns_1::baz::p}
-test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or end of command names} {
+} -result {{p in ::test_ns_1::baz} ::test_ns_1::baz::p ::test_ns_1::baz::p}
+test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or end of command names} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1 {
proc q: {} {return "q:"}
proc value:at: {} {return "value:at:"}
@@ -96,88 +95,102 @@ test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or e
[lsort [info commands test_ns_1::*]] \
[namespace eval test_ns_1 {namespace which q:}] \
[namespace eval test_ns_1 {namespace which value:at:}]
-} {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:}
-test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} {
+} -result {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:}
+test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} -setup {
catch {rename p ""}
- list [catch {proc p {a(1) a(2)} {
- set z [expr $a(1)+$a(2)]
- puts "$z=z, $a(1)=$a(1)"
- }} msg] $msg
-} {1 {formal parameter "a(1)" is an array element}}
-test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} {
+} -returnCodes error -body {
+ proc p {a(1) a(2)} {
+ set z [expr $a(1)+$a(2)]
+ puts "$z=z, $a(1)=$a(1)"
+ }
+} -result {formal parameter "a(1)" is an array element}
+test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
catch {rename p ""}
- list [catch {proc p {b:a b::a} {
- }} msg] $msg
-} {1 {formal parameter "b::a" is not a simple name}}
+} -body {
+ proc p {b:a b::a} {
+ }
+} -returnCodes error -result {formal parameter "b::a" is not a simple name}
-test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} {
+test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
+} -body {
proc p {} {return "p in [namespace current]"}
info body p
-} {return "p in [namespace current]"}
-test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} {
+} -result {return "p in [namespace current]"}
+test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1 {
namespace eval baz {
proc p {} {return "p in [namespace current]"}
}
}
namespace eval test_ns_1::baz {info body p}
-} {return "p in [namespace current]"}
-test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} {
+} -result {return "p in [namespace current]"}
+test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1::baz {}
namespace eval test_ns_1 {
proc baz::p {} {return "p in [namespace current]"}
}
namespace eval test_ns_1 {info body baz::p}
-} {return "p in [namespace current]"}
-test proc-2.4 {TclFindProc, global proc and executing in namespace} {
+} -result {return "p in [namespace current]"}
+test proc-2.4 {TclFindProc, global proc and executing in namespace} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
+} -body {
proc p {} {return "global p"}
namespace eval test_ns_1::baz {info body p}
-} {return "global p"}
+} -result {return "global p"}
-test proc-3.1 {TclObjInterpProc, proc defined and executing in same namespace} {
+test proc-3.1 {TclObjInterpProc, proc defined and executing in same namespace} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
proc p {} {return "p in [namespace current]"}
p
-} {p in ::}
-test proc-3.2 {TclObjInterpProc, proc defined and executing in same namespace} {
+} -result {p in ::}
+test proc-3.2 {TclObjInterpProc, proc defined and executing in same namespace} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1::baz {
proc p {} {return "p in [namespace current]"}
p
}
-} {p in ::test_ns_1::baz}
-test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespaces} {
+} -result {p in ::test_ns_1::baz}
+test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespaces} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
+} -body {
proc p {} {return "p in [namespace current]"}
namespace eval test_ns_1::baz {
p
}
-} {p in ::}
-test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they were defined unless renamed into new namespace} {
+} -result {p in ::}
+test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they were defined unless renamed into new namespace} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
+} -body {
namespace eval test_ns_1::baz {
proc p {} {return "p in [namespace current]"}
rename ::test_ns_1::baz::p ::p
list [p] [namespace which p]
}
-} {{p in ::} ::p}
-test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} {
+} -result {{p in ::} ::p}
+test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} -body {
proc p {x} {info commands 3m}
- list [catch {p} msg] $msg
-} {1 {wrong # args: should be "p x"}}
-
-test proc-3.6 {TclObjInterpProc, proper quoting of proc name, Bug 942757} {
+ p
+} -returnCodes error -result {wrong # args: should be "p x"}
+test proc-3.6 {TclObjInterpProc, proper quoting of proc name, Bug 942757} -body {
proc {a b c} {x} {info commands 3m}
- list [catch {{a b c}} msg] $msg
-} {1 {wrong # args: should be "{a b c} x"}}
+ {a b c}
+} -returnCodes error -result {wrong # args: should be "{a b c} x"}
+
+test proc-3.7 {TclObjInterpProc, wrong num args, Bug 3366265} {
+ proc {} {x} {}
+ list [catch {{}} msg] $msg
+} {1 {wrong # args: should be "{} x"}}
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
@@ -189,116 +202,95 @@ catch {rename p ""}
catch {rename t ""}
# Note that the test require that procedures whose body is used to create
-# procbody objects must be executed before the procbodytest::proc command
-# is executed, so that the Proc struct is populated correctly (CompiledLocals
-# are added at compile time).
+# procbody objects must be executed before the procbodytest::proc command is
+# executed, so that the Proc struct is populated correctly (CompiledLocals are
+# added at compile time).
-test proc-4.1 {TclCreateProc, procbody obj} procbodytest {
- catch {
- proc p x {return "$x:$x"}
- set rv [p P]
- procbodytest::proc t x p
- lappend rv [t T]
- set rv
- } result
+test proc-4.1 {TclCreateProc, procbody obj} -constraints procbodytest -body {
+ proc p x {return "$x:$x"}
+ set rv [p P]
+ procbodytest::proc t x p
+ lappend rv [t T]
+} -cleanup {
catch {rename p ""}
catch {rename t ""}
- set result
-} {P:P T:T}
-test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} procbodytest {
- catch {
- proc p x {
- set y [string tolower $x]
- return "$x:$y"
- }
- set rv [p P]
- procbodytest::proc t x p
- lappend rv [t T]
- set rv
- } result
+} -result {P:P T:T}
+test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} -body {
+ proc p x {
+ set y [string tolower $x]
+ return "$x:$y"
+ }
+ set rv [p P]
+ procbodytest::proc t x p
+ lappend rv [t T]
+} -constraints procbodytest -cleanup {
catch {rename p ""}
catch {rename t ""}
- set result
-} {P:p T:t}
-test proc-4.3 {TclCreateProc, procbody obj, too many args} procbodytest {
- catch {
- proc p x {
- set y [string tolower $x]
- return "$x:$y"
- }
- set rv [p P]
- procbodytest::proc t {x x1 x2} p
- lappend rv [t T]
- set rv
- } result
+} -result {P:p T:t}
+test proc-4.3 {TclCreateProc, procbody obj, too many args} -body {
+ proc p x {
+ set y [string tolower $x]
+ return "$x:$y"
+ }
+ set rv [p P]
+ procbodytest::proc t {x x1 x2} p
+ lappend rv [t T]
+} -constraints procbodytest -returnCodes error -cleanup {
catch {rename p ""}
catch {rename t ""}
- set result
-} {procedure "t": arg list contains 3 entries, precompiled header expects 1}
-test proc-4.4 {TclCreateProc, procbody obj, inconsistent arg name} procbodytest {
- catch {
- proc p {x y z} {
- set v [join [list $x $y $z]]
- set w [string tolower $v]
- return "$v:$w"
- }
- set rv [p P Q R]
- procbodytest::proc t {x x1 z} p
- lappend rv [t S T U]
- set rv
- } result
+} -result {procedure "t": arg list contains 3 entries, precompiled header expects 1}
+test proc-4.4 {TclCreateProc, procbody obj, inconsistent arg name} -body {
+ proc p {x y z} {
+ set v [join [list $x $y $z]]
+ set w [string tolower $v]
+ return "$v:$w"
+ }
+ set rv [p P Q R]
+ procbodytest::proc t {x x1 z} p
+ lappend rv [t S T U]
+} -constraints procbodytest -returnCodes error -cleanup {
catch {rename p ""}
catch {rename t ""}
- set result
-} {procedure "t": formal parameter 1 is inconsistent with precompiled body}
-test proc-4.5 {TclCreateProc, procbody obj, inconsistent arg default type} procbodytest {
- catch {
- proc p {x y {z Z}} {
- set v [join [list $x $y $z]]
- set w [string tolower $v]
- return "$v:$w"
- }
- set rv [p P Q R]
- procbodytest::proc t {x y z} p
- lappend rv [t S T U]
- set rv
- } result
+} -result {procedure "t": formal parameter 1 is inconsistent with precompiled body}
+test proc-4.5 {TclCreateProc, procbody obj, inconsistent arg default type} -body {
+ proc p {x y {z Z}} {
+ set v [join [list $x $y $z]]
+ set w [string tolower $v]
+ return "$v:$w"
+ }
+ set rv [p P Q R]
+ procbodytest::proc t {x y z} p
+ lappend rv [t S T U]
+} -constraints procbodytest -returnCodes error -cleanup {
catch {rename p ""}
catch {rename t ""}
- set result
-} {procedure "t": formal parameter 2 is inconsistent with precompiled body}
-test proc-4.6 {TclCreateProc, procbody obj, inconsistent arg default type} procbodytest {
- catch {
- proc p {x y z} {
- set v [join [list $x $y $z]]
- set w [string tolower $v]
- return "$v:$w"
- }
- set rv [p P Q R]
- procbodytest::proc t {x y {z Z}} p
- lappend rv [t S T U]
- set rv
- } result
+} -result {procedure "t": formal parameter 2 is inconsistent with precompiled body}
+test proc-4.6 {TclCreateProc, procbody obj, inconsistent arg default type} -body {
+ proc p {x y z} {
+ set v [join [list $x $y $z]]
+ set w [string tolower $v]
+ return "$v:$w"
+ }
+ set rv [p P Q R]
+ procbodytest::proc t {x y {z Z}} p
+ lappend rv [t S T U]
+} -returnCodes error -constraints procbodytest -cleanup {
catch {rename p ""}
catch {rename t ""}
- set result
-} {procedure "t": formal parameter 2 is inconsistent with precompiled body}
-test proc-4.7 {TclCreateProc, procbody obj, inconsistent arg default value} procbodytest {
- catch {
- proc p {x y {z Z}} {
- set v [join [list $x $y $z]]
- set w [string tolower $v]
- return "$v:$w"
- }
- set rv [p P Q R]
- procbodytest::proc t {x y {z ZZ}} p
- lappend rv [t S T U]
- set rv
- } result
+} -result {procedure "t": formal parameter 2 is inconsistent with precompiled body}
+test proc-4.7 {TclCreateProc, procbody obj, inconsistent arg default value} -body {
+ proc p {x y {z Z}} {
+ set v [join [list $x $y $z]]
+ set w [string tolower $v]
+ return "$v:$w"
+ }
+ set rv [p P Q R]
+ procbodytest::proc t {x y {z ZZ}} p
+ lappend rv [t S T U]
+} -constraints procbodytest -returnCodes error -cleanup {
catch {rename p ""}
catch {rename t ""}
- set result
-} {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}
+} -result {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}
test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -setup {
proc getbytes {} {
set lines [split [memory info] "\n"]
@@ -310,12 +302,9 @@ test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -set
}
px x
} -constraints {procbodytest memory} -body {
-
set end [getbytes]
for {set i 0} {$i < 5} {incr i} {
-
procbodytest::proc tx x px
-
set tmp $end
set end [getbytes]
}
@@ -325,7 +314,7 @@ test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -set
unset -nocomplain end i tmp leakedBytes
} -result 0
-test proc-5.1 {Bytecompiling noop; test for correct argument substitution} {
+test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body {
proc p args {} ; # this will be bytecompiled into t
proc t {} {
set res {}
@@ -336,20 +325,20 @@ test proc-5.1 {Bytecompiling noop; test for correct argument substitution} {
p $a ccccccw {bfe} {$a} [incr b] [incr a] {[incr b]} {$a} hello
set res
}
- set result [t]
+ t
+} -cleanup {
catch {rename p ""}
catch {rename t ""}
- set result
-} {aba}
+} -result {aba}
-test proc-6.1 {ProcessProcResultCode: Bug 647307 (negative return code)} {
+test proc-6.1 {ProcessProcResultCode: Bug 647307 (negative return code)} -body {
proc a {} {return -code -5}
proc b {} a
- set result [catch b]
+ catch b
+} -cleanup {
rename a {}
rename b {}
- set result
-} -5
+} -result -5
test proc-7.1 {Redefining a compiled cmd: Bug 729692} {
proc bar args {}
@@ -359,19 +348,17 @@ test proc-7.1 {Redefining a compiled cmd: Bug 729692} {
}
foo
} bar
-
-test proc-7.2 {Shadowing a compiled cmd: Bug 729692} {
+test proc-7.2 {Shadowing a compiled cmd: Bug 729692} -body {
namespace eval ugly {}
proc ugly::foo {} {
proc set args {return bar}
set x 1
}
- set res [list [catch {ugly::foo} msg] $msg]
+ ugly::foo
+} -cleanup {
namespace delete ugly
- set res
-} {0 bar}
-
-test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} {
+} -result bar
+test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} -body {
namespace eval ugly {}
proc ugly::foo {} {
set i 0
@@ -383,15 +370,27 @@ test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} {
}
return $i
}
- set res [list [catch {ugly::foo} msg] $msg]
+ ugly::foo
+} -cleanup {
namespace delete ugly
- set res
-} {0 4}
-
-
+} -result 4
+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
+ unset lambda
+} {}
+
# cleanup
catch {rename p ""}
catch {rename t ""}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/pwd.test b/tests/pwd.test
index 1592680..175c852 100644
--- a/tests/pwd.test
+++ b/tests/pwd.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: pwd.test,v 1.7 2004/05/19 13:00:13 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
diff --git a/tests/reg.test b/tests/reg.test
index 46b5e64..a0ea850 100644
--- a/tests/reg.test
+++ b/tests/reg.test
@@ -8,13 +8,14 @@
# to read this file, ignoring the Tcl-isms.)
#
# Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
-#
-# RCS: @(#) $Id: reg.test,v 1.26 2009/10/29 17:21:48 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# All tests require the testregexp command, return if this
# command doesn't exist
@@ -176,14 +177,32 @@ namespace eval RETest {
return $ret
}
+ # Share the generation of the list of test constraints so it is
+ # done the same on all routes.
+ proc TestConstraints {flags} {
+ set constraints [list testregexp]
+
+ variable regBug
+ if {$regBug} {
+ # This will trigger registration as a skipped test
+ lappend constraints knownBug
+ }
+
+ # Tcl locale stuff doesn't do the ch/xy test fakery yet
+ if {[string match *+* $flags]} {
+ # This will trigger registration as a skipped test
+ lappend constraints localeRegexp
+ }
+
+ return $constraints
+ }
+
# match expected, internal routine that does the work
# parameters like the "real" routines except they don't have "opts",
# which is a possibly-empty list of switches for the regexp match attempt
# The ! flag is used to indicate expected match failure (for REG_EXPECT,
# which wants argument testing even in the event of failure).
proc MatchExpected {opts testid flags re target args} {
- variable regBug
-
# if &, test as both BRE and ARE
if {[string match *&* $flags]} {
set f [string map {& {}} $flags]
@@ -192,18 +211,7 @@ namespace eval RETest {
return
}
- set constraints [list testregexp]
-
- if {$regBug} {
- # This will register as a skipped test
- lappend constraints knownBug
- }
-
- # Tcl locale stuff doesn't do the ch/xy test fakery yet
- if {[string match *+* $flags]} {
- # This will register as a skipped test
- lappend constraints localeRegexp
- }
+ set constraints [TestConstraints $flags]
set f [TestFlags $flags]
set infoflags [TestInfoFlags $flags]
@@ -254,13 +262,7 @@ namespace eval RETest {
return
}
- set constraints [list testregexp]
-
- # Tcl locale stuff doesn't do the ch/xy test fakery yet
- if {[string match *+* $flags]} {
- # This will register as a skipped test
- lappend constraints localeRegexp
- }
+ set constraints [TestConstraints $flags]
set cmd [list testregexp -about {*}[TestFlags $flags] $re]
::tcltest::test [TestNum $testid error] [TestDesc $testid error] \
@@ -270,6 +272,7 @@ namespace eval RETest {
# match failure expected
proc expectNomatch {testid flags re target args} {
+ variable regBug
# if &, test as both ARE and BRE
if {[string match *&* $flags]} {
set f [string map {& {}} $flags]
@@ -278,13 +281,7 @@ namespace eval RETest {
return
}
- set constraints [list testregexp]
-
- # Tcl locale stuff doesn't do the ch/xy test fakery yet
- if {[string match *+* $flags]} {
- # This will register as a skipped test
- lappend constraints localeRegexp
- }
+ set constraints [TestConstraints $flags]
set f [TestFlags $flags]
set infoflags [TestInfoFlags $flags]
@@ -333,7 +330,7 @@ namespace eval RETest {
}
}
namespace import RETest::*
-
+
######## the tests themselves ########
# support functions and preliminary misc.
@@ -628,16 +625,24 @@ expectMatch 13.13 P "a\\nb" "a\nb" "a\nb"
expectMatch 13.14 P "a\\rb" "a\rb" "a\rb"
expectMatch 13.15 P "a\\tb" "a\tb" "a\tb"
expectMatch 13.16 P "a\\u0008x" "a\bx" "a\bx"
-expectError 13.17 - {a\u008x} EESCAPE
+expectMatch 13.17 P {a\u008x} "a\bx" "a\bx"
expectMatch 13.18 P "a\\u00088x" "a\b8x" "a\b8x"
expectMatch 13.19 P "a\\U00000008x" "a\bx" "a\bx"
-expectError 13.20 - {a\U0000008x} EESCAPE
+expectMatch 13.20 P {a\U0000008x} "a\bx" "a\bx"
expectMatch 13.21 P "a\\vb" "a\vb" "a\vb"
expectMatch 13.22 MP "a\\x08x" "a\bx" "a\bx"
expectError 13.23 - {a\xq} EESCAPE
-expectMatch 13.24 MP "a\\x0008x" "a\bx" "a\bx"
+expectMatch 13.24 MP "a\\x08x" "a\bx" "a\bx"
expectError 13.25 - {a\z} EESCAPE
expectMatch 13.26 MP "a\\010b" "a\bb" "a\bb"
+expectMatch 13.27 P "a\\U00001234x" "a\u1234x" "a\u1234x"
+expectMatch 13.28 P {a\U00001234x} "a\u1234x" "a\u1234x"
+expectMatch 13.29 P "a\\U0001234x" "a\u1234x" "a\u1234x"
+expectMatch 13.30 P {a\U0001234x} "a\u1234x" "a\u1234x"
+expectMatch 13.31 P "a\\U000012345x" "a\u12345x" "a\u12345x"
+expectMatch 13.32 P {a\U000012345x} "a\u12345x" "a\u12345x"
+expectMatch 13.33 P "a\\U1000000x" "a\ufffd0x" "a\ufffd0x"
+expectMatch 13.34 P {a\U1000000x} "a\ufffd0x" "a\ufffd0x"
doing 14 "back references"
@@ -662,6 +667,9 @@ expectMatch 14.17 RP {a([bc])(\1*)} ab ab b ""
expectError 14.18 - {a((b)\1)} ESUBREG
expectError 14.19 - {a(b)c\2} ESUBREG
expectMatch 14.20 bR {a\(b*\)c\1} abbcbb abbcbb bb
+expectMatch 14.21 RP {^([bc])\1*$} bbb bbb b
+expectMatch 14.22 RP {^([bc])\1*$} ccc ccc c
+knownBug expectNomatch 14.23 R {^([bc])\1*$} bcb
doing 15 "octal escapes vs back references"
@@ -684,6 +692,7 @@ expectError 15.9 - {a((((((((((b\10))))))))))c} ESUBREG
expectMatch 15.10 MP "a\\12b" "a\nb" "a\nb"
expectError 15.11 b {a\12b} ESUBREG
expectMatch 15.12 eAS {a\12b} a12b a12b
+expectMatch 15.13 MP {a\701b} a\u00381b a\u00381b
doing 16 "expanded syntax"
@@ -1071,7 +1080,11 @@ test reg-33.13 {Bug 1810264 - infinite loop} {
test reg-33.14 {Bug 1810264 - super-expensive expression} nonPortable {
regexp {(x{200}){200}$y} {x}
} 0
-
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/regexp.test b/tests/regexp.test
index e2282eb..7cafd1b 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -10,15 +10,13 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: regexp.test,v 1.36 2010/02/21 18:55:41 mdejong Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-catch {unset foo}
+unset -nocomplain foo
testConstraint exec [llength [info commands exec]]
@@ -198,7 +196,7 @@ set x $x$x$x$x$x$x$x$x$x$x$x$x
test regexp-4.4 {case conversion in regexp} {
list [regexp -nocase $x $x foo] $foo
} "1 $x"
-catch {unset x}
+unset -nocomplain x
test regexp-5.1 {exercise cache of compiled expressions} {
regexp .*a b
@@ -262,11 +260,12 @@ test regexp-6.6 {regexp errors} {
test regexp-6.7 {regexp errors} {
list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
} {0 0}
-test regexp-6.8 {regexp errors} {
- catch {unset f1}
+test regexp-6.8 {regexp errors} -setup {
+ unset -nocomplain f1
+} -body {
set f1 44
- list [catch {regexp abc abc f1(f2)} msg] $msg
-} {1 {couldn't set variable "f1(f2)"}}
+ regexp abc abc f1(f2)
+} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
test regexp-6.9 {regexp errors, -start bad int check} {
list [catch {regexp -start bogus {^$} {}} msg] $msg
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
@@ -458,11 +457,12 @@ test regexp-11.5 {regsub errors} {
test regexp-11.6 {regsub errors} {
list [catch {regsub -nocase a( b c d} msg] $msg
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
-test regexp-11.7 {regsub errors} {
- catch {unset f1}
+test regexp-11.7 {regsub errors} -setup {
+ unset -nocomplain f1
+} -body {
set f1 44
- list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
-} {1 {couldn't set variable "f1(f2)"}}
+ regsub -nocase aaa aaa xxx f1(f2)
+} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
test regexp-11.8 {regsub errors, -start bad int check} {
list [catch {regsub -start bogus pattern string rep var} msg] $msg
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
@@ -529,23 +529,23 @@ test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -co
} -result 1
test regexp-15.1 {regexp -start} {
- catch {unset x}
+ unset -nocomplain x
list [regexp -start -10 {\d} 1abc2de3 x] $x
} {1 1}
test regexp-15.2 {regexp -start} {
- catch {unset x}
+ unset -nocomplain x
list [regexp -start 2 {\d} 1abc2de3 x] $x
} {1 2}
test regexp-15.3 {regexp -start} {
- catch {unset x}
+ unset -nocomplain x
list [regexp -start 4 {\d} 1abc2de3 x] $x
} {1 2}
test regexp-15.4 {regexp -start} {
- catch {unset x}
+ unset -nocomplain x
list [regexp -start 5 {\d} 1abc2de3 x] $x
} {1 3}
test regexp-15.5 {regexp -start, over end of string} {
- catch {unset x}
+ unset -nocomplain x
list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
} {0 0}
test regexp-15.6 {regexp -start, loss of ^$ behavior} {
@@ -558,11 +558,11 @@ test regexp-15.8 {regexp -start, double option} {
regexp -start 0 -start 2 a abc
} 0
test regexp-15.9 {regexp -start, end relative index} {
- catch {unset x}
+ unset -nocomplain x
list [regexp -start end {\d} 1abc2de3 x] [info exists x]
} {0 0}
test regexp-15.10 {regexp -start, end relative index} {
- catch {unset x}
+ unset -nocomplain x
list [regexp -start end-1 {\d} 1abc2de3 x] [info exists x] $x
} {1 1 3}
test regexp-15.11 {regexp -start, over end of string} {
@@ -571,15 +571,15 @@ test regexp-15.11 {regexp -start, over end of string} {
} {1 {}}
test regexp-16.1 {regsub -start} {
- catch {unset x}
+ unset -nocomplain x
list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
} {4 a1b/2c/3d/4e/5}
test regexp-16.2 {regsub -start} {
- catch {unset x}
+ unset -nocomplain x
list [regsub -all -start -25 {z} hello {/&} x] $x
} {0 hello}
test regexp-16.3 {regsub -start} {
- catch {unset x}
+ unset -nocomplain x
list [regsub -all -start 3 {z} hello {/&} x] $x
} {0 hello}
test regexp-16.4 {regsub -start, \A behavior} {
@@ -1067,3 +1067,6 @@ test regexp-26.13 {regexp without -line option} {
::tcltest::cleanupTests
return
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/regexpComp.test b/tests/regexpComp.test
index 4f05bc3..94fb90e 100644
--- a/tests/regexpComp.test
+++ b/tests/regexpComp.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -31,7 +29,8 @@ proc evalInProc { script } {
#return [list $status $result]
}
-catch {unset foo}
+unset -nocomplain foo
+
test regexpComp-1.1 {basic regexp operation} {
evalInProc {
regexp ab*c abbbc
@@ -260,7 +259,7 @@ test regexpComp-4.4 {case conversion in regexp} {
list [regexp -nocase $::x $::x foo] $foo
}
} "1 $x"
-catch {unset ::x}
+unset -nocomplain ::x
test regexpComp-5.1 {exercise cache of compiled expressions} {
evalInProc {
@@ -350,11 +349,11 @@ test regexpComp-6.7 {regexp errors} {
} {0 0}
test regexpComp-6.8 {regexp errors} {
evalInProc {
- catch {unset f1}
+ unset -nocomplain f1
set f1 44
list [catch {regexp abc abc f1(f2)} msg] $msg
}
-} {1 {couldn't set variable "f1(f2)"}}
+} {1 {can't set "f1(f2)": variable isn't array}}
test regexpComp-6.9 {regexp errors, -start bad int check} {
evalInProc {
list [catch {regexp -start bogus {^$} {}} msg] $msg
@@ -591,11 +590,11 @@ test regexpComp-11.6 {regsub errors} {
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexpComp-11.7 {regsub errors} {
evalInProc {
- catch {unset f1}
+ unset -nocomplain f1
set f1 44
list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
}
-} {1 {couldn't set variable "f1(f2)"}}
+} {1 {can't set "f1(f2)": variable isn't array}}
test regexpComp-11.8 {regsub errors, -start bad int check} {
evalInProc {
list [catch {regsub -start bogus pattern string rep var} msg] $msg
@@ -662,23 +661,23 @@ test regexpComp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache}
} -result 1
test regexpComp-15.1 {regexp -start} {
- catch {unset x}
+ unset -nocomplain x
list [regexp -start -10 {\d} 1abc2de3 x] $x
} {1 1}
test regexpComp-15.2 {regexp -start} {
- catch {unset x}
+ unset -nocomplain x
list [regexp -start 2 {\d} 1abc2de3 x] $x
} {1 2}
test regexpComp-15.3 {regexp -start} {
- catch {unset x}
+ unset -nocomplain x
list [regexp -start 4 {\d} 1abc2de3 x] $x
} {1 2}
test regexpComp-15.4 {regexp -start} {
- catch {unset x}
+ unset -nocomplain x
list [regexp -start 5 {\d} 1abc2de3 x] $x
} {1 3}
test regexpComp-15.5 {regexp -start, over end of string} {
- catch {unset x}
+ unset -nocomplain x
list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
} {0 0}
test regexpComp-15.6 {regexp -start, loss of ^$ behavior} {
@@ -686,15 +685,15 @@ test regexpComp-15.6 {regexp -start, loss of ^$ behavior} {
} {0}
test regexpComp-16.1 {regsub -start} {
- catch {unset x}
+ unset -nocomplain x
list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
} {4 a1b/2c/3d/4e/5}
test regexpComp-16.2 {regsub -start} {
- catch {unset x}
+ unset -nocomplain x
list [regsub -all -start -25 {z} hello {/&} x] $x
} {0 hello}
test regexpComp-16.3 {regsub -start} {
- catch {unset x}
+ unset -nocomplain x
list [regsub -all -start 3 {z} hello {/&} x] $x
} {0 hello}
test regexpComp-16.4 {regsub -start, \A behavior} {
@@ -983,7 +982,11 @@ test regexpComp-24.11 {regexp command compiling tests} {
regexp -- $re $text
}
} 1
-
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/registry.test b/tests/registry.test
index 02866f3..77588e3 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -9,8 +9,6 @@
#
# Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved.
# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# RCS: @(#) $Id: registry.test,v 1.26 2010/04/02 19:27:44 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -19,13 +17,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
testConstraint reg 0
if {[testConstraint win]} {
- catch {
- # Is the registry extension already static to this shell?
- if [catch {load {} Registry; set ::reglib {}}] {
- # try the location given to use on the commandline to tcltest
+ if {![catch {
::tcltest::loadTestedCommands
- load $::reglib Registry
- }
+ set ::regver [package require registry 1.3.0]
+ }]} {
testConstraint reg 1
}
}
@@ -36,6 +31,9 @@ testConstraint english [expr {
&& [string match "English*" [testlocale all ""]]
}]
+test registry-1.0 {check if we are testing the right dll} {win reg} {
+ set ::regver
+} {1.3.0}
test registry-1.1 {argument parsing for registry command} {win reg} {
list [catch {registry} msg] $msg
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
@@ -507,6 +505,12 @@ test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {
registry delete HKEY_CURRENT_USER\\TclFoobar
set result
} "foo ba r baz"
+test registry-6.21 {GetValue: very long value names and values} {pcOnly reg} {
+ registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz
+ set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]]
+ registry delete HKEY_CURRENT_USER\\TclFoobar
+ set result
+} [string repeat x 16383]
test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup {
registry delete HKEY_CURRENT_USER\\TclFoobar
diff --git a/tests/remote.tcl b/tests/remote.tcl
index 005f2df..097e41f 100644
--- a/tests/remote.tcl
+++ b/tests/remote.tcl
@@ -8,8 +8,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: remote.tcl,v 1.3 1999/04/16 00:47:33 stanton Exp $
# Initialize message delimitor
@@ -32,11 +30,9 @@ proc __doCommands__ {l s} {
puts "---"
}
set callerSocket $s
- if {[catch {uplevel #0 $l} msg]} {
- list error $msg
- } else {
- list success $msg
- }
+ set ::errorInfo ""
+ set code [catch {uplevel "#0" $l} msg]
+ return [list $code $::errorInfo $msg]
}
proc __readAndExecute__ {s} {
@@ -44,10 +40,9 @@ proc __readAndExecute__ {s} {
set l [gets $s]
if {[string compare $l "--Marker--Marker--Marker--"] == 0} {
- if {[info exists command($s)]} {
- puts $s [list error incomplete_command]
- }
+ puts $s [__doCommands__ $command($s) $s]
puts $s "--Marker--Marker--Marker--"
+ set command($s) ""
return
}
if {[string compare $l ""] == 0} {
@@ -59,28 +54,26 @@ proc __readAndExecute__ {s} {
}
return
}
- append command($s) $l "\n"
- if {[info complete $command($s)]} {
- set cmds $command($s)
- unset command($s)
- puts $s [__doCommands__ $cmds $s]
- }
if {[eof $s]} {
if {$VERBOSE} {
puts "Server closing $s, eof from client"
}
close $s
+ unset command($s)
+ return
}
+ append command($s) $l "\n"
}
proc __accept__ {s a p} {
- global VERBOSE
+ global command VERBOSE
if {$VERBOSE} {
puts "Server accepts new connection from $a:$p on $s"
}
- fileevent $s readable [list __readAndExecute__ $s]
+ set command($s) ""
fconfigure $s -buffering line -translation crlf
+ fileevent $s readable [list __readAndExecute__ $s]
}
set serverIsSilent 0
@@ -153,20 +146,14 @@ if {$serverIsSilent == 0} {
flush stdout
}
+proc getPort sock {
+ lindex [fconfigure $sock -sockname] 2
+}
+
if {[catch {set serverSocket \
[socket -myaddr $serverAddress -server __accept__ $serverPort]} msg]} {
puts "Server on $serverAddress:$serverPort cannot start: $msg"
} else {
+ puts ready
vwait __server_wait_variable__
}
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/rename.test b/tests/rename.test
index 3a3a47f..1fa0441 100644
--- a/tests/rename.test
+++ b/tests/rename.test
@@ -10,14 +10,15 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: rename.test,v 1.13 2009/01/08 16:41:35 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testdel [llength [info commands testdel]]
# Must eliminate the "unknown" command while the test is running, especially
diff --git a/tests/resolver.test b/tests/resolver.test
new file mode 100644
index 0000000..e73ea50
--- /dev/null
+++ b/tests/resolver.test
@@ -0,0 +1,203 @@
+# This test collection covers some unwanted interactions between command
+# literal sharing and the use of command resolvers (per-interp) which cause
+# command literals to be re-used with their command references being invalid
+# in the reusing context. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 2011 Gustaf Neumann <gustaf.neumann@wu.ac.at>
+# Copyright (c) 2011 Stefan Sobernig <stefan.sobernig@wu.ac.at>
+#
+# 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]} {
+ namespace import -force ::tcltest::*
+}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testinterpresolver [llength [info commands testinterpresolver]]
+
+test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup {
+ testinterpresolver up
+ namespace eval ::ns1 {
+ proc z {} { return Z }
+ namespace export z
+ }
+ proc ::y {} { return Y }
+ proc ::x {} {
+ z
+ }
+} -constraints testinterpresolver -body {
+ # 1) Have the proc body compiled: During compilation or, alternatively,
+ # the first evaluation of the compiled body, the InterpCmdResolver (see
+ # tclTest.c) maps the cmd token "z" to "::y"; this mapping is saved in the
+ # resulting CmdName Tcl_Obj with the print string "z". The CmdName Tcl_Obj
+ # is turned into a command literal shared for a given (here: the global)
+ # namespace.
+ set r0 [x]; # --> The result of [x] is "Y"
+ # 2) After having requested cmd resolution above, we can now use the
+ # globally shared CmdName Tcl_Obj "z", now bound to cmd ::y. This is
+ # certainly questionable, but defensible
+ set r1 [z]; # --> The result of [z] is "Y"
+ # 3) We import from the namespace ns1 another z. [namespace import] takes
+ # care "shadowed" cmd references, however, till now cmd literals have not
+ # been touched. This is, however, necessary since the BC compiler (used in
+ # the [namespace eval]) seems to be eager to reuse CmdName Tcl_Objs as cmd
+ # literals for a given NS scope. We expect, that r2 is "Z", the result of
+ # the namespace imported cmd.
+ namespace eval :: {
+ namespace import ::ns1::z
+ set r2 [z]
+ }
+ list $r0 $r1 $::r2
+} -cleanup {
+ testinterpresolver down
+ rename ::x ""
+ rename ::y ""
+ namespace delete ::ns1
+} -result {Y Y Z}
+test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup {
+ testinterpresolver up
+ proc ::y {} { return Y }
+ proc ::x {} {
+ z
+ }
+} -constraints testinterpresolver -body {
+ set r0 [x]
+ set r1 [z]
+ proc ::foo {} {
+ proc ::z {} { return Z }
+ return [z]
+ }
+ list $r0 $r1 [::foo]
+} -cleanup {
+ testinterpresolver down
+ rename ::x ""
+ rename ::y ""
+ rename ::foo ""
+ rename ::z ""
+} -result {Y Y Z}
+test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup {
+ testinterpresolver up
+ proc ::Z {} { return Z }
+ proc ::y {} { return Y }
+ proc ::x {} {
+ z
+ }
+} -constraints testinterpresolver -body {
+ set r0 [x]
+ set r1 [z]
+ namespace eval :: {
+ rename ::Z ::z
+ set r2 [z]
+ }
+ list $r0 $r1 $r2
+} -cleanup {
+ testinterpresolver down
+ rename ::x ""
+ rename ::y ""
+ rename ::z ""
+} -result {Y Y Z}
+test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup {
+ testinterpresolver up
+ proc ::Z {} { return Z }
+ interp hide {} Z
+ proc ::y {} { return Y }
+ proc ::x {} {
+ z
+ }
+} -constraints testinterpresolver -body {
+ set r0 [x]
+ set r1 [z]
+ interp expose {} Z z
+ namespace eval :: {
+ set r2 [z]
+ }
+ list $r0 $r1 $r2
+} -cleanup {
+ testinterpresolver down
+ rename ::x ""
+ rename ::y ""
+ rename ::z ""
+} -result {Y Y Z}
+test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -setup {
+ testinterpresolver up
+ namespace eval ::ns1 {
+ proc z {} { return Z }
+ namespace export z
+ }
+ proc ::y {} { return Y }
+ namespace eval ::ns2 {
+ proc x {} {
+ z
+ }
+ }
+} -constraints testinterpresolver -body {
+ set r0 [namespace eval ::ns2 {x}]
+ set r1 [namespace eval ::ns2 {z}]
+ namespace eval ::ns2 {
+ namespace import ::ns1::z
+ set r2 [z]
+ }
+ list $r0 $r1 $r2
+} -cleanup {
+ testinterpresolver down
+ namespace delete ::ns2
+ namespace delete ::ns1
+} -result {Y Y Z}
+test resolver-1.6 {cmdNameObj sharing vs. cmd resolver: interp alias} -setup {
+ testinterpresolver up
+ proc ::Z {} { return Z }
+ proc ::y {} { return Y }
+ proc ::x {} {
+ z
+ }
+} -constraints testinterpresolver -body {
+ set r0 [x]
+ set r1 [z]
+ namespace eval :: {
+ interp alias {} ::z {} ::Z
+ set r2 [z]
+ }
+ list $r0 $r1 $r2
+} -cleanup {
+ testinterpresolver down
+ rename ::x ""
+ rename ::y ""
+ rename ::Z ""
+} -result {Y Y Z}
+
+test resolver-2.1 {compiled var resolver: Bug #3383616} -setup {
+ testinterpresolver up
+ # The compiled var resolver fetches just variables starting with a capital
+ # "T" and stores some test information in the resolver-specific resolver
+ # var info.
+ proc ::x {} {
+ set T1 100
+ return $T1
+ }
+} -constraints testinterpresolver -body {
+ # Call "x" the first time, causing a byte code compilation of the body.
+ # During the compilation the compiled var resolver, the resolve-specific
+ # var info is allocated, during the execution of the body, the variable is
+ # fetched and cached.
+ x;
+ # During later calls, the cached variable is reused.
+ x
+ # When the proc is freed, the resolver-specific resolver var info is
+ # freed. This did not happen before fix #3383616.
+ rename ::x ""
+} -cleanup {
+ testinterpresolver down
+} -result {}
+
+cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/result.test b/tests/result.test
index 8bde7ef..3391ce1 100644
--- a/tests/result.test
+++ b/tests/result.test
@@ -9,14 +9,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# SCCS: @(#) result.test 1.4 97/12/08 15:07:49
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Some tests require the testsaveresult command
testConstraint testsaveresult [llength [info commands testsaveresult]]
@@ -135,14 +136,14 @@ test result-6.3 {Bug 2383005} {
catch {return -code error -errorcode {{}a} eek} m
set m
} {bad -errorcode value: expected a list but got "{}a"}
-test result-6.4 {non-list -errorstack} {
+test result-6.4 {non-list -errorstack} -body {
catch {return -code error -errorstack {{}a} eek} m o
list $m [dict get $o -errorcode] [dict get $o -errorstack]
-} {{bad -errorstack value: expected a list but got "{}a"} {TCL RESULT NONLIST_ERRORSTACK} {UP 1}}
-test result-6.5 {odd-sized-list -errorstack} {
+} -match glob -result {{bad -errorstack value: expected a list but got "{}a"} {TCL RESULT NONLIST_ERRORSTACK} {INNER * UP 1}}
+test result-6.5 {odd-sized-list -errorstack} -body {
catch {return -code error -errorstack a eek} m o
list $m [dict get $o -errorcode] [dict get $o -errorstack]
-} {{forbidden odd-sized list for -errorstack: "a"} {TCL RESULT ODDSIZEDLIST_ERRORSTACK} {UP 1}}
+} -match glob -result {{forbidden odd-sized list for -errorstack: "a"} {TCL RESULT ODDSIZEDLIST_ERRORSTACK} {INNER * UP 1}}
# cleanup
cleanupTests
return
diff --git a/tests/safe.test b/tests/safe.test
index c22cf6e..4a2792e 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -9,8 +9,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: safe.test,v 1.34 2010/08/18 13:31:55 dkf Exp $
package require Tcl 8.5
@@ -30,7 +28,10 @@ set ::auto_path [info library]
# thus un-autoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}
-proc equiv {x} {return $x}
+# 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}]}]
test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body {
safe::interpConfigure
@@ -91,7 +92,7 @@ test safe-3.2 {calling safe::interpCreate on trusted interp} -setup {
lsort [a aliases]
} -cleanup {
safe::interpDelete a
-} -result {::tcl::info::nameofexecutable clock encoding exit file glob load source}
+} -result {::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::tempfile ::tcl::file::type ::tcl::file::volumes ::tcl::file::writable ::tcl::info::nameofexecutable clock encoding exit glob load source}
test safe-3.3 {calling safe::interpCreate on trusted interp} -setup {
catch {safe::interpDelete a}
} -body {
@@ -166,27 +167,24 @@ test safe-6.2 {test safe interpreters knowledge of the world} {
SafeEval {info script}
} {}
test safe-6.3 {test safe interpreters knowledge of the world} {
- set r [lsort [SafeEval {array names tcl_platform}]]
+ set r [SafeEval {array names tcl_platform}]
# If running a windows-debug shell, remove the "debug" element from r.
- if {[testConstraint win] && ("debug" in $r)} {
- set r [lreplace $r 1 1]
+ if {[testConstraint win]} {
+ set r [lsearch -all -inline -not -exact $r "debug"]
}
- set threaded [lsearch $r "threaded"]
- if {$threaded != -1} {
- set r [lreplace $r $threaded $threaded]
- }
- set r
+ set r [lsearch -all -inline -not -exact $r "threaded"]
+ lsort $r
} {byteOrder pathSeparator platform pointerSize wordSize}
-# more test should be added to check that hostname, nameofexecutable,
-# aren't leaking infos, but they still do...
+# 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} {
set i [safe::interpCreate]
# 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)
+ # (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 1}]
# no error shall occur:
interp eval $i {http_config}
@@ -205,7 +203,12 @@ test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body {
[catch {interp eval $i {package require http 1}} msg] $msg \
[safe::interpConfigure $i]\
[safe::interpDelete $i]
-} -match glob -result "{\$p(:0:)} {\$p(:[expr 1+[llength [tcl::tm::list]]]:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library * /dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}"
+} -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 {}} {}"
+test safe-7.3 {check that safe subinterpreters work} {
+ 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}
# test source control on file name
test safe-8.1 {safe source control on file} -setup {
@@ -331,6 +334,20 @@ test safe-8.9 {safe source and return} -setup {
catch {safe::interpDelete $i}
removeFile $returnScript
} -result ok
+test safe-8.10 {safe source and return} -setup {
+ set returnScript [makeFile {return -level 2 "ok"} return.tcl]
+ catch {safe::interpDelete $i}
+} -body {
+ safe::interpCreate $i
+ set token [safe::interpAddToAccessPath $i [file dirname $returnScript]]
+ $i eval [list apply {filename {
+ source $filename
+ error boom
+ }} $token/[file tail $returnScript]]
+} -cleanup {
+ catch {safe::interpDelete $i}
+ removeFile $returnScript
+} -result ok
test safe-9.1 {safe interps' deleteHook} -setup {
set i "a"
@@ -400,17 +417,7 @@ test safe-9.6 {interpConfigure widget like behaviour} -body {
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}}
-# testing that nested and statics do what is advertised (we use a static
-# package : Tcltest)
-try {
- package require Tcltest
- testConstraint TcltestPackage 1
- # we use the Tcltest package , which has no Safe_Init
-} on error {} {
- testConstraint TcltestPackage 0
-}
-
-teststaticpkg Safepkg1 0 0
+catch {teststaticpkg Safepkg1 0 0}
test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
set i [safe::interpCreate]
} -body {
@@ -548,9 +555,214 @@ test safe-12.7 {glob is restricted} -setup {
set i [safe::interpCreate]
} -body {
$i eval glob *
+} -returnCodes error -cleanup {
+ safe::interpDelete $i
+} -result {permission denied}
+
+proc buildEnvironment {filename} {
+ upvar 1 testdir testdir testdir2 testdir2 testfile testfile
+ set testdir [makeDirectory deletethisdir]
+ set testdir2 [makeDirectory deletemetoo $testdir]
+ set testfile [makeFile {} $filename $testdir2]
+}
+#### New tests for Safe base glob, with patches @ Bug 2964715
+test safe-13.1 {glob is restricted [Bug 2964715]} -setup {
+ set i [safe::interpCreate]
+} -body {
+ $i eval glob *
+} -returnCodes error -cleanup {
+ safe::interpDelete $i
+} -result {permission denied}
+test safe-13.2 {mimic the valid glob call by ::tcl::tm::UnknownHandler [Bug 2964715]} -setup {
+ set i [safe::interpCreate]
+ buildEnvironment deleteme.tm
+} -body {
+ ::safe::interpAddToAccessPath $i $testdir2
+ set result [$i eval glob -nocomplain -directory $testdir2 *.tm]
+ if {$result eq [list $testfile]} {
+ return "glob match"
+ } else {
+ return "no match: $result"
+ }
+} -cleanup {
+ safe::interpDelete $i
+ removeDirectory $testdir
+} -result {glob match}
+test safe-13.3 {cf 13.2 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
+ set i [safe::interpCreate]
+ buildEnvironment deleteme.tm
+} -body {
+ $i eval glob -directory $testdir2 *.tm
+} -returnCodes error -cleanup {
+ safe::interpDelete $i
+ removeDirectory $testdir
+} -result {permission denied}
+test safe-13.4 {another valid glob call [Bug 2964715]} -setup {
+ set i [safe::interpCreate]
+ buildEnvironment deleteme.tm
+} -body {
+ ::safe::interpAddToAccessPath $i $testdir
+ ::safe::interpAddToAccessPath $i $testdir2
+ set result [$i eval \
+ glob -nocomplain -directory $testdir [file join deletemetoo *.tm]]
+ if {$result eq [list $testfile]} {
+ return "glob match"
+ } else {
+ return "no match: $result"
+ }
} -cleanup {
safe::interpDelete $i
-} -match glob -result *
+ removeDirectory $testdir
+} -result {glob match}
+test safe-13.5 {as 13.4 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
+ set i [safe::interpCreate]
+ buildEnvironment deleteme.tm
+} -body {
+ ::safe::interpAddToAccessPath $i $testdir2
+ $i eval \
+ glob -directory $testdir [file join deletemetoo *.tm]
+} -returnCodes error -cleanup {
+ safe::interpDelete $i
+ removeDirectory $testdir
+} -result {permission denied}
+test safe-13.6 {as 13.4 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
+ set i [safe::interpCreate]
+ buildEnvironment deleteme.tm
+} -body {
+ ::safe::interpAddToAccessPath $i $testdir
+ $i eval \
+ glob -nocomplain -directory $testdir [file join deletemetoo *.tm]
+} -cleanup {
+ 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 {
+ 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 \
+ 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 {
+ set i [safe::interpCreate]
+ buildEnvironment notIndex.tcl
+} -body {
+ set safeTD [::safe::interpAddToAccessPath $i $testdir]
+ ::safe::interpAddToAccessPath $i $testdir2
+ $i eval [list glob -directory $safeTD -join -nocomplain * notIndex.tcl]
+} -cleanup {
+ safe::interpDelete $i
+ removeDirectory $testdir
+} -result {}
+test safe-13.9 {as 13.8 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
+ set i [safe::interpCreate]
+ buildEnvironment notIndex.tcl
+} -body {
+ ::safe::interpAddToAccessPath $i $testdir2
+ set result [$i eval \
+ glob -directory $testdir -join -nocomplain * notIndex.tcl]
+ if {$result eq [list $testfile]} {
+ return {glob match}
+ } else {
+ return "no match: $result"
+ }
+} -cleanup {
+ safe::interpDelete $i
+ removeDirectory $testdir
+} -result {no match: }
+test safe-13.10 {as 13.8 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
+ set i [safe::interpCreate]
+ buildEnvironment notIndex.tcl
+} -body {
+ ::safe::interpAddToAccessPath $i $testdir
+ $i eval glob -directory $testdir -join -nocomplain * notIndex.tcl
+} -cleanup {
+ safe::interpDelete $i
+ removeDirectory $testdir
+} -result {}
+rename buildEnvironment {}
+
+#### Test for the module path
+test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup {
+ set i [safe::interpCreate]
+} -body {
+ set tm {}
+ foreach token [$i eval ::tcl::tm::path list] {
+ lappend tm [dict get [set ::safe::S${i}(access_path,map)] $token]
+ }
+ return $tm
+} -cleanup {
+ safe::interpDelete $i
+} -result [::tcl::tm::path list]
+
+test safe-15.1 {safe file ensemble does not surprise code} -setup {
+ set i [interp create -safe]
+} -body {
+ set result [expr {"file" in [interp hidden $i]}]
+ lappend result [interp eval $i {tcl::file::split a/b/c}]
+ lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
+ lappend result [interp invokehidden $i file split a/b/c]
+ lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
+ lappend result [catch {interp invokehidden $i file isdirectory .}]
+ interp expose $i file
+ lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
+ lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg
+} -cleanup {
+ interp delete $i
+} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}}
+
+### ~ should have no special meaning in paths in safe interpreters
+test safe-16.1 {Bug 3529949: defang ~ in paths} -setup {
+ set savedHOME $env(HOME)
+ set env(HOME) /foo/bar
+ set i [safe::interpCreate]
+} -body {
+ $i eval {
+ set d [format %c 126]
+ list [file join [file dirname $d] [file tail $d]]
+ }
+} -cleanup {
+ safe::interpDelete $i
+ set env(HOME) $savedHOME
+} -result {./~}
+test safe-16.2 {Bug 3529949: defang ~user in paths} -setup {
+ set i [safe::interpCreate]
+ set user $tcl_platform(user)
+} -body {
+ string map [list $user USER] [$i eval \
+ "file join \[file dirname ~$user\] \[file tail ~$user\]"]
+} -cleanup {
+ safe::interpDelete $i
+} -result {./~USER}
+test safe-16.3 {Bug 3529949: defang ~ in globs} -setup {
+ set syntheticHOME [makeDirectory foo]
+ makeFile {} bar $syntheticHOME
+ set savedHOME $env(HOME)
+ set env(HOME) $syntheticHOME
+ set i [safe::interpCreate]
+} -body {
+ ::safe::interpAddToAccessPath $i $syntheticHOME
+ $i eval {glob -nocomplain ~/*}
+} -cleanup {
+ safe::interpDelete $i
+ set env(HOME) $savedHOME
+ removeDirectory $syntheticHOME
+} -result {}
+test safe-16.4 {Bug 3529949: defang ~user in globs} -setup {
+ set i [safe::interpCreate]
+} -body {
+ ::safe::interpAddToAccessPath $i $~$tcl_platform(user)
+ $i eval [list glob -nocomplain ~$tcl_platform(user)/*]
+} -cleanup {
+ safe::interpDelete $i
+} -result {}
set ::auto_path $saveAutoPath
# cleanup
diff --git a/tests/scan.test b/tests/scan.test
index 4296366..97ad5eb 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: scan.test,v 1.23 2008/12/10 18:21:47 ferrieux Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -330,7 +328,7 @@ test scan-4.60 {Tcl_ScanObjCmd, set errors} {
$msg $x $y]
unset z
set result
-} {1 {couldn't set variable "z"} abc ghi}
+} {1 {can't set "z": variable is array} abc ghi}
test scan-4.61 {Tcl_ScanObjCmd, set errors} {
set x {}
catch {unset y}; array set y {}
@@ -340,7 +338,7 @@ test scan-4.61 {Tcl_ScanObjCmd, set errors} {
unset y
unset z
set result
-} {1 {couldn't set variable "z"couldn't set variable "y"} abc}
+} {1 {can't set "z": variable is array} abc}
# procedure that returns the range of integers
@@ -547,27 +545,27 @@ test scan-8.12 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %d a} msg] $msg
-} {1 {couldn't set variable "a"}}
+} {1 {can't set "a": variable is array}}
test scan-8.13 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %c a} msg] $msg
-} {1 {couldn't set variable "a"}}
+} {1 {can't set "a": variable is array}}
test scan-8.14 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %s a} msg] $msg
-} {1 {couldn't set variable "a"}}
+} {1 {can't set "a": variable is array}}
test scan-8.15 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %f a} msg] $msg
-} {1 {couldn't set variable "a"}}
+} {1 {can't set "a": variable is array}}
test scan-8.16 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %f a} msg] $msg
-} {1 {couldn't set variable "a"}}
+} {1 {can't set "a": variable is array}}
catch {unset a}
test scan-8.17 {error conditions} {
list [catch {scan 44 %2c a} msg] $msg
@@ -755,11 +753,11 @@ testConstraint ieeeFloatingPoint [testIEEE]
# scan infinities - not working
-test scan-14.1 {infinity} ieeeFloatingPoint {
+test scan-14.1 {infinity} {
scan Inf %g d
set d
} Inf
-test scan-14.2 {infinity} ieeeFloatingPoint {
+test scan-14.2 {infinity} {
scan -Inf %g d
set d
} -Inf
diff --git a/tests/security.test b/tests/security.test
index 2549a4a..eeabc9c 100644
--- a/tests/security.test
+++ b/tests/security.test
@@ -1,18 +1,16 @@
# security.test --
#
-# Functionality covered: this file contains a collection of tests for the
-# auto loading and namespaces.
+# Functionality covered: this file contains a collection of tests for the auto
+# loading and namespaces.
#
-# Sourcing this file into Tcl runs the tests and generates output for
-# errors. No output means no errors were found.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
-#
-# RCS: @(#) $Id: security.test,v 1.6 2004/05/19 13:02:10 dkf Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest
namespace import -force ::tcltest::*
}
@@ -41,3 +39,7 @@ test security-1.1 {tcl_endOfPreviousWord} {
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/set-old.test b/tests/set-old.test
index de16d60..52dc0ff 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -12,8 +12,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: set-old.test,v 1.24 2010/02/04 13:49:55 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/set.test b/tests/set.test
index 76eab79..1d88553 100644
--- a/tests/set.test
+++ b/tests/set.test
@@ -9,14 +9,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: set.test,v 1.15 2008/02/13 20:35:03 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testset2 [llength [info commands testset2]]
catch {unset x}
diff --git a/tests/socket.test b/tests/socket.test
index 99ce29f..5542c09 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -9,8 +9,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: socket.test,v 1.43 2010/06/25 15:20:06 rmax Exp $
# Running socket tests with a remote server:
# ------------------------------------------
@@ -65,10 +63,32 @@
package require tcltest 2
namespace import -force ::tcltest::*
-# Some tests require the testthread and exec commands
-testConstraint testthread [llength [info commands testthread]]
+# Some tests require the Thread package or exec command
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint exec [llength [info commands exec]]
+# Produce a random port number in the Dynamic/Private range
+# from 49152 through 65535.
+proc randport {} { expr {int(rand()*16383+49152)} }
+
+# Test the latency of tcp connections over the loopback interface. Some OSes
+# (e.g. NetBSD) seem to use the Nagle algorithm and delayed ACKs, so it takes
+# up to 200ms for a packet sent to localhost to arrive. We're measuring this
+# here, so that OSes that don't have this problem can run the tests at full
+# speed.
+set server [socket -server {apply {{s a p} {set ::s1 $s}}} 0]
+set s2 [socket localhost [lindex [fconfigure $server -sockname] 2]]
+vwait s1; close $server
+fconfigure $s1 -buffering line
+fconfigure $s2 -buffering line
+set t1 [clock milliseconds]
+puts $s2 test1; gets $s1
+puts $s2 test2; gets $s1
+close $s1; close $s2
+set t2 [clock milliseconds]
+set latency [expr {($t2-$t1)*2}]; # doubled as a safety margin
+unset t1 t2 s1 s2 server
+
# If remoteServerIP or remoteServerPort are not set, check in the environment
# variables for externally set values.
#
@@ -79,7 +99,7 @@ if {![info exists remoteServerIP]} {
}
}
if {![info exists remoteServerPort]} {
- if {[info exists env(remoteServerIP)]} {
+ if {[info exists env(remoteServerPort)]} {
set remoteServerPort $env(remoteServerPort)
} else {
if {[info exists remoteServerIP]} {
@@ -88,16 +108,47 @@ if {![info exists remoteServerPort]} {
}
}
+if 0 {
+ # activate this to time the tests
+ proc test {args} {
+ set name [lindex $args 0]
+ puts "[lindex [time {uplevel [linsert $args 0 tcltest::test]}] 0] @@@ $name"
+ }
+}
+
+foreach {af localhost} {
+ inet 127.0.0.1
+ inet6 ::1
+} {
+ # Check if the family is supported and set the constraint accordingly
+ testConstraint supported_$af [expr {![catch {socket -server foo -myaddr $localhost 0} sock]}]
+ catch {close $sock}
+}
+testConstraint supported_any [expr {[testConstraint supported_inet] || [testConstraint supported_inet6]}]
+
+set sock [socket -server foo -myaddr localhost 0]
+set sockname [fconfigure $sock -sockname]
+close $sock
+testConstraint localhost_v4 [expr {"127.0.0.1" in $sockname}]
+testConstraint localhost_v6 [expr {"::1" in $sockname}]
+
+
+foreach {af localhost} {
+ any 127.0.0.1
+ inet 127.0.0.1
+ inet6 ::1
+} {
+ set ::tcl::unsupported::socketAF $af
#
# Check if we're supposed to do tests against the remote server
#
set doTestsWithRemoteServer 1
if {![info exists remoteServerIP]} {
- set remoteServerIP 127.0.0.1
+ set remoteServerIP $localhost
}
if {($doTestsWithRemoteServer == 1) && (![info exists remoteServerPort])} {
- set remoteServerPort 2048
+ set remoteServerPort [randport]
}
# Attempt to connect to a remote server if one is already running. If it is
@@ -119,7 +170,7 @@ if {$doTestsWithRemoteServer} {
set noRemoteTestReason "can't exec"
set doTestsWithRemoteServer 0
} else {
- set remoteServerIP 127.0.0.1
+ set remoteServerIP $localhost
# Be *extra* careful in case this file is sourced from
# a directory other than the current one...
set remoteFile [file join [pwd] [file dirname [info script]] \
@@ -129,7 +180,7 @@ if {$doTestsWithRemoteServer} {
[interpreter] $remoteFile -serverIsSilent \
-port $remoteServerPort -address $remoteServerIP]" w+]
} msg]} then {
- after 1000
+ gets $remoteProcChan
if {[catch {
set commandSocket [socket $remoteServerIP $remoteServerPort]
} msg] == 0} then {
@@ -173,73 +224,73 @@ if {[testConstraint doTestsWithRemoteServer]} {
error "remote server disappeared: $msg"
}
- set resp ""
while {1} {
set line [gets $commandSocket]
if {[eof $commandSocket]} {
error "remote server disappaered"
}
- if {[string compare $line "--Marker--Marker--Marker--"] == 0} {
- if {[string compare [lindex $resp 0] error] == 0} {
- error [lindex $resp 1]
- } else {
- return [lindex $resp 1]
- }
- } else {
- append resp $line "\n"
+ if {$line eq "--Marker--Marker--Marker--"} {
+ lassign $result code info value
+ return -code $code -errorinfo $info $value
}
+ append result $line "\n"
}
}
}
+
+proc getPort sock {
+ lindex [fconfigure $sock -sockname] 2
+}
+
# ----------------------------------------------------------------------
-test socket-1.1 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server
} -returnCodes error -result {no argument given for -server option}
-test socket-1.2 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server foo
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
-test socket-1.3 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.3 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -myaddr
} -returnCodes error -result {no argument given for -myaddr option}
-test socket-1.4 {arg parsing for socket command} -constraints socket -body {
- socket -myaddr 127.0.0.1
+test socket_$af-1.4 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+ socket -myaddr $localhost
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
-test socket-1.5 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.5 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -myport
} -returnCodes error -result {no argument given for -myport option}
-test socket-1.6 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.6 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -myport xxxx
} -returnCodes error -result {expected integer but got "xxxx"}
-test socket-1.7 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.7 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -myport 2522
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
-test socket-1.8 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.8 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -froboz
} -returnCodes error -result {bad option "-froboz": must be -async, -myaddr, -myport, or -server}
-test socket-1.9 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.9 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server foo -myport 2521 3333
} -returnCodes error -result {option -myport is not valid for servers}
-test socket-1.10 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.10 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket host 2528 -junk
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
-test socket-1.11 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.11 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server callback 2520 --
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
-test socket-1.12 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.12 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket foo badport
} -returnCodes error -result {expected integer but got "badport"}
-test socket-1.13 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.13 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -async -server
} -returnCodes error -result {cannot set -async option for server sockets}
-test socket-1.14 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.14 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server foo -async
} -returnCodes error -result {cannot set -async option for server sockets}
set path(script) [makeFile {} script]
-test socket-2.1 {tcp connection} -constraints {socket stdio} -setup {
+test socket_$af-2.1 {tcp connection} -constraints [list socket supported_$af stdio] -setup {
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -263,19 +314,15 @@ test socket-2.1 {tcp connection} -constraints {socket stdio} -setup {
gets $f listen
} -body {
# $x == "ready" at this point
- set sock [socket 127.0.0.1 $listen]
+ set sock [socket $localhost $listen]
lappend x [gets $f]
close $sock
lappend x [gets $f]
} -cleanup {
close $f
} -result {ready done {}}
-if {[info exists port]} {
- incr port
-} else {
- set port [expr {2048 + [pid]%1024}]
-}
-test socket-2.2 {tcp connection with client port specified} -setup {
+test socket_$af-2.2 {tcp connection with client port specified} -setup {
+ set port [randport]
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -297,31 +344,31 @@ test socket-2.2 {tcp connection with client port specified} -setup {
set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
gets $f listen
-} -constraints {socket stdio} -body {
+} -constraints [list socket supported_$af stdio] -body {
# $x == "ready" at this point
- global port
- set sock [socket -myport $port 127.0.0.1 $listen]
+ set sock [socket -myport $port $localhost $listen]
puts $sock hello
flush $sock
- lappend x [gets $f]
+ lappend x [expr {[gets $f] eq "hello $port"}]
close $sock
return $x
} -cleanup {
- catch {close [socket 127.0.0.1 $listen]}
+ catch {close [socket $localhost $listen]}
close $f
-} -result [list ready "hello $port"]
-test socket-2.3 {tcp connection with client interface specified} -setup {
+} -result {ready 1}
+test socket_$af-2.3 {tcp connection with client interface specified} -setup {
file delete $path(script)
set f [open $path(script) w]
puts $f {
set timer [after 2000 "set x done"]
- set f [socket -server accept 2830]
+ set f [socket -server accept 0]
proc accept {file addr port} {
global x
puts "[gets $file] $addr"
close $file
set x done
}
+ puts [lindex [fconfigure $f -sockname] 2]
puts ready
vwait x
after cancel $timer
@@ -329,10 +376,11 @@ test socket-2.3 {tcp connection with client interface specified} -setup {
}
close $f
set f [open "|[list [interpreter] $path(script)]" r]
+ gets $f listen
gets $f x
-} -constraints {socket stdio} -body {
+} -constraints [list socket supported_$af stdio] -body {
# $x == "ready" at this point
- set sock [socket -myaddr 127.0.0.1 127.0.0.1 2830]
+ set sock [socket -myaddr $localhost $localhost $listen]
puts $sock hello
flush $sock
lappend x [gets $f]
@@ -340,13 +388,14 @@ test socket-2.3 {tcp connection with client interface specified} -setup {
return $x
} -cleanup {
close $f
-} -result {ready {hello 127.0.0.1}}
-test socket-2.4 {tcp connection with server interface specified} -setup {
+} -result [list ready [list hello $localhost]]
+test socket_$af-2.4 {tcp connection with server interface specified} -setup {
file delete $path(script)
set f [open $path(script) w]
+ puts $f [list set localhost $localhost]
puts $f {
set timer [after 2000 "set x done"]
- set f [socket -server accept -myaddr 127.0.0.1 0]
+ set f [socket -server accept -myaddr $localhost 0]
proc accept {file addr port} {
global x
puts "[gets $file]"
@@ -363,9 +412,9 @@ test socket-2.4 {tcp connection with server interface specified} -setup {
set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
gets $f listen
-} -constraints {socket stdio} -body {
+} -constraints [list socket supported_$af stdio] -body {
# $x == "ready" at this point
- set sock [socket 127.0.0.1 $listen]
+ set sock [socket $localhost $listen]
puts $sock hello
flush $sock
lappend x [gets $f]
@@ -374,7 +423,7 @@ test socket-2.4 {tcp connection with server interface specified} -setup {
} -cleanup {
close $f
} -result {ready hello}
-test socket-2.5 {tcp connection with redundant server port} -setup {
+test socket_$af-2.5 {tcp connection with redundant server port} -setup {
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -396,9 +445,9 @@ test socket-2.5 {tcp connection with redundant server port} -setup {
set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
gets $f listen
-} -constraints {socket stdio} -body {
+} -constraints [list socket supported_$af stdio] -body {
# $x == "ready" at this point
- set sock [socket 127.0.0.1 $listen]
+ set sock [socket $localhost $listen]
puts $sock hello
flush $sock
lappend x [gets $f]
@@ -407,9 +456,9 @@ test socket-2.5 {tcp connection with redundant server port} -setup {
} -cleanup {
close $f
} -result {ready hello}
-test socket-2.6 {tcp connection} -constraints socket -body {
+test socket_$af-2.6 {tcp connection} -constraints [list socket supported_$af] -body {
set status ok
- if {![catch {set sock [socket 127.0.0.1 2833]}]} {
+ if {![catch {set sock [socket $localhost [randport]]}]} {
if {![catch {gets $sock}]} {
set status broken
}
@@ -417,7 +466,7 @@ test socket-2.6 {tcp connection} -constraints socket -body {
}
set status
} -result ok
-test socket-2.7 {echo server, one line} -constraints {socket stdio} -setup {
+test socket_$af-2.7 {echo server, one line} -constraints [list socket supported_$af stdio] -setup {
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -449,10 +498,9 @@ test socket-2.7 {echo server, one line} -constraints {socket stdio} -setup {
gets $f
gets $f listen
} -body {
- set s [socket 127.0.0.1 $listen]
+ set s [socket $localhost $listen]
fconfigure $s -buffering line -translation lf
puts $s "hello abcdefghijklmnop"
- after 1000
set x [gets $s]
close $s
list $x [gets $f]
@@ -460,7 +508,7 @@ test socket-2.7 {echo server, one line} -constraints {socket stdio} -setup {
close $f
} -result {{hello abcdefghijklmnop} done}
removeFile script
-test socket-2.8 {echo server, loop 50 times, single connection} -setup {
+test socket_$af-2.8 {echo server, loop 50 times, single connection} -setup {
set path(script) [makeFile {
set f [socket -server accept 0]
proc accept {s a p} {
@@ -491,8 +539,8 @@ test socket-2.8 {echo server, loop 50 times, single connection} -setup {
set f [open "|[list [interpreter] $path(script)]" r]
gets $f
gets $f listen
-} -constraints {socket stdio} -body {
- set s [socket 127.0.0.1 $listen]
+} -constraints [list socket supported_$af stdio] -body {
+ set s [socket $localhost $listen]
fconfigure $s -buffering line
catch {
for {set x 0} {$x < 50} {incr x} {
@@ -508,11 +556,12 @@ test socket-2.8 {echo server, loop 50 times, single connection} -setup {
removeFile script
} -result {done 50}
set path(script) [makeFile {} script]
-test socket-2.9 {socket conflict} -constraints {socket stdio} -body {
+test socket_$af-2.9 {socket conflict} -constraints [list socket supported_$af stdio] -body {
set s [socket -server accept 0]
file delete $path(script)
set f [open $path(script) w]
- puts -nonewline $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
+ puts $f [list set ::tcl::unsupported::socketAF $::tcl::unsupported::socketAF]
+ puts $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
close $f
set f [open "|[list [interpreter] $path(script)]" r]
gets $f
@@ -521,10 +570,10 @@ test socket-2.9 {socket conflict} -constraints {socket stdio} -body {
} -returnCodes error -cleanup {
close $s
} -match glob -result {couldn't open socket: address already in use*}
-test socket-2.10 {close on accept, accepted socket lives} -setup {
+test socket_$af-2.10 {close on accept, accepted socket lives} -setup {
set done 0
set timer [after 20000 "set done timed_out"]
-} -constraints socket -body {
+} -constraints [list socket supported_$af] -body {
set ss [socket -server accept 0]
proc accept {s a p} {
global ss
@@ -538,7 +587,7 @@ test socket-2.10 {close on accept, accepted socket lives} -setup {
close $s
set done 1
}
- set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+ set cs [socket $localhost [lindex [fconfigure $ss -sockname] 2]]
puts $cs hello
close $cs
vwait done
@@ -546,7 +595,7 @@ test socket-2.10 {close on accept, accepted socket lives} -setup {
} -cleanup {
after cancel $timer
} -result 1
-test socket-2.11 {detecting new data} -constraints socket -setup {
+test socket_$af-2.11 {detecting new data} -constraints [list socket supported_$af] -setup {
proc accept {s a p} {
global sock
set sock $s
@@ -554,18 +603,20 @@ test socket-2.11 {detecting new data} -constraints socket -setup {
set s [socket -server accept 0]
set sock ""
} -body {
- set s2 [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
+ set s2 [socket $localhost [lindex [fconfigure $s -sockname] 2]]
vwait sock
puts $s2 one
flush $s2
- after 500
+ after idle {set x 1}
+ vwait x
fconfigure $sock -blocking 0
set result a:[gets $sock]
lappend result b:[gets $sock]
fconfigure $sock -blocking 1
puts $s2 two
flush $s2
- after 500
+ after $latency {set x 1}; # NetBSD fails here if we do [after idle]
+ vwait x
fconfigure $sock -blocking 0
lappend result c:[gets $sock]
} -cleanup {
@@ -575,11 +626,12 @@ test socket-2.11 {detecting new data} -constraints socket -setup {
close $sock
} -result {a:one b: c:two}
-test socket-3.1 {socket conflict} -constraints {socket stdio} -setup {
+test socket_$af-3.1 {socket conflict} -constraints [list socket supported_$af stdio] -setup {
file delete $path(script)
set f [open $path(script) w]
+ puts $f [list set localhost $localhost]
puts $f {
- set f [socket -server accept -myaddr 127.0.0.1 0]
+ set f [socket -server accept -myaddr $localhost 0]
puts ready
puts [lindex [fconfigure $f -sockname] 2]
gets stdin
@@ -590,20 +642,21 @@ test socket-3.1 {socket conflict} -constraints {socket stdio} -setup {
gets $f
gets $f listen
} -body {
- socket -server accept -myaddr 127.0.0.1 $listen
+ socket -server accept -myaddr $localhost $listen
} -cleanup {
puts $f bye
close $f
} -returnCodes error -result {couldn't open socket: address already in use}
-test socket-3.2 {server with several clients} -setup {
+test socket_$af-3.2 {server with several clients} -setup {
file delete $path(script)
set f [open $path(script) w]
+ puts $f [list set localhost $localhost]
puts $f {
set t1 [after 30000 "set x timed_out"]
set t2 [after 31000 "set x timed_out"]
set t3 [after 32000 "set x timed_out"]
set counter 0
- set s [socket -server accept -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line
@@ -633,13 +686,13 @@ test socket-3.2 {server with several clients} -setup {
set f [open "|[list [interpreter] $path(script)]" r+]
set x [gets $f]
gets $f listen
-} -constraints {socket stdio} -body {
+} -constraints [list socket supported_$af stdio] -body {
# $x == "ready" here
- set s1 [socket 127.0.0.1 $listen]
+ set s1 [socket $localhost $listen]
fconfigure $s1 -buffering line
- set s2 [socket 127.0.0.1 $listen]
+ set s2 [socket $localhost $listen]
fconfigure $s2 -buffering line
- set s3 [socket 127.0.0.1 $listen]
+ set s3 [socket $localhost $listen]
fconfigure $s3 -buffering line
for {set i 0} {$i < 100} {incr i} {
puts $s1 hello,s1
@@ -657,12 +710,13 @@ test socket-3.2 {server with several clients} -setup {
close $f
} -result {ready done}
-test socket-4.1 {server with several clients} -setup {
+test socket_$af-4.1 {server with several clients} -setup {
file delete $path(script)
set f [open $path(script) w]
+ puts $f [list set localhost $localhost]
puts $f {
set port [gets stdin]
- set s [socket 127.0.0.1 $port]
+ set s [socket $localhost $port]
fconfigure $s -buffering line
for {set i 0} {$i < 100} {incr i} {
puts $s hello
@@ -679,7 +733,7 @@ test socket-4.1 {server with several clients} -setup {
fconfigure $p2 -buffering line
set p3 [open "|[list [interpreter] $path(script)]" r+]
fconfigure $p3 -buffering line
-} -constraints {socket stdio} -body {
+} -constraints [list socket supported_$af stdio] -body {
proc accept {s a p} {
fconfigure $s -buffering line
fileevent $s readable [list echo $s]
@@ -697,7 +751,7 @@ test socket-4.1 {server with several clients} -setup {
set t1 [after 30000 "set x timed_out"]
set t2 [after 31000 "set x timed_out"]
set t3 [after 32000 "set x timed_out"]
- set s [socket -server accept -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
set listen [lindex [fconfigure $s -sockname] 2]
puts $p1 $listen
puts $p2 $listen
@@ -721,34 +775,34 @@ test socket-4.1 {server with several clients} -setup {
close $p2
close $p3
} -result {{p1 bye done} {p2 bye done} {p3 bye done}}
-test socket-4.2 {byte order problems, socket numbers, htons} -body {
- close [socket -server dodo -myaddr 127.0.0.1 0x3000]
+test socket_$af-4.2 {byte order problems, socket numbers, htons} -body {
+ close [socket -server dodo -myaddr $localhost 0x3000]
return ok
-} -constraints socket -result ok
+} -constraints [list socket supported_$af] -result ok
-test socket-5.1 {byte order problems, socket numbers, htons} -body {
+test socket_$af-5.1 {byte order problems, socket numbers, htons} -body {
if {![catch {socket -server dodo 0x1} msg]} {
close $msg
return {htons problem, should be disallowed, are you running as SU?}
}
return {couldn't open socket: not owner}
-} -constraints {socket unix notRoot} -result {couldn't open socket: not owner}
-test socket-5.2 {byte order problems, socket numbers, htons} -body {
+} -constraints [list socket supported_$af unix notRoot] -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
return {port resolution problem, should be disallowed}
}
return {couldn't open socket: port number too high}
-} -constraints socket -result {couldn't open socket: port number too high}
-test socket-5.3 {byte order problems, socket numbers, htons} -body {
+} -constraints [list socket supported_$af] -result {couldn't open socket: port number too high}
+test socket_$af-5.3 {byte order problems, socket numbers, htons} -body {
if {![catch {socket -server dodo 21} msg]} {
close $msg
return {htons problem, should be disallowed, are you running as SU?}
}
return {couldn't open socket: not owner}
-} -constraints {socket unix notRoot} -result {couldn't open socket: not owner}
+} -constraints [list socket supported_$af unix notRoot] -result {couldn't open socket: not owner}
-test socket-6.1 {accept callback error} -constraints {socket stdio} -setup {
+test socket_$af-6.1 {accept callback error} -constraints [list socket supported_$af stdio] -setup {
proc myHandler {msg options} {
variable x $msg
}
@@ -757,14 +811,15 @@ test socket-6.1 {accept callback error} -constraints {socket stdio} -setup {
file delete $path(script)
} -body {
set f [open $path(script) w]
+ puts $f [list set localhost $localhost]
puts $f {
gets stdin port
- socket 127.0.0.1 $port
+ socket $localhost $port
}
close $f
set f [open "|[list [interpreter] $path(script)]" r+]
proc accept {s a p} {expr 10 / 0}
- set s [socket -server accept -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
puts $f [lindex [fconfigure $s -sockname] 2]
close $f
set timer [after 10000 "set x timed_out"]
@@ -776,7 +831,25 @@ test socket-6.1 {accept callback error} -constraints {socket stdio} -setup {
interp bgerror {} $handler
} -result {divide by zero}
-test socket-7.1 {testing socket specific options} -setup {
+test socket_$af-6.2 {
+ readable fileevent on server socket
+} -setup {
+ set sock [socket -server dummy 0]
+} -constraints [list socket supported_$af] -body {
+ fileevent $sock readable dummy
+} -cleanup {
+ close $sock
+} -returnCodes 1 -result "channel is not readable"
+
+test socket_$af-6.3 {writable fileevent on server socket} -setup {
+ set sock [socket -server dummy 0]
+} -constraints [list socket supported_$af] -body {
+ fileevent $sock writable dummy
+} -cleanup {
+ close $sock
+} -returnCodes 1 -result "channel is not writable"
+
+test socket_$af-7.1 {testing socket specific options} -setup {
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -796,21 +869,22 @@ test socket-7.1 {testing socket specific options} -setup {
gets $f
gets $f listen
set l ""
-} -constraints {socket stdio} -body {
- set s [socket 127.0.0.1 $listen]
+} -constraints [list socket supported_$af stdio] -body {
+ set s [socket $localhost $listen]
set p [fconfigure $s -peername]
close $s
- lappend l [string compare [lindex $p 0] 127.0.0.1]
+ lappend l [string compare [lindex $p 0] $localhost]
lappend l [string compare [lindex $p 2] $listen]
lappend l [llength $p]
} -cleanup {
close $f
} -result {0 0 3}
-test socket-7.2 {testing socket specific options} -setup {
+test socket_$af-7.2 {testing socket specific options} -setup {
file delete $path(script)
set f [open $path(script) w]
+ puts $f [list set ::tcl::unsupported::socketAF $::tcl::unsupported::socketAF]
puts $f {
- set ss [socket -server accept 2821]
+ set ss [socket -server accept 0]
proc accept args {
global x
set x done
@@ -825,35 +899,35 @@ test socket-7.2 {testing socket specific options} -setup {
set f [open "|[list [interpreter] $path(script)]" r]
gets $f
gets $f listen
-} -constraints {socket stdio} -body {
- set s [socket 127.0.0.1 $listen]
+} -constraints [list socket supported_$af stdio] -body {
+ set s [socket $localhost $listen]
set p [fconfigure $s -sockname]
close $s
list [llength $p] \
- [regexp {^(127\.0\.0\.1|0\.0\.0\.0)$} [lindex $p 0]] \
+ [regexp {^(127\.0\.0\.1|0\.0\.0\.0|::1)$} [lindex $p 0]] \
[expr {[lindex $p 2] == $listen}]
} -cleanup {
close $f
} -result {3 1 0}
-test socket-7.3 {testing socket specific options} -constraints socket -body {
- set s [socket -server accept -myaddr 127.0.0.1 0]
+test socket_$af-7.3 {testing socket specific options} -constraints [list socket supported_$af] -body {
+ set s [socket -server accept -myaddr $localhost 0]
set l [fconfigure $s]
close $s
update
llength $l
} -result 14
-test socket-7.4 {testing socket specific options} -constraints socket -setup {
+test socket_$af-7.4 {testing socket specific options} -constraints [list socket supported_$af] -setup {
set timer [after 10000 "set x timed_out"]
set l ""
} -body {
- set s [socket -server accept -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
proc accept {s a p} {
global x
set x [fconfigure $s -sockname]
close $s
}
set listen [lindex [fconfigure $s -sockname] 2]
- set s1 [socket 127.0.0.1 $listen]
+ set s1 [socket $localhost $listen]
vwait x
lappend l [expr {[lindex $x 2] == $listen}] [llength $x]
} -cleanup {
@@ -861,10 +935,10 @@ test socket-7.4 {testing socket specific options} -constraints socket -setup {
close $s
close $s1
} -result {1 3}
-test socket-7.5 {testing socket specific options} -setup {
+test socket_$af-7.5 {testing socket specific options} -setup {
set timer [after 10000 "set x timed_out"]
set l ""
-} -constraints {socket unixOrPc} -body {
+} -constraints [list socket supported_$af unixOrPc] -body {
set s [socket -server accept 0]
proc accept {s a p} {
global x
@@ -872,16 +946,16 @@ test socket-7.5 {testing socket specific options} -setup {
close $s
}
set listen [lindex [fconfigure $s -sockname] 2]
- set s1 [socket 127.0.0.1 $listen]
+ set s1 [socket $localhost $listen]
vwait x
lappend l [lindex $x 0] [expr {[lindex $x 2] == $listen}] [llength $x]
} -cleanup {
after cancel $timer
close $s
close $s1
-} -result {127.0.0.1 1 3}
+} -result [list $localhost 1 3]
-test socket-8.1 {testing -async flag on sockets} -constraints socket -body {
+test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket supported_$af] -body {
# NOTE: This test may fail on some Solaris 2.4 systems. If it does, check
# that you have these patches installed (using showrev -p):
#
@@ -896,14 +970,14 @@ test socket-8.1 {testing -async flag on sockets} -constraints socket -body {
# please email jyl@eng.sun.com. We have not observed this failure on
# Solaris 2.5, so another option (instead of installing these patches) is
# to upgrade to Solaris 2.5.
- set s [socket -server accept -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
proc accept {s a p} {
global x
puts $s bye
close $s
set x done
}
- set s1 [socket -async 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
+ set s1 [socket -async $localhost [lindex [fconfigure $s -sockname] 2]]
vwait x
gets $s1
} -cleanup {
@@ -911,7 +985,7 @@ test socket-8.1 {testing -async flag on sockets} -constraints socket -body {
close $s1
} -result bye
-test socket-9.1 {testing spurious events} -constraints socket -setup {
+test socket_$af-9.1 {testing spurious events} -constraints [list socket supported_$af] -setup {
set len 0
set spurious 0
set done 0
@@ -935,8 +1009,8 @@ test socket-9.1 {testing spurious events} -constraints socket -setup {
fconfigure $s -buffering none -blocking off
fileevent $s readable [list readlittle $s]
}
- set s [socket -server accept -myaddr 127.0.0.1 0]
- set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
+ set s [socket -server accept -myaddr $localhost 0]
+ set c [socket $localhost [lindex [fconfigure $s -sockname] 2]]
puts -nonewline $c 01234567890123456789012345678901234567890123456789
close $c
vwait done
@@ -945,7 +1019,7 @@ test socket-9.1 {testing spurious events} -constraints socket -setup {
} -cleanup {
after cancel $timer
} -result {0 50}
-test socket-9.2 {testing async write, fileevents, flush on close} -constraints socket -setup {
+test socket_$af-9.2 {testing async write, fileevents, flush on close} -constraints [list socket supported_$af] -setup {
set firstblock ""
for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}
set secondblock ""
@@ -953,7 +1027,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} -constraints s
set secondblock "b$secondblock$secondblock"
}
set timer [after 10000 "set done timed_out"]
- set l [socket -server accept -myaddr 127.0.0.1 0]
+ set l [socket -server accept -myaddr $localhost 0]
proc accept {s a p} {
fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
-buffering line
@@ -962,12 +1036,12 @@ test socket-9.2 {testing async write, fileevents, flush on close} -constraints s
proc readable {s} {
set l [gets $s]
fileevent $s readable {}
- after 1000 respond $s
+ after idle respond $s
}
proc respond {s} {
global firstblock
puts -nonewline $s $firstblock
- after 1000 writedata $s
+ after idle writedata $s
}
proc writedata {s} {
global secondblock
@@ -975,7 +1049,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} -constraints s
close $s
}
} -body {
- set s [socket 127.0.0.1 [lindex [fconfigure $l -sockname] 2]]
+ set s [socket $localhost [lindex [fconfigure $l -sockname] 2]]
fconfigure $s -blocking 0 -trans lf -buffering line
set count 0
puts $s hello
@@ -995,7 +1069,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} -constraints s
close $l
after cancel $timer
} -result 65566
-test socket-9.3 {testing EOF stickyness} -constraints socket -setup {
+test socket_$af-9.3 {testing EOF stickyness} -constraints [list socket supported_$af] -setup {
set count 0
set done false
proc write_then_close {s} {
@@ -1006,7 +1080,7 @@ test socket-9.3 {testing EOF stickyness} -constraints socket -setup {
fconfigure $s -buffering line -translation lf
fileevent $s writable "write_then_close $s"
}
- set s [socket -server accept -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
} -body {
proc count_to_eof {s} {
global count done
@@ -1026,7 +1100,7 @@ test socket-9.3 {testing EOF stickyness} -constraints socket -setup {
set count {timer went off, eof is not sticky}
close $s
}
- set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
+ set c [socket $localhost [lindex [fconfigure $s -sockname] 2]]
fconfigure $c -blocking off -buffering line -translation lf
fileevent $c readable "count_to_eof $c"
set timer [after 1000 timerproc $c]
@@ -1039,9 +1113,8 @@ test socket-9.3 {testing EOF stickyness} -constraints socket -setup {
removeFile script
-test socket-10.1 {testing socket accept callback error handling} -constraints {
- socket
-} -setup {
+test socket_$af-10.1 {testing socket accept callback error handling} \
+ -constraints [list socket supported_$af] -setup {
variable goterror 0
proc myHandler {msg options} {
variable goterror 1
@@ -1049,9 +1122,9 @@ test socket-10.1 {testing socket accept callback error handling} -constraints {
set handler [interp bgerror {}]
interp bgerror {} [namespace which myHandler]
} -body {
- set s [socket -server accept -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
proc accept {s a p} {close $s; error}
- set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
+ set c [socket $localhost [lindex [fconfigure $s -sockname] 2]]
vwait goterror
close $s
close $c
@@ -1060,55 +1133,53 @@ test socket-10.1 {testing socket accept callback error handling} -constraints {
interp bgerror {} $handler
} -result 1
-test socket-11.1 {tcp connection} -setup {
- sendCommand {
- set socket9_1_test_server [socket -server accept 2834]
+test socket_$af-11.1 {tcp connection} -setup {
+ set port [sendCommand {
+ set server [socket -server accept 0]
proc accept {s a p} {
puts $s done
close $s
}
- }
-} -constraints {socket doTestsWithRemoteServer} -body {
- set s [socket $remoteServerIP 2834]
+ getPort $server
+ }]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+ set s [socket $remoteServerIP $port]
gets $s
} -cleanup {
close $s
- sendCommand {close $socket9_1_test_server}
+ sendCommand {close $server}
} -result done
-test socket-11.2 {client specifies its port} -setup {
- if {[info exists port]} {
- incr port
- } else {
- set port [expr 2048 + [pid]%1024]
- }
- sendCommand {
- set socket9_2_test_server [socket -server accept 2835]
+test socket_$af-11.2 {client specifies its port} -setup {
+ set lport [randport]
+ set rport [sendCommand {
+ set server [socket -server accept 0]
proc accept {s a p} {
puts $s $p
close $s
}
- }
-} -constraints {socket doTestsWithRemoteServer} -body {
- set s [socket -myport $port $remoteServerIP 2835]
+ getPort $server
+ }]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+ set s [socket -myport $lport $remoteServerIP $rport]
set r [gets $s]
- expr {$r==$port ? "ok" : "broken: $r != $port"}
+ expr {$r==$lport ? "ok" : "broken: $r != $port"}
} -cleanup {
close $s
- sendCommand {close $socket9_2_test_server}
+ sendCommand {close $server}
} -result ok
-test socket-11.3 {trying to connect, no server} -body {
+test socket_$af-11.3 {trying to connect, no server} -body {
set status ok
- if {![catch {set s [socket $remoteServerIp 2836]}]} {
+ if {![catch {set s [socket $remoteServerIp [randport]]}]} {
if {![catch {gets $s}]} {
set status broken
}
close $s
}
return $status
-} -constraints {socket doTestsWithRemoteServer} -result ok
-test socket-11.4 {remote echo, one line} -setup {
- sendCommand {
- set socket10_6_test_server [socket -server accept 2836]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -result ok
+test socket_$af-11.4 {remote echo, one line} -setup {
+ set port [sendCommand {
+ set server [socket -server accept 0]
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line -translation crlf
@@ -1121,19 +1192,20 @@ test socket-11.4 {remote echo, one line} -setup {
puts $s $l
}
}
- }
-} -constraints {socket doTestsWithRemoteServer} -body {
- set f [socket $remoteServerIP 2836]
+ getPort $server
+ }]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+ set f [socket $remoteServerIP $port]
fconfigure $f -translation crlf -buffering line
puts $f hello
gets $f
} -cleanup {
catch {close $f}
- sendCommand {close $socket10_6_test_server}
+ sendCommand {close $server}
} -result hello
-test socket-11.5 {remote echo, 50 lines} -setup {
- sendCommand {
- set socket10_7_test_server [socket -server accept 2836]
+test socket_$af-11.5 {remote echo, 50 lines} -setup {
+ set port [sendCommand {
+ set server [socket -server accept 0]
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line -translation crlf
@@ -1146,9 +1218,10 @@ test socket-11.5 {remote echo, 50 lines} -setup {
puts $s $l
}
}
- }
-} -constraints {socket doTestsWithRemoteServer} -body {
- set f [socket $remoteServerIP 2836]
+ getPort $server
+ }]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+ set f [socket $remoteServerIP $port]
fconfigure $f -translation crlf -buffering line
for {set cnt 0} {$cnt < 50} {incr cnt} {
puts $f "hello, $cnt"
@@ -1159,19 +1232,19 @@ test socket-11.5 {remote echo, 50 lines} -setup {
return $cnt
} -cleanup {
close $f
- sendCommand {close $socket10_7_test_server}
+ sendCommand {close $server}
} -result 50
-test socket-11.6 {socket conflict} -setup {
- set s1 [socket -server accept -myaddr 127.0.0.1 2836]
-} -constraints {socket doTestsWithRemoteServer} -body {
- set s2 [socket -server accept -myaddr 127.0.0.1 2836]
- list [lindex [fconfigure $s2 -sockname] 2] [close $s2]
+test socket_$af-11.6 {socket conflict} -setup {
+ set s1 [socket -server accept -myaddr $localhost 0]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+ set s2 [socket -server accept -myaddr $localhost [getPort $s1]]
+ list [getPort $s2] [close $s2]
} -cleanup {
close $s1
} -returnCodes error -result {couldn't open socket: address already in use}
-test socket-11.7 {server with several clients} -setup {
- sendCommand {
- set socket10_9_test_server [socket -server accept 2836]
+test socket_$af-11.7 {server with several clients} -setup {
+ set port [sendCommand {
+ set server [socket -server accept 0]
proc accept {s a p} {
fconfigure $s -buffering line
fileevent $s readable [list echo $s]
@@ -1184,13 +1257,14 @@ test socket-11.7 {server with several clients} -setup {
puts $s $l
}
}
- }
-} -constraints {socket doTestsWithRemoteServer} -body {
- set s1 [socket $remoteServerIP 2836]
+ getPort $server
+ }]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+ set s1 [socket $remoteServerIP $port]
fconfigure $s1 -buffering line
- set s2 [socket $remoteServerIP 2836]
+ set s2 [socket $remoteServerIP $port]
fconfigure $s2 -buffering line
- set s3 [socket $remoteServerIP 2836]
+ set s3 [socket $remoteServerIP $port]
fconfigure $s3 -buffering line
for {set i 0} {$i < 100} {incr i} {
puts $s1 hello,s1
@@ -1205,22 +1279,23 @@ test socket-11.7 {server with several clients} -setup {
close $s1
close $s2
close $s3
- sendCommand {close $socket10_9_test_server}
+ sendCommand {close $server}
} -result 100
-test socket-11.8 {client with several servers} -setup {
- sendCommand {
- set s1 [socket -server "accept 4003" 4003]
- set s2 [socket -server "accept 4004" 4004]
- set s3 [socket -server "accept 4005" 4005]
+test socket_$af-11.8 {client with several servers} -setup {
+ lassign [sendCommand {
+ set s1 [socket -server "accept server1" 0]
+ set s2 [socket -server "accept server2" 0]
+ set s3 [socket -server "accept server3" 0]
proc accept {mp s a p} {
puts $s $mp
close $s
}
- }
-} -constraints {socket doTestsWithRemoteServer} -body {
- set s1 [socket $remoteServerIP 4003]
- set s2 [socket $remoteServerIP 4004]
- set s3 [socket $remoteServerIP 4005]
+ list [getPort $s1] [getPort $s2] [getPort $s3]
+ }] p1 p2 p3
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+ set s1 [socket $remoteServerIP $p1]
+ set s2 [socket $remoteServerIP $p2]
+ set s3 [socket $remoteServerIP $p3]
list [gets $s1] [gets $s1] [eof $s1] [gets $s2] [gets $s2] [eof $s2] \
[gets $s3] [gets $s3] [eof $s3]
} -cleanup {
@@ -1232,10 +1307,8 @@ test socket-11.8 {client with several servers} -setup {
close $s2
close $s3
}
-} -result {4003 {} 1 4004 {} 1 4005 {} 1}
-test socket-11.9 {accept callback error} -constraints {
- socket doTestsWithRemoteServer
-} -setup {
+} -result {server1 {} 1 server2 {} 1 server3 {} 1}
+test socket_$af-11.9 {accept callback error} -constraints [list socket supported_$af doTestsWithRemoteServer] -setup {
proc myHandler {msg options} {
variable x $msg
}
@@ -1243,12 +1316,13 @@ test socket-11.9 {accept callback error} -constraints {
interp bgerror {} [namespace which myHandler]
set timer [after 10000 "set x timed_out"]
} -body {
- set s [socket -server accept 2836]
- proc accept {s a p} {expr 10 / 0}
+ set s [socket -server accept 0]
+ proc accept {s a p} {expr {10 / 0}}
+ sendCommand "set port [getPort $s]"
if {[catch {
sendCommand {
set peername [fconfigure $callerSocket -peername]
- set s [socket [lindex $peername 0] 2836]
+ set s [socket [lindex $peername 0] $port]
close $s
}
} msg]} then {
@@ -1262,26 +1336,27 @@ test socket-11.9 {accept callback error} -constraints {
after cancel $timer
interp bgerror {} $handler
} -result {divide by zero}
-test socket-11.10 {testing socket specific options} -setup {
- sendCommand {
- set socket10_12_test_server [socket -server accept 2836]
+test socket_$af-11.10 {testing socket specific options} -setup {
+ set port [sendCommand {
+ set server [socket -server accept 0]
proc accept {s a p} {close $s}
- }
-} -constraints {socket doTestsWithRemoteServer} -body {
- set s [socket $remoteServerIP 2836]
+ getPort $server
+ }]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+ set s [socket $remoteServerIP $port]
set p [fconfigure $s -peername]
set n [fconfigure $s -sockname]
- list [lindex $p 2] [llength $p] [llength $n]
+ list [expr {[lindex $p 2] == $port}] [llength $p] [llength $n]
} -cleanup {
close $s
- sendCommand {close $socket10_12_test_server}
-} -result {2836 3 3}
-test socket-11.11 {testing spurious events} -setup {
- sendCommand {
- set socket10_13_test_server [socket -server accept 2836]
+ sendCommand {close $server}
+} -result {1 3 3}
+test socket_$af-11.11 {testing spurious events} -setup {
+ set port [sendCommand {
+ set server [socket -server accept 0]
proc accept {s a p} {
fconfigure $s -translation "auto lf"
- after 100 writesome $s
+ after idle writesome $s
}
proc writesome {s} {
for {set i 0} {$i < 100} {incr i} {
@@ -1289,12 +1364,13 @@ test socket-11.11 {testing spurious events} -setup {
}
close $s
}
- }
+ getPort $server
+ }]
set len 0
set spurious 0
set done 0
set timer [after 40000 "set done timed_out"]
-} -constraints {socket doTestsWithRemoteServer} -body {
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
proc readlittle {s} {
global spurious done len
set l [read $s 1]
@@ -1309,23 +1385,24 @@ test socket-11.11 {testing spurious events} -setup {
incr len [string length $l]
}
}
- set c [socket $remoteServerIP 2836]
+ set c [socket $remoteServerIP $port]
fileevent $c readable "readlittle $c"
vwait done
list $spurious $len $done
} -cleanup {
after cancel $timer
- sendCommand {close $socket10_13_test_server}
+ sendCommand {close $server}
} -result {0 2690 1}
-test socket-11.12 {testing EOF stickyness} -constraints {socket doTestsWithRemoteServer} -setup {
+test socket_$af-11.12 {testing EOF stickyness} -constraints [list socket supported_$af doTestsWithRemoteServer] -setup {
set counter 0
set done 0
- sendCommand {
- set socket10_14_test_server [socket -server accept 2836]
+ set port [sendCommand {
+ set server [socket -server accept 0]
proc accept {s a p} {
- after 100 close $s
+ after idle close $s
}
- }
+ getPort $server
+ }]
proc timed_out {} {
global c done
set done {timed_out, EOF is not sticky}
@@ -1344,16 +1421,16 @@ test socket-11.12 {testing EOF stickyness} -constraints {socket doTestsWithRemot
}
}
}
- set c [socket $remoteServerIP 2836]
+ set c [socket $remoteServerIP $port]
fileevent $c readable [list count_up $c]
vwait done
return $done
} -cleanup {
after cancel $after_id
- sendCommand {close $socket10_14_test_server}
+ sendCommand {close $server}
} -result {EOF is sticky}
-test socket-11.13 {testing async write, async flush, async close} -setup {
- sendCommand {
+test socket_$af-11.13 {testing async write, async flush, async close} -setup {
+ set port [sendCommand {
set firstblock ""
for {set i 0} {$i < 5} {incr i} {
set firstblock "a$firstblock$firstblock"
@@ -1362,7 +1439,7 @@ test socket-11.13 {testing async write, async flush, async close} -setup {
for {set i 0} {$i < 16} {incr i} {
set secondblock "b$secondblock$secondblock"
}
- set l [socket -server accept 2845]
+ set l [socket -server accept 0]
proc accept {s a p} {
fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
-buffering line
@@ -1371,21 +1448,22 @@ test socket-11.13 {testing async write, async flush, async close} -setup {
proc readable {s} {
set l [gets $s]
fileevent $s readable {}
- after 1000 respond $s
+ after idle respond $s
}
proc respond {s} {
global firstblock
puts -nonewline $s $firstblock
- after 1000 writedata $s
+ after idle writedata $s
}
proc writedata {s} {
global secondblock
puts -nonewline $s $secondblock
close $s
}
- }
+ getPort $l
+ }]
set timer [after 10000 "set done timed_out"]
-} -constraints {socket doTestsWithRemoteServer} -body {
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
proc readit {s} {
global count done
set l [read $s]
@@ -1395,7 +1473,7 @@ test socket-11.13 {testing async write, async flush, async close} -setup {
set done 1
}
}
- set s [socket $remoteServerIP 2845]
+ set s [socket $remoteServerIP $port]
fconfigure $s -blocking 0 -trans lf -buffering line
set count 0
puts $s hello
@@ -1410,57 +1488,56 @@ test socket-11.13 {testing async write, async flush, async close} -setup {
set path(script1) [makeFile {} script1]
set path(script2) [makeFile {} script2]
-test socket-12.1 {testing inheritance of server sockets} -setup {
+test socket_$af-12.1 {testing inheritance of server sockets} -setup {
file delete $path(script1)
file delete $path(script2)
# Script1 is just a 10 second delay. If the server socket is inherited, it
# will be held open for 10 seconds
set f [open $path(script1) w]
puts $f {
+ fileevent stdin readable exit
after 10000 exit
vwait forever
}
close $f
- # Script2 creates the server socket, launches script1, waits a second, and
- # exits. The server socket will now be closed unless script1 inherited it.
+ # Script2 creates the server socket, launches script1, and exits.
+ # The server socket will now be closed unless script1 inherited it.
set f [open $path(script2) w]
puts $f [list set tcltest [interpreter]]
puts $f [list set delay $path(script1)]
+ puts $f [list set localhost $localhost]
puts $f {
- set f [socket -server accept -myaddr 127.0.0.1 0]
- puts [lindex [fconfigure $f -sockname] 2]
+ set f [socket -server accept -myaddr $localhost 0]
proc accept { file addr port } {
close $file
}
exec $tcltest $delay &
+ puts [lindex [fconfigure $f -sockname] 2]
close $f
- after 1000 exit
- vwait forever
+ exit
}
close $f
-} -constraints {socket stdio exec} -body {
+} -constraints [list socket supported_$af stdio exec] -body {
# Launch script2 and wait 5 seconds
### exec [interpreter] script2 &
set p [open "|[list [interpreter] $path(script2)]" r]
- gets $p listen
- after 5000 { set ok_to_proceed 1 }
- vwait ok_to_proceed
# If we can still connect to the server, the socket got inherited.
- if {[catch {close [socket 127.0.0.1 $listen]}]} {
+ if {[catch {close [socket $localhost $listen]}]} {
return {server socket was not inherited}
} else {
return {server socket was inherited}
}
} -cleanup {
- close $p
+ catch {close $p}
} -result {server socket was not inherited}
-test socket-12.2 {testing inheritance of client sockets} -setup {
+test socket_$af-12.2 {testing inheritance of client sockets} -setup {
file delete $path(script1)
file delete $path(script2)
# Script1 is just a 20 second delay. If the server socket is inherited, it
# will be held open for 20 seconds
set f [open $path(script1) w]
puts $f {
+ fileevent stdin readable exit
after 20000 exit
vwait forever
}
@@ -1471,23 +1548,23 @@ test socket-12.2 {testing inheritance of client sockets} -setup {
set f [open $path(script2) w]
puts $f [list set tcltest [interpreter]]
puts $f [list set delay $path(script1)]
+ puts $f [list set localhost $localhost]
puts $f {
gets stdin port
- set f [socket 127.0.0.1 $port]
+ set f [socket $localhost $port]
exec $tcltest $delay &
puts $f testing
flush $f
- after 1000 exit
- vwait forever
+ exit
}
close $f
# If the socket doesn't hit end-of-file in 10 seconds, the script1 process
# must have inherited the client.
set failed 0
- after 10000 [list set failed 1]
-} -constraints {socket stdio exec} -body {
+ set after [after 10000 [list set failed 1]]
+} -constraints [list socket supported_$af stdio exec] -body {
# Create the server socket
- set server [socket -server accept -myaddr 127.0.0.1 0]
+ set server [socket -server accept -myaddr $localhost 0]
proc accept { file host port } {
# When the client connects, establish the read handler
global server
@@ -1523,16 +1600,15 @@ test socket-12.2 {testing inheritance of client sockets} -setup {
vwait x
return $x
} -cleanup {
- if {!$failed} {
- vwait failed
- }
+ after cancel $after
close $p
} -result {client socket was not inherited}
-test socket-12.3 {testing inheritance of accepted sockets} -setup {
+test socket_$af-12.3 {testing inheritance of accepted sockets} -setup {
file delete $path(script1)
file delete $path(script2)
set f [open $path(script1) w]
puts $f {
+ fileevent stdin readable exit
after 10000 exit
vwait forever
}
@@ -1540,33 +1616,32 @@ test socket-12.3 {testing inheritance of accepted sockets} -setup {
set f [open $path(script2) w]
puts $f [list set tcltest [interpreter]]
puts $f [list set delay $path(script1)]
+ puts $f [list set localhost $localhost]
puts $f {
- set server [socket -server accept -myaddr 127.0.0.1 0]
- puts stdout [lindex [fconfigure $server -sockname] 2]
+ set server [socket -server accept -myaddr $localhost 0]
proc accept { file host port } {
global tcltest delay
puts $file {test data on socket}
exec $tcltest $delay &
- after 1000 exit
+ after idle exit
}
+ puts stdout [lindex [fconfigure $server -sockname] 2]
vwait forever
}
close $f
-} -constraints {socket stdio exec} -body {
+} -constraints [list socket supported_$af stdio exec] -body {
# Launch the script2 process and connect to it. See how long the socket
# stays open
## exec [interpreter] script2 &
set p [open "|[list [interpreter] $path(script2)]" r]
gets $p listen
- after 1000 set ok_to_proceed 1
- vwait ok_to_proceed
- set f [socket 127.0.0.1 $listen]
+ set f [socket $localhost $listen]
fconfigure $f -buffering full -blocking 0
fileevent $f readable [list getdata $f]
# If the socket is still open after 5 seconds, the script1 process must
# have inherited the accepted socket.
set failed 0
- after 5000 set failed 1
+ set after [after 5000 [list set failed 1]]
proc getdata { file } {
# Read handler on the client socket.
global x
@@ -1593,13 +1668,14 @@ test socket-12.3 {testing inheritance of accepted sockets} -setup {
vwait x
return $x
} -cleanup {
+ after cancel $after
catch {close $p}
} -result {accepted socket was not inherited}
-test socket-13.1 {Testing use of shared socket between two threads} -setup {
- threadReap
- set path(script) [makeFile {
- set f [socket -server accept -myaddr 127.0.0.1 0]
+test socket_$af-13.1 {Testing use of shared socket between two threads} -body {
+ # create a thread
+ set serverthread [thread::create -preserved [string map [list @localhost@ $localhost] {
+ set f [socket -server accept -myaddr @localhost@ 0]
set listen [lindex [fconfigure $f -sockname] 2]
proc accept {s a p} {
fileevent $s readable [list echo $s]
@@ -1620,29 +1696,19 @@ test socket-13.1 {Testing use of shared socket between two threads} -setup {
set i 0
vwait x
close $f
- # thread cleans itself up.
- testthread exit
- } script]
-} -constraints {socket testthread} -body {
- # create a thread
- set serverthread [testthread create [list source $path(script) ] ]
- update
- set port [testthread send $serverthread {set listen}]
- update
- after 1000
- set s [socket 127.0.0.1 $port]
+ thread::wait
+ }]]
+ set port [thread::send $serverthread {set listen}]
+ set s [socket $localhost $port]
fconfigure $s -buffering line
catch {
puts $s "hello"
gets $s result
}
close $s
- update
- after 2000
- append result " " [threadReap]
-} -cleanup {
- removeFile script
-} -result {hello 1}
+ thread::release $serverthread
+ append result " " [llength [thread::names]]
+} -result {hello 1} -constraints [list socket supported_$af thread]
# ----------------------------------------------------------------------
@@ -1650,11 +1716,140 @@ removeFile script1
removeFile script2
# cleanup
-if {[string match sock* $commandSocket] == 1} {
+if {$remoteProcChan ne ""} {
catch {sendCommand exit}
}
catch {close $commandSocket}
catch {close $remoteProcChan}
+}
+unset ::tcl::unsupported::socketAF
+test socket-14.0 {[socket -async] when server only listens on IPv4} \
+ -constraints [list socket supported_any localhost_v4] \
+ -setup {
+ proc accept {s a p} {
+ global x
+ puts $s bye
+ close $s
+ set x ok
+ }
+ set server [socket -server accept -myaddr 127.0.0.1 0]
+ set port [lindex [fconfigure $server -sockname] 2]
+ } -body {
+ set client [socket -async localhost $port]
+ set after [after 1000 {set x [fconfigure $client -error]}]
+ vwait x
+ set x
+ } -cleanup {
+ after cancel $after
+ close $server
+ close $client
+ unset x
+ } -result ok
+test socket-14.1 {[socket -async] fileevent while still connecting} \
+ -constraints [list socket supported_any] \
+ -setup {
+ proc accept {s a p} {
+ global x
+ puts $s bye
+ close $s
+ lappend x ok
+ }
+ set server [socket -server accept -myaddr localhost 0]
+ set port [lindex [fconfigure $server -sockname] 2]
+ set x ""
+ } -body {
+ set client [socket -async localhost $port]
+ fileevent $client writable {
+ lappend x [fconfigure $client -error]
+ fileevent $client writable {}
+ }
+ set after [after 1000 {lappend x timeout}]
+ while {[llength $x] < 2 && "timeout" ni $x} {
+ vwait x
+ }
+ lsort $x; # we only want to see both events, the order doesn't matter
+ } -cleanup {
+ after cancel $after
+ close $server
+ close $client
+ unset x
+ } -result {{} ok}
+test socket-14.2 {[socket -async] fileevent connection refused} \
+ -constraints [list socket supported_any] \
+ -body {
+ if {[catch {socket -async localhost [randport]} client]} {
+ regexp {[^:]*: (.*)} $client -> x
+ } else {
+ fileevent $client writable {set x [fconfigure $client -error]}
+ set after [after 1000 {set x timeout}]
+ vwait x
+ after cancel $after
+ if {$x eq "timeout"} {
+ append x ": [fconfigure $client -error]"
+ }
+ close $client
+ }
+ set x
+ } -cleanup {
+ unset x
+ } -result "connection refused"
+test socket-14.3 {[socket -async] when server only listens on IPv6} \
+ -constraints [list socket supported_any localhost_v6] \
+ -setup {
+ proc accept {s a p} {
+ global x
+ puts $s bye
+ close $s
+ set x ok
+ }
+ set server [socket -server accept -myaddr ::1 0]
+ set port [lindex [fconfigure $server -sockname] 2]
+ } -body {
+ set client [socket -async localhost $port]
+ set after [after 1000 {set x [fconfigure $client -error]}]
+ vwait x
+ set x
+ } -cleanup {
+ after cancel $after
+ close $server
+ close $client
+ unset x
+ } -result ok
+test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \
+ -constraints [list socket supported_any] \
+ -setup {
+ proc accept {s a p} {
+ puts $s bye
+ close $s
+ }
+ set server [socket -server accept -myaddr localhost 0]
+ set port [lindex [fconfigure $server -sockname] 2]
+ set x ""
+ } -body {
+ set client [socket -async localhost $port]
+ fileevent $client writable {
+ lappend x [fconfigure $client -error]
+ fileevent $client writable {}
+ }
+ fileevent $client readable {lappend x [gets $client]}
+ set after [after 1000 {lappend x timeout}]
+ while {[llength $x] < 2 && "timeout" ni $x} {
+ vwait x
+ }
+ lsort $x
+ } -cleanup {
+ after cancel $after
+ close $client
+ close $server
+ } -result {{} bye}
+test socket-14.5 {[socket -async] which fails before any connect() can be made} \
+ -constraints [list socket supported_any] \
+ -body {
+ # address from rfc5737
+ socket -async -myaddr 192.0.2.42 127.0.0.1 [randport]
+ } \
+ -returnCodes 1 \
+ -result {couldn't open socket: cannot assign requested address}
::tcltest::cleanupTests
flush stdout
return
diff --git a/tests/source.test b/tests/source.test
index f358042..d71212d 100644
--- a/tests/source.test
+++ b/tests/source.test
@@ -11,8 +11,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: source.test,v 1.14 2009/01/05 11:27:41 dkf Exp $
if {[catch {package require tcltest 2.1}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
@@ -109,6 +107,19 @@ test source-2.6 {source error conditions} -setup {
} -match listGlob -result [list 1 \
{couldn't read file "*_non_existent_": no such file or directory} \
{POSIX ENOENT {no such file or directory}}]
+test source-2.7 {utf-8 with BOM} -setup {
+ set sourcefile [makeFile {} source.file]
+} -body {
+ set out [open $sourcefile w]
+ fconfigure $out -encoding utf-8
+ puts $out "\ufeffset y new-y"
+ close $out
+ set y old-y
+ source -encoding utf-8 $sourcefile
+ return $y
+} -cleanup {
+ removeFile $sourcefile
+} -result {new-y}
test source-3.1 {return in middle of source file} -setup {
set sourcefile [makeFile {
@@ -288,4 +299,4 @@ return
# Local Variables:
# mode: tcl
-# End: \ No newline at end of file
+# End:
diff --git a/tests/split.test b/tests/split.test
index 1cc13b7..778131f 100644
--- a/tests/split.test
+++ b/tests/split.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: split.test,v 1.10 2009/01/08 16:41:35 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/stack.test b/tests/stack.test
index da587b5..873cb08 100644
--- a/tests/stack.test
+++ b/tests/stack.test
@@ -8,8 +8,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: stack.test,v 1.25 2008/10/03 19:20:24 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
diff --git a/tests/string.test b/tests/string.test
index 39b12ff..f558d30 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -11,14 +11,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: string.test,v 1.78 2010/03/01 23:25:43 ferrieux Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Some tests require the testobj command
testConstraint testobj [expr {[info commands testobj] != {}}]
@@ -314,10 +315,10 @@ test string-6.4 {string is, too many args} {
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.5 {string is, class check} {
list [catch {string is bogus str} msg] $msg
-} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
+} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.6 {string is, ambiguous class} {
list [catch {string is al str} msg] $msg
-} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
+} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.7 {string is alpha, all ok} {
string is alpha -strict -failindex var abc
} 1
@@ -594,7 +595,7 @@ test string-6.90 {string is integer, bad integers} {
foreach num $numbers {
lappend result [string is int -strict $num]
}
- set result
+ return $result
} {1 1 0 0 0 1 0 0}
test string-6.91 {string is double, bad doubles} {
set result ""
@@ -602,20 +603,20 @@ test string-6.91 {string is double, bad doubles} {
foreach num $numbers {
lappend result [string is double -strict $num]
}
- set result
+ return $result
} {1 1 0 0 0 1 0 0}
-test string-6.92 {string is double, 32-bit overflow} {
+test string-6.92 {string is integer, 32-bit overflow} {
# Bug 718878
set x 0x100000000
list [string is integer -failindex var $x] $var
} {0 -1}
-test string-6.93 {string is double, 32-bit overflow} {
+test string-6.93 {string is integer, 32-bit overflow} {
# Bug 718878
set x 0x100000000
append x ""
list [string is integer -failindex var $x] $var
} {0 -1}
-test string-6.94 {string is double, 32-bit overflow} {
+test string-6.94 {string is integer, 32-bit overflow} {
# Bug 718878
set x 0x100000000
list [string is integer -failindex var [expr {$x}]] $var
@@ -666,7 +667,7 @@ test string-6.107 {string is integer, bad integers} {
foreach num $numbers {
lappend result [string is wideinteger -strict $num]
}
- set result
+ return $result
} {1 1 0 0 0 1 0 0}
test string-6.108 {string is double, Bug 1382287} {
set x 2turtledoves
@@ -676,6 +677,78 @@ test string-6.108 {string is double, Bug 1382287} {
test string-6.109 {string is double, Bug 1360532} {
string is double 1\u00a0
} 0
+test string-6.110 {string is entier, true} {
+ string is entier +1234567890
+} 1
+test string-6.111 {string is entier, true on type} {
+ string is entier [expr wide(50.0)]
+} 1
+test string-6.112 {string is entier, true} {
+ string is entier [list -10]
+} 1
+test string-6.113 {string is entier, true as hex} {
+ string is entier 0xabcdef
+} 1
+test string-6.114 {string is entier, true as octal} {
+ string is entier 0123456
+} 1
+test string-6.115 {string is entier, true with whitespace} {
+ string is entier " \n1234\v"
+} 1
+test string-6.116 {string is entier, false} {
+ list [string is entier -fail var 123abc] $var
+} {0 3}
+test string-6.117 {string is entier, false} {
+ list [string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc] $var
+} {0 84}
+test string-6.118 {string is entier, false} {
+ list [string is entier -fail var [expr double(1)]] $var
+} {0 1}
+test string-6.119 {string is entier, false} {
+ list [string is entier -fail var " "] $var
+} {0 0}
+test string-6.120 {string is entier, false on bad octal} {
+ list [string is entier -fail var 0o36963] $var
+} {0 4}
+test string-6.121.1 {string is entier, false on bad octal} {
+ list [string is entier -fail var 0o36963] $var
+} {0 4}
+test string-6.122 {string is entier, false on bad hex} {
+ list [string is entier -fail var 0X345XYZ] $var
+} {0 5}
+test string-6.123 {string is entier, bad integers} {
+ # SF bug #634856
+ set result ""
+ set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
+ foreach num $numbers {
+ lappend result [string is entier -strict $num]
+ }
+ return $result
+} {1 1 0 0 0 1 0 0}
+test string-6.124 {string is entier, true} {
+ string is entier +1234567890123456789012345678901234567890
+} 1
+test string-6.125 {string is entier, true} {
+ string is entier [list -10000000000000000000000000000000000000000000000000000000000000000000000000000000000000]
+} 1
+test string-6.126 {string is entier, true as hex} {
+ string is entier 0xabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdef
+} 1
+test string-6.127 {string is entier, true as octal} {
+ string is entier 0123456112341234561234565623456123456123456123456123456123456123456123456123456123456
+} 1
+test string-6.128 {string is entier, true with whitespace} {
+ string is entier " \n12340000000000000000000000000000000000000000000000000000000000000000000000000000000000000\v"
+} 1
+test string-6.129 {string is entier, false on bad octal} {
+ list [string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963] $var
+} {0 87}
+test string-6.130.1 {string is entier, false on bad octal} {
+ list [string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963] $var
+} {0 87}
+test string-6.131 {string is entier, false on bad hex} {
+ list [string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ] $var
+} {0 88}
catch {rename largest_int {}}
@@ -1411,8 +1484,8 @@ test string-18.11 {string trim, unicode} {
string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8
} " AB\xe7C "
test string-18.12 {string trim, unicode default} {
- string trim ABC\u1361\u1680\u3000
-} ABC
+ string trim \ufeff\x00\u0085\u00a0\u1680\u180eABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000
+} ABC\u1361
test string-19.1 {string trimleft} {
list [catch {string trimleft} msg] $msg
@@ -1421,8 +1494,8 @@ test string-19.2 {string trimleft} {
string trimleft " XYZ "
} {XYZ }
test string-19.3 {string trimleft, unicode default} {
- string trimleft \u1361\u1680\u3000ABC
-} ABC
+ string trimleft \ufeff\u0085\u00a0\x00\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000\u1361ABC
+} \u1361ABC
test string-20.1 {string trimright errors} {
list [catch {string trimright} msg] $msg
@@ -1440,8 +1513,8 @@ test string-20.5 {string trimright} {
string trimright ""
} {}
test string-20.6 {string trimright, unicode default} {
- string trimright ABC\u1361\u1680\u3000
-} ABC
+ string trimright ABC\u1361\u0085\x00\u00a0\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000
+} ABC\u1361
test string-21.1 {string wordend} {
list [catch {string wordend a} msg] $msg
@@ -1620,6 +1693,22 @@ test string-24.11 {string reverse command - corner case} {
set y \udead
string reverse $x$y
} \udead\ubeef
+test string-24.12 {string reverse command - corner case} {
+ set x \ubeef
+ set y \udead
+ string is ascii [string reverse $x$y]
+} 0
+test string-24.13 {string reverse command - pure Unicode string} {
+ string reverse [string range \ubeef\udead\ubeef\udead\ubeef\udead 1 5]
+} \udead\ubeef\udead\ubeef\udead
+test string-24.14 {string reverse command - pure bytearray} {
+ binary scan [string reverse [binary format H* 010203]] H* x
+ set x
+} 030201
+test string-24.15 {string reverse command - pure bytearray} {
+ binary scan [tcl::string::reverse [binary format H* 010203]] H* x
+ set x
+} 030201
test string-25.1 {string is list} {
string is list {a b c}
@@ -1687,10 +1776,10 @@ test string-26.3.1 {tcl::prefix, bad args} -body {
} -returnCodes 1 -result {error options must have an even number of elements}
test string-26.3.2 {tcl::prefix, bad args} -body {
tcl::prefix match -error str1 str2
-} -returnCodes 1 -result {missing error options}
+} -returnCodes 1 -result {missing value for -error}
test string-26.4 {tcl::prefix, bad args} -body {
tcl::prefix match -message str1 str2
-} -returnCodes 1 -result {missing message}
+} -returnCodes 1 -result {missing value for -message}
test string-26.5 {tcl::prefix} {
tcl::prefix match {apa bepa cepa depa} cepa
} cepa
diff --git a/tests/stringComp.test b/tests/stringComp.test
index 6ef94ee..9e00ce7 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -14,18 +14,19 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: stringComp.test,v 1.18 2010/09/25 02:25:54 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Some tests require the testobj command
testConstraint testobj [expr {[info commands testobj] != {}}]
-
+
test stringComp-1.1 {error conditions} {
proc foo {} {string gorp a b}
list [catch {foo} msg] $msg
@@ -676,7 +677,11 @@ test stringComp-11.54 {string match, failure} {
} {0 1 1 1 0 0}
## string range
-## not yet bc
+test stringComp-12.1 {Bug 3588366: end-offsets before start} {
+ apply {s {
+ string range $s 0 end-5
+ }} 12345
+} {}
## string repeat
## not yet bc
@@ -698,8 +703,12 @@ test stringComp-11.54 {string match, failure} {
## string word*
## not yet bc
-
+
# cleanup
catch {rename foo {}}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 921deef..6f331d3 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -11,14 +11,15 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: stringObj.test,v 1.22 2009/03/21 02:55:49 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testobj [llength [info commands testobj]]
testConstraint testdstring [llength [info commands testdstring]]
@@ -446,35 +447,35 @@ test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj {
teststringobj get 1
} {bar}
-test stringObj-15.1 {Tcl_Append*ToObj: self appends} {
+test stringObj-15.1 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself 1 0
} foofoo
-test stringObj-15.2 {Tcl_Append*ToObj: self appends} {
+test stringObj-15.2 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself 1 1
} foooo
-test stringObj-15.3 {Tcl_Append*ToObj: self appends} {
+test stringObj-15.3 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself 1 2
} fooo
-test stringObj-15.4 {Tcl_Append*ToObj: self appends} {
+test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself 1 3
} foo
-test stringObj-15.5 {Tcl_Append*ToObj: self appends} {
+test stringObj-15.5 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself2 1 0
} foofoo
-test stringObj-15.6 {Tcl_Append*ToObj: self appends} {
+test stringObj-15.6 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself2 1 1
} foooo
-test stringObj-15.7 {Tcl_Append*ToObj: self appends} {
+test stringObj-15.7 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself2 1 2
} fooo
-test stringObj-15.8 {Tcl_Append*ToObj: self appends} {
+test stringObj-15.8 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself2 1 3
} foo
diff --git a/tests/subst.test b/tests/subst.test
index 1b9ccf6..4be4798 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: subst.test,v 1.20 2010/04/08 13:26:25 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -271,6 +269,30 @@ test subst-12.7 {nasty case with compilation} {
set y unset
list [eval [list subst {[set x 1;continue;incr x][set y $x]}]] $x $y
} {1 1 1}
+
+test subst-13.1 {Bug 3081065} -setup {
+ set script [makeFile {
+ proc demo {string} {
+ subst $string
+ }
+ demo name2
+ } subst13.tcl]
+} -body {
+ interp create slave
+ slave eval [list source $script]
+ interp delete slave
+ interp create slave
+ slave eval {
+ set count 400
+ while {[incr count -1]} {
+ lappend bloat [expr {rand()}]
+ }
+ }
+ slave eval [list source $script]
+ interp delete slave
+} -cleanup {
+ removeFile subst13.tcl
+}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/switch.test b/tests/switch.test
index 738565f..a03948b 100644
--- a/tests/switch.test
+++ b/tests/switch.test
@@ -10,14 +10,12 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: switch.test,v 1.25 2009/07/14 16:52:28 kennykb Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-
+
test switch-1.1 {simple patterns} {
switch a a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 1
@@ -538,7 +536,7 @@ test switch-11.6 {-matchvar unwritable} {
test switch-12.1 {regexp matching with -indexvar} {
switch -regexp -indexvar x -- abc {.(.). {set x}}
-} {{0 3} {1 2}}
+} {{0 2} {1 1}}
test switch-12.2 {regexp matching with -indexvar} {
set x GOOD
switch -regexp -indexvar x -- abc {.(.).. {list $x z}}
@@ -546,7 +544,7 @@ test switch-12.2 {regexp matching with -indexvar} {
} GOOD
test switch-12.3 {regexp matching with -indexvar} {
switch -regexp -indexvar x -- "a b c" {.(.). {set x}}
-} {{0 3} {1 2}}
+} {{0 2} {1 1}}
test switch-12.4 {regexp matching with -indexvar} {
set x BAD
switch -regexp -indexvar x -- "a b c" {
@@ -562,22 +560,32 @@ test switch-12.6 {-indexvar unwritable} {
set x {}
list [catch {switch -regexp -indexvar x(x) -- abc . {set x}} msg] $x $msg
} {1 {} {can't set "x(x)": variable isn't array}}
+test switch-12.7 {[Bug 3106532] -indexvar should be directly usable with [string range]} {
+ set str abcdef
+ switch -regexp -indexvar x -- $str ^... {string range $str {*}[lindex $x 0]}
+} abc
+test switch-12.8 {-indexvar and matched empty strings} {
+ switch -regexp -indexvar x -- abcdef ^...(x?) {return $x}
+} {{0 2} {3 2}}
+test switch-12.9 {-indexvar and unmatched strings} {
+ switch -regexp -indexvar x -- abcdef ^...(x)? {return $x}
+} {{0 2} {-1 -1}}
test switch-13.1 {-indexvar -matchvar combinations} {
switch -regexp -indexvar x -matchvar y abc {
. {list $x $y}
}
-} {{{0 1}} a}
+} {{{0 0}} a}
test switch-13.2 {-indexvar -matchvar combinations} {
switch -regexp -indexvar x -matchvar y abc {
.$ {list $x $y}
}
-} {{{2 3}} c}
+} {{{2 2}} c}
test switch-13.3 {-indexvar -matchvar combinations} {
switch -regexp -indexvar x -matchvar y abc {
(.)(.)(.) {list $x $y}
}
-} {{{0 3} {0 1} {1 2} {2 3}} {abc a b c}}
+} {{{0 2} {0 0} {1 1} {2 2}} {abc a b c}}
test switch-13.4 {-indexvar -matchvar combinations} {
set x -
set y -
@@ -599,7 +607,7 @@ test switch-13.6 {-indexvar -matchvar combinations} {
list [catch {
switch -regexp -indexvar x -matchvar y(y) abc {. {list $x $y}}
} msg] $x $y $msg
-} {1 {{0 1}} - {can't set "y(y)": variable isn't array}}
+} {1 {{0 0}} - {can't set "y(y)": variable isn't array}}
test switch-14.1 {-regexp -- compilation [Bug 1854399]} {
switch -regexp -- 0 {
@@ -753,7 +761,7 @@ test switch-15.1 {coroutine safety of non-bytecoded switch} {*}{
rename coro {}
}
}
-
+
# cleanup
catch {rename foo {}}
::tcltest::cleanupTests
diff --git a/tests/tailcall.test b/tests/tailcall.test
index 46e2471..2d04f82 100644
--- a/tests/tailcall.test
+++ b/tests/tailcall.test
@@ -8,14 +8,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: tailcall.test,v 1.14 2010/08/30 14:02:10 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testnrelevels [llength [info commands testnrelevels]]
#
diff --git a/tests/tcltest.test b/tests/tcltest.test
index f235fac..86aca6f 100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -5,8 +5,6 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2000 by Ajuba Solutions
# All rights reserved.
-#
-# RCS: @(#) $Id: tcltest.test,v 1.56 2009/10/30 11:13:21 patthoyts Exp $
# Note that there are several places where the value of
# tcltest::currentFailure is stored/reset in the -setup/-cleanup
diff --git a/tests/thread.test b/tests/thread.test
index 15988bd..d79f693 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -10,278 +10,275 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: thread.test,v 1.21 2009/10/18 08:00:40 mistachkin Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2.2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Some tests require the testthread command
testConstraint testthread [expr {[info commands testthread] != {}}]
+# Some tests require the Thread package
+
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
+
+# Some tests may not work under valgrind
+
+testConstraint notValgrind [expr {![testConstraint valgrind]}]
+
+set threadSuperKillScript {
+ rename catch ""
+ rename while ""
+ rename unknown ""
+ rename update ""
+ thread::release
+}
+
+proc getThreadErrorFromInfo { info } {
+ set list [split $info \n]
+ set idx [lsearch -glob $list "*eval*unwound*"]
+ if {$idx != -1} then {
+ return [lindex $list $idx]
+ }
+ set idx [lsearch -glob $list "*eval*canceled*"]
+ if {$idx != -1} then {
+ return [lindex $list $idx]
+ }
+ return ""; # some other error we do not care about.
+}
+
+proc findThreadError { info } {
+ foreach error [lreverse $info] {
+ set error [getThreadErrorFromInfo $error]
+ if {[string length $error] > 0} then {
+ return $error
+ }
+ }
+ return ""; # some other error we do not care about.
+}
+
+proc ThreadError {id info} {
+ global threadSawError
+ if {[string length [getThreadErrorFromInfo $info]] > 0} then {
+ global threadId threadError
+ set threadId $id
+ lappend threadError($id) $info
+ }
+ set threadSawError($id) true; # signal main thread to exit [vwait].
+}
+
+if {[testConstraint thread]} {
+ thread::errorproc ThreadError
+}
+
if {[testConstraint testthread]} {
+ proc drainEventQueue {} {
+ while {[set x [testthread event]]} {
+ #puts "WARNING: drained $x event(s) on main thread"
+ }
+ }
+
testthread errorproc ThreadError
- proc ThreadError {id info} {
- global threadId threadError
- set threadId $id
- set threadError $info
- }
+ set mainThread [testthread id]
proc ThreadNullError {id info} {
# ignore
}
+
+ proc threadReap {} {
+ testthread errorproc ThreadNullError
+ while {[llength [testthread names]] > 1} {
+ foreach tid [testthread names] {
+ if {$tid != [testthread id]} {
+ catch {
+ testthread send -async $tid {testthread exit}
+ }
+ }
+ }
+ after 1
+ }
+ testthread errorproc ThreadError
+ return [llength [testthread names]]
+ }
}
+# Some tests require manual draining of the event queue
-test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} {
- list [catch {testthread} msg] $msg
-} {1 {wrong # args: should be "testthread option ?arg ...?"}}
-test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} {
- list [catch {testthread foo} msg] $msg
-} {1 {bad option "foo": must be cancel, create, event, exit, id, join, names, send, wait, or errorproc}}
-test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {testthread} {
- list [threadReap] [llength [testthread names]]
-} {1 1}
-test thread-1.4 {Tcl_ThreadObjCmd: thread create } {testthread} {
- threadReap
- set serverthread [testthread create]
- update
- set numthreads [llength [testthread names]]
- threadReap
+testConstraint drainEventQueue [expr {[info commands drainEventQueue] != {}}]
+
+test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {thread} {
+ llength [thread::names]
+} 1
+test thread-1.4 {Tcl_ThreadObjCmd: thread create } {thread} {
+ set serverthread [thread::create -preserved]
+ set numthreads [llength [thread::names]]
+ thread::release $serverthread
set numthreads
} {2}
-test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {testthread} {
- threadReap
- testthread create {set x 5}
+test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {thread} {
+ thread::create {set x 5}
foreach try {0 1 2 4 5 6} {
# Try various ways to yield
update
after 10
- set l [llength [testthread names]]
+ set l [llength [thread::names]]
if {$l == 1} {
break
}
}
- threadReap
set l
} {1}
-test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {testthread} {
- threadReap
- testthread create {testthread exit}
+test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} {
+ thread::create {{*}{}}
update
after 10
- set result [llength [testthread names]]
- threadReap
- set result
+ llength [thread::names]
} {1}
-test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {testthread} {
- set x [catch {testthread id x} msg]
- list $x $msg
-} {1 {wrong # args: should be "testthread id"}}
-test thread-1.8 {Tcl_ThreadObjCmd: thread id} {testthread} {
- string compare [testthread id] $::tcltest::mainThread
-} {0}
-test thread-1.9 {Tcl_ThreadObjCmd: thread names args} {testthread} {
- set x [catch {testthread names x} msg]
- list $x $msg
-} {1 {wrong # args: should be "testthread names"}}
-test thread-1.10 {Tcl_ThreadObjCmd: thread id} {testthread} {
- string compare [testthread names] $::tcltest::mainThread
-} {0}
-test thread-1.11 {Tcl_ThreadObjCmd: send args} {testthread} {
- set x [catch {testthread send} msg]
- list $x $msg
-} {1 {wrong # args: should be "testthread send ?-async? id script"}}
-test thread-1.12 {Tcl_ThreadObjCmd: send nonint} {testthread} {
- set x [catch {testthread send abc command} msg]
- list $x $msg
-} {1 {expected integer but got "abc"}}
-test thread-1.13 {Tcl_ThreadObjCmd: send args} {testthread} {
- threadReap
- set serverthread [testthread create]
- set five [testthread send $serverthread {set x 5}]
- threadReap
+test thread-1.13 {Tcl_ThreadObjCmd: send args} {thread} {
+ set serverthread [thread::create -preserved]
+ set five [thread::send $serverthread {set x 5}]
+ thread::release $serverthread
set five
} 5
-test thread-1.14 {Tcl_ThreadObjCmd: send bad id} {testthread} {
- set tid [expr $::tcltest::mainThread + 10]
- set x [catch {testthread send $tid {set x 5}} msg]
- list $x $msg
-} {1 {invalid thread id}}
-test thread-1.15 {Tcl_ThreadObjCmd: wait} {testthread} {
- threadReap
- set serverthread [testthread create {set z 5 ; testthread wait}]
- set five [testthread send $serverthread {set z}]
- threadReap
+test thread-1.15 {Tcl_ThreadObjCmd: wait} {thread} {
+ set serverthread [thread::create -preserved {set z 5 ; thread::wait}]
+ set five [thread::send $serverthread {set z}]
+ thread::release $serverthread
set five
} 5
-test thread-1.16 {Tcl_ThreadObjCmd: errorproc args} {testthread} {
- set x [catch {testthread errorproc foo bar} msg]
- list $x $msg
-} {1 {wrong # args: should be "testthread errorproc proc"}}
-test thread-1.17 {Tcl_ThreadObjCmd: errorproc change} {testthread} {
- testthread errorproc foo
- testthread errorproc ThreadError
-} {}
# The tests above also cover:
# TclCreateThread, except when pthread_create fails
# NewThread, safe and regular
# ThreadErrorProc, except for printing to standard error
-test thread-2.1 {ListUpdateInner and ListRemove} {testthread} {
- threadReap
+test thread-2.1 {ListUpdateInner and ListRemove} {thread} {
catch {unset tid}
foreach t {0 1 2} {
upvar #0 t$t tid
- set tid [testthread create]
+ set tid [thread::create -preserved]
+ }
+ foreach t {0 1 2} {
+ upvar #0 t$t tid
+ thread::release $tid
}
- threadReap
+ llength [thread::names]
} 1
-test thread-3.1 {TclThreadList} {testthread} {
- threadReap
+test thread-3.1 {TclThreadList} {thread} {
catch {unset tid}
- set len [llength [testthread names]]
+ set len [llength [thread::names]]
set l1 {}
foreach t {0 1 2} {
- lappend l1 [testthread create]
+ lappend l1 [thread::create -preserved]
+ }
+ set l2 [thread::names]
+ set c [string compare [lsort [concat [thread::id] $l1]] [lsort $l2]]
+ foreach t $l1 {
+ thread::release $t
}
- set l2 [testthread names]
- list $l1 $l2
- set c [string compare \
- [lsort -integer [concat $::tcltest::mainThread $l1]] \
- [lsort -integer $l2]]
- threadReap
list $len $c
} {1 0}
-test thread-4.1 {TclThreadSend to self} {testthread} {
+test thread-4.1 {TclThreadSend to self} {thread} {
catch {unset x}
- testthread send [testthread id] {
+ thread::send [thread::id] {
set x 4
}
set x
} {4}
-test thread-4.2 {TclThreadSend -async} {testthread} {
- threadReap
- set len [llength [testthread names]]
- set serverthread [testthread create]
- testthread send -async $serverthread {
- after 1000
- testthread exit
+test thread-4.2 {TclThreadSend -async} {thread} {
+ set len [llength [thread::names]]
+ set serverthread [thread::create -preserved]
+ thread::send -async $serverthread {
+ after 1 {thread::release}
}
- set two [llength [testthread names]]
- after 1500 {set done 1}
+ set two [llength [thread::names]]
+ after 100 {set done 1}
vwait done
- threadReap
- list $len [llength [testthread names]] $two
+ list $len [llength [thread::names]] $two
} {1 1 2}
-test thread-4.3 {TclThreadSend preserve errorInfo} {testthread} {
- threadReap
- set len [llength [testthread names]]
- set serverthread [testthread create]
- set x [catch {testthread send $serverthread {set undef}} msg]
+test thread-4.3 {TclThreadSend preserve errorInfo} {thread} {
+ set len [llength [thread::names]]
+ set serverthread [thread::create -preserved]
+ set x [catch {thread::send $serverthread {set undef}} msg]
set savedErrorInfo $::errorInfo
- threadReap
+ thread::release $serverthread
list $len $x $msg $savedErrorInfo
} {1 1 {can't read "undef": no such variable} {can't read "undef": no such variable
while executing
"set undef"
invoked from within
-"testthread send $serverthread {set undef}"}}
-test thread-4.4 {TclThreadSend preserve code} {testthread} {
- threadReap
- set len [llength [testthread names]]
- set serverthread [testthread create]
+"thread::send $serverthread {set undef}"}}
+test thread-4.4 {TclThreadSend preserve code} {thread} {
+ set len [llength [thread::names]]
+ set serverthread [thread::create -preserved]
set ::errorInfo {}
- set x [catch {testthread send $serverthread {set ::errorInfo {}; break}} msg]
+ set x [catch {thread::send $serverthread {set ::errorInfo {}; break}} msg]
set savedErrorInfo $::errorInfo
- threadReap
+ thread::release $serverthread
list $len $x $msg $savedErrorInfo
} {1 3 {} {}}
-test thread-4.5 {TclThreadSend preserve errorCode} {testthread} {
- threadReap
- set ::tcltest::mainThread [testthread names]
- set serverthread [testthread create]
- set x [catch {testthread send $serverthread {error ERR INFO CODE}} msg]
+test thread-4.5 {TclThreadSend preserve errorCode} {thread} {
+ set serverthread [thread::create]
+ set x [catch {thread::send $serverthread {error ERR INFO CODE}} msg]
set savedErrorCode $::errorCode
- threadReap
+ thread::release $serverthread
list $x $msg $savedErrorCode
} {1 ERR CODE}
-test thread-5.0 {Joining threads} {testthread} {
- threadReap
- set serverthread [testthread create -joinable]
- testthread send -async $serverthread {after 1000 ; testthread exit}
- set res [testthread join $serverthread]
- threadReap
- set res
+test thread-5.0 {Joining threads} {thread} {
+ set serverthread [thread::create -joinable -preserved]
+ thread::send -async $serverthread {after 1000 ; thread::release}
+ thread::join $serverthread
} {0}
-test thread-5.1 {Joining threads after the fact} {testthread} {
- threadReap
- set serverthread [testthread create -joinable]
- testthread send -async $serverthread {testthread exit}
+test thread-5.1 {Joining threads after the fact} {thread} {
+ set serverthread [thread::create -joinable -preserved]
+ thread::send -async $serverthread {thread::release}
after 2000
- set res [testthread join $serverthread]
- threadReap
- set res
+ thread::join $serverthread
} {0}
-test thread-5.2 {Try to join a detached thread} {testthread} {
- threadReap
- set serverthread [testthread create]
- testthread send -async $serverthread {after 1000 ; testthread exit}
- catch {set res [testthread join $serverthread]} msg
- threadReap
+test thread-5.2 {Try to join a detached thread} {thread} {
+ set serverthread [thread::create -preserved]
+ thread::send -async $serverthread {after 1000 ; thread::release}
+ catch {set res [thread::join $serverthread]} msg
+ while {[llength [thread::names]] > 1} {
+ after 20
+ }
lrange $msg 0 2
} {cannot join thread}
-test thread-6.1 {freeing very large object trees in a thread} testthread {
+test thread-6.1 {freeing very large object trees in a thread} thread {
# conceptual duplicate of obj-32.1
- threadReap
- set serverthread [testthread create -joinable]
- testthread send -async $serverthread {
+ set serverthread [thread::create -preserved]
+ thread::send -async $serverthread {
set x {}
for {set i 0} {$i<100000} {incr i} {
set x [list $x {}]
}
unset x
- testthread exit
}
- catch {set res [testthread join $serverthread]} msg
- threadReap
- set res
-} {0}
+ thread::release -wait $serverthread
+} 0
# TIP #285: Script cancellation support
-test thread-7.1 {cancel: args} {testthread} {
- set x [catch {testthread cancel} msg]
- list $x $msg
-} {1 {wrong # args: should be "testthread cancel ?-unwind? id ?result?"}}
-test thread-7.2 {cancel: nonint} {testthread} {
- set x [catch {testthread cancel abc} msg]
- list $x $msg
-} {1 {expected integer but got "abc"}}
-test thread-7.3 {cancel: bad id} {testthread} {
- set tid [expr $::tcltest::mainThread + 10]
- set x [catch {testthread cancel $tid} msg]
- list $x $msg
-} {1 {invalid thread id}}
-test thread-7.4 {cancel: pure bytecode loop} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+test thread-7.4 {cancel: pure bytecode loop} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
while {1} {
@@ -289,30 +286,30 @@ test thread-7.4 {cancel: pure bytecode loop} {testthread} {
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval canceled}}
-test thread-7.5 {cancel: pure inside-command loop} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.5 {cancel: pure inside-command loop} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
set while while
@@ -321,30 +318,30 @@ test thread-7.5 {cancel: pure inside-command loop} {testthread} {
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval canceled}}
-test thread-7.6 {cancel: pure bytecode loop -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.6 {cancel: pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
while {1} {
@@ -352,30 +349,30 @@ test thread-7.6 {cancel: pure bytecode loop -unwind} {testthread} {
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel -unwind $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
-test thread-7.7 {cancel: pure inside-command loop -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
- proc foobar {} {
+ vwait ::threadIdStarted
+ set res [thread::cancel -unwind $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.7 {cancel: pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
+ proc foobar {} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
set while while
@@ -384,30 +381,30 @@ test thread-7.7 {cancel: pure inside-command loop -unwind} {testthread} {
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel -unwind $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
-test thread-7.8 {cancel: pure bytecode loop custom result} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel -unwind $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.8 {cancel: pure bytecode loop custom result} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
while {1} {
@@ -415,30 +412,33 @@ test thread-7.8 {cancel: pure bytecode loop custom result} {testthread} {
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel $serverthread "the eval was canceled"]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {the eval was canceled}}
-test thread-7.9 {cancel: pure inside-command loop custom result} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
- proc foobar {} {
+ vwait ::threadIdStarted
+ set res [thread::cancel $serverthread "the eval was canceled"]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {the eval was canceled}}
+test thread-7.9 {cancel: pure inside-command loop custom result} -constraints {
+ thread
+ drainEventQueue
+} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
+ proc foobar {} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
set while while
@@ -447,30 +447,33 @@ test thread-7.9 {cancel: pure inside-command loop custom result} {testthread} {
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel $serverthread "the eval was canceled"]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {the eval was canceled}}
-test thread-7.10 {cancel: pure bytecode loop custom result -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel $serverthread "the eval was canceled"]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {the eval was canceled}}
+test thread-7.10 {cancel: pure bytecode loop custom result -unwind} -constraints {
+ thread
+ drainEventQueue
+} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
while {1} {
@@ -478,30 +481,33 @@ test thread-7.10 {cancel: pure bytecode loop custom result -unwind} {testthread}
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel -unwind $serverthread "the eval was unwound"]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {the eval was unwound}}
-test thread-7.11 {cancel: pure inside-command loop custom result -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
- proc foobar {} {
+ vwait ::threadIdStarted
+ set res [thread::cancel -unwind $serverthread "the eval was unwound"]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {the eval was unwound}}
+test thread-7.11 {cancel: pure inside-command loop custom result -unwind} -constraints {
+ thread
+ drainEventQueue
+} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
+ proc foobar {} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
set while while
@@ -510,383 +516,379 @@ test thread-7.11 {cancel: pure inside-command loop custom result -unwind} {testt
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel -unwind $serverthread "the eval was unwound"]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {the eval was unwound}}
-test thread-7.12 {cancel: after} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel -unwind $serverthread "the eval was unwound"]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {the eval was unwound}}
+test thread-7.12 {cancel: after} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
after 30000
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval canceled}}
-test thread-7.13 {cancel: after -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.13 {cancel: after -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
after 30000
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel -unwind $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
-test thread-7.14 {cancel: vwait} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel -unwind $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.14 {cancel: vwait} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID [thread::id]] {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
vwait forever
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval canceled}}
-test thread-7.15 {cancel: vwait -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.15 {cancel: vwait -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
vwait forever
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel -unwind $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
-test thread-7.16 {cancel: expr} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel -unwind $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.16 {cancel: expr} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID [thread::id]] {
set i [interp create]
- interp alias $i testthread {} testthread
+ $i eval "package require -exact Thread [package present Thread]"
$i eval {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
expr {[while {1} {incr x}]}
}
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval canceled}}
-test thread-7.17 {cancel: expr -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.17 {cancel: expr -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
set i [interp create]
- interp alias $i testthread {} testthread
+ $i eval "package require -exact Thread [package present Thread]"
$i eval {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
expr {[while {1} {incr x}]}
}
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel -unwind $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
-test thread-7.18 {cancel: expr bignum} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
- set i [interp create]
- interp alias $i testthread {} testthread
- $i eval {
- if {![info exists foo]} then {
- # signal the primary thread that we are ready
- # to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
- set foo 1
- }
- #
- # TODO: This will not cancel because libtommath
- # does not check Tcl_Canceled.
- #
- expr {2**99999}
- }
- }]
+ vwait ::threadIdStarted
+ set res [thread::cancel -unwind $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.18 {cancel: expr bignum} {thread drainEventQueue knownBug} {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
+ set i [interp create]
+ $i eval "package require -exact Thread [package present Thread]"
+ $i eval {
+ if {![info exists foo]} then {
+ # signal the primary thread that we are ready
+ # to be canceled now (we are running).
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
+ set foo 1
+ }
+ #
+ # BUGBUG: This will not cancel because libtommath
+ # does not check Tcl_Canceled.
+ #
+ expr {2**99999}
+ }
+ }]]
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
- set res [testthread cancel $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
+ set res [thread::cancel $serverthread]
+ vwait ::threadSawError($serverthread); # WARNING: Never returns (see above).
+ thread::join $serverthread; drainEventQueue; # WARNING: Never returns (see above).
list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
+ $::threadIdStarted == $serverthread : 0}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
} {{} 1 0 {}}
-test thread-7.19 {cancel: expr bignum -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
- set i [interp create]
- interp alias $i testthread {} testthread
- $i eval {
- if {![info exists foo]} then {
- # signal the primary thread that we are ready
- # to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
- set foo 1
- }
- #
- # TODO: This will not cancel because libtommath
- # does not check Tcl_Canceled.
- #
- expr {2**99999}
- }
- }]
+test thread-7.19 {cancel: expr bignum -unwind} {thread drainEventQueue knownBug} {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
+ set i [interp create]
+ $i eval "package require -exact Thread [package present Thread]"
+ $i eval {
+ if {![info exists foo]} then {
+ # signal the primary thread that we are ready
+ # to be canceled now (we are running).
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
+ set foo 1
+ }
+ #
+ # BUGBUG: This will not cancel because libtommath
+ # does not check Tcl_Canceled.
+ #
+ expr {2**99999}
+ }
+ }]]
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
- set res [testthread cancel -unwind $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
+ set res [thread::cancel -unwind $serverthread]
+ vwait ::threadSawError($serverthread); # WARNING: Never returns (see above).
+ thread::join $serverthread; drainEventQueue; # WARNING: Never returns (see above).
list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
+ $::threadIdStarted == $serverthread : 0}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
} {{} 1 0 {}}
-test thread-7.20 {cancel: subst} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+test thread-7.20 {cancel: subst} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
set i [interp create]
- interp alias $i testthread {} testthread
+ $i eval "package require -exact Thread [package present Thread]"
$i eval {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
subst {[while {1} {incr x}]}
}
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval canceled}}
-test thread-7.21 {cancel: subst -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.21 {cancel: subst -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
set i [interp create]
- interp alias $i testthread {} testthread
+ $i eval "package require -exact Thread [package present Thread]"
$i eval {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
subst {[while {1} {incr x}]}
}
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel -unwind $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
-test thread-7.22 {cancel: slave interp} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel -unwind $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.22 {cancel: slave interp} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
set i [interp create]
- interp alias $i testthread {} testthread
+ $i eval "package require -exact Thread [package present Thread]"
$i eval {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
while {1} {}
}
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval canceled}}
-test thread-7.23 {cancel: slave interp -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.23 {cancel: slave interp -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
set i [interp create]
- interp alias $i testthread {} testthread
+ $i eval "package require -exact Thread [package present Thread]"
$i eval {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
set while while; $while {1} {}
}
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel -unwind $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
-test thread-7.24 {cancel: nested catch inside pure bytecode loop} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel -unwind $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.24 {cancel: nested catch inside pure bytecode loop} {thread drainEventQueue} {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
catch {
@@ -903,25 +905,24 @@ test thread-7.24 {cancel: nested catch inside pure bytecode loop} {testthread} {
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
- set res [testthread cancel $serverthread]
- after 1000; # wait for ThreadErrorProc to be called.
- while {[testthread event]} {}; # force events to service
- catch {testthread send $serverthread {testthread exit}}
- threadReap
+ set res [thread::cancel $serverthread]
+ thread::send $serverthread $::threadSuperKillScript
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
list $res [expr {[info exists ::threadIdStarted] ? \
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
} {{} 1 0 {}}
-test thread-7.25 {cancel: nested catch inside pure inside-command loop} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread drainEventQueue} {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
set catch catch
set while while
@@ -929,8 +930,7 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {testthr
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
$catch {
@@ -947,61 +947,59 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {testthr
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
- set res [testthread cancel $serverthread]
- after 1000; # wait for ThreadErrorProc to be called.
- while {[testthread event]} {}; # force events to service
- catch {testthread send $serverthread {testthread exit}}
- threadReap
+ set res [thread::cancel $serverthread]
+ thread::send $serverthread $::threadSuperKillScript
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
list $res [expr {[info exists ::threadIdStarted] ? \
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
} {{} 1 0 {}}
-test thread-7.26 {cancel: send async cancel bad interp path} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+test thread-7.26 {cancel: send async cancel bad interp path} {thread drainEventQueue} {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
update
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- catch {testthread send $serverthread {interp cancel -- bad}} msg
- threadReap
- list [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- $msg
+ vwait ::threadIdStarted
+ catch {thread::send $serverthread {interp cancel -- bad}} msg
+ thread::send -async $serverthread {interp cancel -unwind}
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list [expr {$::threadIdStarted == $serverthread}] $msg
} {1 {could not find interpreter "bad"}}
-test thread-7.27 {cancel: send async cancel -- switch} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
- interp create -- -unwind
- interp alias -unwind testthread {} testthread
- interp eval -unwind {
+test thread-7.27 {cancel: send async cancel -- switch} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
+ set i [interp create -- -unwind]
+ $i eval "package require -exact Thread [package present Thread]"
+ $i eval {
proc foobar {} {
while {1} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
update
@@ -1009,31 +1007,30 @@ test thread-7.27 {cancel: send async cancel -- switch} {testthread} {
}
foobar
}
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread send -async $serverthread {interp cancel -- -unwind}]
- after 1000; # wait for ThreadErrorProc to be called.
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval canceled}}
-test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::send -async $serverthread {interp cancel -- -unwind}]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {thread drainEventQueue} {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
catch {
@@ -1050,25 +1047,24 @@ test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode lo
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
- set res [testthread send -async $serverthread {interp cancel}]
- after 1000; # wait for ThreadErrorProc to be called.
- while {[testthread event]} {}; # force events to service
- catch {testthread send $serverthread {testthread exit}}
- threadReap
+ set res [thread::send -async $serverthread {interp cancel}]
+ thread::send $serverthread $::threadSuperKillScript
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
list $res [expr {[info exists ::threadIdStarted] ? \
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 0 {}}
-test thread-7.29 {cancel: send async cancel nested catch pure inside-command loop} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 1 {eval canceled}}
+test thread-7.29 {cancel: send async cancel nested catch pure inside-command loop} {thread drainEventQueue} {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
set catch catch
set while while
@@ -1076,8 +1072,7 @@ test thread-7.29 {cancel: send async cancel nested catch pure inside-command loo
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
$catch {
@@ -1094,32 +1089,30 @@ test thread-7.29 {cancel: send async cancel nested catch pure inside-command loo
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
- set res [testthread send -async $serverthread {interp cancel}]
- after 1000; # wait for ThreadErrorProc to be called.
- while {[testthread event]} {}; # force events to service
- catch {testthread send $serverthread {testthread exit}}
- threadReap
+ set res [thread::send -async $serverthread {interp cancel}]
+ thread::send $serverthread $::threadSuperKillScript
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
list $res [expr {[info exists ::threadIdStarted] ? \
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 0 {}}
-test thread-7.30 {cancel: send async testthread cancel nested catch inside pure bytecode loop} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 1 {eval canceled}}
+test thread-7.30 {cancel: send async thread cancel nested catch inside pure bytecode loop} {thread drainEventQueue} {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
catch {
@@ -1136,25 +1129,24 @@ test thread-7.30 {cancel: send async testthread cancel nested catch inside pure
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
- set res [testthread send -async $serverthread {testthread cancel [testthread id]}]
- after 1000; # wait for ThreadErrorProc to be called.
- while {[testthread event]} {}; # force events to service
- catch {testthread send $serverthread {testthread exit}}
- threadReap
+ set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
+ thread::send $serverthread $::threadSuperKillScript
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
list $res [expr {[info exists ::threadIdStarted] ? \
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 0 {}}
-test thread-7.31 {cancel: send async testthread cancel nested catch pure inside-command loop} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 1 {eval canceled}}
+test thread-7.31 {cancel: send async thread cancel nested catch pure inside-command loop} {thread drainEventQueue} {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
set catch catch
set while while
@@ -1162,8 +1154,7 @@ test thread-7.31 {cancel: send async testthread cancel nested catch pure inside-
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
$catch {
@@ -1180,32 +1171,31 @@ test thread-7.31 {cancel: send async testthread cancel nested catch pure inside-
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
- set res [testthread send -async $serverthread {testthread cancel [testthread id]}]
- after 1000; # wait for ThreadErrorProc to be called.
- while {[testthread event]} {}; # force events to service
- catch {testthread send $serverthread {testthread exit}}
- threadReap
+ set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
+ thread::send $serverthread $::threadSuperKillScript
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
list $res [expr {[info exists ::threadIdStarted] ? \
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 0 {}}
-test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 1 {eval canceled}}
+test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
catch {
@@ -1220,24 +1210,25 @@ test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} {testt
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel -unwind $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
-test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel -unwind $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
set catch catch
set while while
@@ -1245,8 +1236,7 @@ test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind}
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
$catch {
@@ -1261,31 +1251,31 @@ test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind}
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread cancel -unwind $serverthread]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
-test thread-7.34 {cancel: send async cancel nested catch inside pure bytecode loop -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::cancel -unwind $serverthread]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.34 {cancel: send async cancel nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
catch {
@@ -1302,24 +1292,25 @@ test thread-7.34 {cancel: send async cancel nested catch inside pure bytecode lo
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread send -async $serverthread {interp cancel -unwind}]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
-test thread-7.35 {cancel: send async cancel nested catch inside pure inside-command loop -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::send -async $serverthread {interp cancel -unwind}]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.35 {cancel: send async cancel nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
set catch catch
set while while
@@ -1327,8 +1318,7 @@ test thread-7.35 {cancel: send async cancel nested catch inside pure inside-comm
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
$catch {
@@ -1345,31 +1335,31 @@ test thread-7.35 {cancel: send async cancel nested catch inside pure inside-comm
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread send -async $serverthread {interp cancel -unwind}]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
-test thread-7.36 {cancel: send async testthread cancel nested catch inside pure bytecode loop -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::send -async $serverthread {interp cancel -unwind}]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.36 {cancel: send async thread cancel nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
catch {
@@ -1386,24 +1376,25 @@ test thread-7.36 {cancel: send async testthread cancel nested catch inside pure
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread send -async $serverthread {testthread cancel -unwind [testthread id]}]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
-test thread-7.37 {cancel: send async testthread cancel nested catch inside pure inside-command loop -unwind} {testthread} {
- threadReap
- unset -nocomplain ::threadError ::threadId ::threadIdStarted
- set serverthread [testthread create -joinable {
+ vwait ::threadIdStarted
+ set res [thread::send -async $serverthread {thread::cancel -unwind [thread::id]}]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.37 {cancel: send async thread cancel nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+ set serverthread [thread::create -joinable \
+ [string map [list %ID [thread::id]] {
proc foobar {} {
set catch catch
set while while
@@ -1411,8 +1402,7 @@ test thread-7.37 {cancel: send async testthread cancel nested catch inside pure
if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
- testthread send [testthread id -main] \
- [list set ::threadIdStarted [testthread id]]
+ thread::send %ID% [list set ::threadIdStarted [thread::id]]
set foo 1
}
$catch {
@@ -1429,20 +1419,20 @@ test thread-7.37 {cancel: send async testthread cancel nested catch inside pure
}
}
foobar
- }]
+ }]]
# wait for other thread to signal "ready to cancel"
- vwait ::threadIdStarted; after 1000
- set res [testthread send -async $serverthread {testthread cancel -unwind [testthread id]}]
- testthread join $serverthread
- while {[testthread event]} {}; # force events to service
- threadReap
- list $res [expr {[info exists ::threadIdStarted] ? \
- $::threadIdStarted == $serverthread : 0}] \
- [expr {[info exists ::threadId] ? \
- $::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
-} {{} 1 1 {eval unwound}}
+ vwait ::threadIdStarted
+ set res [thread::send -async $serverthread {thread::cancel -unwind [thread::id]}]
+ vwait ::threadSawError($serverthread)
+ thread::join $serverthread; drainEventQueue
+ list $res [expr {$::threadIdStarted == $serverthread}] \
+ [expr {[info exists ::threadId] ? \
+ $::threadId == $serverthread : 0}] \
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+ unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/timer.test b/tests/timer.test
index 76be883..ab6efc9 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -12,8 +12,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: timer.test,v 1.14 2008/07/19 22:50:39 nijtmans Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
diff --git a/tests/tm.test b/tests/tm.test
index 72bcc72..149a65d 100644
--- a/tests/tm.test
+++ b/tests/tm.test
@@ -5,8 +5,6 @@
#
# Copyright (c) 2004 by Donal K. Fellows.
# All rights reserved.
-#
-# RCS: @(#) $Id: tm.test,v 1.8 2008/09/26 19:54:59 dgp Exp $
package require Tcl 8.5
if {"::tcltest" ni [namespace children]} {
diff --git a/tests/trace.test b/tests/trace.test
index 4d924e2..0f48dcf 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -10,14 +10,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: trace.test,v 1.62 2008/07/19 22:50:38 nijtmans Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
testConstraint testevalobjv [llength [info commands testevalobjv]]
@@ -2560,8 +2561,69 @@ set base {
}
runbase {{- *} {-* *} {- *} {- *}} $base
+test trace-39 {bug #3484621: tracing Bc'ed commands} -setup {
+ set ::traceLog 0
+ set ::traceCalls 0
+ set ::bar [list 0 1 2 3]
+ set res {}
+ proc dotrace args {
+ incr ::traceLog
+ }
+ proc foo {} {
+ incr ::traceCalls
+ # choose a BC'ed command that is 'unlikely' to interfere with tcltest's
+ # internals
+ lset ::bar 1 2
+ }
+} -body {
+ foo
+ lappend res $::traceLog
+
+ trace add execution lset enter dotrace
+ foo
+ lappend res $::traceLog
+
+ trace remove execution lset enter dotrace
+ foo
+ lappend res $::traceLog
+
+ list $::traceCalls | {*}$res
+} -cleanup {
+ unset ::traceLog ::traceCalls ::bar res
+ rename dotrace {}
+ rename foo {}
+} -result {3 | 0 1 1}
+
+test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
+ set ::traceLog 0
+ set ::traceCalls 0
+ set res {}
+ proc dotrace args {
+ incr ::traceLog
+ }
+ proc foo {} {
+ incr ::traceCalls
+ string equal zip zap
+ }
+} -body {
+ foo
+ lappend res $::traceLog
+
+ trace add execution ::tcl::string::equal enter dotrace
+ foo
+ lappend res $::traceLog
+ trace remove execution tcl::string::equal enter dotrace
+ foo
+ lappend res $::traceLog
+ list $::traceCalls | {*}$res
+} -cleanup {
+ unset ::traceLog ::traceCalls res
+ rename dotrace {}
+ rename foo {}
+} -result {3 | 0 1 1}
+
# Delete procedures when done, so we don't clash with other tests
# (e.g. foobar will clash with 'unknown' tests).
catch {rename foobar {}}
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index 43dcf1a..2453e01 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -8,14 +8,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixFCmd.test,v 1.26 2008/04/11 14:55:10 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testchmod [llength [info commands testchmod]]
# These tests really need to be run from a writable directory, which
diff --git a/tests/unixFile.test b/tests/unixFile.test
index 8e37b5d..8147f48 100644
--- a/tests/unixFile.test
+++ b/tests/unixFile.test
@@ -8,14 +8,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixFile.test,v 1.9 2004/06/23 15:36:58 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testfindexecutable [llength [info commands testfindexecutable]]
set oldpwd [pwd]
diff --git a/tests/unixInit.test b/tests/unixInit.test
index 1f4dc7a..9ba9c11 100644
--- a/tests/unixInit.test
+++ b/tests/unixInit.test
@@ -1,23 +1,21 @@
# The file tests the functions in the tclUnixInit.c file.
#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
#
# Copyright (c) 1997 by 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.
-#
-# RCS: @(#) $Id: unixInit.test,v 1.50 2006/11/03 11:45:35 dkf Exp $
+# 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 -force ::tcltest::*
unset -nocomplain path
catch {set oldlang $env(LANG)}
set env(LANG) C
-
+
test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} {
set x {}
# Watch out for a race condition here. If tcltest is too slow to start
@@ -36,13 +34,13 @@ test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} {
lappend x [catch {close $f}]
set x
} {0 1}
-# This test is really a test of code in tclUnixChan.c, but the
-# channels are set up as part of initialisation of the interpreter so
-# the test seems to me to fit here as well as anywhere else.
+# This test is really a test of code in tclUnixChan.c, but the channels are
+# set up as part of initialisation of the interpreter so the test seems to me
+# to fit here as well as anywhere else.
test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} {
- # pipe1 is a connection to a server that reports what port it
- # starts on, and delivers a constant string to the first client to
- # connect to that port before exiting.
+ # pipe1 is a connection to a server that reports what port it starts on,
+ # and delivers a constant string to the first client to connect to that
+ # port before exiting.
set pipe1 [open "|[list [interpreter]]" r+]
puts $pipe1 {
proc accept {channel host port} {
@@ -53,16 +51,16 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio}
puts [fconfigure [socket -server accept -myaddr 127.0.0.1 0] -sockname]
vwait forever \
}
- # Note the backslash above; this is important to make sure that the
- # whole string is read before an [exit] can happen...
+ # Note the backslash above; this is important to make sure that the whole
+ # string is read before an [exit] can happen...
flush $pipe1
set port [lindex [gets $pipe1] 2]
set sock [socket localhost $port]
- # pipe2 is a connection to a Tcl interpreter that takes its orders
- # from the socket we hand it (i.e. the server we create above.)
- # These orders will tell it to print out the details about the
- # socket it is taking instructions from, hopefully identifying it
- # as a socket. Which is what this test is all about.
+ # pipe2 is a connection to a Tcl interpreter that takes its orders from
+ # the socket we hand it (i.e. the server we create above.) These orders
+ # will tell it to print out the details about the socket it is taking
+ # instructions from, hopefully identifying it as a socket. Which is what
+ # this test is all about.
set pipe2 [open "|[list [interpreter] <@$sock]" r]
set result [gets $pipe2]
# Clear any pending data; stops certain kinds of (non-important) errors
@@ -75,8 +73,7 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio}
# Can't use normal comparison, as hostname varies due to some
# installations having a messed up /etc/hosts file.
if {
- [string equal 127.0.0.1 [lindex $result 0]] &&
- [string equal $port [lindex $result 2]]
+ "127.0.0.1" eq [lindex $result 0] && $port == [lindex $result 2]
} then {
subst "OK"
} else {
@@ -85,8 +82,8 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio}
} {OK}
# The unixInit-2.* tests were written to test the internal routine,
-# TclpInitLibraryPath. That routine no longer does the things it used
-# to do so those tests are obsolete. Skip them.
+# TclpInitLibraryPath. That routine no longer does the things it used to do
+# so those tests are obsolete. Skip them.
skip [concat [skip] unixInit-2.*]
@@ -108,16 +105,14 @@ test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup
set installLib lib/tcl[info tclversion]
set developLib tcl[info patchlevel]/library
set prefix [file dirname [file dirname [interpreter]]]
- set x {}
- lappend x [string compare [lindex $path 0] $prefix/$installLib]
- lappend x [string compare [lindex $path 4] [file dirname $prefix]/$developLib]
- set x
+ list [string equal [lindex $path 0] $prefix/$installLib] \
+ [string equal [lindex $path 4] [file dirname $prefix]/$developLib]
} -cleanup {
if {[info exists oldlibrary]} {
set env(TCL_LIBRARY) $oldlibrary
unset oldlibrary
}
-} -result {0 0}
+} -result {1 1}
test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
@@ -126,10 +121,9 @@ test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup {
} -body {
# ((str != NULL) && (str[0] != '\0'))
set env(TCL_LIBRARY) sparkly
- set path [getlibpath]
- unset env(TCL_LIBRARY)
- lindex $path 0
+ lindex [getlibpath] 0
} -cleanup {
+ unset -nocomplain env(TCL_LIBRARY)
if {[info exists oldlibrary]} {
set env(TCL_LIBRARY) $oldlibrary
unset oldlibrary
@@ -143,10 +137,9 @@ test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -setup {
} -body {
# ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc - 1]) != 0))
set env(TCL_LIBRARY) /a/b/tcl1.7
- set path [getlibpath]
- unset env(TCL_LIBRARY)
- lrange $path 0 1
+ lrange [getlibpath] 0 1
} -cleanup {
+ unset -nocomplain env(TCL_LIBRARY)
if {[info exists oldlibrary]} {
set env(TCL_LIBRARY) $oldlibrary
unset oldlibrary
@@ -159,11 +152,9 @@ test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup {
} -body {
# Child process translates env variable from native encoding.
set env(TCL_LIBRARY) "\xa7"
- set x [lindex [getlibpath] 0]
- unset env(TCL_LIBRARY)
- unset env(LANG)
- set x
+ lindex [getlibpath] 0
} -cleanup {
+ unset -nocomplain env(TCL_LIBRARY) env(LANG)
if {[info exists oldlibrary]} {
set env(TCL_LIBRARY) $oldlibrary
unset oldlibrary
@@ -207,10 +198,9 @@ test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} {
# [lindex $auto_path end]
} {}
#
-# The following two tests write to the directory /tmp/sparkly instead
-# of to [temporaryDirectory]. This is because the failures tested by
-# these tests need paths near the "root" of the file system to present
-# themselves.
+# The following two tests write to the directory /tmp/sparkly instead of to
+# [temporaryDirectory]. This is because the failures tested by these tests
+# need paths near the "root" of the file system to present themselves.
#
test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
unset -nocomplain oldlibrary
@@ -219,20 +209,20 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
}
set env(TCL_LIBRARY) [info library]
# Checking for Bug 219416
- # When a program that embeds the Tcl library, like tcltest, is
- # installed near the "root" of the file system, there was a problem
- # constructing directories relative to the executable. When a
- # relative ".." went past the root, relative path names were created
- # rather than absolute pathnames. In some cases, accessing past the
- # root caused memory access violations too.
+ # When a program that embeds the Tcl library, like tcltest, is installed
+ # near the "root" of the file system, there was a problem constructing
+ # directories relative to the executable. When a relative ".." went past
+ # the root, relative path names were created rather than absolute
+ # pathnames. In some cases, accessing past the root caused memory access
+ # violations too.
#
- # The bug is now fixed, but here we check for it by making sure that
- # the directories constructed relative to the executable are all
- # absolute pathnames, even when the executable is installed near
- # the root of the filesystem.
+ # The bug is now fixed, but here we check for it by making sure that the
+ # directories constructed relative to the executable are all absolute
+ # pathnames, even when the executable is installed near the root of the
+ # filesystem.
#
- # The only directory near the root we are likely to have write access
- # to is /tmp.
+ # The only directory near the root we are likely to have write access to
+ # is /tmp.
file delete -force /tmp/sparkly
file delete -force /tmp/lib/tcl[info tclversion]
file mkdir /tmp/sparkly
@@ -318,21 +308,15 @@ test unixInit-2.10 {TclpInitLibraryPath: executable relative} -setup {
set y
} -cleanup {
cd $saveDir
- unset saveDir
removeFile init.tcl $scriptDir
- unset scriptDir
removeDirectory tcl[info tclversion] $libDir
- unset libDir
file delete $execPath
- unset execPath
removeDirectory bin $sparklyDir
removeDirectory lib $sparklyDir
- unset sparklyDir
removeDirectory sparkly $tmpDir
- unset tmpDir
removeDirectory tmp
- unset x p y
- unset env(TCL_LIBRARY)
+ unset -nocomplain saveDir scriptDir libDir execPath sparklyDir tmpDir
+ unset -nocomplain x p y env(TCL_LIBRARY)
if {[info exists oldlibrary]} {
set env(TCL_LIBRARY) $oldlibrary
unset oldlibrary
@@ -349,31 +333,32 @@ test unixInit-3.1 {TclpSetInitialEncodings} -constraints {
puts $f {puts [encoding system]; exit}
set enc [gets $f]
close $f
- unset env(LANG)
- set enc
+ return $enc
+} -cleanup {
+ unset -nocomplain env(LANG)
} -match regexp -result [expr {
($tcl_platform(os) eq "Darwin") ? "^utf-8$" : "^iso8859-15?$"}]
-test unixInit-3.2 {TclpSetInitialEncodings} {unix stdio} {
- set env(LANG) japanese
+test unixInit-3.2 {TclpSetInitialEncodings} -setup {
catch {set oldlc_all $env(LC_ALL)}
+} -constraints {unix stdio} -body {
+ set env(LANG) japanese
set env(LC_ALL) japanese
set f [open "|[list [interpreter]]" w+]
fconfigure $f -buffering none
puts $f {puts [encoding system]; exit}
set enc [gets $f]
close $f
- unset env(LANG)
- unset env(LC_ALL)
- catch {set env(LC_ALL) $oldlc_all}
set validEncodings [list euc-jp]
if {[string match HP-UX $tcl_platform(os)]} {
- # Some older HP-UX systems need us to accept this as valid
- # Bug 453883 reports that newer HP-UX systems report euc-jp
- # like everybody else.
+ # Some older HP-UX systems need us to accept this as valid Bug 453883
+ # reports that newer HP-UX systems report euc-jp like everybody else.
lappend validEncodings shiftjis
}
- expr {[lsearch -exact $validEncodings $enc] < 0}
-} 0
+ expr {$enc ni $validEncodings}
+} -cleanup {
+ unset -nocomplain env(LANG) env(LC_ALL)
+ catch {set env(LC_ALL) $oldlc_all}
+} -result 0
test unixInit-4.1 {TclpSetVariables} {unix} {
# just make sure they exist
@@ -403,7 +388,7 @@ test unixInit-7.1 {closed standard channel: Bug 772288} -constraints {
removeFile crash.tcl
removeFile crashtest.tcl
} -returnCodes 0
-
+
# cleanup
catch {unset env(LANG)}
catch {set env(LANG) $oldlang}
@@ -411,3 +396,7 @@ unset -nocomplain path
::tcltest::cleanupTests
return
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test
index 24717ee..2f03529 100644
--- a/tests/unixNotfy.test
+++ b/tests/unixNotfy.test
@@ -9,12 +9,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixNotfy.test,v 1.19 2005/11/01 16:41:20 dgp Exp $
-
-# The tests should not be run if you have a notifier which is unable to
-# detect infinite vwaits, as the tests below will hang. The presence of
-# the "testthread" command indicates that this is the case.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -22,11 +16,11 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
}
# When run in a Tk shell, these tests hang.
-testConstraint noTk [expr {![info exists tk_version]}]
-testConstraint testthread [expr {[info commands testthread] != {}}]
+testConstraint noTk [expr {0 != [catch {package present Tk}]}]
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
# Darwin always uses a threaded notifier
testConstraint unthreaded [expr {
- (![info exist tcl_platform(threaded)] || !$tcl_platform(threaded))
+ ![::tcl::pkgconfig get threaded]
&& $tcl_platform(os) ne "Darwin"
}]
@@ -63,16 +57,15 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -
}
test unixNotfy-2.1 {Tcl_DeleteFileHandler} \
- -constraints {noTk unix testthread} \
+ -constraints {noTk unix thread} \
-body {
update
set f [open [makeFile "" foo] w]
fileevent $f writable {set x 1}
vwait x
close $f
- testthread create "testthread send [testthread id] {set x ok}"
+ thread::create "thread::send [thread::id] {set x ok}"
vwait x
- threadReap
set x
} \
-result {ok} \
@@ -81,7 +74,7 @@ test unixNotfy-2.1 {Tcl_DeleteFileHandler} \
catch { removeFile foo }
}
test unixNotfy-2.2 {Tcl_DeleteFileHandler} \
- -constraints {noTk unix testthread} \
+ -constraints {noTk unix thread} \
-body {
update
set f1 [open [makeFile "" foo] w]
@@ -92,9 +85,8 @@ test unixNotfy-2.2 {Tcl_DeleteFileHandler} \
close $f1
vwait y
close $f2
- testthread create "testthread send [testthread id] {set x ok}"
+ thread::create "thread::send [thread::id] {set x ok}"
vwait x
- threadReap
set x
} \
-result {ok} \
diff --git a/tests/unknown.test b/tests/unknown.test
index 72b3252..40be6602 100644
--- a/tests/unknown.test
+++ b/tests/unknown.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unknown.test,v 1.9 2010/07/05 08:03:53 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/unload.test b/tests/unload.test
index bf704c7..5a374c4 100644
--- a/tests/unload.test
+++ b/tests/unload.test
@@ -10,14 +10,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unload.test,v 1.9 2010/04/02 21:21:06 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Figure out what extension is used for shared libraries on this
# platform.
if {![info exists ext]} {
diff --git a/tests/uplevel.test b/tests/uplevel.test
index f676290..0410469 100644
--- a/tests/uplevel.test
+++ b/tests/uplevel.test
@@ -1,17 +1,15 @@
# Commands covered: uplevel
#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 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.
-#
-# RCS: @(#) $Id: uplevel.test,v 1.9 2008/06/08 03:21:33 msofer Exp $
+# 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
@@ -26,7 +24,7 @@ proc newset {name value} {
uplevel set $name $value
uplevel 1 {uplevel 1 {set xyz 22}}
}
-
+
test uplevel-1.1 {simple operation} {
set xyz 0
a 22 33
@@ -85,20 +83,24 @@ test uplevel-3.4 {uplevel to same level} {
a1
} 55
-test uplevel-4.1 {error: non-existent level} {
- list [catch c1 msg] $msg
-} {1 {bad level "#2"}}
-test uplevel-4.2 {error: non-existent level} {
- proc c2 {} {uplevel 3 {set a b}}
- list [catch c2 msg] $msg
-} {1 {bad level "3"}}
-test uplevel-4.3 {error: not enough args} {
- list [catch uplevel msg] $msg
-} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
-test uplevel-4.4 {error: not enough args} {
- proc upBug {} {uplevel 1}
- list [catch upBug msg] $msg
-} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
+test uplevel-4.1 {error: non-existent level} -returnCodes error -body {
+ apply {{} {
+ uplevel #2 {set y 222}
+ }}
+} -result {bad level "#2"}
+test uplevel-4.2 {error: non-existent level} -returnCodes error -body {
+ apply {{} {
+ uplevel 3 {set a b}
+ }}
+} -result {bad level "3"}
+test uplevel-4.3 {error: not enough args} -returnCodes error -body {
+ uplevel
+} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
+test uplevel-4.4 {error: not enough args} -returnCodes error -body {
+ apply {{} {
+ uplevel 1
+ }}
+} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
proc a2 {} {
uplevel a3
@@ -193,7 +195,12 @@ test uplevel-7.3 {var access, LVT in upper level} -setup {
rename foo {}
rename moo {}
} -result {3 3 3}
-
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/upvar.test b/tests/upvar.test
index dbf6dd5..e2c9ffd 100644
--- a/tests/upvar.test
+++ b/tests/upvar.test
@@ -10,14 +10,15 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: upvar.test,v 1.20 2010/02/10 23:28:39 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testupvar [llength [info commands testupvar]]
test upvar-1.1 {reading variables with upvar} {
@@ -427,116 +428,103 @@ namespace eval test_ns_0 {
}
set ::x test_global
-test upvar-NS-1.1 {nsupvar links to correct variable} \
- -body {
- namespace eval test_ns_1 {
+test upvar-NS-1.1 {nsupvar links to correct variable} -body {
+ namespace eval test_ns_1 {
+ namespace upvar ::test_ns_0 x w
+ set w
+ }
+} -result {test_ns_0} -cleanup {
+ namespace delete test_ns_1
+}
+test upvar-NS-1.2 {nsupvar links to correct variable} -body {
+ namespace eval test_ns_1 {
+ proc a {} {
namespace upvar ::test_ns_0 x w
set w
}
- } \
- -result {test_ns_0} \
- -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.2 {nsupvar links to correct variable} \
- -body {
- namespace eval test_ns_1 {
- proc a {} {
- namespace upvar ::test_ns_0 x w
- set w
- }
- return [a]
- }
- } \
- -result {test_ns_0} \
- -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.3 {nsupvar links to correct variable} \
- -body {
- namespace eval test_ns_1 {
+ return [a]
+ }
+} -result {test_ns_0} -cleanup {
+ namespace delete test_ns_1
+}
+test upvar-NS-1.3 {nsupvar links to correct variable} -body {
+ namespace eval test_ns_1 {
+ namespace upvar test_ns_0 x w
+ set w
+ }
+} -returnCodes error -cleanup {
+ namespace delete test_ns_1
+} -result {namespace "test_ns_0" not found in "::test_ns_1"}
+test upvar-NS-1.4 {nsupvar links to correct variable} -body {
+ namespace eval test_ns_1 {
+ proc a {} {
namespace upvar test_ns_0 x w
set w
}
- } \
- -result {namespace "test_ns_0" not found in "::test_ns_1"} \
- -returnCodes error \
- -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.4 {nsupvar links to correct variable} \
- -body {
- namespace eval test_ns_1 {
- proc a {} {
- namespace upvar test_ns_0 x w
- set w
- }
- return [a]
- }
- } \
- -result {namespace "test_ns_0" not found in "::test_ns_1"} \
- -returnCodes error \
- -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.5 {nsupvar links to correct variable} \
- -body {
- namespace eval test_ns_1 {
- namespace eval test_ns_0 {}
+ return [a]
+ }
+} -returnCodes error -cleanup {
+ namespace delete test_ns_1
+} -result {namespace "test_ns_0" not found in "::test_ns_1"}
+
+test upvar-NS-1.5 {nsupvar links to correct variable} -body {
+ namespace eval test_ns_1 {
+ namespace eval test_ns_0 {}
+ namespace upvar test_ns_0 x w
+ set w
+ }
+} -cleanup {
+ namespace delete test_ns_1
+} -result {can't read "w": no such variable} -returnCodes error
+test upvar-NS-1.6 {nsupvar links to correct variable} -body {
+ namespace eval test_ns_1 {
+ namespace eval test_ns_0 {}
+ proc a {} {
namespace upvar test_ns_0 x w
set w
}
- } \
- -result {can't read "w": no such variable} \
- -returnCodes error \
- -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.6 {nsupvar links to correct variable} \
- -body {
- namespace eval test_ns_1 {
- namespace eval test_ns_0 {}
- proc a {} {
- namespace upvar test_ns_0 x w
- set w
- }
- return [a]
+ return [a]
+ }
+} -cleanup {
+ namespace delete test_ns_1
+} -result {can't read "w": no such variable} -returnCodes error
+test upvar-NS-1.7 {nsupvar links to correct variable} -body {
+ namespace eval test_ns_1 {
+ namespace eval test_ns_0 {
+ variable x test_ns_1::test_ns_0
}
- } \
- -result {can't read "w": no such variable} \
- -returnCodes error \
- -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.7 {nsupvar links to correct variable} \
- -body {
- namespace eval test_ns_1 {
- namespace eval test_ns_0 {
- variable x test_ns_1::test_ns_0
- }
+ namespace upvar test_ns_0 x w
+ set w
+ }
+} -cleanup {
+ namespace delete test_ns_1
+} -result {test_ns_1::test_ns_0}
+test upvar-NS-1.8 {nsupvar links to correct variable} -body {
+ namespace eval test_ns_1 {
+ namespace eval test_ns_0 {
+ variable x test_ns_1::test_ns_0
+ }
+ proc a {} {
namespace upvar test_ns_0 x w
set w
}
- } \
- -result {test_ns_1::test_ns_0} \
- -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.8 {nsupvar links to correct variable} \
- -body {
- namespace eval test_ns_1 {
- namespace eval test_ns_0 {
- variable x test_ns_1::test_ns_0
- }
- proc a {} {
- namespace upvar test_ns_0 x w
- set w
- }
- return [a]
- }
- } \
- -result {test_ns_1::test_ns_0} \
- -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.9 {nsupvar links to correct variable} \
- -body {
- namespace eval test_ns_1 {
- variable x test_ns_1
- proc a {} {
- namespace upvar test_ns_0 x w
- set w
- }
- return [a]
+ return [a]
+ }
+} -cleanup {
+ namespace delete test_ns_1
+} -result {test_ns_1::test_ns_0}
+test upvar-NS-1.9 {nsupvar links to correct variable} -body {
+ namespace eval test_ns_1 {
+ variable x test_ns_1
+ proc a {} {
+ namespace upvar test_ns_0 x w
+ set w
}
- } \
- -result {namespace "test_ns_0" not found in "::test_ns_1"} \
- -returnCodes error \
- -cleanup {namespace delete test_ns_1}
+ return [a]
+ }
+} -returnCodes error -cleanup {
+ namespace delete test_ns_1
+} -result {namespace "test_ns_0" not found in "::test_ns_1"}
test upvar-NS-2.1 {TIP 323} -returnCodes error -body {
namespace upvar
diff --git a/tests/utf.test b/tests/utf.test
index 575a5cd..c41cfe3 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -7,14 +7,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: utf.test,v 1.14 2007/05/02 01:37:28 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
catch {unset x}
test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} {
@@ -29,9 +30,12 @@ test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} {
test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} {
set x "\u4e4e"
} [bytestring "\xe4\xb9\x8e"]
-test utf-1.5 {Tcl_UniCharToUtf: negative Tcl_UniChar} {
- string length [format %c -1]
-} 1
+test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} {
+ format %c 0x110000
+} [bytestring "\xef\xbf\xbd"]
+test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} {
+ format %c -1
+} [bytestring "\xef\xbf\xbd"]
test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
string length "abc"
@@ -170,7 +174,7 @@ bsCheck \x 120
bsCheck \xa 10
bsCheck \xA 10
bsCheck \x41 65
-bsCheck \x541 65
+bsCheck \x541 84
bsCheck \u 117
bsCheck \uk 117
bsCheck \u41 65
@@ -179,6 +183,18 @@ 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 \U00110000 65533
+bsCheck \Uffffffff 65533
test utf-11.1 {Tcl_UtfToUpper} {
string toupper {}
@@ -246,8 +262,9 @@ test utf-16.1 {Tcl_UniCharToLower, negative delta} {
string tolower aA
} aa
test utf-16.2 {Tcl_UniCharToLower, positive delta} {
- string tolower \u0178\u00ff
-} \u00ff\u00ff
+ string tolower \u0178\u00ff\uA78D\u01c5
+} \u00ff\u00ff\u0265\u01c6
+
test utf-17.1 {Tcl_UniCharToLower, no delta} {
string tolower !
} !
@@ -276,13 +293,53 @@ test utf-20.1 {TclUniCharNcmp} {
} {}
test utf-21.1 {TclUniCharIsAlnum} {
- # this returns 1 with Unicode 3 compliance
- string is alnum \u1040\u021f
+ # this returns 1 with Unicode 6 compliance
+ string is alnum \u1040\u021f\u0220
} {1}
test utf-21.2 {unicode alnum char in regc_locale.c} {
- # this returns 1 with Unicode 3 compliance
- list [regexp {^[[:alnum:]]+$} \u1040\u021f] [regexp {^\w+$} \u1040\u021f]
+ # this returns 1 with Unicode 6 compliance
+ list [regexp {^[[:alnum:]]+$} \u1040\u021f\u0220] [regexp {^\w+$} \u1040\u021f\u0220]
} {1 1}
+test utf-21.3 {unicode print char in regc_locale.c} {
+ # this returns 1 with Unicode 6 compliance
+ regexp {^[[:print:]]+$} \ufbc1
+} 1
+test utf-21.4 {TclUniCharIsGraph} {
+ # [Bug 3464428]
+ string is graph \u0120
+} {1}
+test utf-21.5 {unicode graph char in regc_locale.c} {
+ # [Bug 3464428]
+ regexp {^[[:graph:]]+$} \u0120
+} {1}
+test utf-21.6 {TclUniCharIsGraph} {
+ # [Bug 3464428]
+ string is graph \u00a0
+} {0}
+test utf-21.7 {unicode graph char in regc_locale.c} {
+ # [Bug 3464428]
+ regexp {[[:graph:]]} \u0020\u00a0\u2028\u2029
+} {0}
+test utf-21.8 {TclUniCharIsPrint} {
+ # [Bug 3464428]
+ string is print \u0009
+} {0}
+test utf-21.9 {unicode print char in regc_locale.c} {
+ # [Bug 3464428]
+ regexp {[[:print:]]} \u0009
+} {0}
+test utf-21.10 {unicode print char in regc_locale.c} {
+ # [Bug 3464428]
+ regexp {[[:print:]]} \u0009
+} {0}
+test utf-21.11 {TclUniCharIsControl} {
+ # [Bug 3464428]
+ string is control \u00ad
+} {1}
+test utf-21.12 {unicode control char in regc_locale.c} {
+ # [Bug 3464428]
+ regexp {^[[:cntrl:]]$} \u00ad
+} {1}
test utf-22.1 {TclUniCharIsWordChar} {
string wordend "xyz123_bar fg" 0
@@ -292,30 +349,30 @@ test utf-22.2 {TclUniCharIsWordChar} {
} 10
test utf-23.1 {TclUniCharIsAlpha} {
- # this returns 1 with Unicode 3 compliance
- string is alpha \u021f
+ # this returns 1 with Unicode 6 compliance
+ string is alpha \u021f\u0220
} {1}
test utf-23.2 {unicode alpha char in regc_locale.c} {
- # this returns 1 with Unicode 3 compliance
- regexp {^[[:alpha:]]+$} \u021f
+ # this returns 1 with Unicode 6 compliance
+ regexp {^[[:alpha:]]+$} \u021f\u0220
} {1}
test utf-24.1 {TclUniCharIsDigit} {
- # this returns 1 with Unicode 3 compliance
- string is digit \u1040
+ # this returns 1 with Unicode 6 compliance
+ string is digit \u1040\uabf0
} {1}
test utf-24.2 {unicode digit char in regc_locale.c} {
- # this returns 1 with Unicode 3 compliance
- list [regexp {^[[:digit:]]+$} \u1040] [regexp {^\d+$} \u1040]
+ # this returns 1 with Unicode 6 compliance
+ list [regexp {^[[:digit:]]+$} \u1040\uabf0] [regexp {^\d+$} \u1040\uabf0]
} {1 1}
test utf-24.3 {TclUniCharIsSpace} {
- # this returns 1 with Unicode 3 compliance
- string is space \u1680
+ # this returns 1 with Unicode 6 compliance
+ string is space \u1680\u180e
} {1}
test utf-24.4 {unicode space char in regc_locale.c} {
- # this returns 1 with Unicode 3 compliance
- list [regexp {^[[:space:]]+$} \u1680] [regexp {^\s+$} \u1680]
+ # this returns 1 with Unicode 6 compliance
+ list [regexp {^[[:space:]]+$} \u1680\u180e] [regexp {^\s+$} \u1680\u180e]
} {1 1}
testConstraint teststringobj [llength [info commands teststringobj]]
diff --git a/tests/util.test b/tests/util.test
index 994fc0f..0e50483 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -6,16 +6,19 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: util.test,v 1.20 2008/10/14 16:35:44 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint controversialNaN 1
testConstraint testdstring [llength [info commands testdstring]]
testConstraint testconcatobj [llength [info commands testconcatobj]]
+testConstraint testdoubledigits [llength [info commands testdoubledigits]]
# Big test for correct ordering of data in [expr]
@@ -43,6 +46,10 @@ proc testIEEE {} {
ieeeValues(+Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
ieeeValues(NaN)
+ binary scan \x00\x00\x00\x00\x00\x00\xf8\xff d \
+ ieeeValues(-NaN)
+ binary scan \xef\xcd\xab\x89\x67\x45\xfb\xff d \
+ ieeeValues(-NaN(3456789abcdef))
set ieeeValues(littleEndian) 1
return 1
}
@@ -65,6 +72,10 @@ proc testIEEE {} {
ieeeValues(+Infinity)
binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(NaN)
+ binary scan \xff\xf8\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-NaN)
+ binary scan \xff\xfb\x45\x67\x89\xab\xcd\xef d \
+ ieeeValues(-NaN(3456789abcdef))
set ieeeValues(littleEndian) 0
return 1
}
@@ -85,6 +96,30 @@ proc convertDouble { x } {
return $result
}
+proc verdonk_test {sig binexp shouldbe exp} {
+ regexp {([-+]?)([0-9a-f]+)} $sig -> signum sig
+ scan $sig %llx sig
+ if {$signum eq {-}} {
+ set signum [expr 1<<63]
+ } else {
+ set signum 0
+ }
+ regexp {E([-+]?[0-9]+)} $binexp -> binexp
+ set word [expr {$signum | (($binexp + 0x3ff)<<52)|($sig & ~(1<<52))}]
+ binary scan [binary format w $word] q double
+ regexp {([-+])(\d+)_(\d+)\&} $shouldbe -> signum digits1 digits2
+ regexp {E([-+]\d+)} $exp -> decexp
+ incr decexp [expr {[string length $digits1] - 1}]
+ lassign [testdoubledigits $double [string length $digits1] e] \
+ outdigits decpt outsign
+ if {[string index $digits2 0] >= 5} {
+ incr digits1
+ }
+ if {$outsign != $signum || $outdigits != $digits1 || $decpt != $decexp} {
+ return -code error "result is ${outsign}0.${outdigits}E$decpt\
+ should be ${signum}0.${digits1}E$decexp"
+ }
+}
test util-1.1 {TclFindElement procedure - binary element in middle of list} {
lindex {0 foo\x00help 1} 1
@@ -144,6 +179,12 @@ test util-3.5.1 {Tcl_ConverCountedElement procedure - quote leading '#'} {
rename #\{ {}
set result
} {#}
+test util-3.6 {Tcl_ConvertElement, Bug 3371644} {
+ interp create #\\
+ interp alias {} x #\\ concat
+ interp target {} x ;# Crash if bug not fixed
+ interp delete #\\
+} {}
test util-4.1 {Tcl_ConcatObj - backslash-space at end of argument} {
concat a {b\ } c
@@ -1106,6 +1147,2881 @@ test util-11.23 {Tcl_PrintDouble - scaling} {
expr 1.1e17
} {1.1e+17}
+test util-12.1 {TclDoubleDigits - Inf} {testdoubledigits ieeeFloatingPoint} {
+ testdoubledigits Inf -1 shortest
+} {Infinity 9999 +}
+test util-12.2 {TclDoubleDigits - -Inf} {testdoubledigits ieeeFloatingPoint} {
+ testdoubledigits -Inf -1 shortest
+} {Infinity 9999 -}
+test util-12.3 {TclDoubleDigits - NaN} {testdoubledigits ieeeFloatingPoint} {
+ testdoubledigits $ieeeValues(NaN) -1 shortest
+} {NaN 9999 +}
+test util-12.4 {TclDoubleDigits - NaN} {*}{
+ -constraints {testdoubledigits ieeeFloatingPoint controversialNaN}
+ -body {
+ testdoubledigits -NaN -1 shortest
+ }
+ -result {NaN 9999 -}
+}
+test util-12.5 {TclDoubleDigits - 0} testdoubledigits {
+ testdoubledigits 0.0 -1 shortest
+} {0 0 +}
+test util-12.6 {TclDoubleDigits - -0} testdoubledigits {
+ testdoubledigits -0.0 -1 shortest
+} {0 0 -}
+
+# Verdonk test vectors
+
+test util-13.1 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1754e31cd072da E+1008 +4_000000000000000000& E+303
+ }
+ -result {}
+}
+test util-13.2 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1afcef51f0fb5f E+265 -1_000000000000000000& E+80
+ }
+ -result {}
+}
+test util-13.3 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1754e31cd072da E+1006 +1_000000000000000000& E+303
+ }
+ -result {}
+}
+test util-13.4 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1754e31cd072da E+1007 -2_000000000000000000& E+303
+ }
+ -result {}
+}
+test util-13.5 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1e07b27dd78b14 E-848 +1_00000000000000000& E-255
+ }
+ -result {}
+}
+test util-13.6 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1e29e9c56687fe E-709 -7_00000000000000000& E-214
+ }
+ -result {}
+}
+test util-13.7 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1be03d0bf225c7 E-137 +1_00000000000000000& E-41
+ }
+ -result {}
+}
+test util-13.8 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1a2fe76a3f9475 E-499 -1_00000000000000000& E-150
+ }
+ -result {}
+}
+test util-13.9 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 19a2028368022e E+1019 +8_999999999999999999& E+306
+ }
+ -result {}
+}
+test util-13.10 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1317e5ef3ab327 E+509 -1_999999999999999999& E+153
+ }
+ -result {}
+}
+test util-13.11 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1317e5ef3ab327 E+510 +3_99999999999999999& E+153
+ }
+ -result {}
+}
+test util-13.12 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1317e5ef3ab327 E+511 -7_99999999999999999& E+153
+ }
+ -result {}
+}
+test util-13.13 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1eb8e84fa0b278 E-1008 +6_999999999999999999& E-304
+ }
+ -result {}
+}
+test util-13.14 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -13339131c46f8b E-1004 -6_999999999999999999& E-303
+ }
+ -result {}
+}
+test util-13.15 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1c0f92a6276c9d E-162 +2_999999999999999999& E-49
+ }
+ -result {}
+}
+test util-13.16 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -15ce1f143d7ad2 E-443 -5_99999999999999999& E-134
+ }
+ -result {}
+}
+test util-13.17 {just over exact - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1c0794d9d40e96 E-301 +43_000000000000000000& E-92
+ }
+ -result {}
+}
+test util-13.18 {just over exact - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1c0794d9d40e96 E-300 -86_000000000000000000& E-92
+ }
+ -result {}
+}
+test util-13.19 {just over exact - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1cd5bee57763e6 E-241 +51_000000000000000000& E-74
+ }
+ -result {}
+}
+test util-13.20 {just under exact - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1d1c26db7d0dae E+651 +16_999999999999999999& E+195
+ }
+ -result {}
+}
+test util-13.21 {just under exact - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -13f7ced916872b E-5 -38_999999999999999999& E-3
+ }
+ -result {}
+}
+test util-13.22 {just over exact - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 17d93193f78fc6 E+588 +151_0000000000000000000& E+175
+ }
+ -result {}
+}
+test util-13.23 {just over exact - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1a82a1631eeb30 E-625 -119_000000000000000000& E-190
+ }
+ -result {}
+}
+test util-13.24 {just under exact - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -16c309024bab4b E+290 -282_999999999999999999& E+85
+ }
+ -result {}
+}
+test util-13.25 {just over exact - 8 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1dbbac6f83a821 E-800 +27869147_0000000000000000000& E-248
+ }
+ -result {}
+}
+test util-13.26 {just under exact - 9 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1c569e968e0944 E+430 -491080653_9999999999999999999& E+121
+ }
+ -result {}
+}
+test util-13.27 {just under exact - 9 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1c569e968e0944 E+429 +245540326_9999999999999999999& E+121
+ }
+ -result {}
+}
+test util-13.28 {just over exact - 10 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1fc575867314ee E-330 -9078555839_0000000000000000000& E-109
+ }
+ -result {}
+}
+test util-13.29 {just under exact - 10 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1c569e968e0944 E+428 -1227701634_9999999999999999999& E+120
+ }
+ -result {}
+}
+test util-13.30 {just over exact - 11 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1fc575867314ee E-329 +18157111678_0000000000000000000& E-109
+ }
+ -result {}
+}
+test util-13.31 {just over exact - 14 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -18bf7e7fa6f02a E-196 -15400733123779_0000000000000000000& E-72
+ }
+ -result {}
+}
+test util-13.32 {just over exact - 17 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -13de005bd620df E+217 -26153245263757307_0000000000000000000& E+49
+ }
+ -result {}
+}
+test util-13.33 {just over exact - 18 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1f92bacb3cb40c E+718 +272104041512242479_0000000000000000000& E+199
+ }
+ -result {}
+}
+test util-13.34 {just over exact - 18 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1f92bacb3cb40c E+719 -544208083024484958_0000000000000000000& E+199
+ }
+ -result {}
+}
+test util-13.35 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 142dbf25096cf5 E+148 +4_500000000000000000& E+44
+ }
+ -result {}
+}
+test util-13.36 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1afcef51f0fb5f E+263 -2_500000000000000000& E+79
+ }
+ -result {}
+}
+test util-13.37 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 102498ea6df0c4 E+145 +4_500000000000000000& E+43
+ }
+ -result {}
+}
+test util-13.38 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1754e31cd072da E+1004 -2_500000000000000000& E+302
+ }
+ -result {}
+}
+test util-13.39 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 12deac01e2b4f7 E-557 +2_50000000000000000& E-168
+ }
+ -result {}
+}
+test util-13.40 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1b1df536c13eee E-307 -6_50000000000000000& E-93
+ }
+ -result {}
+}
+test util-13.41 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 10711fed5b19a4 E-154 +4_50000000000000000& E-47
+ }
+ -result {}
+}
+test util-13.42 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -148d67e8b1e00d E-151 -4_50000000000000000& E-46
+ }
+ -result {}
+}
+test util-13.43 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1c8c574c0c6be7 E+187 +3_49999999999999999& E+56
+ }
+ -result {}
+}
+test util-13.44 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1756183c147514 E+206 -1_49999999999999999& E+62
+ }
+ -result {}
+}
+test util-13.45 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 12ab469676c410 E+203 +1_49999999999999999& E+61
+ }
+ -result {}
+}
+test util-13.46 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1539684e774b48 E+246 -1_49999999999999999& E+74
+ }
+ -result {}
+}
+test util-13.47 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 12e5f5dfa4fe9d E-286 +9_499999999999999999& E-87
+ }
+ -result {}
+}
+test util-13.48 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1bdc2417bf7787 E-838 -9_499999999999999999& E-253
+ }
+ -result {}
+}
+test util-13.49 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1eb8e84fa0b278 E-1009 +3_499999999999999999& E-304
+ }
+ -result {}
+}
+test util-13.50 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1e3cbc9907fdc8 E-290 -9_499999999999999999& E-88
+ }
+ -result {}
+}
+test util-13.51 {just over half ulp - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 10ad836f269a17 E-324 +30_500000000000000000& E-99
+ }
+ -result {}
+}
+test util-13.52 {just over half ulp - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1b39ae1909c31b E-687 -26_500000000000000000& E-208
+ }
+ -result {}
+}
+test util-13.53 {just over half ulp - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1b2ab18615fcc6 E-576 +686_500000000000000000& E-176
+ }
+ -result {}
+}
+test util-13.54 {just over half ulp - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -13e1f90a573064 E-624 -178_500000000000000000& E-190
+ }
+ -result {}
+}
+test util-13.55 {just under half ulp - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 16c309024bab4b E+289 +141_499999999999999999& E+85
+ }
+ -result {}
+}
+test util-13.56 {just under half ulp - 4 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -159bd3ad46e346 E+193 -1695_499999999999999999& E+55
+ }
+ -result {}
+}
+test util-13.57 {just under half ulp - 4 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1df4170f0fdecc E+124 +3981_499999999999999999& E+34
+ }
+ -result {}
+}
+test util-13.58 {just over half ulp - 6 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 17e1e0f1c7a4ac E+415 +126300_5000000000000000000& E+120
+ }
+ -result {}
+}
+test util-13.59 {just over half ulp - 6 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1dda592e398dd7 E+418 -126300_5000000000000000000& E+121
+ }
+ -result {}
+}
+test util-13.60 {just under half ulp - 7 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1e597c0b94b7ae E+453 -4411845_499999999999999999& E+130
+ }
+ -result {}
+}
+test util-13.61 {just under half ulp - 9 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1c569e968e0944 E+427 +613850817_4999999999999999999& E+120
+ }
+ -result {}
+}
+test util-13.62 {just under half ulp - 9 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1c569e968e0944 E+428 -122770163_49999999999999999999& E+121
+ }
+ -result {}
+}
+test util-13.63 {just over half ulp - 18 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 17ae0c186d8709 E+719 +408156062268363718_5000000000000000000& E+199
+ }
+ -result {}
+}
+test util-13.64 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 152d02c7e14af7 E+76 +1_0000000000000000& E+23
+ }
+ -result {}
+}
+test util-13.65 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -19d971e4fe8402 E+89 -1_0000000000000000& E+27
+ }
+ -result {}
+}
+test util-13.66 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 19d971e4fe8402 E+90 +2_0000000000000000& E+27
+ }
+ -result {}
+}
+test util-13.67 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -19d971e4fe8402 E+91 -4_0000000000000000& E+27
+ }
+ -result {}
+}
+test util-13.68 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 15798ee2308c3a E-27 +1_0000000000000000& E-8
+ }
+ -result {}
+}
+test util-13.69 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -15798ee2308c3a E-26 -2_0000000000000000& E-8
+ }
+ -result {}
+}
+test util-13.70 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 15798ee2308c3a E-25 +4_0000000000000000& E-8
+ }
+ -result {}
+}
+test util-13.71 {just over exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1ef2d0f5da7dd9 E-84 -1_0000000000000000& E-25
+ }
+ -result {}
+}
+test util-13.72 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1a784379d99db4 E+78 +4_9999999999999999& E+23
+ }
+ -result {}
+}
+test util-13.73 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1a784379d99db4 E+80 -1_9999999999999999& E+24
+ }
+ -result {}
+}
+test util-13.74 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 13da329b633647 E+81 +2_9999999999999999& E+24
+ }
+ -result {}
+}
+test util-13.75 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1cf389cd46047d E+85 -6_9999999999999999& E+25
+ }
+ -result {}
+}
+test util-13.76 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 19999999999999 E-3 +1_99999999999999999& E-1
+ }
+ -result {}
+}
+test util-13.77 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -13333333333333 E-2 -2_99999999999999999& E-1
+ }
+ -result {}
+}
+test util-13.78 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 16849b86a12b9b E-48 +4_99999999999999999& E-15
+ }
+ -result {}
+}
+test util-13.79 {just under exact - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -16849b86a12b9b E-46 -1_99999999999999999& E-14
+ }
+ -result {}
+}
+test util-13.80 {just over exact - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 17ccfc73126788 E-71 +63_00000000000000000& E-23
+ }
+ -result {}
+}
+test util-13.81 {just over exact - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1dc03b8fd7016a E-68 -63_00000000000000000& E-22
+ }
+ -result {}
+}
+test util-13.82 {just under exact - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 13f7ced916872b E-5 +38_999999999999999999& E-3
+ }
+ -result {}
+}
+test util-13.83 {just over exact - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1b297cad9f70b6 E+97 +269_000000000000000000& E+27
+ }
+ -result {}
+}
+test util-13.84 {just over exact - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1b297cad9f70b6 E+98 -538_00000000000000000& E+27
+ }
+ -result {}
+}
+test util-13.85 {just over exact - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1cdc06b20ef183 E-82 +373_00000000000000000& E-27
+ }
+ -result {}
+}
+test util-13.86 {just over exact - 4 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1b297cad9f70b6 E+96 +1345_00000000000000000& E+26
+ }
+ -result {}
+}
+# this one is not 4 digits, it is 3, and it is covered above.
+test util-13.87 {just over exact - 4 digits} {*}{
+ -constraints {testdoubledigits knownBadTest}
+ -body {
+ verdonk_test -1b297cad9f70b6 E+97 -2690_00000000000000000& E+26
+ }
+ -result {}
+}
+test util-13.88 {just over exact - 5 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -150a246ecd44f3 E-63 -14257_00000000000000000& E-23
+ }
+ -result {}
+}
+test util-13.89 {just under exact - 6 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -119b96f36ec68b E-19 -209900_999999999999999999& E-11
+ }
+ -result {}
+}
+test util-13.90 {just over exact - 11 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1c06d366394441 E-35 +50980203373_000000000000000000& E-21
+ }
+ -result {}
+}
+test util-13.91 {just under exact - 12 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1f58ac4db68c90 E+122 -104166211810_99999999999999999& E+26
+ }
+ -result {}
+}
+test util-13.92 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 19d971e4fe8402 E+87 +2_5000000000000000& E+26
+ }
+ -result {}
+}
+test util-13.93 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1dc74be914d16b E+81 -4_500000000000000& E+24
+ }
+ -result {}
+}
+test util-13.94 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 14adf4b7320335 E+84 +2_500000000000000& E+25
+ }
+ -result {}
+}
+test util-13.95 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1ae22487c1042b E+85 -6_5000000000000000& E+25
+ }
+ -result {}
+}
+test util-13.96 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 187fe49aab41e0 E-54 +8_5000000000000000& E-17
+ }
+ -result {}
+}
+test util-13.97 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1f5c05e4b23fd7 E-61 -8_5000000000000000& E-19
+ }
+ -result {}
+}
+test util-13.98 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1faa7ab552a552 E-42 +4_5000000000000000& E-13
+ }
+ -result {}
+}
+test util-13.99 {just over half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1b7cdfd9d7bdbb E-36 -2_5000000000000000& E-11
+ }
+ -result {}
+}
+test util-13.100 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 13da329b633647 E+80 +1_4999999999999999& E+24
+ }
+ -result {}
+}
+test util-13.101 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1cf389cd46047d E+84 -3_49999999999999999& E+25
+ }
+ -result {}
+}
+test util-13.102 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1f04ef12cb04cf E+85 +7_4999999999999999& E+25
+ }
+ -result {}
+}
+test util-13.103 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1f04ef12cb04cf E+86 -1_4999999999999999& E+26
+ }
+ -result {}
+}
+test util-13.104 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 13333333333333 E-3 +1_49999999999999999& E-1
+ }
+ -result {}
+}
+test util-13.105 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -107e1fe91b0b70 E-36 -1_49999999999999999& E-11
+ }
+ -result {}
+}
+test util-13.106 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 149da7e361ce4c E-33 +1_49999999999999999& E-10
+ }
+ -result {}
+}
+test util-13.107 {just under half ulp - 1 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -19c511dc3a41df E-30 -1_49999999999999999& E-9
+ }
+ -result {}
+}
+test util-13.108 {just over half ulp - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1aa83d74267822 E+93 -16_5000000000000000& E+27
+ }
+ -result {}
+}
+test util-13.109 {just over half ulp - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 18f1d5969453de E+89 +96_5000000000000000& E+25
+ }
+ -result {}
+}
+test util-13.110 {just over half ulp - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 11d9bd564dcda6 E-70 +94_50000000000000000& E-23
+ }
+ -result {}
+}
+test util-13.111 {just over half ulp - 2 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1a58973ecbede6 E-48 -58_50000000000000000& E-16
+ }
+ -result {}
+}
+test util-13.112 {just over half ulp - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1b297cad9f70b6 E+95 +672_50000000000000000& E+26
+ }
+ -result {}
+}
+test util-13.113 {just over half ulp - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -1b297cad9f70b6 E+96 -134_500000000000000000& E+27
+ }
+ -result {}
+}
+test util-13.114 {just over half ulp - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1cdc06b20ef183 E-83 +186_50000000000000000& E-27
+ }
+ -result {}
+}
+test util-13.115 {just over half ulp - 3 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -136071dcae4565 E-47 -860_50000000000000000& E-17
+ }
+ -result {}
+}
+test util-13.116 {just over half ulp - 6 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1cb968d297dde8 E+99 +113788_50000000000000000& E+25
+ }
+ -result {}
+}
+test util-13.117 {just over half ulp - 6 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test -11f3e1839eeab1 E+103 -113788_50000000000000000& E+26
+ }
+ -result {}
+}
+test util-13.118 {just under half ulp - 9 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1e9cec176c96f8 E+117 +317903333_49999999999999999& E+27
+ }
+ -result {}
+}
+test util-13.119 {just over half ulp - 11 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1c06d366394441 E-36 +25490101686_500000000000000000& E-21
+ }
+ -result {}
+}
+test util-13.120 {just under half ulp - 11 digits} {*}{
+ -constraints testdoubledigits
+ -body {
+ verdonk_test 1f58ac4db68c90 E+121 +52083105905_49999999999999999& E+26
+ }
+ -result {}
+}
+
+test util-14.1 {funky NaN} {*}{
+ -constraints {ieeeFloatingPoint controversialNaN}
+ -body {
+ set ieeeValues(-NaN)
+ }
+ -result -NaN
+}
+
+test util-14.2 {funky NaN} {*}{
+ -constraints {ieeeFloatingPoint controversialNaN}
+ -body {
+ set ieeeValues(-NaN(3456789abcdef))
+ }
+ -result -NaN(3456789abcdef)
+}
+
+test util-15.1 {largest subnormal} {*}{
+ -body {
+ binary scan [binary format w 0x000fffffffffffff] q x
+ set x
+ }
+ -result 2.225073858507201e-308
+ -cleanup {
+ unset x
+ }
+}
+
+test util-15.2 {largest subnormal} {*}{
+ -body {
+ binary scan [binary format w 0x800fffffffffffff] q x
+ set x
+ }
+ -result -2.225073858507201e-308
+ -cleanup {
+ unset x
+ }
+}
+
+test util-15.3 {largest subnormal} {*}{
+ -body {
+ binary scan [binary format q 2.225073858507201e-308] w x
+ format %#lx $x
+ }
+ -result 0xfffffffffffff
+ -cleanup {
+ unset x
+ }
+}
+
+test util-15.4 {largest subnormal} {*}{
+ -body {
+ binary scan [binary format q -2.225073858507201e-308] w x
+ format %#lx $x
+ }
+ -result 0x800fffffffffffff
+ -cleanup {
+ unset x
+ }
+}
+
+test util-15.5 {smallest normal} {*}{
+ -body {
+ binary scan [binary format w 0x0010000000000000] q x
+ set x
+ }
+ -result 2.2250738585072014e-308
+ -cleanup {
+ unset x
+ }
+}
+
+test util-15.6 {smallest normal} {*}{
+ -body {
+ binary scan [binary format w 0x8010000000000000] q x
+ set x
+ }
+ -result -2.2250738585072014e-308
+ -cleanup {
+ unset x
+ }
+}
+
+test util-15.7 {smallest normal} {*}{
+ -body {
+ binary scan [binary format q 2.2250738585072014e-308] w x
+ format %#lx $x
+ }
+ -result 0x10000000000000
+ -cleanup {
+ unset x
+ }
+}
+
+test util-15.8 {smallest normal} {*}{
+ -body {
+ binary scan [binary format q -2.2250738585072014e-308] w x
+ format %#lx $x
+ }
+ -result 0x8010000000000000
+ -cleanup {
+ unset x
+ }
+}
+
+set saved_precision $::tcl_precision
+foreach ::tcl_precision {0 12} {
+ for {set e -312} {$e < -9} {incr e} {
+ test util-16.1.$::tcl_precision.$e {shortening of numbers} \
+ "expr 1.1e$e" 1.1e$e
+ }
+}
+set tcl_precision 0
+for {set e -9} {$e < -4} {incr e} {
+ test util-16.1.$::tcl_precision.$e {shortening of numbers} \
+ "expr 1.1e$e" 1.1e$e
+}
+set tcl_precision 12
+for {set e -9} {$e < -4} {incr e} {
+ test util-16.1.$::tcl_precision.$e {8.4 compatible formatting of doubles} \
+ "expr 1.1e$e" 1.1e[format %+03d $e]
+}
+foreach ::tcl_precision {0 12} {
+ test util-16.1.$::tcl_precision.-4 {shortening of numbers} \
+ {expr 1.1e-4} \
+ 0.00011
+ test util-16.1.$::tcl_precision.-3 {shortening of numbers} \
+ {expr 1.1e-3} \
+ 0.0011
+ test util-16.1.$::tcl_precision.-2 {shortening of numbers} \
+ {expr 1.1e-2} \
+ 0.011
+ test util-16.1.$::tcl_precision.-1 {shortening of numbers} \
+ {expr 1.1e-1} \
+ 0.11
+ test util-16.1.$::tcl_precision.0 {shortening of numbers} \
+ {expr 1.1} \
+ 1.1
+ for {set e 1} {$e < 17} {incr e} {
+ test util-16.1.$::tcl_precision.$e {shortening of numbers} \
+ "expr 11[string repeat 0 [expr {$e-1}]].0" \
+ 11[string repeat 0 [expr {$e-1}]].0
+ }
+ for {set e 17} {$e < 309} {incr e} {
+ test util-16.1.$::tcl_precision.$e {shortening of numbers} \
+ "expr 1.1e$e" 1.1e+$e
+ }
+}
+set tcl_precision 17
+test util-16.1.17.-300 {8.4 compatible formatting of doubles} \
+ {expr 1e-300} \
+ 1e-300
+test util-16.1.17.-299 {8.4 compatible formatting of doubles} \
+ {expr 1e-299} \
+ 9.9999999999999999e-300
+test util-16.1.17.-298 {8.4 compatible formatting of doubles} \
+ {expr 1e-298} \
+ 9.9999999999999991e-299
+test util-16.1.17.-297 {8.4 compatible formatting of doubles} \
+ {expr 1e-297} \
+ 1e-297
+test util-16.1.17.-296 {8.4 compatible formatting of doubles} \
+ {expr 1e-296} \
+ 1e-296
+test util-16.1.17.-295 {8.4 compatible formatting of doubles} \
+ {expr 1e-295} \
+ 1.0000000000000001e-295
+test util-16.1.17.-294 {8.4 compatible formatting of doubles} \
+ {expr 1e-294} \
+ 1e-294
+test util-16.1.17.-293 {8.4 compatible formatting of doubles} \
+ {expr 1e-293} \
+ 1.0000000000000001e-293
+test util-16.1.17.-292 {8.4 compatible formatting of doubles} \
+ {expr 1e-292} \
+ 1.0000000000000001e-292
+test util-16.1.17.-291 {8.4 compatible formatting of doubles} \
+ {expr 1e-291} \
+ 9.9999999999999996e-292
+test util-16.1.17.-290 {8.4 compatible formatting of doubles} \
+ {expr 1e-290} \
+ 1.0000000000000001e-290
+test util-16.1.17.-289 {8.4 compatible formatting of doubles} \
+ {expr 1e-289} \
+ 1e-289
+test util-16.1.17.-288 {8.4 compatible formatting of doubles} \
+ {expr 1e-288} \
+ 1.0000000000000001e-288
+test util-16.1.17.-287 {8.4 compatible formatting of doubles} \
+ {expr 1e-287} \
+ 1e-287
+test util-16.1.17.-286 {8.4 compatible formatting of doubles} \
+ {expr 1e-286} \
+ 1.0000000000000001e-286
+test util-16.1.17.-285 {8.4 compatible formatting of doubles} \
+ {expr 1e-285} \
+ 1.0000000000000001e-285
+test util-16.1.17.-284 {8.4 compatible formatting of doubles} \
+ {expr 1e-284} \
+ 1e-284
+test util-16.1.17.-283 {8.4 compatible formatting of doubles} \
+ {expr 1e-283} \
+ 9.9999999999999995e-284
+test util-16.1.17.-282 {8.4 compatible formatting of doubles} \
+ {expr 1e-282} \
+ 1e-282
+test util-16.1.17.-281 {8.4 compatible formatting of doubles} \
+ {expr 1e-281} \
+ 1e-281
+test util-16.1.17.-280 {8.4 compatible formatting of doubles} \
+ {expr 1e-280} \
+ 9.9999999999999996e-281
+test util-16.1.17.-279 {8.4 compatible formatting of doubles} \
+ {expr 1e-279} \
+ 1.0000000000000001e-279
+test util-16.1.17.-278 {8.4 compatible formatting of doubles} \
+ {expr 1e-278} \
+ 9.9999999999999994e-279
+test util-16.1.17.-277 {8.4 compatible formatting of doubles} \
+ {expr 1e-277} \
+ 9.9999999999999997e-278
+test util-16.1.17.-276 {8.4 compatible formatting of doubles} \
+ {expr 1e-276} \
+ 1.0000000000000001e-276
+test util-16.1.17.-275 {8.4 compatible formatting of doubles} \
+ {expr 1e-275} \
+ 9.9999999999999993e-276
+test util-16.1.17.-274 {8.4 compatible formatting of doubles} \
+ {expr 1e-274} \
+ 9.9999999999999997e-275
+test util-16.1.17.-273 {8.4 compatible formatting of doubles} \
+ {expr 1e-273} \
+ 1.0000000000000001e-273
+test util-16.1.17.-272 {8.4 compatible formatting of doubles} \
+ {expr 1e-272} \
+ 9.9999999999999993e-273
+test util-16.1.17.-271 {8.4 compatible formatting of doubles} \
+ {expr 1e-271} \
+ 9.9999999999999996e-272
+test util-16.1.17.-270 {8.4 compatible formatting of doubles} \
+ {expr 1e-270} \
+ 1e-270
+test util-16.1.17.-269 {8.4 compatible formatting of doubles} \
+ {expr 1e-269} \
+ 9.9999999999999996e-270
+test util-16.1.17.-268 {8.4 compatible formatting of doubles} \
+ {expr 1e-268} \
+ 9.9999999999999996e-269
+test util-16.1.17.-267 {8.4 compatible formatting of doubles} \
+ {expr 1e-267} \
+ 9.9999999999999998e-268
+test util-16.1.17.-266 {8.4 compatible formatting of doubles} \
+ {expr 1e-266} \
+ 9.9999999999999998e-267
+test util-16.1.17.-265 {8.4 compatible formatting of doubles} \
+ {expr 1e-265} \
+ 9.9999999999999998e-266
+test util-16.1.17.-264 {8.4 compatible formatting of doubles} \
+ {expr 1e-264} \
+ 1e-264
+test util-16.1.17.-263 {8.4 compatible formatting of doubles} \
+ {expr 1e-263} \
+ 1e-263
+test util-16.1.17.-262 {8.4 compatible formatting of doubles} \
+ {expr 1e-262} \
+ 1e-262
+test util-16.1.17.-261 {8.4 compatible formatting of doubles} \
+ {expr 1e-261} \
+ 9.9999999999999998e-262
+test util-16.1.17.-260 {8.4 compatible formatting of doubles} \
+ {expr 1e-260} \
+ 9.9999999999999996e-261
+test util-16.1.17.-259 {8.4 compatible formatting of doubles} \
+ {expr 1e-259} \
+ 1.0000000000000001e-259
+test util-16.1.17.-258 {8.4 compatible formatting of doubles} \
+ {expr 1e-258} \
+ 9.9999999999999995e-259
+test util-16.1.17.-257 {8.4 compatible formatting of doubles} \
+ {expr 1e-257} \
+ 9.9999999999999998e-258
+test util-16.1.17.-256 {8.4 compatible formatting of doubles} \
+ {expr 1e-256} \
+ 9.9999999999999998e-257
+test util-16.1.17.-255 {8.4 compatible formatting of doubles} \
+ {expr 1e-255} \
+ 1e-255
+test util-16.1.17.-254 {8.4 compatible formatting of doubles} \
+ {expr 1e-254} \
+ 9.9999999999999991e-255
+test util-16.1.17.-253 {8.4 compatible formatting of doubles} \
+ {expr 1e-253} \
+ 1.0000000000000001e-253
+test util-16.1.17.-252 {8.4 compatible formatting of doubles} \
+ {expr 1e-252} \
+ 9.9999999999999994e-253
+test util-16.1.17.-251 {8.4 compatible formatting of doubles} \
+ {expr 1e-251} \
+ 1e-251
+test util-16.1.17.-250 {8.4 compatible formatting of doubles} \
+ {expr 1e-250} \
+ 1.0000000000000001e-250
+test util-16.1.17.-249 {8.4 compatible formatting of doubles} \
+ {expr 1e-249} \
+ 1.0000000000000001e-249
+test util-16.1.17.-248 {8.4 compatible formatting of doubles} \
+ {expr 1e-248} \
+ 9.9999999999999998e-249
+test util-16.1.17.-247 {8.4 compatible formatting of doubles} \
+ {expr 1e-247} \
+ 1e-247
+test util-16.1.17.-246 {8.4 compatible formatting of doubles} \
+ {expr 1e-246} \
+ 9.9999999999999996e-247
+test util-16.1.17.-245 {8.4 compatible formatting of doubles} \
+ {expr 1e-245} \
+ 9.9999999999999993e-246
+test util-16.1.17.-244 {8.4 compatible formatting of doubles} \
+ {expr 1e-244} \
+ 9.9999999999999993e-245
+test util-16.1.17.-243 {8.4 compatible formatting of doubles} \
+ {expr 1e-243} \
+ 1e-243
+test util-16.1.17.-242 {8.4 compatible formatting of doubles} \
+ {expr 1e-242} \
+ 9.9999999999999997e-243
+test util-16.1.17.-241 {8.4 compatible formatting of doubles} \
+ {expr 1e-241} \
+ 9.9999999999999997e-242
+test util-16.1.17.-240 {8.4 compatible formatting of doubles} \
+ {expr 1e-240} \
+ 9.9999999999999997e-241
+test util-16.1.17.-239 {8.4 compatible formatting of doubles} \
+ {expr 1e-239} \
+ 1.0000000000000001e-239
+test util-16.1.17.-238 {8.4 compatible formatting of doubles} \
+ {expr 1e-238} \
+ 9.9999999999999999e-239
+test util-16.1.17.-237 {8.4 compatible formatting of doubles} \
+ {expr 1e-237} \
+ 9.9999999999999999e-238
+test util-16.1.17.-236 {8.4 compatible formatting of doubles} \
+ {expr 1e-236} \
+ 1e-236
+test util-16.1.17.-235 {8.4 compatible formatting of doubles} \
+ {expr 1e-235} \
+ 9.9999999999999996e-236
+test util-16.1.17.-234 {8.4 compatible formatting of doubles} \
+ {expr 1e-234} \
+ 9.9999999999999996e-235
+test util-16.1.17.-233 {8.4 compatible formatting of doubles} \
+ {expr 1e-233} \
+ 9.9999999999999996e-234
+test util-16.1.17.-232 {8.4 compatible formatting of doubles} \
+ {expr 1e-232} \
+ 1e-232
+test util-16.1.17.-231 {8.4 compatible formatting of doubles} \
+ {expr 1e-231} \
+ 9.9999999999999999e-232
+test util-16.1.17.-230 {8.4 compatible formatting of doubles} \
+ {expr 1e-230} \
+ 1e-230
+test util-16.1.17.-229 {8.4 compatible formatting of doubles} \
+ {expr 1e-229} \
+ 1.0000000000000001e-229
+test util-16.1.17.-228 {8.4 compatible formatting of doubles} \
+ {expr 1e-228} \
+ 1e-228
+test util-16.1.17.-227 {8.4 compatible formatting of doubles} \
+ {expr 1e-227} \
+ 9.9999999999999994e-228
+test util-16.1.17.-226 {8.4 compatible formatting of doubles} \
+ {expr 1e-226} \
+ 9.9999999999999992e-227
+test util-16.1.17.-225 {8.4 compatible formatting of doubles} \
+ {expr 1e-225} \
+ 9.9999999999999996e-226
+test util-16.1.17.-224 {8.4 compatible formatting of doubles} \
+ {expr 1e-224} \
+ 1e-224
+test util-16.1.17.-223 {8.4 compatible formatting of doubles} \
+ {expr 1e-223} \
+ 9.9999999999999997e-224
+test util-16.1.17.-222 {8.4 compatible formatting of doubles} \
+ {expr 1e-222} \
+ 1e-222
+test util-16.1.17.-221 {8.4 compatible formatting of doubles} \
+ {expr 1e-221} \
+ 1e-221
+test util-16.1.17.-220 {8.4 compatible formatting of doubles} \
+ {expr 1e-220} \
+ 9.9999999999999999e-221
+test util-16.1.17.-219 {8.4 compatible formatting of doubles} \
+ {expr 1e-219} \
+ 1e-219
+test util-16.1.17.-218 {8.4 compatible formatting of doubles} \
+ {expr 1e-218} \
+ 1e-218
+test util-16.1.17.-217 {8.4 compatible formatting of doubles} \
+ {expr 1e-217} \
+ 1.0000000000000001e-217
+test util-16.1.17.-216 {8.4 compatible formatting of doubles} \
+ {expr 1e-216} \
+ 1e-216
+test util-16.1.17.-215 {8.4 compatible formatting of doubles} \
+ {expr 1e-215} \
+ 1e-215
+test util-16.1.17.-214 {8.4 compatible formatting of doubles} \
+ {expr 1e-214} \
+ 9.9999999999999991e-215
+test util-16.1.17.-213 {8.4 compatible formatting of doubles} \
+ {expr 1e-213} \
+ 9.9999999999999995e-214
+test util-16.1.17.-212 {8.4 compatible formatting of doubles} \
+ {expr 1e-212} \
+ 9.9999999999999995e-213
+test util-16.1.17.-211 {8.4 compatible formatting of doubles} \
+ {expr 1e-211} \
+ 1.0000000000000001e-211
+test util-16.1.17.-210 {8.4 compatible formatting of doubles} \
+ {expr 1e-210} \
+ 1e-210
+test util-16.1.17.-209 {8.4 compatible formatting of doubles} \
+ {expr 1e-209} \
+ 1e-209
+test util-16.1.17.-208 {8.4 compatible formatting of doubles} \
+ {expr 1e-208} \
+ 1.0000000000000001e-208
+test util-16.1.17.-207 {8.4 compatible formatting of doubles} \
+ {expr 1e-207} \
+ 9.9999999999999993e-208
+test util-16.1.17.-206 {8.4 compatible formatting of doubles} \
+ {expr 1e-206} \
+ 1e-206
+test util-16.1.17.-205 {8.4 compatible formatting of doubles} \
+ {expr 1e-205} \
+ 1e-205
+test util-16.1.17.-204 {8.4 compatible formatting of doubles} \
+ {expr 1e-204} \
+ 1e-204
+test util-16.1.17.-203 {8.4 compatible formatting of doubles} \
+ {expr 1e-203} \
+ 1e-203
+test util-16.1.17.-202 {8.4 compatible formatting of doubles} \
+ {expr 1e-202} \
+ 1e-202
+test util-16.1.17.-201 {8.4 compatible formatting of doubles} \
+ {expr 1e-201} \
+ 9.9999999999999995e-202
+test util-16.1.17.-200 {8.4 compatible formatting of doubles} \
+ {expr 1e-200} \
+ 9.9999999999999998e-201
+test util-16.1.17.-199 {8.4 compatible formatting of doubles} \
+ {expr 1e-199} \
+ 9.9999999999999998e-200
+test util-16.1.17.-198 {8.4 compatible formatting of doubles} \
+ {expr 1e-198} \
+ 9.9999999999999991e-199
+test util-16.1.17.-197 {8.4 compatible formatting of doubles} \
+ {expr 1e-197} \
+ 9.9999999999999999e-198
+test util-16.1.17.-196 {8.4 compatible formatting of doubles} \
+ {expr 1e-196} \
+ 1e-196
+test util-16.1.17.-195 {8.4 compatible formatting of doubles} \
+ {expr 1e-195} \
+ 1.0000000000000001e-195
+test util-16.1.17.-194 {8.4 compatible formatting of doubles} \
+ {expr 1e-194} \
+ 1e-194
+test util-16.1.17.-193 {8.4 compatible formatting of doubles} \
+ {expr 1e-193} \
+ 1e-193
+test util-16.1.17.-192 {8.4 compatible formatting of doubles} \
+ {expr 1e-192} \
+ 1.0000000000000001e-192
+test util-16.1.17.-191 {8.4 compatible formatting of doubles} \
+ {expr 1e-191} \
+ 1e-191
+test util-16.1.17.-190 {8.4 compatible formatting of doubles} \
+ {expr 1e-190} \
+ 1e-190
+test util-16.1.17.-189 {8.4 compatible formatting of doubles} \
+ {expr 1e-189} \
+ 1.0000000000000001e-189
+test util-16.1.17.-188 {8.4 compatible formatting of doubles} \
+ {expr 1e-188} \
+ 9.9999999999999995e-189
+test util-16.1.17.-187 {8.4 compatible formatting of doubles} \
+ {expr 1e-187} \
+ 1e-187
+test util-16.1.17.-186 {8.4 compatible formatting of doubles} \
+ {expr 1e-186} \
+ 9.9999999999999991e-187
+test util-16.1.17.-185 {8.4 compatible formatting of doubles} \
+ {expr 1e-185} \
+ 9.9999999999999999e-186
+test util-16.1.17.-184 {8.4 compatible formatting of doubles} \
+ {expr 1e-184} \
+ 1.0000000000000001e-184
+test util-16.1.17.-183 {8.4 compatible formatting of doubles} \
+ {expr 1e-183} \
+ 1e-183
+test util-16.1.17.-182 {8.4 compatible formatting of doubles} \
+ {expr 1e-182} \
+ 1e-182
+test util-16.1.17.-181 {8.4 compatible formatting of doubles} \
+ {expr 1e-181} \
+ 1e-181
+test util-16.1.17.-180 {8.4 compatible formatting of doubles} \
+ {expr 1e-180} \
+ 1e-180
+test util-16.1.17.-179 {8.4 compatible formatting of doubles} \
+ {expr 1e-179} \
+ 1e-179
+test util-16.1.17.-178 {8.4 compatible formatting of doubles} \
+ {expr 1e-178} \
+ 9.9999999999999995e-179
+test util-16.1.17.-177 {8.4 compatible formatting of doubles} \
+ {expr 1e-177} \
+ 9.9999999999999995e-178
+test util-16.1.17.-176 {8.4 compatible formatting of doubles} \
+ {expr 1e-176} \
+ 1e-176
+test util-16.1.17.-175 {8.4 compatible formatting of doubles} \
+ {expr 1e-175} \
+ 1e-175
+test util-16.1.17.-174 {8.4 compatible formatting of doubles} \
+ {expr 1e-174} \
+ 1e-174
+test util-16.1.17.-173 {8.4 compatible formatting of doubles} \
+ {expr 1e-173} \
+ 1e-173
+test util-16.1.17.-172 {8.4 compatible formatting of doubles} \
+ {expr 1e-172} \
+ 1e-172
+test util-16.1.17.-171 {8.4 compatible formatting of doubles} \
+ {expr 1e-171} \
+ 9.9999999999999998e-172
+test util-16.1.17.-170 {8.4 compatible formatting of doubles} \
+ {expr 1e-170} \
+ 9.9999999999999998e-171
+test util-16.1.17.-169 {8.4 compatible formatting of doubles} \
+ {expr 1e-169} \
+ 1e-169
+test util-16.1.17.-168 {8.4 compatible formatting of doubles} \
+ {expr 1e-168} \
+ 1e-168
+test util-16.1.17.-167 {8.4 compatible formatting of doubles} \
+ {expr 1e-167} \
+ 1e-167
+test util-16.1.17.-166 {8.4 compatible formatting of doubles} \
+ {expr 1e-166} \
+ 1e-166
+test util-16.1.17.-165 {8.4 compatible formatting of doubles} \
+ {expr 1e-165} \
+ 1e-165
+test util-16.1.17.-164 {8.4 compatible formatting of doubles} \
+ {expr 1e-164} \
+ 9.9999999999999996e-165
+test util-16.1.17.-163 {8.4 compatible formatting of doubles} \
+ {expr 1e-163} \
+ 9.9999999999999992e-164
+test util-16.1.17.-162 {8.4 compatible formatting of doubles} \
+ {expr 1e-162} \
+ 9.9999999999999995e-163
+test util-16.1.17.-161 {8.4 compatible formatting of doubles} \
+ {expr 1e-161} \
+ 1e-161
+test util-16.1.17.-160 {8.4 compatible formatting of doubles} \
+ {expr 1e-160} \
+ 9.9999999999999999e-161
+test util-16.1.17.-159 {8.4 compatible formatting of doubles} \
+ {expr 1e-159} \
+ 9.9999999999999999e-160
+test util-16.1.17.-158 {8.4 compatible formatting of doubles} \
+ {expr 1e-158} \
+ 1.0000000000000001e-158
+test util-16.1.17.-157 {8.4 compatible formatting of doubles} \
+ {expr 1e-157} \
+ 9.9999999999999994e-158
+test util-16.1.17.-156 {8.4 compatible formatting of doubles} \
+ {expr 1e-156} \
+ 1e-156
+test util-16.1.17.-155 {8.4 compatible formatting of doubles} \
+ {expr 1e-155} \
+ 1e-155
+test util-16.1.17.-154 {8.4 compatible formatting of doubles} \
+ {expr 1e-154} \
+ 9.9999999999999997e-155
+test util-16.1.17.-153 {8.4 compatible formatting of doubles} \
+ {expr 1e-153} \
+ 1e-153
+test util-16.1.17.-152 {8.4 compatible formatting of doubles} \
+ {expr 1e-152} \
+ 1.0000000000000001e-152
+test util-16.1.17.-151 {8.4 compatible formatting of doubles} \
+ {expr 1e-151} \
+ 9.9999999999999994e-152
+test util-16.1.17.-150 {8.4 compatible formatting of doubles} \
+ {expr 1e-150} \
+ 1e-150
+test util-16.1.17.-149 {8.4 compatible formatting of doubles} \
+ {expr 1e-149} \
+ 9.9999999999999998e-150
+test util-16.1.17.-148 {8.4 compatible formatting of doubles} \
+ {expr 1e-148} \
+ 9.9999999999999994e-149
+test util-16.1.17.-147 {8.4 compatible formatting of doubles} \
+ {expr 1e-147} \
+ 9.9999999999999997e-148
+test util-16.1.17.-146 {8.4 compatible formatting of doubles} \
+ {expr 1e-146} \
+ 1e-146
+test util-16.1.17.-145 {8.4 compatible formatting of doubles} \
+ {expr 1e-145} \
+ 9.9999999999999991e-146
+test util-16.1.17.-144 {8.4 compatible formatting of doubles} \
+ {expr 1e-144} \
+ 9.9999999999999995e-145
+test util-16.1.17.-143 {8.4 compatible formatting of doubles} \
+ {expr 1e-143} \
+ 9.9999999999999995e-144
+test util-16.1.17.-142 {8.4 compatible formatting of doubles} \
+ {expr 1e-142} \
+ 1e-142
+test util-16.1.17.-141 {8.4 compatible formatting of doubles} \
+ {expr 1e-141} \
+ 1e-141
+test util-16.1.17.-140 {8.4 compatible formatting of doubles} \
+ {expr 1e-140} \
+ 9.9999999999999998e-141
+test util-16.1.17.-139 {8.4 compatible formatting of doubles} \
+ {expr 1e-139} \
+ 1e-139
+test util-16.1.17.-138 {8.4 compatible formatting of doubles} \
+ {expr 1e-138} \
+ 1.0000000000000001e-138
+test util-16.1.17.-137 {8.4 compatible formatting of doubles} \
+ {expr 1e-137} \
+ 9.9999999999999998e-138
+test util-16.1.17.-136 {8.4 compatible formatting of doubles} \
+ {expr 1e-136} \
+ 1e-136
+test util-16.1.17.-135 {8.4 compatible formatting of doubles} \
+ {expr 1e-135} \
+ 1e-135
+test util-16.1.17.-134 {8.4 compatible formatting of doubles} \
+ {expr 1e-134} \
+ 1e-134
+test util-16.1.17.-133 {8.4 compatible formatting of doubles} \
+ {expr 1e-133} \
+ 1.0000000000000001e-133
+test util-16.1.17.-132 {8.4 compatible formatting of doubles} \
+ {expr 1e-132} \
+ 9.9999999999999999e-133
+test util-16.1.17.-131 {8.4 compatible formatting of doubles} \
+ {expr 1e-131} \
+ 9.9999999999999999e-132
+test util-16.1.17.-130 {8.4 compatible formatting of doubles} \
+ {expr 1e-130} \
+ 1.0000000000000001e-130
+test util-16.1.17.-129 {8.4 compatible formatting of doubles} \
+ {expr 1e-129} \
+ 9.9999999999999993e-130
+test util-16.1.17.-128 {8.4 compatible formatting of doubles} \
+ {expr 1e-128} \
+ 1.0000000000000001e-128
+test util-16.1.17.-127 {8.4 compatible formatting of doubles} \
+ {expr 1e-127} \
+ 1e-127
+test util-16.1.17.-126 {8.4 compatible formatting of doubles} \
+ {expr 1e-126} \
+ 9.9999999999999995e-127
+test util-16.1.17.-125 {8.4 compatible formatting of doubles} \
+ {expr 1e-125} \
+ 1e-125
+test util-16.1.17.-124 {8.4 compatible formatting of doubles} \
+ {expr 1e-124} \
+ 9.9999999999999993e-125
+test util-16.1.17.-123 {8.4 compatible formatting of doubles} \
+ {expr 1e-123} \
+ 1.0000000000000001e-123
+test util-16.1.17.-122 {8.4 compatible formatting of doubles} \
+ {expr 1e-122} \
+ 1.0000000000000001e-122
+test util-16.1.17.-121 {8.4 compatible formatting of doubles} \
+ {expr 1e-121} \
+ 9.9999999999999998e-122
+test util-16.1.17.-120 {8.4 compatible formatting of doubles} \
+ {expr 1e-120} \
+ 9.9999999999999998e-121
+test util-16.1.17.-119 {8.4 compatible formatting of doubles} \
+ {expr 1e-119} \
+ 1e-119
+test util-16.1.17.-118 {8.4 compatible formatting of doubles} \
+ {expr 1e-118} \
+ 9.9999999999999999e-119
+test util-16.1.17.-117 {8.4 compatible formatting of doubles} \
+ {expr 1e-117} \
+ 1e-117
+test util-16.1.17.-116 {8.4 compatible formatting of doubles} \
+ {expr 1e-116} \
+ 9.9999999999999999e-117
+test util-16.1.17.-115 {8.4 compatible formatting of doubles} \
+ {expr 1e-115} \
+ 1.0000000000000001e-115
+test util-16.1.17.-114 {8.4 compatible formatting of doubles} \
+ {expr 1e-114} \
+ 1.0000000000000001e-114
+test util-16.1.17.-113 {8.4 compatible formatting of doubles} \
+ {expr 1e-113} \
+ 9.9999999999999998e-114
+test util-16.1.17.-112 {8.4 compatible formatting of doubles} \
+ {expr 1e-112} \
+ 9.9999999999999995e-113
+test util-16.1.17.-111 {8.4 compatible formatting of doubles} \
+ {expr 1e-111} \
+ 1.0000000000000001e-111
+test util-16.1.17.-110 {8.4 compatible formatting of doubles} \
+ {expr 1e-110} \
+ 1.0000000000000001e-110
+test util-16.1.17.-109 {8.4 compatible formatting of doubles} \
+ {expr 1e-109} \
+ 9.9999999999999999e-110
+test util-16.1.17.-108 {8.4 compatible formatting of doubles} \
+ {expr 1e-108} \
+ 1e-108
+test util-16.1.17.-107 {8.4 compatible formatting of doubles} \
+ {expr 1e-107} \
+ 1e-107
+test util-16.1.17.-106 {8.4 compatible formatting of doubles} \
+ {expr 1e-106} \
+ 9.9999999999999994e-107
+test util-16.1.17.-105 {8.4 compatible formatting of doubles} \
+ {expr 1e-105} \
+ 9.9999999999999997e-106
+test util-16.1.17.-104 {8.4 compatible formatting of doubles} \
+ {expr 1e-104} \
+ 9.9999999999999993e-105
+test util-16.1.17.-103 {8.4 compatible formatting of doubles} \
+ {expr 1e-103} \
+ 9.9999999999999996e-104
+test util-16.1.17.-102 {8.4 compatible formatting of doubles} \
+ {expr 1e-102} \
+ 9.9999999999999993e-103
+test util-16.1.17.-101 {8.4 compatible formatting of doubles} \
+ {expr 1e-101} \
+ 1.0000000000000001e-101
+test util-16.1.17.-100 {8.4 compatible formatting of doubles} \
+ {expr 1e-100} \
+ 1e-100
+test util-16.1.17.-99 {8.4 compatible formatting of doubles} \
+ {expr 1e-99} \
+ 1e-99
+test util-16.1.17.-98 {8.4 compatible formatting of doubles} \
+ {expr 1e-98} \
+ 9.9999999999999994e-99
+test util-16.1.17.-97 {8.4 compatible formatting of doubles} \
+ {expr 1e-97} \
+ 1e-97
+test util-16.1.17.-96 {8.4 compatible formatting of doubles} \
+ {expr 1e-96} \
+ 9.9999999999999991e-97
+test util-16.1.17.-95 {8.4 compatible formatting of doubles} \
+ {expr 1e-95} \
+ 9.9999999999999999e-96
+test util-16.1.17.-94 {8.4 compatible formatting of doubles} \
+ {expr 1e-94} \
+ 9.9999999999999996e-95
+test util-16.1.17.-93 {8.4 compatible formatting of doubles} \
+ {expr 1e-93} \
+ 9.999999999999999e-94
+test util-16.1.17.-92 {8.4 compatible formatting of doubles} \
+ {expr 1e-92} \
+ 9.9999999999999999e-93
+test util-16.1.17.-91 {8.4 compatible formatting of doubles} \
+ {expr 1e-91} \
+ 1e-91
+test util-16.1.17.-90 {8.4 compatible formatting of doubles} \
+ {expr 1e-90} \
+ 9.9999999999999999e-91
+test util-16.1.17.-89 {8.4 compatible formatting of doubles} \
+ {expr 1e-89} \
+ 1e-89
+test util-16.1.17.-88 {8.4 compatible formatting of doubles} \
+ {expr 1e-88} \
+ 9.9999999999999993e-89
+test util-16.1.17.-87 {8.4 compatible formatting of doubles} \
+ {expr 1e-87} \
+ 1e-87
+test util-16.1.17.-86 {8.4 compatible formatting of doubles} \
+ {expr 1e-86} \
+ 1.0000000000000001e-86
+test util-16.1.17.-85 {8.4 compatible formatting of doubles} \
+ {expr 1e-85} \
+ 9.9999999999999998e-86
+test util-16.1.17.-84 {8.4 compatible formatting of doubles} \
+ {expr 1e-84} \
+ 1e-84
+test util-16.1.17.-83 {8.4 compatible formatting of doubles} \
+ {expr 1e-83} \
+ 1e-83
+test util-16.1.17.-82 {8.4 compatible formatting of doubles} \
+ {expr 1e-82} \
+ 9.9999999999999996e-83
+test util-16.1.17.-81 {8.4 compatible formatting of doubles} \
+ {expr 1e-81} \
+ 9.9999999999999996e-82
+test util-16.1.17.-80 {8.4 compatible formatting of doubles} \
+ {expr 1e-80} \
+ 9.9999999999999996e-81
+test util-16.1.17.-79 {8.4 compatible formatting of doubles} \
+ {expr 1e-79} \
+ 1e-79
+test util-16.1.17.-78 {8.4 compatible formatting of doubles} \
+ {expr 1e-78} \
+ 1e-78
+test util-16.1.17.-77 {8.4 compatible formatting of doubles} \
+ {expr 1e-77} \
+ 9.9999999999999993e-78
+test util-16.1.17.-76 {8.4 compatible formatting of doubles} \
+ {expr 1e-76} \
+ 9.9999999999999993e-77
+test util-16.1.17.-75 {8.4 compatible formatting of doubles} \
+ {expr 1e-75} \
+ 9.9999999999999996e-76
+test util-16.1.17.-74 {8.4 compatible formatting of doubles} \
+ {expr 1e-74} \
+ 9.9999999999999996e-75
+test util-16.1.17.-73 {8.4 compatible formatting of doubles} \
+ {expr 1e-73} \
+ 1e-73
+test util-16.1.17.-72 {8.4 compatible formatting of doubles} \
+ {expr 1e-72} \
+ 9.9999999999999997e-73
+test util-16.1.17.-71 {8.4 compatible formatting of doubles} \
+ {expr 1e-71} \
+ 9.9999999999999992e-72
+test util-16.1.17.-70 {8.4 compatible formatting of doubles} \
+ {expr 1e-70} \
+ 1e-70
+test util-16.1.17.-69 {8.4 compatible formatting of doubles} \
+ {expr 1e-69} \
+ 9.9999999999999996e-70
+test util-16.1.17.-68 {8.4 compatible formatting of doubles} \
+ {expr 1e-68} \
+ 1.0000000000000001e-68
+test util-16.1.17.-67 {8.4 compatible formatting of doubles} \
+ {expr 1e-67} \
+ 9.9999999999999994e-68
+test util-16.1.17.-66 {8.4 compatible formatting of doubles} \
+ {expr 1e-66} \
+ 9.9999999999999998e-67
+test util-16.1.17.-65 {8.4 compatible formatting of doubles} \
+ {expr 1e-65} \
+ 9.9999999999999992e-66
+test util-16.1.17.-64 {8.4 compatible formatting of doubles} \
+ {expr 1e-64} \
+ 9.9999999999999997e-65
+test util-16.1.17.-63 {8.4 compatible formatting of doubles} \
+ {expr 1e-63} \
+ 1.0000000000000001e-63
+test util-16.1.17.-62 {8.4 compatible formatting of doubles} \
+ {expr 1e-62} \
+ 1e-62
+test util-16.1.17.-61 {8.4 compatible formatting of doubles} \
+ {expr 1e-61} \
+ 1e-61
+test util-16.1.17.-60 {8.4 compatible formatting of doubles} \
+ {expr 1e-60} \
+ 9.9999999999999997e-61
+test util-16.1.17.-59 {8.4 compatible formatting of doubles} \
+ {expr 1e-59} \
+ 1e-59
+test util-16.1.17.-58 {8.4 compatible formatting of doubles} \
+ {expr 1e-58} \
+ 1e-58
+test util-16.1.17.-57 {8.4 compatible formatting of doubles} \
+ {expr 1e-57} \
+ 9.9999999999999995e-58
+test util-16.1.17.-56 {8.4 compatible formatting of doubles} \
+ {expr 1e-56} \
+ 1e-56
+test util-16.1.17.-55 {8.4 compatible formatting of doubles} \
+ {expr 1e-55} \
+ 9.9999999999999999e-56
+test util-16.1.17.-54 {8.4 compatible formatting of doubles} \
+ {expr 1e-54} \
+ 1e-54
+test util-16.1.17.-53 {8.4 compatible formatting of doubles} \
+ {expr 1e-53} \
+ 1e-53
+test util-16.1.17.-52 {8.4 compatible formatting of doubles} \
+ {expr 1e-52} \
+ 1e-52
+test util-16.1.17.-51 {8.4 compatible formatting of doubles} \
+ {expr 1e-51} \
+ 1e-51
+test util-16.1.17.-50 {8.4 compatible formatting of doubles} \
+ {expr 1e-50} \
+ 1e-50
+test util-16.1.17.-49 {8.4 compatible formatting of doubles} \
+ {expr 1e-49} \
+ 9.9999999999999994e-50
+test util-16.1.17.-48 {8.4 compatible formatting of doubles} \
+ {expr 1e-48} \
+ 9.9999999999999997e-49
+test util-16.1.17.-47 {8.4 compatible formatting of doubles} \
+ {expr 1e-47} \
+ 9.9999999999999997e-48
+test util-16.1.17.-46 {8.4 compatible formatting of doubles} \
+ {expr 1e-46} \
+ 1e-46
+test util-16.1.17.-45 {8.4 compatible formatting of doubles} \
+ {expr 1e-45} \
+ 9.9999999999999998e-46
+test util-16.1.17.-44 {8.4 compatible formatting of doubles} \
+ {expr 1e-44} \
+ 9.9999999999999995e-45
+test util-16.1.17.-43 {8.4 compatible formatting of doubles} \
+ {expr 1e-43} \
+ 1.0000000000000001e-43
+test util-16.1.17.-42 {8.4 compatible formatting of doubles} \
+ {expr 1e-42} \
+ 1e-42
+test util-16.1.17.-41 {8.4 compatible formatting of doubles} \
+ {expr 1e-41} \
+ 1e-41
+test util-16.1.17.-40 {8.4 compatible formatting of doubles} \
+ {expr 1e-40} \
+ 9.9999999999999993e-41
+test util-16.1.17.-39 {8.4 compatible formatting of doubles} \
+ {expr 1e-39} \
+ 9.9999999999999993e-40
+test util-16.1.17.-38 {8.4 compatible formatting of doubles} \
+ {expr 1e-38} \
+ 9.9999999999999996e-39
+test util-16.1.17.-37 {8.4 compatible formatting of doubles} \
+ {expr 1e-37} \
+ 1.0000000000000001e-37
+test util-16.1.17.-36 {8.4 compatible formatting of doubles} \
+ {expr 1e-36} \
+ 9.9999999999999994e-37
+test util-16.1.17.-35 {8.4 compatible formatting of doubles} \
+ {expr 1e-35} \
+ 1e-35
+test util-16.1.17.-34 {8.4 compatible formatting of doubles} \
+ {expr 1e-34} \
+ 9.9999999999999993e-35
+test util-16.1.17.-33 {8.4 compatible formatting of doubles} \
+ {expr 1e-33} \
+ 1.0000000000000001e-33
+test util-16.1.17.-32 {8.4 compatible formatting of doubles} \
+ {expr 1e-32} \
+ 1.0000000000000001e-32
+test util-16.1.17.-31 {8.4 compatible formatting of doubles} \
+ {expr 1e-31} \
+ 1.0000000000000001e-31
+test util-16.1.17.-30 {8.4 compatible formatting of doubles} \
+ {expr 1e-30} \
+ 1.0000000000000001e-30
+test util-16.1.17.-29 {8.4 compatible formatting of doubles} \
+ {expr 1e-29} \
+ 9.9999999999999994e-30
+test util-16.1.17.-28 {8.4 compatible formatting of doubles} \
+ {expr 1e-28} \
+ 9.9999999999999997e-29
+test util-16.1.17.-27 {8.4 compatible formatting of doubles} \
+ {expr 1e-27} \
+ 1e-27
+test util-16.1.17.-26 {8.4 compatible formatting of doubles} \
+ {expr 1e-26} \
+ 1e-26
+test util-16.1.17.-25 {8.4 compatible formatting of doubles} \
+ {expr 1e-25} \
+ 1e-25
+test util-16.1.17.-24 {8.4 compatible formatting of doubles} \
+ {expr 1e-24} \
+ 9.9999999999999992e-25
+test util-16.1.17.-23 {8.4 compatible formatting of doubles} \
+ {expr 1e-23} \
+ 9.9999999999999996e-24
+test util-16.1.17.-22 {8.4 compatible formatting of doubles} \
+ {expr 1e-22} \
+ 1e-22
+test util-16.1.17.-21 {8.4 compatible formatting of doubles} \
+ {expr 1e-21} \
+ 9.9999999999999991e-22
+test util-16.1.17.-20 {8.4 compatible formatting of doubles} \
+ {expr 1e-20} \
+ 9.9999999999999995e-21
+test util-16.1.17.-19 {8.4 compatible formatting of doubles} \
+ {expr 1e-19} \
+ 9.9999999999999998e-20
+test util-16.1.17.-18 {8.4 compatible formatting of doubles} \
+ {expr 1e-18} \
+ 1.0000000000000001e-18
+test util-16.1.17.-17 {8.4 compatible formatting of doubles} \
+ {expr 1e-17} \
+ 1.0000000000000001e-17
+test util-16.1.17.-16 {8.4 compatible formatting of doubles} \
+ {expr 1e-16} \
+ 9.9999999999999998e-17
+test util-16.1.17.-15 {8.4 compatible formatting of doubles} \
+ {expr 1e-15} \
+ 1.0000000000000001e-15
+test util-16.1.17.-14 {8.4 compatible formatting of doubles} \
+ {expr 1e-14} \
+ 1e-14
+test util-16.1.17.-13 {8.4 compatible formatting of doubles} \
+ {expr 1e-13} \
+ 1e-13
+test util-16.1.17.-12 {8.4 compatible formatting of doubles} \
+ {expr 1e-12} \
+ 9.9999999999999998e-13
+test util-16.1.17.-11 {8.4 compatible formatting of doubles} \
+ {expr 1e-11} \
+ 9.9999999999999994e-12
+test util-16.1.17.-10 {8.4 compatible formatting of doubles} \
+ {expr 1e-10} \
+ 1e-10
+test util-16.1.17.-9 {8.4 compatible formatting of doubles} \
+ {expr 1e-9} \
+ 1.0000000000000001e-09
+test util-16.1.17.-8 {8.4 compatible formatting of doubles} \
+ {expr 1e-8} \
+ 1e-08
+test util-16.1.17.-7 {8.4 compatible formatting of doubles} \
+ {expr 1e-7} \
+ 9.9999999999999995e-08
+test util-16.1.17.-6 {8.4 compatible formatting of doubles} \
+ {expr 1e-6} \
+ 9.9999999999999995e-07
+test util-16.1.17.-5 {8.4 compatible formatting of doubles} \
+ {expr 1e-5} \
+ 1.0000000000000001e-05
+test util-16.1.17.-4 {8.4 compatible formatting of doubles} \
+ {expr 1e-4} \
+ 0.0001
+test util-16.1.17.-3 {8.4 compatible formatting of doubles} \
+ {expr 1e-3} \
+ 0.001
+test util-16.1.17.-2 {8.4 compatible formatting of doubles} \
+ {expr 1e-2} \
+ 0.01
+test util-16.1.17.-1 {8.4 compatible formatting of doubles} \
+ {expr 1e-1} \
+ 0.10000000000000001
+test util-16.1.17.0 {8.4 compatible formatting of doubles} \
+ {expr 1e0} \
+ 1.0
+test util-16.1.17.1 {8.4 compatible formatting of doubles} \
+ {expr 1e1} \
+ 10.0
+test util-16.1.17.2 {8.4 compatible formatting of doubles} \
+ {expr 1e2} \
+ 100.0
+test util-16.1.17.3 {8.4 compatible formatting of doubles} \
+ {expr 1e3} \
+ 1000.0
+test util-16.1.17.4 {8.4 compatible formatting of doubles} \
+ {expr 1e4} \
+ 10000.0
+test util-16.1.17.5 {8.4 compatible formatting of doubles} \
+ {expr 1e5} \
+ 100000.0
+test util-16.1.17.6 {8.4 compatible formatting of doubles} \
+ {expr 1e6} \
+ 1000000.0
+test util-16.1.17.7 {8.4 compatible formatting of doubles} \
+ {expr 1e7} \
+ 10000000.0
+test util-16.1.17.8 {8.4 compatible formatting of doubles} \
+ {expr 1e8} \
+ 100000000.0
+test util-16.1.17.9 {8.4 compatible formatting of doubles} \
+ {expr 1e9} \
+ 1000000000.0
+test util-16.1.17.10 {8.4 compatible formatting of doubles} \
+ {expr 1e10} \
+ 10000000000.0
+test util-16.1.17.11 {8.4 compatible formatting of doubles} \
+ {expr 1e11} \
+ 100000000000.0
+test util-16.1.17.12 {8.4 compatible formatting of doubles} \
+ {expr 1e12} \
+ 1000000000000.0
+test util-16.1.17.13 {8.4 compatible formatting of doubles} \
+ {expr 1e13} \
+ 10000000000000.0
+test util-16.1.17.14 {8.4 compatible formatting of doubles} \
+ {expr 1e14} \
+ 100000000000000.0
+test util-16.1.17.15 {8.4 compatible formatting of doubles} \
+ {expr 1e15} \
+ 1000000000000000.0
+test util-16.1.17.16 {8.4 compatible formatting of doubles} \
+ {expr 1e16} \
+ 10000000000000000.0
+test util-16.1.17.17 {8.4 compatible formatting of doubles} \
+ {expr 1e17} \
+ 1e+17
+test util-16.1.17.18 {8.4 compatible formatting of doubles} \
+ {expr 1e18} \
+ 1e+18
+test util-16.1.17.19 {8.4 compatible formatting of doubles} \
+ {expr 1e19} \
+ 1e+19
+test util-16.1.17.20 {8.4 compatible formatting of doubles} \
+ {expr 1e20} \
+ 1e+20
+test util-16.1.17.21 {8.4 compatible formatting of doubles} \
+ {expr 1e21} \
+ 1e+21
+test util-16.1.17.22 {8.4 compatible formatting of doubles} \
+ {expr 1e22} \
+ 1e+22
+test util-16.1.17.23 {8.4 compatible formatting of doubles} \
+ {expr 1e23} \
+ 9.9999999999999992e+22
+test util-16.1.17.24 {8.4 compatible formatting of doubles} \
+ {expr 1e24} \
+ 9.9999999999999998e+23
+test util-16.1.17.25 {8.4 compatible formatting of doubles} \
+ {expr 1e25} \
+ 1.0000000000000001e+25
+test util-16.1.17.26 {8.4 compatible formatting of doubles} \
+ {expr 1e26} \
+ 1e+26
+test util-16.1.17.27 {8.4 compatible formatting of doubles} \
+ {expr 1e27} \
+ 1e+27
+test util-16.1.17.28 {8.4 compatible formatting of doubles} \
+ {expr 1e28} \
+ 9.9999999999999996e+27
+test util-16.1.17.29 {8.4 compatible formatting of doubles} \
+ {expr 1e29} \
+ 9.9999999999999991e+28
+test util-16.1.17.30 {8.4 compatible formatting of doubles} \
+ {expr 1e30} \
+ 1e+30
+test util-16.1.17.31 {8.4 compatible formatting of doubles} \
+ {expr 1e31} \
+ 9.9999999999999996e+30
+test util-16.1.17.32 {8.4 compatible formatting of doubles} \
+ {expr 1e32} \
+ 1.0000000000000001e+32
+test util-16.1.17.33 {8.4 compatible formatting of doubles} \
+ {expr 1e33} \
+ 9.9999999999999995e+32
+test util-16.1.17.34 {8.4 compatible formatting of doubles} \
+ {expr 1e34} \
+ 9.9999999999999995e+33
+test util-16.1.17.35 {8.4 compatible formatting of doubles} \
+ {expr 1e35} \
+ 9.9999999999999997e+34
+test util-16.1.17.36 {8.4 compatible formatting of doubles} \
+ {expr 1e36} \
+ 1e+36
+test util-16.1.17.37 {8.4 compatible formatting of doubles} \
+ {expr 1e37} \
+ 9.9999999999999995e+36
+test util-16.1.17.38 {8.4 compatible formatting of doubles} \
+ {expr 1e38} \
+ 9.9999999999999998e+37
+test util-16.1.17.39 {8.4 compatible formatting of doubles} \
+ {expr 1e39} \
+ 9.9999999999999994e+38
+test util-16.1.17.40 {8.4 compatible formatting of doubles} \
+ {expr 1e40} \
+ 1e+40
+test util-16.1.17.41 {8.4 compatible formatting of doubles} \
+ {expr 1e41} \
+ 1e+41
+test util-16.1.17.42 {8.4 compatible formatting of doubles} \
+ {expr 1e42} \
+ 1e+42
+test util-16.1.17.43 {8.4 compatible formatting of doubles} \
+ {expr 1e43} \
+ 1e+43
+test util-16.1.17.44 {8.4 compatible formatting of doubles} \
+ {expr 1e44} \
+ 1.0000000000000001e+44
+test util-16.1.17.45 {8.4 compatible formatting of doubles} \
+ {expr 1e45} \
+ 9.9999999999999993e+44
+test util-16.1.17.46 {8.4 compatible formatting of doubles} \
+ {expr 1e46} \
+ 9.9999999999999999e+45
+test util-16.1.17.47 {8.4 compatible formatting of doubles} \
+ {expr 1e47} \
+ 1e+47
+test util-16.1.17.48 {8.4 compatible formatting of doubles} \
+ {expr 1e48} \
+ 1e+48
+test util-16.1.17.49 {8.4 compatible formatting of doubles} \
+ {expr 1e49} \
+ 9.9999999999999995e+48
+test util-16.1.17.50 {8.4 compatible formatting of doubles} \
+ {expr 1e50} \
+ 1.0000000000000001e+50
+test util-16.1.17.51 {8.4 compatible formatting of doubles} \
+ {expr 1e51} \
+ 9.9999999999999999e+50
+test util-16.1.17.52 {8.4 compatible formatting of doubles} \
+ {expr 1e52} \
+ 9.9999999999999999e+51
+test util-16.1.17.53 {8.4 compatible formatting of doubles} \
+ {expr 1e53} \
+ 9.9999999999999999e+52
+test util-16.1.17.54 {8.4 compatible formatting of doubles} \
+ {expr 1e54} \
+ 1.0000000000000001e+54
+test util-16.1.17.55 {8.4 compatible formatting of doubles} \
+ {expr 1e55} \
+ 1e+55
+test util-16.1.17.56 {8.4 compatible formatting of doubles} \
+ {expr 1e56} \
+ 1.0000000000000001e+56
+test util-16.1.17.57 {8.4 compatible formatting of doubles} \
+ {expr 1e57} \
+ 1e+57
+test util-16.1.17.58 {8.4 compatible formatting of doubles} \
+ {expr 1e58} \
+ 9.9999999999999994e+57
+test util-16.1.17.59 {8.4 compatible formatting of doubles} \
+ {expr 1e59} \
+ 9.9999999999999997e+58
+test util-16.1.17.60 {8.4 compatible formatting of doubles} \
+ {expr 1e60} \
+ 9.9999999999999995e+59
+test util-16.1.17.61 {8.4 compatible formatting of doubles} \
+ {expr 1e61} \
+ 9.9999999999999995e+60
+test util-16.1.17.62 {8.4 compatible formatting of doubles} \
+ {expr 1e62} \
+ 1e+62
+test util-16.1.17.63 {8.4 compatible formatting of doubles} \
+ {expr 1e63} \
+ 1.0000000000000001e+63
+test util-16.1.17.64 {8.4 compatible formatting of doubles} \
+ {expr 1e64} \
+ 1e+64
+test util-16.1.17.65 {8.4 compatible formatting of doubles} \
+ {expr 1e65} \
+ 9.9999999999999999e+64
+test util-16.1.17.66 {8.4 compatible formatting of doubles} \
+ {expr 1e66} \
+ 9.9999999999999995e+65
+test util-16.1.17.67 {8.4 compatible formatting of doubles} \
+ {expr 1e67} \
+ 9.9999999999999998e+66
+test util-16.1.17.68 {8.4 compatible formatting of doubles} \
+ {expr 1e68} \
+ 9.9999999999999995e+67
+test util-16.1.17.69 {8.4 compatible formatting of doubles} \
+ {expr 1e69} \
+ 1.0000000000000001e+69
+test util-16.1.17.70 {8.4 compatible formatting of doubles} \
+ {expr 1e70} \
+ 1.0000000000000001e+70
+test util-16.1.17.71 {8.4 compatible formatting of doubles} \
+ {expr 1e71} \
+ 1e+71
+test util-16.1.17.72 {8.4 compatible formatting of doubles} \
+ {expr 1e72} \
+ 9.9999999999999994e+71
+test util-16.1.17.73 {8.4 compatible formatting of doubles} \
+ {expr 1e73} \
+ 9.9999999999999998e+72
+test util-16.1.17.74 {8.4 compatible formatting of doubles} \
+ {expr 1e74} \
+ 9.9999999999999995e+73
+test util-16.1.17.75 {8.4 compatible formatting of doubles} \
+ {expr 1e75} \
+ 9.9999999999999993e+74
+test util-16.1.17.76 {8.4 compatible formatting of doubles} \
+ {expr 1e76} \
+ 1e+76
+test util-16.1.17.77 {8.4 compatible formatting of doubles} \
+ {expr 1e77} \
+ 9.9999999999999998e+76
+test util-16.1.17.78 {8.4 compatible formatting of doubles} \
+ {expr 1e78} \
+ 1e+78
+test util-16.1.17.79 {8.4 compatible formatting of doubles} \
+ {expr 1e79} \
+ 9.9999999999999997e+78
+test util-16.1.17.80 {8.4 compatible formatting of doubles} \
+ {expr 1e80} \
+ 1e+80
+test util-16.1.17.81 {8.4 compatible formatting of doubles} \
+ {expr 1e81} \
+ 9.9999999999999992e+80
+test util-16.1.17.82 {8.4 compatible formatting of doubles} \
+ {expr 1e82} \
+ 9.9999999999999996e+81
+test util-16.1.17.83 {8.4 compatible formatting of doubles} \
+ {expr 1e83} \
+ 1e+83
+test util-16.1.17.84 {8.4 compatible formatting of doubles} \
+ {expr 1e84} \
+ 1.0000000000000001e+84
+test util-16.1.17.85 {8.4 compatible formatting of doubles} \
+ {expr 1e85} \
+ 1e+85
+test util-16.1.17.86 {8.4 compatible formatting of doubles} \
+ {expr 1e86} \
+ 1e+86
+test util-16.1.17.87 {8.4 compatible formatting of doubles} \
+ {expr 1e87} \
+ 9.9999999999999996e+86
+test util-16.1.17.88 {8.4 compatible formatting of doubles} \
+ {expr 1e88} \
+ 9.9999999999999996e+87
+test util-16.1.17.89 {8.4 compatible formatting of doubles} \
+ {expr 1e89} \
+ 9.9999999999999999e+88
+test util-16.1.17.90 {8.4 compatible formatting of doubles} \
+ {expr 1e90} \
+ 9.9999999999999997e+89
+test util-16.1.17.91 {8.4 compatible formatting of doubles} \
+ {expr 1e91} \
+ 1.0000000000000001e+91
+test util-16.1.17.92 {8.4 compatible formatting of doubles} \
+ {expr 1e92} \
+ 1e+92
+test util-16.1.17.93 {8.4 compatible formatting of doubles} \
+ {expr 1e93} \
+ 1e+93
+test util-16.1.17.94 {8.4 compatible formatting of doubles} \
+ {expr 1e94} \
+ 1e+94
+test util-16.1.17.95 {8.4 compatible formatting of doubles} \
+ {expr 1e95} \
+ 1e+95
+test util-16.1.17.96 {8.4 compatible formatting of doubles} \
+ {expr 1e96} \
+ 1e+96
+test util-16.1.17.97 {8.4 compatible formatting of doubles} \
+ {expr 1e97} \
+ 1.0000000000000001e+97
+test util-16.1.17.98 {8.4 compatible formatting of doubles} \
+ {expr 1e98} \
+ 1e+98
+test util-16.1.17.99 {8.4 compatible formatting of doubles} \
+ {expr 1e99} \
+ 9.9999999999999997e+98
+test util-16.1.17.100 {8.4 compatible formatting of doubles} \
+ {expr 1e100} \
+ 1e+100
+test util-16.1.17.101 {8.4 compatible formatting of doubles} \
+ {expr 1e101} \
+ 9.9999999999999998e+100
+test util-16.1.17.102 {8.4 compatible formatting of doubles} \
+ {expr 1e102} \
+ 9.9999999999999998e+101
+test util-16.1.17.103 {8.4 compatible formatting of doubles} \
+ {expr 1e103} \
+ 1e+103
+test util-16.1.17.104 {8.4 compatible formatting of doubles} \
+ {expr 1e104} \
+ 1e+104
+test util-16.1.17.105 {8.4 compatible formatting of doubles} \
+ {expr 1e105} \
+ 9.9999999999999994e+104
+test util-16.1.17.106 {8.4 compatible formatting of doubles} \
+ {expr 1e106} \
+ 1.0000000000000001e+106
+test util-16.1.17.107 {8.4 compatible formatting of doubles} \
+ {expr 1e107} \
+ 9.9999999999999997e+106
+test util-16.1.17.108 {8.4 compatible formatting of doubles} \
+ {expr 1e108} \
+ 1e+108
+test util-16.1.17.109 {8.4 compatible formatting of doubles} \
+ {expr 1e109} \
+ 9.9999999999999998e+108
+test util-16.1.17.110 {8.4 compatible formatting of doubles} \
+ {expr 1e110} \
+ 1e+110
+test util-16.1.17.111 {8.4 compatible formatting of doubles} \
+ {expr 1e111} \
+ 9.9999999999999996e+110
+test util-16.1.17.112 {8.4 compatible formatting of doubles} \
+ {expr 1e112} \
+ 9.9999999999999993e+111
+test util-16.1.17.113 {8.4 compatible formatting of doubles} \
+ {expr 1e113} \
+ 1e+113
+test util-16.1.17.114 {8.4 compatible formatting of doubles} \
+ {expr 1e114} \
+ 1e+114
+test util-16.1.17.115 {8.4 compatible formatting of doubles} \
+ {expr 1e115} \
+ 1e+115
+test util-16.1.17.116 {8.4 compatible formatting of doubles} \
+ {expr 1e116} \
+ 1e+116
+test util-16.1.17.117 {8.4 compatible formatting of doubles} \
+ {expr 1e117} \
+ 1.0000000000000001e+117
+test util-16.1.17.118 {8.4 compatible formatting of doubles} \
+ {expr 1e118} \
+ 9.9999999999999997e+117
+test util-16.1.17.119 {8.4 compatible formatting of doubles} \
+ {expr 1e119} \
+ 9.9999999999999994e+118
+test util-16.1.17.120 {8.4 compatible formatting of doubles} \
+ {expr 1e120} \
+ 9.9999999999999998e+119
+test util-16.1.17.121 {8.4 compatible formatting of doubles} \
+ {expr 1e121} \
+ 1e+121
+test util-16.1.17.122 {8.4 compatible formatting of doubles} \
+ {expr 1e122} \
+ 1e+122
+test util-16.1.17.123 {8.4 compatible formatting of doubles} \
+ {expr 1e123} \
+ 9.9999999999999998e+122
+test util-16.1.17.124 {8.4 compatible formatting of doubles} \
+ {expr 1e124} \
+ 9.9999999999999995e+123
+test util-16.1.17.125 {8.4 compatible formatting of doubles} \
+ {expr 1e125} \
+ 9.9999999999999992e+124
+test util-16.1.17.126 {8.4 compatible formatting of doubles} \
+ {expr 1e126} \
+ 9.9999999999999992e+125
+test util-16.1.17.127 {8.4 compatible formatting of doubles} \
+ {expr 1e127} \
+ 9.9999999999999995e+126
+test util-16.1.17.128 {8.4 compatible formatting of doubles} \
+ {expr 1e128} \
+ 1.0000000000000001e+128
+test util-16.1.17.129 {8.4 compatible formatting of doubles} \
+ {expr 1e129} \
+ 1e+129
+test util-16.1.17.130 {8.4 compatible formatting of doubles} \
+ {expr 1e130} \
+ 1.0000000000000001e+130
+test util-16.1.17.131 {8.4 compatible formatting of doubles} \
+ {expr 1e131} \
+ 9.9999999999999991e+130
+test util-16.1.17.132 {8.4 compatible formatting of doubles} \
+ {expr 1e132} \
+ 9.9999999999999999e+131
+test util-16.1.17.133 {8.4 compatible formatting of doubles} \
+ {expr 1e133} \
+ 1e+133
+test util-16.1.17.134 {8.4 compatible formatting of doubles} \
+ {expr 1e134} \
+ 9.9999999999999992e+133
+test util-16.1.17.135 {8.4 compatible formatting of doubles} \
+ {expr 1e135} \
+ 9.9999999999999996e+134
+test util-16.1.17.136 {8.4 compatible formatting of doubles} \
+ {expr 1e136} \
+ 1.0000000000000001e+136
+test util-16.1.17.137 {8.4 compatible formatting of doubles} \
+ {expr 1e137} \
+ 1e+137
+test util-16.1.17.138 {8.4 compatible formatting of doubles} \
+ {expr 1e138} \
+ 1e+138
+test util-16.1.17.139 {8.4 compatible formatting of doubles} \
+ {expr 1e139} \
+ 1e+139
+test util-16.1.17.140 {8.4 compatible formatting of doubles} \
+ {expr 1e140} \
+ 1.0000000000000001e+140
+test util-16.1.17.141 {8.4 compatible formatting of doubles} \
+ {expr 1e141} \
+ 1e+141
+test util-16.1.17.142 {8.4 compatible formatting of doubles} \
+ {expr 1e142} \
+ 1.0000000000000001e+142
+test util-16.1.17.143 {8.4 compatible formatting of doubles} \
+ {expr 1e143} \
+ 1e+143
+test util-16.1.17.144 {8.4 compatible formatting of doubles} \
+ {expr 1e144} \
+ 1e+144
+test util-16.1.17.145 {8.4 compatible formatting of doubles} \
+ {expr 1e145} \
+ 9.9999999999999999e+144
+test util-16.1.17.146 {8.4 compatible formatting of doubles} \
+ {expr 1e146} \
+ 9.9999999999999993e+145
+test util-16.1.17.147 {8.4 compatible formatting of doubles} \
+ {expr 1e147} \
+ 9.9999999999999998e+146
+test util-16.1.17.148 {8.4 compatible formatting of doubles} \
+ {expr 1e148} \
+ 1e+148
+test util-16.1.17.149 {8.4 compatible formatting of doubles} \
+ {expr 1e149} \
+ 1e+149
+test util-16.1.17.150 {8.4 compatible formatting of doubles} \
+ {expr 1e150} \
+ 9.9999999999999998e+149
+test util-16.1.17.151 {8.4 compatible formatting of doubles} \
+ {expr 1e151} \
+ 1e+151
+test util-16.1.17.152 {8.4 compatible formatting of doubles} \
+ {expr 1e152} \
+ 1e+152
+test util-16.1.17.153 {8.4 compatible formatting of doubles} \
+ {expr 1e153} \
+ 1e+153
+test util-16.1.17.154 {8.4 compatible formatting of doubles} \
+ {expr 1e154} \
+ 1e+154
+test util-16.1.17.155 {8.4 compatible formatting of doubles} \
+ {expr 1e155} \
+ 1e+155
+test util-16.1.17.156 {8.4 compatible formatting of doubles} \
+ {expr 1e156} \
+ 9.9999999999999998e+155
+test util-16.1.17.157 {8.4 compatible formatting of doubles} \
+ {expr 1e157} \
+ 9.9999999999999998e+156
+test util-16.1.17.158 {8.4 compatible formatting of doubles} \
+ {expr 1e158} \
+ 9.9999999999999995e+157
+test util-16.1.17.159 {8.4 compatible formatting of doubles} \
+ {expr 1e159} \
+ 9.9999999999999993e+158
+test util-16.1.17.160 {8.4 compatible formatting of doubles} \
+ {expr 1e160} \
+ 1e+160
+test util-16.1.17.161 {8.4 compatible formatting of doubles} \
+ {expr 1e161} \
+ 1e+161
+test util-16.1.17.162 {8.4 compatible formatting of doubles} \
+ {expr 1e162} \
+ 9.9999999999999994e+161
+test util-16.1.17.163 {8.4 compatible formatting of doubles} \
+ {expr 1e163} \
+ 9.9999999999999994e+162
+test util-16.1.17.164 {8.4 compatible formatting of doubles} \
+ {expr 1e164} \
+ 1e+164
+test util-16.1.17.165 {8.4 compatible formatting of doubles} \
+ {expr 1e165} \
+ 9.999999999999999e+164
+test util-16.1.17.166 {8.4 compatible formatting of doubles} \
+ {expr 1e166} \
+ 9.9999999999999994e+165
+test util-16.1.17.167 {8.4 compatible formatting of doubles} \
+ {expr 1e167} \
+ 1e+167
+test util-16.1.17.168 {8.4 compatible formatting of doubles} \
+ {expr 1e168} \
+ 9.9999999999999993e+167
+test util-16.1.17.169 {8.4 compatible formatting of doubles} \
+ {expr 1e169} \
+ 9.9999999999999993e+168
+test util-16.1.17.170 {8.4 compatible formatting of doubles} \
+ {expr 1e170} \
+ 1e+170
+test util-16.1.17.171 {8.4 compatible formatting of doubles} \
+ {expr 1e171} \
+ 9.9999999999999995e+170
+test util-16.1.17.172 {8.4 compatible formatting of doubles} \
+ {expr 1e172} \
+ 1.0000000000000001e+172
+test util-16.1.17.173 {8.4 compatible formatting of doubles} \
+ {expr 1e173} \
+ 1e+173
+test util-16.1.17.174 {8.4 compatible formatting of doubles} \
+ {expr 1e174} \
+ 1.0000000000000001e+174
+test util-16.1.17.175 {8.4 compatible formatting of doubles} \
+ {expr 1e175} \
+ 9.9999999999999994e+174
+test util-16.1.17.176 {8.4 compatible formatting of doubles} \
+ {expr 1e176} \
+ 1e+176
+test util-16.1.17.177 {8.4 compatible formatting of doubles} \
+ {expr 1e177} \
+ 1e+177
+test util-16.1.17.178 {8.4 compatible formatting of doubles} \
+ {expr 1e178} \
+ 1.0000000000000001e+178
+test util-16.1.17.179 {8.4 compatible formatting of doubles} \
+ {expr 1e179} \
+ 9.9999999999999998e+178
+test util-16.1.17.180 {8.4 compatible formatting of doubles} \
+ {expr 1e180} \
+ 1e+180
+test util-16.1.17.181 {8.4 compatible formatting of doubles} \
+ {expr 1e181} \
+ 9.9999999999999992e+180
+test util-16.1.17.182 {8.4 compatible formatting of doubles} \
+ {expr 1e182} \
+ 1.0000000000000001e+182
+test util-16.1.17.183 {8.4 compatible formatting of doubles} \
+ {expr 1e183} \
+ 9.9999999999999995e+182
+test util-16.1.17.184 {8.4 compatible formatting of doubles} \
+ {expr 1e184} \
+ 1e+184
+test util-16.1.17.185 {8.4 compatible formatting of doubles} \
+ {expr 1e185} \
+ 9.9999999999999998e+184
+test util-16.1.17.186 {8.4 compatible formatting of doubles} \
+ {expr 1e186} \
+ 9.9999999999999998e+185
+test util-16.1.17.187 {8.4 compatible formatting of doubles} \
+ {expr 1e187} \
+ 9.9999999999999991e+186
+test util-16.1.17.188 {8.4 compatible formatting of doubles} \
+ {expr 1e188} \
+ 1e+188
+test util-16.1.17.189 {8.4 compatible formatting of doubles} \
+ {expr 1e189} \
+ 1e+189
+test util-16.1.17.190 {8.4 compatible formatting of doubles} \
+ {expr 1e190} \
+ 1.0000000000000001e+190
+test util-16.1.17.191 {8.4 compatible formatting of doubles} \
+ {expr 1e191} \
+ 1.0000000000000001e+191
+test util-16.1.17.192 {8.4 compatible formatting of doubles} \
+ {expr 1e192} \
+ 1e+192
+test util-16.1.17.193 {8.4 compatible formatting of doubles} \
+ {expr 1e193} \
+ 1.0000000000000001e+193
+test util-16.1.17.194 {8.4 compatible formatting of doubles} \
+ {expr 1e194} \
+ 9.9999999999999994e+193
+test util-16.1.17.195 {8.4 compatible formatting of doubles} \
+ {expr 1e195} \
+ 9.9999999999999998e+194
+test util-16.1.17.196 {8.4 compatible formatting of doubles} \
+ {expr 1e196} \
+ 9.9999999999999995e+195
+test util-16.1.17.197 {8.4 compatible formatting of doubles} \
+ {expr 1e197} \
+ 9.9999999999999995e+196
+test util-16.1.17.198 {8.4 compatible formatting of doubles} \
+ {expr 1e198} \
+ 1e+198
+test util-16.1.17.199 {8.4 compatible formatting of doubles} \
+ {expr 1e199} \
+ 1.0000000000000001e+199
+test util-16.1.17.200 {8.4 compatible formatting of doubles} \
+ {expr 1e200} \
+ 9.9999999999999997e+199
+test util-16.1.17.201 {8.4 compatible formatting of doubles} \
+ {expr 1e201} \
+ 1e+201
+test util-16.1.17.202 {8.4 compatible formatting of doubles} \
+ {expr 1e202} \
+ 9.999999999999999e+201
+test util-16.1.17.203 {8.4 compatible formatting of doubles} \
+ {expr 1e203} \
+ 9.9999999999999999e+202
+test util-16.1.17.204 {8.4 compatible formatting of doubles} \
+ {expr 1e204} \
+ 9.9999999999999999e+203
+test util-16.1.17.205 {8.4 compatible formatting of doubles} \
+ {expr 1e205} \
+ 1e+205
+test util-16.1.17.206 {8.4 compatible formatting of doubles} \
+ {expr 1e206} \
+ 1e+206
+test util-16.1.17.207 {8.4 compatible formatting of doubles} \
+ {expr 1e207} \
+ 1e+207
+test util-16.1.17.208 {8.4 compatible formatting of doubles} \
+ {expr 1e208} \
+ 9.9999999999999998e+207
+test util-16.1.17.209 {8.4 compatible formatting of doubles} \
+ {expr 1e209} \
+ 1.0000000000000001e+209
+test util-16.1.17.210 {8.4 compatible formatting of doubles} \
+ {expr 1e210} \
+ 9.9999999999999993e+209
+test util-16.1.17.211 {8.4 compatible formatting of doubles} \
+ {expr 1e211} \
+ 9.9999999999999996e+210
+test util-16.1.17.212 {8.4 compatible formatting of doubles} \
+ {expr 1e212} \
+ 9.9999999999999991e+211
+test util-16.1.17.213 {8.4 compatible formatting of doubles} \
+ {expr 1e213} \
+ 9.9999999999999998e+212
+test util-16.1.17.214 {8.4 compatible formatting of doubles} \
+ {expr 1e214} \
+ 9.9999999999999995e+213
+test util-16.1.17.215 {8.4 compatible formatting of doubles} \
+ {expr 1e215} \
+ 9.9999999999999991e+214
+test util-16.1.17.216 {8.4 compatible formatting of doubles} \
+ {expr 1e216} \
+ 1e+216
+test util-16.1.17.217 {8.4 compatible formatting of doubles} \
+ {expr 1e217} \
+ 9.9999999999999996e+216
+test util-16.1.17.218 {8.4 compatible formatting of doubles} \
+ {expr 1e218} \
+ 1.0000000000000001e+218
+test util-16.1.17.219 {8.4 compatible formatting of doubles} \
+ {expr 1e219} \
+ 9.9999999999999997e+218
+test util-16.1.17.220 {8.4 compatible formatting of doubles} \
+ {expr 1e220} \
+ 1e+220
+test util-16.1.17.221 {8.4 compatible formatting of doubles} \
+ {expr 1e221} \
+ 1e+221
+test util-16.1.17.222 {8.4 compatible formatting of doubles} \
+ {expr 1e222} \
+ 1e+222
+test util-16.1.17.223 {8.4 compatible formatting of doubles} \
+ {expr 1e223} \
+ 1e+223
+test util-16.1.17.224 {8.4 compatible formatting of doubles} \
+ {expr 1e224} \
+ 9.9999999999999997e+223
+test util-16.1.17.225 {8.4 compatible formatting of doubles} \
+ {expr 1e225} \
+ 9.9999999999999993e+224
+test util-16.1.17.226 {8.4 compatible formatting of doubles} \
+ {expr 1e226} \
+ 9.9999999999999996e+225
+test util-16.1.17.227 {8.4 compatible formatting of doubles} \
+ {expr 1e227} \
+ 1.0000000000000001e+227
+test util-16.1.17.228 {8.4 compatible formatting of doubles} \
+ {expr 1e228} \
+ 9.9999999999999992e+227
+test util-16.1.17.229 {8.4 compatible formatting of doubles} \
+ {expr 1e229} \
+ 9.9999999999999999e+228
+test util-16.1.17.230 {8.4 compatible formatting of doubles} \
+ {expr 1e230} \
+ 1.0000000000000001e+230
+test util-16.1.17.231 {8.4 compatible formatting of doubles} \
+ {expr 1e231} \
+ 1.0000000000000001e+231
+test util-16.1.17.232 {8.4 compatible formatting of doubles} \
+ {expr 1e232} \
+ 1.0000000000000001e+232
+test util-16.1.17.233 {8.4 compatible formatting of doubles} \
+ {expr 1e233} \
+ 9.9999999999999997e+232
+test util-16.1.17.234 {8.4 compatible formatting of doubles} \
+ {expr 1e234} \
+ 1e+234
+test util-16.1.17.235 {8.4 compatible formatting of doubles} \
+ {expr 1e235} \
+ 1.0000000000000001e+235
+test util-16.1.17.236 {8.4 compatible formatting of doubles} \
+ {expr 1e236} \
+ 1.0000000000000001e+236
+test util-16.1.17.237 {8.4 compatible formatting of doubles} \
+ {expr 1e237} \
+ 9.9999999999999994e+236
+test util-16.1.17.238 {8.4 compatible formatting of doubles} \
+ {expr 1e238} \
+ 1e+238
+test util-16.1.17.239 {8.4 compatible formatting of doubles} \
+ {expr 1e239} \
+ 9.9999999999999999e+238
+test util-16.1.17.240 {8.4 compatible formatting of doubles} \
+ {expr 1e240} \
+ 1e+240
+test util-16.1.17.241 {8.4 compatible formatting of doubles} \
+ {expr 1e241} \
+ 1.0000000000000001e+241
+test util-16.1.17.242 {8.4 compatible formatting of doubles} \
+ {expr 1e242} \
+ 1.0000000000000001e+242
+test util-16.1.17.243 {8.4 compatible formatting of doubles} \
+ {expr 1e243} \
+ 1.0000000000000001e+243
+test util-16.1.17.244 {8.4 compatible formatting of doubles} \
+ {expr 1e244} \
+ 1.0000000000000001e+244
+test util-16.1.17.245 {8.4 compatible formatting of doubles} \
+ {expr 1e245} \
+ 1e+245
+test util-16.1.17.246 {8.4 compatible formatting of doubles} \
+ {expr 1e246} \
+ 1.0000000000000001e+246
+test util-16.1.17.247 {8.4 compatible formatting of doubles} \
+ {expr 1e247} \
+ 9.9999999999999995e+246
+test util-16.1.17.248 {8.4 compatible formatting of doubles} \
+ {expr 1e248} \
+ 1e+248
+test util-16.1.17.249 {8.4 compatible formatting of doubles} \
+ {expr 1e249} \
+ 9.9999999999999992e+248
+test util-16.1.17.250 {8.4 compatible formatting of doubles} \
+ {expr 1e250} \
+ 9.9999999999999992e+249
+test util-16.1.17.251 {8.4 compatible formatting of doubles} \
+ {expr 1e251} \
+ 1e+251
+test util-16.1.17.252 {8.4 compatible formatting of doubles} \
+ {expr 1e252} \
+ 1.0000000000000001e+252
+test util-16.1.17.253 {8.4 compatible formatting of doubles} \
+ {expr 1e253} \
+ 9.9999999999999994e+252
+test util-16.1.17.254 {8.4 compatible formatting of doubles} \
+ {expr 1e254} \
+ 9.9999999999999994e+253
+test util-16.1.17.255 {8.4 compatible formatting of doubles} \
+ {expr 1e255} \
+ 9.9999999999999999e+254
+test util-16.1.17.256 {8.4 compatible formatting of doubles} \
+ {expr 1e256} \
+ 1e+256
+test util-16.1.17.257 {8.4 compatible formatting of doubles} \
+ {expr 1e257} \
+ 1e+257
+test util-16.1.17.258 {8.4 compatible formatting of doubles} \
+ {expr 1e258} \
+ 1.0000000000000001e+258
+test util-16.1.17.259 {8.4 compatible formatting of doubles} \
+ {expr 1e259} \
+ 9.9999999999999993e+258
+test util-16.1.17.260 {8.4 compatible formatting of doubles} \
+ {expr 1e260} \
+ 1.0000000000000001e+260
+test util-16.1.17.261 {8.4 compatible formatting of doubles} \
+ {expr 1e261} \
+ 9.9999999999999993e+260
+test util-16.1.17.262 {8.4 compatible formatting of doubles} \
+ {expr 1e262} \
+ 1e+262
+test util-16.1.17.263 {8.4 compatible formatting of doubles} \
+ {expr 1e263} \
+ 1e+263
+test util-16.1.17.264 {8.4 compatible formatting of doubles} \
+ {expr 1e264} \
+ 1e+264
+test util-16.1.17.265 {8.4 compatible formatting of doubles} \
+ {expr 1e265} \
+ 1.0000000000000001e+265
+test util-16.1.17.266 {8.4 compatible formatting of doubles} \
+ {expr 1e266} \
+ 1e+266
+test util-16.1.17.267 {8.4 compatible formatting of doubles} \
+ {expr 1e267} \
+ 9.9999999999999997e+266
+test util-16.1.17.268 {8.4 compatible formatting of doubles} \
+ {expr 1e268} \
+ 9.9999999999999997e+267
+test util-16.1.17.269 {8.4 compatible formatting of doubles} \
+ {expr 1e269} \
+ 1e+269
+test util-16.1.17.270 {8.4 compatible formatting of doubles} \
+ {expr 1e270} \
+ 1e+270
+test util-16.1.17.271 {8.4 compatible formatting of doubles} \
+ {expr 1e271} \
+ 9.9999999999999995e+270
+test util-16.1.17.272 {8.4 compatible formatting of doubles} \
+ {expr 1e272} \
+ 1.0000000000000001e+272
+test util-16.1.17.273 {8.4 compatible formatting of doubles} \
+ {expr 1e273} \
+ 9.9999999999999995e+272
+test util-16.1.17.274 {8.4 compatible formatting of doubles} \
+ {expr 1e274} \
+ 9.9999999999999992e+273
+test util-16.1.17.275 {8.4 compatible formatting of doubles} \
+ {expr 1e275} \
+ 9.9999999999999996e+274
+test util-16.1.17.276 {8.4 compatible formatting of doubles} \
+ {expr 1e276} \
+ 1.0000000000000001e+276
+test util-16.1.17.277 {8.4 compatible formatting of doubles} \
+ {expr 1e277} \
+ 1e+277
+test util-16.1.17.278 {8.4 compatible formatting of doubles} \
+ {expr 1e278} \
+ 9.9999999999999996e+277
+test util-16.1.17.279 {8.4 compatible formatting of doubles} \
+ {expr 1e279} \
+ 1.0000000000000001e+279
+test util-16.1.17.280 {8.4 compatible formatting of doubles} \
+ {expr 1e280} \
+ 1e+280
+test util-16.1.17.281 {8.4 compatible formatting of doubles} \
+ {expr 1e281} \
+ 1e+281
+test util-16.1.17.282 {8.4 compatible formatting of doubles} \
+ {expr 1e282} \
+ 1e+282
+test util-16.1.17.283 {8.4 compatible formatting of doubles} \
+ {expr 1e283} \
+ 9.9999999999999996e+282
+test util-16.1.17.284 {8.4 compatible formatting of doubles} \
+ {expr 1e284} \
+ 1.0000000000000001e+284
+test util-16.1.17.285 {8.4 compatible formatting of doubles} \
+ {expr 1e285} \
+ 9.9999999999999998e+284
+test util-16.1.17.286 {8.4 compatible formatting of doubles} \
+ {expr 1e286} \
+ 1e+286
+test util-16.1.17.287 {8.4 compatible formatting of doubles} \
+ {expr 1e287} \
+ 1.0000000000000001e+287
+test util-16.1.17.288 {8.4 compatible formatting of doubles} \
+ {expr 1e288} \
+ 1e+288
+test util-16.1.17.289 {8.4 compatible formatting of doubles} \
+ {expr 1e289} \
+ 1.0000000000000001e+289
+test util-16.1.17.290 {8.4 compatible formatting of doubles} \
+ {expr 1e290} \
+ 1.0000000000000001e+290
+test util-16.1.17.291 {8.4 compatible formatting of doubles} \
+ {expr 1e291} \
+ 9.9999999999999996e+290
+test util-16.1.17.292 {8.4 compatible formatting of doubles} \
+ {expr 1e292} \
+ 1e+292
+test util-16.1.17.293 {8.4 compatible formatting of doubles} \
+ {expr 1e293} \
+ 9.9999999999999992e+292
+test util-16.1.17.294 {8.4 compatible formatting of doubles} \
+ {expr 1e294} \
+ 1.0000000000000001e+294
+test util-16.1.17.295 {8.4 compatible formatting of doubles} \
+ {expr 1e295} \
+ 9.9999999999999998e+294
+test util-16.1.17.296 {8.4 compatible formatting of doubles} \
+ {expr 1e296} \
+ 9.9999999999999998e+295
+test util-16.1.17.297 {8.4 compatible formatting of doubles} \
+ {expr 1e297} \
+ 1e+297
+test util-16.1.17.298 {8.4 compatible formatting of doubles} \
+ {expr 1e298} \
+ 9.9999999999999996e+297
+test util-16.1.17.299 {8.4 compatible formatting of doubles} \
+ {expr 1e299} \
+ 1.0000000000000001e+299
+test util-16.1.17.300 {8.4 compatible formatting of doubles} \
+ {expr 1e300} \
+ 1.0000000000000001e+300
+test util-16.1.17.301 {8.4 compatible formatting of doubles} \
+ {expr 1e301} \
+ 1.0000000000000001e+301
+test util-16.1.17.302 {8.4 compatible formatting of doubles} \
+ {expr 1e302} \
+ 1.0000000000000001e+302
+test util-16.1.17.303 {8.4 compatible formatting of doubles} \
+ {expr 1e303} \
+ 1e+303
+test util-16.1.17.304 {8.4 compatible formatting of doubles} \
+ {expr 1e304} \
+ 9.9999999999999994e+303
+test util-16.1.17.305 {8.4 compatible formatting of doubles} \
+ {expr 1e305} \
+ 9.9999999999999994e+304
+test util-16.1.17.306 {8.4 compatible formatting of doubles} \
+ {expr 1e306} \
+ 1e+306
+test util-16.1.17.307 {8.4 compatible formatting of doubles} \
+ {expr 1e307} \
+ 9.9999999999999999e+306
+
+test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} {
+ set r {}
+ foreach {input} {
+ 0x1ffffffffffffc000
+ 0x1ffffffffffffc800
+ 0x1ffffffffffffd000
+ 0x1ffffffffffffd800
+ 0x1ffffffffffffe000
+ 0x1ffffffffffffe800
+ 0x1fffffffffffff000
+ 0x1fffffffffffff800
+ } {
+ binary scan [binary format q [expr double($input)]] wu x
+ lappend r [format %#llx $x]
+ binary scan [binary format q [expr double(-$input)]] wu x
+ lappend r [format %#llx $x]
+ }
+ set r
+} [list {*}{
+ 0x43fffffffffffffc 0xc3fffffffffffffc
+ 0x43fffffffffffffc 0xc3fffffffffffffc
+ 0x43fffffffffffffd 0xc3fffffffffffffd
+ 0x43fffffffffffffe 0xc3fffffffffffffe
+ 0x43fffffffffffffe 0xc3fffffffffffffe
+ 0x43fffffffffffffe 0xc3fffffffffffffe
+ 0x43ffffffffffffff 0xc3ffffffffffffff
+ 0x4400000000000000 0xc400000000000000
+}]
+
+set ::tcl_precision $saved_precision
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/var.test b/tests/var.test
index dd9483b..ed7e930 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -1,27 +1,27 @@
-# This file contains tests for the tclVar.c source file. Tests appear in
-# the same order as the C code that they test. The set of tests is
-# currently incomplete since it currently includes only new tests for
-# code changed for the addition of Tcl namespaces. Other variable-
-# related tests appear in several other test files including
-# namespace.test, set.test, trace.test, and upvar.test.
+# This file contains tests for the tclVar.c source file. Tests appear in the
+# same order as the C code that they test. The set of tests is currently
+# incomplete since it currently includes only new tests for code changed for
+# the addition of Tcl namespaces. Other variable-related tests appear in
+# several other test files including namespace.test, set.test, trace.test, and
+# upvar.test.
#
-# Sourcing this file into Tcl runs the tests and generates output for
-# errors. No output means no errors were found.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
#
# Copyright (c) 1997 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.
-#
-# RCS: @(#) $Id: var.test,v 1.36 2010/08/03 17:25:13 andreas_kupries Exp $
-#
+# 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.2
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testupvar [llength [info commands testupvar]]
testConstraint testgetvarfullname [llength [info commands testgetvarfullname]]
testConstraint testsetnoerr [llength [info commands testsetnoerr]]
@@ -35,13 +35,14 @@ catch {unset i}
catch {unset a}
catch {unset arr}
-test var-1.1 {TclLookupVar, Array handling} {
+test var-1.1 {TclLookupVar, Array handling} -setup {
catch {unset a}
+} -body {
set x "incr" ;# force no compilation and runtime call to Tcl_IncrCmd
set i 10
set arr(foo) 37
list [$x i] $i [$x arr(foo)] $arr(foo)
-} {11 11 38 38}
+} -result {11 11 38 38}
test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
set x "global value"
namespace eval test_ns_var {
@@ -71,34 +72,35 @@ test var-1.5 {TclLookupVar, active call frame pushed for namespace eval implies
test var-1.6 {TclLookupVar, name starts with :: implies some namespace var} {
namespace eval test_ns_var {set ::x}
} {global value}
-test var-1.7 {TclLookupVar, error finding namespace var} {
- list [catch {set a:::b} msg] $msg
-} {1 {can't read "a:::b": no such variable}}
-test var-1.8 {TclLookupVar, error finding namespace var} {
- list [catch {set ::foobarfoo} msg] $msg
-} {1 {can't read "::foobarfoo": no such variable}}
+test var-1.7 {TclLookupVar, error finding namespace var} -body {
+ set a:::b
+} -returnCodes error -result {can't read "a:::b": no such variable}
+test var-1.8 {TclLookupVar, error finding namespace var} -body {
+ set ::foobarfoo
+} -returnCodes error -result {can't read "::foobarfoo": no such variable}
test var-1.9 {TclLookupVar, create new namespace var} {
namespace eval test_ns_var {
set v hello
}
} {hello}
-test var-1.10 {TclLookupVar, create new namespace var} {
+test var-1.10 {TclLookupVar, create new namespace var} -setup {
catch {unset y}
+} -body {
namespace eval test_ns_var {
set ::y 789
}
set y
-} {789}
-test var-1.11 {TclLookupVar, error creating new namespace var} {
+} -result {789}
+test var-1.11 {TclLookupVar, error creating new namespace var} -body {
namespace eval test_ns_var {
- list [catch {set ::test_ns_var::foo::bar 314159} msg] $msg
+ set ::test_ns_var::foo::bar 314159
}
-} {1 {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist}}
-test var-1.12 {TclLookupVar, error creating new namespace var} {
+} -returnCodes error -result {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist}
+test var-1.12 {TclLookupVar, error creating new namespace var} -body {
namespace eval test_ns_var {
- list [catch {set ::test_ns_var::foo:: 1997} msg] $msg
+ set ::test_ns_var::foo:: 1997
}
-} {1 {can't set "::test_ns_var::foo::": parent namespace doesn't exist}}
+} -returnCodes error -result {can't set "::test_ns_var::foo::": parent namespace doesn't exist}
test var-1.13 {TclLookupVar, new namespace var is created in a particular namespace} {
catch {unset aNeWnAmEiNnS}
namespace eval test_ns_var {
@@ -116,9 +118,9 @@ test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of va
set x:y: 789
list [set :] [set v:] [set x:y:] \
${:} ${v:} ${x:y:} \
- [expr {[lsearch [info vars] :] != -1}] \
- [expr {[lsearch [info vars] v:] != -1}] \
- [expr {[lsearch [info vars] x:y:] != -1}]
+ [expr {":" in [info vars]}] \
+ [expr {"v:" in [info vars]}] \
+ [expr {"x:y:" in [info vars]}]
}
} {123 456 789 123 456 789 1 1 1}
test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace: compiled code path} {
@@ -177,24 +179,25 @@ test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array:
set result
}
} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
-test var-1.19 {TclLookupVar, right error message when parsing variable name} {
- list [catch {[format set] thisvar(doesntexist)} msg] $msg
-} {1 {can't read "thisvar(doesntexist)": no such variable}}
+test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
+ [format set] thisvar(doesntexist)
+} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}
test var-2.1 {Tcl_LappendObjCmd, create var if new} {
catch {unset x}
lappend x 1 2
} {1 2}
-test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} {
+test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} -setup {
catch {unset x}
+} -body {
set x 1997
proc p {} {
global x ;# calls MakeUpvar with TCL_NAMESPACE_ONLY for other var x
return $x
}
p
-} {1997}
+} -result {1997}
test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} {
namespace eval test_ns_var {
catch {unset v}
@@ -206,17 +209,19 @@ test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} {
p
}
} {1998}
-test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} testupvar {
+test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} -setup {
catch {unset a}
+} -constraints testupvar -body {
set a 123321
proc p {} {
# create global xx linked to global a
testupvar 1 a {} xx global
}
list [p] $xx [set xx 789] $a
-} {{} 123321 789 789}
-test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} testupvar {
+} -result {{} 123321 789 789}
+test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup {
catch {unset a}
+} -constraints testupvar -body {
set a 456
namespace eval test_ns_var {
catch {unset ::test_ns_var::vv}
@@ -227,58 +232,64 @@ test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} testupvar {
p
}
list $test_ns_var::vv [set test_ns_var::vv 123] $a
-} {456 123 123}
-test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} {
+} -result {456 123 123}
+test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup {
catch {unset aaaaa}
catch {unset xxxxx}
+} -body {
set aaaaa 77777
upvar #0 aaaaa xxxxx
list [set xxxxx] [set aaaaa]
-} {77777 77777}
-test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} {
+} -result {77777 77777}
+test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} -setup {
catch {unset a}
+} -body {
set a 121212
namespace eval test_ns_var {
upvar ::a vvv
set vvv
}
-} {121212}
-test var-3.7 {MakeUpvar, my var has ::s} {
+} -result {121212}
+test var-3.7 {MakeUpvar, my var has ::s} -setup {
catch {unset a}
+} -body {
set a 789789
upvar #0 a test_ns_var::lnk
namespace eval test_ns_var {
set lnk
}
-} {789789}
-test var-3.8 {MakeUpvar, my var already exists in global ns} {
+} -result {789789}
+test var-3.8 {MakeUpvar, my var already exists in global ns} -setup {
catch {unset aaaaa}
catch {unset xxxxx}
+} -body {
set aaaaa 456654
set xxxxx hello
upvar #0 aaaaa xxxxx
set xxxxx
-} {hello}
-test var-3.9 {MakeUpvar, my var has invalid ns name} {
+} -result {hello}
+test var-3.9 {MakeUpvar, my var has invalid ns name} -setup {
catch {unset aaaaa}
+} -returnCodes error -body {
set aaaaa 789789
- list [catch {upvar #0 aaaaa test_ns_fred::lnk} msg] $msg
-} {1 {can't create "test_ns_fred::lnk": parent namespace doesn't exist}}
-test var-3.10 {MakeUpvar, } {
+ upvar #0 aaaaa test_ns_fred::lnk
+} -result {can't create "test_ns_fred::lnk": parent namespace doesn't exist}
+test var-3.10 {MakeUpvar, between namespaces} -body {
namespace eval {} {
- set bar 0
+ variable bar 0
namespace eval foo upvar bar bar
set foo::bar 1
- catch {list $bar $foo::bar} msg
- unset ::aaaaa
- set msg
+ list $bar $foo::bar
}
-} {1 1}
-test var-3.11 {MakeUpvar, my var looks like array elem} -body {
+} -cleanup {
+ unset ::aaaaa
+} -result {1 1}
+test var-3.11 {MakeUpvar, my var looks like array elem} -setup {
catch {unset aaaaa}
+} -returnCodes error -body {
set aaaaa 789789
upvar #0 aaaaa foo(bar)
-} -returnCodes 1 -result {bad variable name "foo(bar)": upvar won't create a scalar variable that looks like an array element}
+} -result {bad variable name "foo(bar)": upvar won't create a scalar variable that looks like an array element}
test var-4.1 {Tcl_GetVariableName, global variable} testgetvarfullname {
catch {unset a}
@@ -291,17 +302,19 @@ test var-4.2 {Tcl_GetVariableName, namespace variable} testgetvarfullname {
testgetvarfullname george namespace
}
} ::test_ns_var::george
-test var-4.3 {Tcl_GetVariableName, variable can't be array element} testgetvarfullname {
+test var-4.3 {Tcl_GetVariableName, variable can't be array element} -setup {
catch {unset a}
+} -constraints testgetvarfullname -body {
set a(1) foo
- list [catch {testgetvarfullname a(1) global} msg] $msg
-} {1 {unknown variable "a(1)"}}
+ testgetvarfullname a(1) global
+} -returnCodes error -result {unknown variable "a(1)"}
-test var-5.1 {Tcl_GetVariableFullName, global variable} {
+test var-5.1 {Tcl_GetVariableFullName, global variable} -setup {
catch {unset a}
+} -body {
set a bar
namespace which -variable a
-} {::a}
+} -result {::a}
test var-5.2 {Tcl_GetVariableFullName, namespace variable} {
namespace eval test_ns_var {
variable martha
@@ -316,11 +329,10 @@ test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
namespace eval test_ns_var {
variable boeing 777
}
- proc p {} {
+ apply {{} {
global ::test_ns_var::boeing
set boeing
- }
- p
+ }}
} {777}
test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
namespace eval test_ns_var {
@@ -336,11 +348,10 @@ test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
} {java}
test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
set ::test_ns_var::test_ns_nested:: 24
- proc p {} {
+ apply {{} {
global ::test_ns_var::test_ns_nested::
set {}
- }
- p
+ }}
} {24}
test var-6.4 {Tcl_GlobalObjCmd, variable name matching :*} {
# Test for Tcl Bug 480176
@@ -362,13 +373,14 @@ test var-6.6 {Tcl_GlobalObjCmd, no-op case (TIP 323)} {
p
} {}
-test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} {
+test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} -setup {
catch {namespace delete test_ns_var}
+} -body {
namespace eval test_ns_var {
variable one 1
}
list [info vars test_ns_var::*] [set test_ns_var::one]
-} {::test_ns_var::one 1}
+} -result {::test_ns_var::one 1}
test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
set two 2222222
namespace eval test_ns_var {
@@ -390,10 +402,11 @@ test var-7.4 {Tcl_VariableObjCmd, list of vars} {
list [lsort [info vars test_ns_var::*]] \
[namespace eval test_ns_var {expr $three+$four}]
} [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
-test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} {
+test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
catch {unset a}
catch {unset five}
catch {unset six}
+} -body {
set a ""
set five 555
set six 666
@@ -403,23 +416,25 @@ test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} {
}
lappend a $test_ns_var::five \
[set test_ns_var::six 6] [set test_ns_var::six] $six
+} -cleanup {
catch {unset five}
catch {unset six}
- set a
-} {5 5 6 6 666}
-catch {unset newvar}
-test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} {
+} -result {5 5 6 6 666}
+test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} -setup {
+ catch {unset newvar}
+} -body {
namespace eval test_ns_var {
variable ::newvar cheers!
}
- set newvar
-} {cheers!}
-catch {unset newvar}
-test var-7.7 {Tcl_VariableObjCmd, bad var name} {
+ return $newvar
+} -cleanup {
+ catch {unset newvar}
+} -result {cheers!}
+test var-7.7 {Tcl_VariableObjCmd, bad var name} -returnCodes error -body {
namespace eval test_ns_var {
- list [catch {variable sev:::en 7} msg] $msg
+ variable sev:::en 7
}
-} {1 {can't define "sev:::en": parent namespace doesn't exist}}
+} -result {can't define "sev:::en": parent namespace doesn't exist}
test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} {
set a ""
namespace eval test_ns_var {
@@ -430,8 +445,9 @@ test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, l
}
set a
} {8 8}
-test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} {
+test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} -setup {
catch {namespace delete test_ns_var2}
+} -body {
set a ""
namespace eval test_ns_var2 {
variable x 123
@@ -451,8 +467,7 @@ test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until na
lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
lappend a [list [catch {unset test_ns_var2::z} msg] $msg]
lappend a [namespace delete test_ns_var2]
- set a
-} [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\
+} -result [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\
{1 {can't read "test_ns_var2::y": no such variable}}\
[lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 0 0\
hello 1 0\
@@ -496,20 +511,16 @@ test var-7.13 {Tcl_VariableObjCmd, variable named ":"} {
p
}
} {{My name is ":"} :}
-test var-7.14 {Tcl_VariableObjCmd, array element parameter} {
- catch {namespace eval test_ns_var { variable arrayvar(1) }} res
- set res
-} "can't define \"arrayvar(1)\": name refers to an element in an array"
-test var-7.15 {Tcl_VariableObjCmd, array element parameter} {
- catch {
- namespace eval test_ns_var {
- variable arrayvar
- set arrayvar(1) x
- variable arrayvar(1) y
- }
- } res
- set res
-} "can't define \"arrayvar(1)\": name refers to an element in an array"
+test var-7.14 {Tcl_VariableObjCmd, array element parameter} -body {
+ namespace eval test_ns_var { variable arrayvar(1) }
+} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
+test var-7.15 {Tcl_VariableObjCmd, array element parameter} -body {
+ namespace eval test_ns_var {
+ variable arrayvar
+ set arrayvar(1) x
+ variable arrayvar(1) y
+ }
+} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.16 {Tcl_VariableObjCmd, no args (TIP 323)} {
variable
} {}
@@ -519,158 +530,173 @@ test var-7.17 {Tcl_VariableObjCmd, no args (TIP 323)} {
}
} {}
-test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} {
+test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} -setup {
catch {namespace delete test_ns_var}
catch {unset a}
+} -body {
namespace eval test_ns_var {
variable v 123
variable info ""
-
proc traceUnset {name1 name2 op} {
variable info
set info [concat $info [list $name1 $name2 $op]]
}
-
trace var v u [namespace code traceUnset]
}
list [unset test_ns_var::v] $test_ns_var::info
-} {{} {test_ns_var::v {} u}}
-
-test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} {
+} -result {{} {test_ns_var::v {} u}}
+test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} -setup {
catch {namespace delete test_ns_var}
catch {unset a}
+} -body {
set info ""
namespace eval test_ns_var {
variable v 123 1
trace var v u ::traceUnset
}
-
proc traceUnset {name1 name2 op} {
set ::info [concat $::info [list $name1 $name2 $op]]
}
-
list [namespace delete test_ns_var] $::info
-} {{} {::test_ns_var::v {} u}}
+} -result {{} {::test_ns_var::v {} u}}
-test var-9.1 {behaviour of TclGet/SetVar simple get/set} testsetnoerr {
- catch {unset u}; catch {unset v}
+test var-9.1 {behaviour of TclGet/SetVar simple get/set} -setup {
+ catch {unset u}
+ catch {unset v}
+} -constraints testsetnoerr -body {
list \
- [set u a; testsetnoerr u] \
- [testsetnoerr v b] \
- [testseterr u] \
- [unset v; testseterr v b]
-} [list {before get a} {before set b} {before get a} {before set b}]
-test var-9.2 {behaviour of TclGet/SetVar namespace get/set} testsetnoerr {
+ [set u a; testsetnoerr u] \
+ [testsetnoerr v b] \
+ [testseterr u] \
+ [unset v; testseterr v b]
+} -result [list {before get a} {before set b} {before get a} {before set b}]
+test var-9.2 {behaviour of TclGet/SetVar namespace get/set} -setup {
catch {namespace delete ns}
+} -constraints testsetnoerr -body {
namespace eval ns {variable u a; variable v}
list \
- [testsetnoerr ns::u] \
- [testsetnoerr ns::v b] \
- [testseterr ns::u] \
- [unset ns::v; testseterr ns::v b]
-} [list {before get a} {before set b} {before get a} {before set b}]
-test var-9.3 {behaviour of TclGetVar no variable} testsetnoerr {
+ [testsetnoerr ns::u] \
+ [testsetnoerr ns::v b] \
+ [testseterr ns::u] \
+ [unset ns::v; testseterr ns::v b]
+} -result [list {before get a} {before set b} {before get a} {before set b}]
+test var-9.3 {behaviour of TclGetVar no variable} -setup {
catch {unset u}
+} -constraints testsetnoerr -body {
list \
- [catch {testsetnoerr u} res] $res \
- [catch {testseterr u} res] $res
-} {1 {before get} 1 {can't read "u": no such variable}}
-test var-9.4 {behaviour of TclGetVar no namespace variable} testsetnoerr {
+ [catch {testsetnoerr u} res] $res \
+ [catch {testseterr u} res] $res
+} -result {1 {before get} 1 {can't read "u": no such variable}}
+test var-9.4 {behaviour of TclGetVar no namespace variable} -setup {
catch {namespace delete ns}
+} -constraints testsetnoerr -body {
namespace eval ns {}
list \
- [catch {testsetnoerr ns::w} res] $res \
- [catch {testseterr ns::w} res] $res
-} {1 {before get} 1 {can't read "ns::w": no such variable}}
-test var-9.5 {behaviour of TclGetVar no namespace} testsetnoerr {
+ [catch {testsetnoerr ns::w} res] $res \
+ [catch {testseterr ns::w} res] $res
+} -result {1 {before get} 1 {can't read "ns::w": no such variable}}
+test var-9.5 {behaviour of TclGetVar no namespace} -setup {
catch {namespace delete ns}
+} -constraints testsetnoerr -body {
list \
- [catch {testsetnoerr ns::u} res] $res \
- [catch {testseterr ns::v} res] $res
-} {1 {before get} 1 {can't read "ns::v": no such variable}}
-test var-9.6 {behaviour of TclSetVar no namespace} testsetnoerr {
+ [catch {testsetnoerr ns::u} res] $res \
+ [catch {testseterr ns::v} res] $res
+} -result {1 {before get} 1 {can't read "ns::v": no such variable}}
+test var-9.6 {behaviour of TclSetVar no namespace} -setup {
catch {namespace delete ns}
+} -constraints testsetnoerr -body {
list \
- [catch {testsetnoerr ns::v 1} res] $res \
- [catch {testseterr ns::v 1} res] $res
-} {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
-test var-9.7 {behaviour of TclGetVar array variable} testsetnoerr {
+ [catch {testsetnoerr ns::v 1} res] $res \
+ [catch {testseterr ns::v 1} res] $res
+} -result {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
+test var-9.7 {behaviour of TclGetVar array variable} -setup {
catch {unset arr}
- set arr(1) 1;
+} -constraints testsetnoerr -body {
+ set arr(1) 1
list \
- [catch {testsetnoerr arr} res] $res \
- [catch {testseterr arr} res] $res
-} {1 {before get} 1 {can't read "arr": variable is array}}
-test var-9.8 {behaviour of TclSetVar array variable} testsetnoerr {
+ [catch {testsetnoerr arr} res] $res \
+ [catch {testseterr arr} res] $res
+} -result {1 {before get} 1 {can't read "arr": variable is array}}
+test var-9.8 {behaviour of TclSetVar array variable} -setup {
catch {unset arr}
+} -constraints testsetnoerr -body {
set arr(1) 1
list \
- [catch {testsetnoerr arr 2} res] $res \
- [catch {testseterr arr 2} res] $res
-} {1 {before set} 1 {can't set "arr": variable is array}}
-test var-9.9 {behaviour of TclGetVar read trace success} testsetnoerr {
+ [catch {testsetnoerr arr 2} res] $res \
+ [catch {testseterr arr 2} res] $res
+} -result {1 {before set} 1 {can't set "arr": variable is array}}
+test var-9.9 {behaviour of TclGetVar read trace success} -setup {
+ catch {unset u}
+ catch {unset v}
+} -constraints testsetnoerr -body {
proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
- catch {unset u}; catch {unset v}
set u 10
trace var u r [list resetvar 1]
trace var v r [list resetvar 2]
list \
- [testsetnoerr u] \
- [testseterr v]
-} {{before get 1} {before get 2}}
+ [testsetnoerr u] \
+ [testseterr v]
+} -result {{before get 1} {before get 2}}
test var-9.10 {behaviour of TclGetVar read trace error} testsetnoerr {
proc writeonly args {error "write-only"}
set v 456
trace var v r writeonly
list \
- [catch {testsetnoerr v} msg] $msg \
- [catch {testseterr v} msg] $msg
+ [catch {testsetnoerr v} msg] $msg \
+ [catch {testseterr v} msg] $msg
} {1 {before get} 1 {can't read "v": write-only}}
-test var-9.11 {behaviour of TclSetVar write trace success} testsetnoerr {
+test var-9.11 {behaviour of TclSetVar write trace success} -setup {
+ catch {unset u}
+ catch {unset v}
+} -constraints testsetnoerr -body {
proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
- catch {unset u}; catch {unset v}
set v 1
trace var v w doubleval
trace var u w doubleval
list \
- [testsetnoerr u 2] \
- [testseterr v 3]
-} {{before set 4} {before set 6}}
+ [testsetnoerr u 2] \
+ [testseterr v 3]
+} -result {{before set 4} {before set 6}}
test var-9.12 {behaviour of TclSetVar write trace error} testsetnoerr {
proc readonly args {error "read-only"}
set v 456
trace var v w readonly
list \
- [catch {testsetnoerr v 2} msg] $msg $v \
- [catch {testseterr v 3} msg] $msg $v
+ [catch {testsetnoerr v 2} msg] $msg $v \
+ [catch {testseterr v 3} msg] $msg $v
} {1 {before set} 2 1 {can't set "v": read-only} 3}
-test var-10.1 {can't nest arrays with array set} {
+test var-10.1 {can't nest arrays with array set} -setup {
catch {unset arr}
- list [catch {array set arr(x) {a 1 b 2}} res] $res
-} {1 {can't set "arr(x)": variable isn't array}}
-test var-10.2 {can't nest arrays with array set} {
+} -returnCodes error -body {
+ array set arr(x) {a 1 b 2}
+} -result {can't set "arr(x)": variable isn't array}
+test var-10.2 {can't nest arrays with array set} -setup {
catch {unset arr}
- list [catch {array set arr(x) {}} res] $res
-} {1 {can't set "arr(x)": variable isn't array}}
+} -returnCodes error -body {
+ array set arr(x) {}
+} -result {can't set "arr(x)": variable isn't array}
-test var-11.1 {array unset} {
+test var-11.1 {array unset} -setup {
catch {unset a}
+} -body {
array set a { 1,1 a 1,2 b 2,1 c 2,3 d }
array unset a 1,*
lsort -dict [array names a]
-} {2,1 2,3}
-test var-11.2 {array unset} {
+} -result {2,1 2,3}
+test var-11.2 {array unset} -setup {
catch {unset a}
+} -body {
array set a { 1,1 a 1,2 b }
array unset a
array exists a
-} 0
-test var-11.3 {array unset errors} {
+} -result 0
+test var-11.3 {array unset errors} -setup {
catch {unset a}
+} -returnCodes error -body {
array set a { 1,1 a 1,2 b }
- list [catch {array unset a pattern too} msg] $msg
-} {1 {wrong # args: should be "array unset arrayName ?pattern?"}}
+ array unset a pattern too
+} -result {wrong # args: should be "array unset arrayName ?pattern?"}
test var-12.1 {TclFindCompiledLocals, {} array name} {
namespace eval n {
@@ -687,8 +713,9 @@ test var-12.1 {TclFindCompiledLocals, {} array name} {
}
} {0 1 2 2,foo}
-test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} {
+test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} -setup {
catch {unset t}
+} -body {
proc foo {var ind op} {
global t
set foo bar
@@ -699,15 +726,14 @@ test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} {
unset t
}
set x "If you see this, it worked"
-} "If you see this, it worked"
+} -result "If you see this, it worked"
test var-14.1 {array names syntax} -body {
array names foo bar baz snafu
} -returnCodes 1 -match glob -result *
-
test var-14.2 {array names -glob} -body {
array names tcl_platform -glob os
-} -returnCodes 0 -match exact -result os
+} -result os
test var-15.1 {segfault in [unset], [Bug 735335]} {
proc A { name } {
@@ -723,7 +749,6 @@ test var-15.1 {segfault in [unset], [Bug 735335]} {
namespace eval test unset useSomeUnlikelyNameHere
} {}
-
test var-16.1 {CallVarTraces: save/restore interp error state} {
trace add variable ::errorCode write " ;#"
catch {error foo bar baz}
@@ -763,7 +788,6 @@ test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
unset x already
} -result 0
-
test var-19.1 {crash when freeing locals hashtable: Bug 3037525} {
proc foo {} { catch {upvar 0 dummy \$index} }
foo ; # This crashes without the fix for the bug
diff --git a/tests/while-old.test b/tests/while-old.test
index 12e8537..ee17d0b 100644
--- a/tests/while-old.test
+++ b/tests/while-old.test
@@ -12,8 +12,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: while-old.test,v 1.8 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/while.test b/tests/while.test
index 323e160..642ec93 100644
--- a/tests/while.test
+++ b/tests/while.test
@@ -9,8 +9,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: while.test,v 1.14 2009/10/30 16:28:02 dkf Exp $
if {"::tcltest" ni [namespace children]} {
package require tcltest 2
diff --git a/tests/winConsole.test b/tests/winConsole.test
index 51c1781..fdde41c 100644
--- a/tests/winConsole.test
+++ b/tests/winConsole.test
@@ -8,8 +8,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winConsole.test,v 1.8 2006/11/03 00:34:53 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
diff --git a/tests/winDde.test b/tests/winDde.test
index f59a7f2..f04fb45 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -8,26 +8,21 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winDde.test,v 1.28 2005/05/10 18:35:25 kennykb Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2
#tcltest::configure -verbose {pass start}
namespace import -force ::tcltest::*
}
+testConstraint debug [::tcl::pkgconfig get debug]
+testConstraint dde 0
if {[testConstraint win]} {
- if [catch {
- # Is the dde extension already static to this shell?
- if [catch {load {} Dde; set ::ddelib {}}] {
- # try the location given to use on the commandline to tcltest
+ if {![catch {
::tcltest::loadTestedCommands
- load $::ddelib Dde
- }
+ set ::ddever [package require dde 1.4.0]
+ set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
testConstraint dde 1
- }] {
- testConstraint dde 0
}
}
@@ -38,22 +33,20 @@ if {[testConstraint win]} {
set scriptName [makeFile {} script1.tcl]
-proc createChildProcess { ddeServerName {handler {}}} {
+proc createChildProcess {ddeServerName args} {
file delete -force $::scriptName
set f [open $::scriptName w+]
puts $f [list set ddeServerName $ddeServerName]
- if {$::ddelib != ""} {
- puts $f [list load $::ddelib Dde]
- }
+ puts $f [list load $::ddelib dde]
puts $f {
# DDE child server -
#
- if {[lsearch [namespace children] ::tcltest] == -1} {
+ if {"::tcltest" ni [namespace children]} {
package require tcltest
namespace import -force ::tcltest::*
}
-
+
# If an error occurs during the tests, this process may end up not
# being closed down. To deal with this we create a 30s timeout.
proc ::DoTimeout {} {
@@ -63,16 +56,19 @@ proc createChildProcess { ddeServerName {handler {}}} {
flush stdout
}
set timeout [after 30000 ::DoTimeout]
-
+
# Define a restricted handler.
proc Handler1 {cmd} {
if {$cmd eq "stop"} {set ::done 1}
- puts $cmd ; flush stdout
+ if {$cmd == ""} {
+ set cmd "null data"
+ }
+ puts $cmd ; flush stdout
return
}
proc Handler2 {cmd} {
if {$cmd eq "stop"} {set ::done 1}
- puts [uplevel \#0 $cmd] ; flush stdout
+ puts [uplevel \#0 $cmd] ; flush stdout
return
}
proc Handler3 {prefix cmd} {
@@ -82,11 +78,7 @@ proc createChildProcess { ddeServerName {handler {}}} {
}
}
# set the dde server name to the supplied argument.
- if {$handler == {}} {
- puts $f [list dde servername $ddeServerName]
- } else {
- puts $f [list dde servername -handler $handler -- $ddeServerName]
- }
+ puts $f [list dde servername {*}$args -- $ddeServerName]
puts $f {
# run the server and handle final cleanup.
after 200;# give dde a chance to get going.
@@ -96,12 +88,12 @@ proc createChildProcess { ddeServerName {handler {}}} {
# allow enough time for the calling process to
# claim all results, to avoid spurious "server did
# not respond"
- after 200 { set reallyDone 1 }
+ after 200 {set reallyDone 1}
vwait reallyDone
exit
}
close $f
-
+
# run the child server script.
set f [open |[list [interpreter] $::scriptName] r]
fconfigure $f -buffering line
@@ -110,147 +102,184 @@ proc createChildProcess { ddeServerName {handler {}}} {
}
# -------------------------------------------------------------------------
+test winDde-1.0 {check if we are testing the right dll} {win dde} {
+ set ::ddever
+} {1.4.0}
-test winDde-1.1 {Settings the server's topic name} {win dde} {
+test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
list [dde servername foobar] [dde servername] [dde servername self]
-} {foobar foobar self}
+} -result {foobar foobar self}
-test winDde-2.1 {Checking for other services} {win dde} {
+test winDde-2.1 {Checking for other services} -constraints dde -body {
expr [llength [dde services {} {}]] >= 0
-} 1
+} -result 1
test winDde-2.2 {Checking for existence, with service and topic specified} \
- {win dde} {
+ -constraints dde -body {
llength [dde services TclEval self]
-} 1
+} -result 1
test winDde-2.3 {Checking for existence, with only the service specified} \
- {win dde} {
+ -constraints dde -body {
expr [llength [dde services TclEval {}]] >= 1
-} 1
+} -result 1
test winDde-2.4 {Checking for existence, with only the topic specified} \
- {win dde} {
+ -constraints dde -body {
expr [llength [dde services {} self]] >= 1
-} 1
+} -result 1
# -------------------------------------------------------------------------
-test winDde-3.1 {DDE execute locally} {win dde} {
- set a ""
- dde execute TclEval self {set a "foo"}
- set a
-} foo
-test winDde-3.2 {DDE execute -async locally} {win dde} {
- set a ""
- dde execute -async TclEval self {set a "foo"}
+test winDde-3.1 {DDE execute locally} -constraints dde -body {
+ set \xe1 ""
+ dde execute TclEval self [list set \xe1 foo]
+ set \xe1
+} -result foo
+test winDde-3.2 {DDE execute -async locally} -constraints dde -body {
+ set \xe1 ""
+ dde execute -async TclEval self [list set \xe1 foo]
update
- set a
-} foo
-test winDde-3.3 {DDE request locally} {win dde} {
- set a ""
- dde execute TclEval self {set a "foo"}
- dde request TclEval self a
-} foo
-test winDde-3.4 {DDE eval locally} {win dde} {
- set a ""
- dde eval self set a "foo"
-} foo
-test winDde-3.5 {DDE request locally} {win dde} {
- set a ""
- dde execute TclEval self {set a "foo"}
- dde request -binary TclEval self a
-} "foo\x00"
+ set \xe1
+} -result foo
+test winDde-3.3 {DDE request locally} -constraints dde -body {
+ set \xe1 ""
+ dde execute TclEval self [list set \xe1 foo]
+ dde request TclEval self \xe1
+} -result foo
+test winDde-3.4 {DDE eval locally} -constraints dde -body {
+ set \xe1 ""
+ dde eval self set \xe1 foo
+} -result foo
+test winDde-3.5 {DDE request locally} -constraints dde -body {
+ set \xe1 ""
+ dde execute TclEval self [list set \xe1 foo]
+ dde request -binary TclEval self \xe1
+} -result "foo\x00"
+# Set variable a to A with diaeresis (unicode C4) by relying on the fact
+# that utf8 is sent (e.g. "c3 84" on the wire)
+test winDde-3.6 {DDE request utf8} -constraints dde -body {
+ set \xe1 "not set"
+ dde execute TclEval self "set \xe1 \xc4"
+ scan [set \xe1] %c
+} -result 196
+# Set variable a to A with diaeresis (unicode C4) using binary execute
+# and compose utf-8 (e.g. "c3 84" ) manualy
+test winDde-3.7 {DDE request binary} -constraints dde -body {
+ set \xe1 "not set"
+ dde execute -binary TclEval self [list set \xc3\xa1 \xc3\x84\x00]
+ scan [set \xe1] %c
+} -result 196
+test winDde-3.8 {DDE poke locally} -constraints {dde debug} -body {
+ set \xe1 ""
+ dde poke TclEval self \xe1 \xc4
+ dde request TclEval self \xe1
+} -result \xc4
+test winDde-3.9 {DDE poke -binary locally} -constraints {dde debug} -body {
+ set \xe1 ""
+ dde poke -binary TclEval self \xe1 \xc3\x84\x00
+ dde request TclEval self \xe1
+} -result \xc4
# -------------------------------------------------------------------------
-test winDde-4.1 {DDE execute remotely} {stdio win dde} {
- set a ""
- set name child-4.1
+test winDde-4.1 {DDE execute remotely} -constraints {dde stdio} -body {
+ set \xe1 ""
+ set name ch\xEDld-4.1
set child [createChildProcess $name]
- dde execute TclEval $name {set a "foo"}
+ dde execute TclEval $name [list set \xe1 foo]
dde execute TclEval $name {set done 1}
update
- set a
-} ""
-test winDde-4.2 {DDE execute async remotely} {stdio win dde} {
- set a ""
- set name child-4.2
+ set \xe1
+} -result ""
+test winDde-4.2 {DDE execute async remotely} -constraints {dde stdio} -body {
+ set \xe1 ""
+ set name ch\xEDld-4.2
set child [createChildProcess $name]
- dde execute -async TclEval $name {set a "foo"}
+ dde execute -async TclEval $name [list set \xe1 foo]
update
dde execute TclEval $name {set done 1}
update
- set a
-} ""
-test winDde-4.3 {DDE request remotely} {stdio win dde} {
- set a ""
- set name chile-4.3
+ set \xe1
+} -result ""
+test winDde-4.3 {DDE request remotely} -constraints {dde stdio} -body {
+ set \xe1 ""
+ set name ch\xEDld-4.3
set child [createChildProcess $name]
- dde execute TclEval $name {set a "foo"}
- set a [dde request TclEval $name a]
+ dde execute TclEval $name [list set \xe1 foo]
+ set \xe1 [dde request TclEval $name \xe1]
dde execute TclEval $name {set done 1}
update
- set a
-} foo
-test winDde-4.4 {DDE eval remotely} {stdio win dde} {
- set a ""
- set name child-4.4
+ set \xe1
+} -result foo
+test winDde-4.4 {DDE eval remotely} -constraints {dde stdio} -body {
+ set \xe1 ""
+ set name ch\xEDld-4.4
set child [createChildProcess $name]
- set a [dde eval $name set a "foo"]
+ set \xe1 [dde eval $name set \xe1 foo]
dde execute TclEval $name {set done 1}
update
- set a
-} foo
+ set \xe1
+} -result foo
+test winDde-4.5 {DDE poke remotely} -constraints {dde debug stdio} -body {
+ set \xe1 ""
+ set name ch\xEDld-4.5
+ set child [createChildProcess $name]
+ dde poke TclEval $name \xe1 foo
+ set \xe1 [dde request TclEval $name \xe1]
+ dde execute TclEval $name {set done 1}
+ update
+ set \xe1
+} -result foo
# -------------------------------------------------------------------------
-test winDde-5.1 {check for bad arguments} -constraints {win dde} -body {
+test winDde-5.1 {check for bad arguments} -constraints dde -body {
dde execute "" "" "" ""
-} -returnCodes error -result {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
-test winDde-5.2 {check for bad arguments} -constraints {win dde} -body {
- dde execute "" "" ""
+} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
+test winDde-5.2 {check for bad arguments} -constraints dde -body {
+ dde execute -binary "" "" ""
} -returnCodes error -result {cannot execute null data}
-test winDde-5.3 {check for bad arguments} -constraints {win dde} -body {
+test winDde-5.3 {check for bad arguments} -constraints dde -body {
dde execute -foo "" "" ""
-} -returnCodes error -result {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
-test winDde-5.4 {DDE eval bad arguments} -constraints {win dde} -body {
+} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
+test winDde-5.4 {DDE eval bad arguments} -constraints dde -body {
dde eval "" "foo"
} -returnCodes error -result {invalid service name ""}
# -------------------------------------------------------------------------
-test winDde-6.1 {DDE servername bad arguments} -constraints {win dde} -body {
+test winDde-6.1 {DDE servername bad arguments} -constraints dde -body {
dde servername -z -z -z
} -returnCodes error -result {bad option "-z": must be -force, -handler, or --}
-test winDde-6.2 {DDE servername set name} -constraints {win dde} -body {
+test winDde-6.2 {DDE servername set name} -constraints dde -body {
dde servername -- winDde-6.2
} -result {winDde-6.2}
-test winDde-6.3 {DDE servername set exact name} -constraints {win dde} -body {
+test winDde-6.3 {DDE servername set exact name} -constraints dde -body {
dde servername -force winDde-6.3
} -result {winDde-6.3}
-test winDde-6.4 {DDE servername set exact name} -constraints {win dde} -body {
+test winDde-6.4 {DDE servername set exact name} -constraints dde -body {
dde servername -force -- winDde-6.4
} -result {winDde-6.4}
-test winDde-6.5 {DDE remote servername collision} -constraints {stdio win dde} -setup {
- set name child-6.5
+test winDde-6.5 {DDE remote servername collision} -constraints {dde stdio} -setup {
+ set name ch\xEDld-6.5
set child [createChildProcess $name]
} -body {
dde servername -- $name
} -cleanup {
dde execute TclEval $name {set done 1}
update
-} -result "child-6.5 #2"
-test winDde-6.6 {DDE remote servername collision force} -constraints {stdio win dde} -setup {
- set name child-6.6
+} -result "ch\xEDld-6.5 #2"
+test winDde-6.6 {DDE remote servername collision force} -constraints {dde stdio} -setup {
+ set name ch\xEDld-6.6
set child [createChildProcess $name]
} -body {
dde servername -force -- $name
} -cleanup {
dde execute TclEval $name {set done 1}
update
-} -result {child-6.6}
+} -result "ch\xEDld-6.6"
# -------------------------------------------------------------------------
-test winDde-7.1 {Load DDE in slave interpreter } -constraints {win dde} -setup {
+test winDde-7.1 {Load DDE in slave interpreter} -constraints dde -setup {
interp create slave
} -body {
slave eval [list load $::ddelib Dde]
@@ -258,7 +287,7 @@ test winDde-7.1 {Load DDE in slave interpreter } -constraints {win dde} -setup {
} -cleanup {
interp delete slave
} -result {dde-interp-7.1}
-test winDde-7.2 {DDE slave cleanup} -constraints {win dde} -setup {
+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]
@@ -267,11 +296,11 @@ test winDde-7.2 {DDE slave cleanup} -constraints {win dde} -setup {
dde services TclEval {}
set s [dde services TclEval {}]
set m [list [list TclEval dde-interp-7.5]]
- if {[lsearch -exact $s $m] != -1} {
+ if {$m in $s} {
set s
}
} -result {}
-test winDde-7.3 {DDE present in slave interp} -constraints {win dde} -setup {
+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]
@@ -280,7 +309,7 @@ test winDde-7.3 {DDE present in slave interp} -constraints {win dde} -setup {
} -cleanup {
interp delete slave
} -result {{TclEval dde-interp-7.3}}
-test winDde-7.4 {interp name collision with -force} -constraints {win dde} -setup {
+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]
@@ -289,7 +318,7 @@ test winDde-7.4 {interp name collision with -force} -constraints {win dde} -setu
} -cleanup {
interp delete slave
} -result {dde-interp-7.4}
-test winDde-7.5 {interp name collision without -force} -constraints {win dde} -setup {
+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]
@@ -301,7 +330,7 @@ test winDde-7.5 {interp name collision without -force} -constraints {win dde} -s
# -------------------------------------------------------------------------
-test winDde-8.1 {Safe DDE load} -constraints {win dde} -setup {
+test winDde-8.1 {Safe DDE load} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
} -body {
@@ -309,20 +338,20 @@ test winDde-8.1 {Safe DDE load} -constraints {win dde} -setup {
} -cleanup {
interp delete slave
} -returnCodes error -result {invalid command name "dde"}
-test winDde-8.2 {Safe DDE set servername} -constraints {win dde} -setup {
+test winDde-8.2 {Safe DDE set servername} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
} -body {
slave invokehidden dde servername slave
} -cleanup {interp delete slave} -result {slave}
-test winDde-8.3 {Safe DDE check handler required for eval} -constraints {win dde} -setup {
+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
} -body {
catch {dde eval slave set a 1} msg
} -cleanup {interp delete slave} -result {1}
-test winDde-8.4 {Safe DDE check that execute is denied} -constraints {win dde} -setup {
+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
@@ -331,7 +360,7 @@ test winDde-8.4 {Safe DDE check that execute is denied} -constraints {win dde} -
dde execute TclEval slave {set a 2}
slave eval set a
} -cleanup {interp delete slave} -result 1
-test winDde-8.5 {Safe DDE check that request is denied} -constraints {win dde} -setup {
+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
@@ -341,14 +370,14 @@ test winDde-8.5 {Safe DDE check that request is denied} -constraints {win dde} -
} -cleanup {
interp delete slave
} -returnCodes error -result {remote server cannot handle this command}
-test winDde-8.6 {Safe DDE assign handler procedure} -constraints {win dde} -setup {
+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}}
} -body {
slave invokehidden dde servername -handler DDEACCEPT slave
} -cleanup {interp delete slave} -result slave
-test winDde-8.7 {Safe DDE check simple command} -constraints {win dde} -setup {
+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}}
@@ -356,7 +385,7 @@ test winDde-8.7 {Safe DDE check simple command} -constraints {win dde} -setup {
} -body {
dde eval slave set x 1
} -cleanup {interp delete slave} -result {set x 1}
-test winDde-8.8 {Safe DDE check non-list command} -constraints {win dde} -setup {
+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}}
@@ -366,16 +395,16 @@ test winDde-8.8 {Safe DDE check non-list command} -constraints {win dde} -setup
dde eval slave $s
string equal [slave eval set DDECMD] $s
} -cleanup {interp delete slave} -result 1
-test winDde-8.9 {Safe DDE check command evaluation} -constraints {win dde} -setup {
+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
} -body {
- dde eval slave set x 1
- slave eval set x
+ dde eval slave set \xe1 1
+ slave eval set \xe1
} -cleanup {interp delete slave} -result 1
-test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints {win dde} -setup {
+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]}}
@@ -384,7 +413,7 @@ test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints {win dde}
dde eval slave [list set x 1]
slave eval set x
} -cleanup {interp delete slave} -result 1
-test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints {win dde} -setup {
+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]}}
@@ -396,9 +425,9 @@ test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints {win dde}
# -------------------------------------------------------------------------
-test winDde-9.1 {External safe DDE check string passing} -constraints {win dde stdio} -setup {
- set name child-9.1
- set child [createChildProcess $name Handler1]
+test winDde-9.1 {External safe DDE check string passing} -constraints {dde stdio} -setup {
+ set name ch\xEDld-9.1
+ set child [createChildProcess $name -handler Handler1]
file copy -force script1.tcl dde-script.tcl
} -body {
dde eval $name set x 1
@@ -409,9 +438,9 @@ test winDde-9.1 {External safe DDE check string passing} -constraints {win dde s
update
file delete -force -- dde-script.tcl
} -result {set x 1}
-test winDde-9.2 {External safe DDE check command evaluation} -constraints {win dde stdio} -setup {
- set name child-9.2
- set child [createChildProcess $name Handler2]
+test winDde-9.2 {External safe DDE check command evaluation} -constraints {dde stdio} -setup {
+ set name ch\xEDld-9.2
+ set child [createChildProcess $name -handler Handler2]
file copy -force script1.tcl dde-script.tcl
} -body {
dde eval $name set x 1
@@ -422,9 +451,9 @@ test winDde-9.2 {External safe DDE check command evaluation} -constraints {win d
update
file delete -force -- dde-script.tcl
} -result 1
-test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {win dde stdio} -setup {
- set name child-9.3
- set child [createChildProcess $name [list Handler3 ARG]]
+test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {dde stdio} -setup {
+ set name ch\xEDld-9.3
+ set child [createChildProcess $name -handler [list Handler3 ARG]]
file copy -force script1.tcl dde-script.tcl
} -body {
dde eval $name set x 1
@@ -435,6 +464,19 @@ test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {win d
update
file delete -force -- dde-script.tcl
} -result {ARG {set x 1}}
+test winDde-9.4 {External safe DDE check null data passing} -constraints {dde stdio} -setup {
+ set name ch\xEDld-9.4
+ set child [createChildProcess $name -handler Handler1]
+ file copy -force script1.tcl dde-script.tcl
+} -body {
+ dde execute TclEval $name ""
+ gets $child line
+ set line
+} -cleanup {
+ dde execute TclEval $name stop
+ update
+ file delete -force -- dde-script.tcl
+} -result {null data}
# -------------------------------------------------------------------------
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 7736985..28a0e9f 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -9,15 +9,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winFCmd.test,v 1.46 2009/11/10 20:40:06 patthoyts Exp $
-#
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Initialise the test constraints
testConstraint winVista 0
diff --git a/tests/winFile.test b/tests/winFile.test
index d502b30..fba9bcb 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -9,8 +9,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winFile.test,v 1.22 2008/10/23 12:18:47 das Exp $
if {[catch {package require tcltest 2.0.2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -18,6 +16,9 @@ if {[catch {package require tcltest 2.0.2}]} {
}
namespace import -force ::tcltest::*
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint notNTFS 0
testConstraint win2000 0
diff --git a/tests/winNotify.test b/tests/winNotify.test
index 09ddc1c..3e9aa29 100644
--- a/tests/winNotify.test
+++ b/tests/winNotify.test
@@ -9,14 +9,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winNotify.test,v 1.10 2004/06/23 15:36:59 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testeventloop [expr {[info commands testeventloop] != {}}]
# There is no explicit test for InitNotifier or NotifierExitHandler
diff --git a/tests/winPipe.test b/tests/winPipe.test
index a2df9b6..d2e804d 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -9,15 +9,18 @@
# Copyright (c) 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.
-#
-# RCS: @(#) $Id: winPipe.test,v 1.33 2006/11/03 15:31:26 dkf Exp $
+# 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::*
unset -nocomplain path
+catch {
+ ::tcltest::loadTestedCommands
+ package require -exact Tcltest [info patchlevel]
+ set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
+}
set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]
@@ -26,6 +29,8 @@ testConstraint exec [llength [info commands exec]]
testConstraint cat32 [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole [expr {![testConstraint AllocConsole]}]
+testConstraint testexcept [llength [info commands testexcept]]
+
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
@@ -60,7 +65,7 @@ set path(more) [makeFile {
set path(stdout) [makeFile {} stdout]
set path(stderr) [makeFile {} stderr]
-
+
test winpipe-1.1 {32 bit comprehensive tests: from little file} {win exec cat32} {
exec $cat32 < $path(little) > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
@@ -70,15 +75,15 @@ test winpipe-1.2 {32 bit comprehensive tests: from big file} {win exec cat32} {
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {win nt exec cat32} {
- exec [interpreter] more < little | $cat32 > $path(stdout) 2> $path(stderr)
+ exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} {
- exec [interpreter] more < big | $cat32 > $path(stdout) 2> $path(stderr)
+ exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {win 95 exec cat32} {
- exec command /c type big |& $cat32 > $path(stdout) 2> $path(stderr)
+ exec command /c type $path(big) |& $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.6 {32 bit comprehensive tests: from console} \
@@ -173,7 +178,6 @@ test winpipe-1.22 {Checking command.com for Win95/98 hanging} {win 95 exec} {
exec command.com /c dir /b
set result 1
} 1
-file delete more
test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
proc readResults {f} {
@@ -186,8 +190,7 @@ test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
set result "$result$line"
}
}
-
- set f [open "|[list $cat32] < big 2> $path(stderr)" r]
+ set f [open "|[list $cat32] < $path(big) 2> $path(stderr)" r]
fconfigure $f -buffering none -blocking 0
fileevent $f readable "readResults $f"
set x 0
@@ -195,30 +198,34 @@ test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
vwait x
list $result $x [contents $path(stderr)]
} "{$big} 1 stderr32"
-test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec} {
+test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept} {
set f [open "|[list [interpreter]]" w+]
set pid [pid $f]
+ puts $f "load $::tcltestlib Tcltest"
puts $f "testexcept float_underflow"
set status [catch {close $f}]
list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGFPE}
-test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec} {
+test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept} {
set f [open "|[list [interpreter]]" w+]
set pid [pid $f]
+ puts $f "load $::tcltestlib Tcltest"
puts $f "testexcept access_violation"
set status [catch {close $f}]
list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGSEGV}
-test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec} {
+test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept} {
set f [open "|[list [interpreter]]" w+]
set pid [pid $f]
+ puts $f "load $::tcltestlib Tcltest"
puts $f "testexcept illegal_instruction"
set status [catch {close $f}]
list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGILL}
-test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec} {
+test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept} {
set f [open "|[list [interpreter]]" w+]
set pid [pid $f]
+ puts $f "load $::tcltestlib Tcltest"
puts $f "testexcept ctrl+c"
set status [catch {close $f}]
list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
@@ -236,9 +243,9 @@ set env(TEMP) c:/
test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {win exec} {
set x {}
set existing [glob -nocomplain c:/tcl*.tmp]
- exec [interpreter] < nothing
+ exec [interpreter] < $path(nothing)
foreach p [glob -nocomplain c:/tcl*.tmp] {
- if {[lsearch $existing $p] == -1} {
+ if {$p ni $existing} {
lappend x $p
}
}
@@ -249,7 +256,7 @@ test winpipe-5.2 {TclpCreateTempFile: TMP and TEMP not defined} {win exec} {
set temp $env(TEMP)
unset env(TMP)
unset env(TEMP)
- exec [interpreter] < nothing
+ exec [interpreter] < $path(nothing)
set env(TMP) $tmp
set env(TEMP) $temp
set x {}
@@ -258,7 +265,7 @@ test winpipe-5.3 {TclpCreateTempFile: TMP specifies non-existent directory} \
{win exec } {
set tmp $env(TMP)
set env(TMP) snarky
- exec [interpreter] < nothing
+ exec [interpreter] < $path(nothing)
set env(TMP) $tmp
set x {}
} {}
@@ -268,7 +275,7 @@ test winpipe-5.4 {TclpCreateTempFile: TEMP specifies non-existent directory} \
set temp $env(TEMP)
unset env(TMP)
set env(TEMP) snarky
- exec [interpreter] < nothing
+ exec [interpreter] < $path(nothing)
set env(TMP) $tmp
set env(TEMP) $temp
set x {}
@@ -313,7 +320,6 @@ set path(echoArgs.tcl) [makeFile {
puts "[list $argv0 $argv]"
} echoArgs.tcl]
-
### validate the raw output of BuildCommandLine().
###
test winpipe-7.1 {BuildCommandLine: null arguments} {win exec} {
@@ -430,7 +436,7 @@ test winpipe-8.18 {BuildCommandLine/parse_cmdline pass-thru: special chars #2} {
test winpipe-8.19 {ensure parse_cmdline isn't doing wildcard replacement} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo * makefile.?c bar
} [list $path(echoArgs.tcl) [list foo * makefile.?c bar]]
-
+
# restore old values for env(TMP) and env(TEMP)
if {[catch {set env(TMP) $env_tmp}]} {
@@ -441,6 +447,16 @@ if {[catch {set env(TEMP) $env_temp}]} {
}
# cleanup
-file delete big little stdout stderr nothing echoArgs.tcl
+removeFile little
+removeFile big
+removeFile more
+removeFile stdout
+removeFile stderr
+removeFile nothing
+removeFile echoArgs.tcl
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/winTime.test b/tests/winTime.test
index 00cf4d8..add8f98 100644
--- a/tests/winTime.test
+++ b/tests/winTime.test
@@ -9,14 +9,15 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winTime.test,v 1.10 2004/06/23 15:36:59 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
testConstraint testwinclock [llength [info commands testwinclock]]
# The next two tests will crash on Windows if the check for negative
diff --git a/tests/zlib.test b/tests/zlib.test
index 6159e65..891dba0 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -9,10 +9,8 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: zlib.test,v 1.12 2010/02/26 00:39:29 patthoyts Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2.1
namespace import -force ::tcltest::*
}
@@ -25,6 +23,12 @@ test zlib-1.1 {zlib basics} -constraints zlib -returnCodes error -body {
test zlib-1.2 {zlib basics} -constraints zlib -returnCodes error -body {
zlib ? {}
} -result {bad command "?": must be adler32, compress, crc32, decompress, deflate, gunzip, gzip, inflate, push, or stream}
+test zlib-1.3 {zlib basics} -constraints zlib -body {
+ zlib::pkgconfig list
+} -result zlibVersion
+test zlib-1.4 {zlib basics} -constraints zlib -body {
+ package present zlib
+} -result 2.0
test zlib-2.1 {zlib compress/decompress} zlib {
zlib decompress [zlib compress abcdefghijklm]
@@ -72,7 +76,7 @@ test zlib-7.0 {zlib stream} -constraints zlib -returnCodes error -setup {
$s ?
} -cleanup {
$s close
-} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, put, or reset}
+} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, header, put, or reset}
test zlib-7.1 {zlib stream} zlib {
set s [zlib stream compress]
$s put -finalize abcdeEDCBA
@@ -105,6 +109,22 @@ test zlib-7.4 {zlib stream} zlib {
$s close
lappend result $data
} {{} 1 abcdeEDCBA}
+test zlib-7.5 {zlib stream} zlib {
+ set s [zlib stream gzip]
+ $s put -finalize abcdeEDCBA..
+ set data [$s get]
+ set result [list [$s get] [format %x [$s checksum]]]
+ $s close
+ lappend result [zlib gunzip $data]
+} {{} 69f34b6a abcdeEDCBA..}
+test zlib-7.6 {zlib stream} zlib {
+ set s [zlib stream gunzip]
+ $s put -finalize [zlib gzip abcdeEDCBA..]
+ set data [$s get]
+ set result [list [$s get] [format %x [$s checksum]]]
+ $s close
+ lappend result $data
+} {{} 69f34b6a abcdeEDCBA..}
test zlib-8.1 {zlib transformation} -constraints zlib -setup {
set file [makeFile {} test.gz]
@@ -132,7 +152,7 @@ test zlib-8.2 {zlib transformation} -constraints zlib -setup {
} -result ok
test zlib-8.3 {zlib transformation and fileevent} -constraints zlib -setup {
set srv [socket -myaddr localhost -server {apply {{c a p} {
- fconfigure $c -translation binary
+ fconfigure $c -translation binary -buffering none -blocking 0
puts -nonewline $c [zlib gzip [string repeat a 81920]]
close $c
}}} 0]
@@ -149,6 +169,7 @@ test zlib-8.3 {zlib transformation and fileevent} -constraints zlib -setup {
set ::total [expr {$e eq {} ? $c : $e}]
}}}
vwait total
+ after cancel {set total timeout}
} finally {
close $sin
}
@@ -158,6 +179,194 @@ test zlib-8.3 {zlib transformation and fileevent} -constraints zlib -setup {
close $srv
removeFile $file
} -result 81920-->81920
+test zlib-8.4 {transformation and flushing: Bug 3517696} -setup {
+ set file [makeFile {} test.z]
+ set fd [open $file w]
+} -constraints zlib -body {
+ zlib push compress $fd
+ puts $fd "qwertyuiop"
+ fconfigure $fd -flush sync
+ puts $fd "qwertyuiop"
+} -cleanup {
+ catch {close $fd}
+ removeFile $file
+} -result {}
+test zlib-8.5 {transformation and flushing and fileevents: Bug 3525907} -setup {
+ foreach {r w} [chan pipe] break
+} -constraints zlib -body {
+ set ::res {}
+ fconfigure $w -buffering none
+ zlib push compress $w
+ puts -nonewline $w qwertyuiop
+ chan configure $w -flush sync
+ after 500 {puts -nonewline $w asdfghjkl;close $w}
+ fconfigure $r -blocking 0 -buffering none
+ zlib push decompress $r
+ fileevent $r readable {set msg [read $r];lappend ::res $msg;if {[eof $r]} {set ::done 1}}
+ after 250 {lappend ::res MIDDLE}
+ vwait ::done
+ set ::res
+} -cleanup {
+ catch {close $r}
+} -result {qwertyuiop MIDDLE asdfghjkl}
+test zlib-8.6 {transformation and fconfigure} -setup {
+ set file [makeFile {} test.z]
+ set fd [open $file wb]
+} -constraints zlib -body {
+ list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \
+ [chan pop $fd; fconfigure $fd]
+} -cleanup {
+ catch {close $fd}
+ removeFile $file
+} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
+test zlib-8.7 {transformation and fconfigure} -setup {
+ set file [makeFile {} test.gz]
+ set fd [open $file wb]
+} -constraints zlib -body {
+ list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \
+ [chan pop $fd; fconfigure $fd]
+} -cleanup {
+ catch {close $fd}
+ removeFile $file
+} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
+# Input is headers from fetching SPDY draft
+# Dictionary is that which is proposed _in_ SPDY draft
+set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n"
+set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl"
+test zlib-8.8 {transformtion and fconfigure} -setup {
+ lassign [chan pipe] inSide outSide
+} -constraints zlib -body {
+ zlib push compress $outSide -dictionary $spdyDict
+ fconfigure $outSide -blocking 0 -translation binary -buffering none
+ fconfigure $inSide -blocking 0 -translation binary
+ puts -nonewline $outSide $spdyHeaders
+ chan pop $outSide
+ set compressed [read $inSide]
+ catch {zlib decompress $compressed} err opt
+ list [string length [zlib compress $spdyHeaders]] \
+ [string length $compressed] \
+ $err [dict get $opt -errorcode] [zlib adler32 $spdyDict]
+} -cleanup {
+ catch {close $outSide}
+ catch {close $inSide}
+} -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010}
+test zlib-8.9 {transformtion and fconfigure} -setup {
+ lassign [chan pipe] inSide outSide
+ set strm [zlib stream decompress]
+} -constraints zlib -body {
+ zlib push compress $outSide -dictionary $spdyDict
+ fconfigure $outSide -blocking 0 -translation binary -buffering none
+ fconfigure $inSide -blocking 0 -translation binary
+ puts -nonewline $outSide $spdyHeaders
+ set result [fconfigure $outSide -checksum]
+ chan pop $outSide
+ $strm put -dictionary $spdyDict [read $inSide]
+ lappend result [string length $spdyHeaders] [string length [$strm get]]
+} -cleanup {
+ catch {close $outSide}
+ catch {close $inSide}
+ catch {$strm close}
+} -result {3064818174 358 358}
+test zlib-8.10 {transformtion and fconfigure} -setup {
+ lassign [chan pipe] inSide outSide
+} -constraints zlib -body {
+ zlib push deflate $outSide -dictionary $spdyDict
+ fconfigure $outSide -blocking 0 -translation binary -buffering none
+ fconfigure $inSide -blocking 0 -translation binary
+ puts -nonewline $outSide $spdyHeaders
+ chan pop $outSide
+ set compressed [read $inSide]
+ catch {zlib inflate $compressed} err opt
+ list [string length [zlib deflate $spdyHeaders]] \
+ [string length $compressed] \
+ $err [dict get $opt -errorcode]
+} -cleanup {
+ catch {close $outSide}
+ catch {close $inSide}
+} -result {254 212 {data error} {TCL ZLIB DATA}}
+test zlib-8.11 {transformtion and fconfigure} -setup {
+ lassign [chan pipe] inSide outSide
+ set strm [zlib stream inflate]
+} -constraints zlib -body {
+ zlib push deflate $outSide -dictionary $spdyDict
+ fconfigure $outSide -blocking 0 -translation binary -buffering none
+ fconfigure $inSide -blocking 0 -translation binary
+ puts -nonewline $outSide $spdyHeaders
+ chan pop $outSide
+ $strm put -dictionary $spdyDict [read $inSide]
+ list [string length $spdyHeaders] [string length [$strm get]]
+} -cleanup {
+ catch {close $outSide}
+ catch {close $inSide}
+ catch {$strm close}
+} -result {358 358}
+test zlib-8.12 {transformtion and fconfigure} -setup {
+ lassign [chan pipe] inSide outSide
+ set strm [zlib stream compress]
+} -constraints zlib -body {
+ $strm put -dictionary $spdyDict -finalize $spdyHeaders
+ zlib push decompress $inSide
+ fconfigure $outSide -blocking 0 -translation binary
+ fconfigure $inSide -translation binary -dictionary $spdyDict
+ puts -nonewline $outSide [$strm get]
+ close $outSide
+ list [string length $spdyHeaders] [string length [read $inSide]] \
+ [fconfigure $inSide -checksum]
+} -cleanup {
+ catch {close $outSide}
+ catch {close $inSide}
+ catch {$strm close}
+} -result {358 358 3064818174}
+test zlib-8.13 {transformtion and fconfigure} -setup {
+ lassign [chan pipe] inSide outSide
+ set strm [zlib stream compress]
+} -constraints zlib -body {
+ $strm put -dictionary $spdyDict -finalize $spdyHeaders
+ zlib push decompress $inSide -dictionary $spdyDict
+ fconfigure $outSide -blocking 0 -translation binary
+ fconfigure $inSide -translation binary
+ puts -nonewline $outSide [$strm get]
+ close $outSide
+ list [string length $spdyHeaders] [string length [read $inSide]] \
+ [fconfigure $inSide -checksum]
+} -cleanup {
+ catch {close $outSide}
+ catch {close $inSide}
+ catch {$strm close}
+} -result {358 358 3064818174}
+test zlib-8.14 {transformtion and fconfigure} -setup {
+ lassign [chan pipe] inSide outSide
+ set strm [zlib stream deflate]
+} -constraints zlib -body {
+ $strm put -finalize -dictionary $spdyDict $spdyHeaders
+ zlib push inflate $inSide
+ fconfigure $outSide -blocking 0 -buffering none -translation binary
+ fconfigure $inSide -translation binary -dictionary $spdyDict
+ puts -nonewline $outSide [$strm get]
+ close $outSide
+ list [string length $spdyHeaders] [string length [read $inSide]]
+} -cleanup {
+ catch {close $outSide}
+ catch {close $inSide}
+ catch {$strm close}
+} -result {358 358}
+test zlib-8.15 {transformtion and fconfigure} -setup {
+ lassign [chan pipe] inSide outSide
+ set strm [zlib stream deflate]
+} -constraints zlib -body {
+ $strm put -finalize -dictionary $spdyDict $spdyHeaders
+ zlib push inflate $inSide -dictionary $spdyDict
+ fconfigure $outSide -blocking 0 -buffering none -translation binary
+ fconfigure $inSide -translation binary
+ puts -nonewline $outSide [$strm get]
+ close $outSide
+ list [string length $spdyHeaders] [string length [read $inSide]]
+} -cleanup {
+ catch {close $outSide}
+ catch {close $inSide}
+ catch {$strm close}
+} -result {358 358}
+
test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
set sfile [makeFile {} testsrc.gz]
set file [makeFile {} test.gz]
@@ -176,7 +385,7 @@ test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
} -result {copied 81920 size 81920}
test zlib-9.2 "socket fcopy with push" -constraints zlib -setup {
set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -encoding binary -translation binary
+ chan configure $c -translation binary -buffering none -blocking 0
puts -nonewline $c [zlib gzip [string repeat a 81920]]
close $c
}}} 0]
@@ -198,7 +407,7 @@ test zlib-9.2 "socket fcopy with push" -constraints zlib -setup {
test zlib-9.3 "socket fcopy bg (identity)" -constraints {tempNotWin zlib} -setup {
set srv [socket -myaddr localhost -server {apply {{c a p} {
#puts "connection from $a:$p on $c"
- chan configure $c -encoding binary -translation binary
+ chan configure $c -translation binary -buffering none -blocking 0
puts -nonewline $c [string repeat a 81920]
close $c
}}} 0]
@@ -215,6 +424,7 @@ test zlib-9.3 "socket fcopy bg (identity)" -constraints {tempNotWin zlib} -setup
set ::total [expr {$e eq {} ? $c : $e}]
}}}
vwait ::total
+ after cancel {set ::total timeout}
close $sin; close $fout
list read $::total size [file size $file]
} -cleanup {
@@ -223,7 +433,7 @@ test zlib-9.3 "socket fcopy bg (identity)" -constraints {tempNotWin zlib} -setup
} -returnCodes {ok error} -result {read 81920 size 81920}
test zlib-9.4 "socket fcopy bg (gzip)" -constraints zlib -setup {
set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -encoding binary -translation binary
+ chan configure $c -translation binary -buffering none -blocking 0
puts -nonewline $c [zlib gzip [string repeat a 81920]]
close $c
}}} 0]
@@ -240,6 +450,7 @@ test zlib-9.4 "socket fcopy bg (gzip)" -constraints zlib -setup {
set ::total [expr {$e eq {} ? $c : $e}]
}}}
vwait ::total
+ after cancel {set ::total timeout}
close $sin; close $fout
list read $::total size [file size $file]
} -cleanup {
@@ -248,7 +459,7 @@ test zlib-9.4 "socket fcopy bg (gzip)" -constraints zlib -setup {
} -result {read 81920 size 81920}
test zlib-9.5 "socket fcopy incremental (gzip)" -constraints zlib -setup {
set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -encoding binary -translation binary
+ chan configure $c -translation binary -buffering none -blocking 0
puts -nonewline $c [zlib gzip [string repeat a 81920]]
close $c
}}} 0]
@@ -273,6 +484,7 @@ test zlib-9.5 "socket fcopy incremental (gzip)" -constraints zlib -setup {
after 1000 {set ::total timeout}
fcopy $sin $fout -size 8192 -command [list zlib95copy $sin $fout 0]
vwait ::total
+ after cancel {set ::total timeout}
close $sin; close $fout
list $::total size [file size $file]
} -cleanup {
@@ -282,7 +494,7 @@ test zlib-9.5 "socket fcopy incremental (gzip)" -constraints zlib -setup {
} -result {{eof 81920} size 81920}
test zlib-9.6 "bug #2818131 (gzip)" -constraints zlib -setup {
set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none
+ chan configure $c -translation binary -buffering none -blocking 0
zlib push gzip $c
puts -nonewline $c [string repeat hello 100]
close $c
@@ -291,7 +503,7 @@ test zlib-9.6 "bug #2818131 (gzip)" -constraints zlib -setup {
lassign [chan configure $srv -sockname] addr name port
after 1000 {set ::total timeout}
set s [socket $addr $port]
- chan configure $s -translation binary -buffering none
+ chan configure $s -translation binary
zlib push gunzip $s
chan event $s readable [list apply {{s} {
set d [read $s]
@@ -301,6 +513,7 @@ test zlib-9.6 "bug #2818131 (gzip)" -constraints zlib -setup {
}
}} $s]
vwait ::total
+ after cancel {set ::total timeout}
close $s
set ::total
} -cleanup {
@@ -309,7 +522,7 @@ test zlib-9.6 "bug #2818131 (gzip)" -constraints zlib -setup {
} -result {eof 500}
test zlib-9.7 "bug #2818131 (compress)" -constraints zlib -setup {
set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none
+ chan configure $c -translation binary -buffering none -blocking 0
zlib push compress $c
puts -nonewline $c [string repeat hello 100]
close $c
@@ -318,7 +531,7 @@ test zlib-9.7 "bug #2818131 (compress)" -constraints zlib -setup {
lassign [chan configure $srv -sockname] addr name port
after 1000 {set ::total timeout}
set s [socket $addr $port]
- chan configure $s -translation binary -buffering none
+ chan configure $s -translation binary
zlib push decompress $s
chan event $s readable [list apply {{s} {
set d [read $s]
@@ -328,6 +541,7 @@ test zlib-9.7 "bug #2818131 (compress)" -constraints zlib -setup {
}
}} $s]
vwait ::total
+ after cancel {set ::total timeout}
close $s
set ::total
} -cleanup {
@@ -336,7 +550,7 @@ test zlib-9.7 "bug #2818131 (compress)" -constraints zlib -setup {
} -result {eof 500}
test zlib-9.8 "bug #2818131 (deflate)" -constraints zlib -setup {
set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none
+ chan configure $c -translation binary -buffering none -blocking 0
zlib push deflate $c
puts -nonewline $c [string repeat hello 100]
close $c
@@ -345,7 +559,7 @@ test zlib-9.8 "bug #2818131 (deflate)" -constraints zlib -setup {
lassign [chan configure $srv -sockname] addr name port
after 1000 {set ::total timeout}
set s [socket $addr $port]
- chan configure $s -translation binary -buffering none
+ chan configure $s -translation binary
zlib push inflate $s
chan event $s readable [list apply {{s} {
set d [read $s]
@@ -355,6 +569,7 @@ test zlib-9.8 "bug #2818131 (deflate)" -constraints zlib -setup {
}
}} $s]
vwait ::total
+ after cancel {set ::total timeout}
close $s
set ::total
} -cleanup {
@@ -364,7 +579,7 @@ test zlib-9.8 "bug #2818131 (deflate)" -constraints zlib -setup {
test zlib-9.9 "bug #2818131 (gzip mismatch)" -constraints zlib -setup {
proc bgerror {s} {set ::total [list error $s]}
set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none
+ chan configure $c -translation binary -buffering none -blocking 0
zlib push gzip $c
puts -nonewline $c [string repeat hello 100]
close $c
@@ -374,7 +589,7 @@ test zlib-9.9 "bug #2818131 (gzip mismatch)" -constraints zlib -setup {
after 1000 {set ::total timeout}
set s [socket $addr $port]
try {
- chan configure $s -translation binary -buffering none
+ chan configure $s -translation binary
zlib push inflate $s
chan event $s readable [list apply {{s} {
set d [read $s]
@@ -385,6 +600,7 @@ test zlib-9.9 "bug #2818131 (gzip mismatch)" -constraints zlib -setup {
}} $s]
vwait ::total
} finally {
+ after cancel {set ::total timeout}
close $s
}
set ::total
@@ -396,7 +612,7 @@ test zlib-9.9 "bug #2818131 (gzip mismatch)" -constraints zlib -setup {
test zlib-9.10 "bug #2818131 (compress mismatch)" -constraints zlib -setup {
proc bgerror {s} {set ::total [list error $s]}
set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none
+ chan configure $c -translation binary -buffering none -blocking 0
zlib push compress $c
puts -nonewline $c [string repeat hello 100]
close $c
@@ -406,7 +622,7 @@ test zlib-9.10 "bug #2818131 (compress mismatch)" -constraints zlib -setup {
after 1000 {set ::total timeout}
set s [socket $addr $port]
try {
- chan configure $s -translation binary -buffering none
+ chan configure $s -translation binary
zlib push inflate $s
chan event $s readable [list apply {{s} {
set d [read $s]
@@ -417,6 +633,7 @@ test zlib-9.10 "bug #2818131 (compress mismatch)" -constraints zlib -setup {
}} $s]
vwait ::total
} finally {
+ after cancel {set ::total timeout}
close $s
}
set ::total
@@ -428,7 +645,7 @@ test zlib-9.10 "bug #2818131 (compress mismatch)" -constraints zlib -setup {
test zlib-9.11 "bug #2818131 (deflate mismatch)" -constraints zlib -setup {
proc bgerror {s} {set ::total [list error $s]}
set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none
+ chan configure $c -translation binary -buffering none -blocking 0
zlib push deflate $c
puts -nonewline $c [string repeat hello 100]
close $c
@@ -438,7 +655,7 @@ test zlib-9.11 "bug #2818131 (deflate mismatch)" -constraints zlib -setup {
after 1000 {set ::total timeout}
set s [socket $addr $port]
try {
- chan configure $s -translation binary -buffering none
+ chan configure $s -translation binary
zlib push gunzip $s
chan event $s readable [list apply {{s} {
set d [read $s]
@@ -449,6 +666,7 @@ test zlib-9.11 "bug #2818131 (deflate mismatch)" -constraints zlib -setup {
}} $s]
vwait ::total
} finally {
+ after cancel {set ::total timeout}
close $s
}
set ::total
@@ -463,7 +681,7 @@ test zlib-10.0 "bug #2818131 (close with null interp)" -constraints {
} -setup {
proc bgerror {s} {set ::total [list error $s]}
set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none
+ chan configure $c -translation binary
zlib push inflate $c
chan event $c readable [list apply {{c} {
set d [read $c]
@@ -478,7 +696,7 @@ test zlib-10.0 "bug #2818131 (close with null interp)" -constraints {
lassign [chan configure $srv -sockname] addr name port
after 1000 {set ::total timeout}
set s [socket $addr $port]
- chan configure $s -translation binary -buffering none
+ chan configure $s -translation binary -buffering none -blocking 0
zlib push gzip $s
chan event $s xyzzy [list apply {{s} {
if {[gets $s line] < 0} {
@@ -491,6 +709,8 @@ test zlib-10.0 "bug #2818131 (close with null interp)" -constraints {
after 100 {set ::total done}
}} $s]
vwait ::total
+ after cancel {set ::total timeout}
+ after cancel {set ::total done}
set ::total
} -cleanup {
close $srv
@@ -510,7 +730,7 @@ test zlib-10.1 "bug #2818131 (mismatch read)" -constraints {
}
}
set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none
+ chan configure $c -translation binary
zlib push inflate $c
chan event $c readable [list zlibRead $c]
}}} 0]
@@ -518,7 +738,7 @@ test zlib-10.1 "bug #2818131 (mismatch read)" -constraints {
lassign [chan configure $srv -sockname] addr name port
after 1000 {set ::total timeout}
set s [socket $addr $port]
- chan configure $s -translation binary -buffering none
+ chan configure $s -translation binary -buffering none -blocking 0
zlib push gzip $s
chan event $s readable [list zlibRead $s]
after idle [list apply {{s} {
@@ -527,6 +747,8 @@ test zlib-10.1 "bug #2818131 (mismatch read)" -constraints {
after 100 {set ::total done}
}} $s]
vwait ::total
+ after cancel {set ::total timeout}
+ after cancel {set ::total done}
set ::total
} -cleanup {
close $srv
@@ -548,7 +770,7 @@ test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints {
}
}
set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none
+ chan configure $c -translation binary
zlib push inflate $c
chan event $c readable [list zlibRead $c]
}}} 0]
@@ -556,7 +778,7 @@ test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints {
lassign [chan configure $srv -sockname] addr name port
after 1000 {set ::total timeout}
set s [socket $addr $port]
- chan configure $s -translation binary -buffering none
+ chan configure $s -translation binary -buffering none -blocking 0
zlib push gzip $s
chan event $s readable [list zlibRead $s]
after idle [list apply {{s} {
@@ -565,12 +787,59 @@ test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints {
after 100 {set ::total done}
}} $s]
vwait ::total
+ after cancel {set ::total timeout}
+ after cancel {set ::total done}
set ::total
} -cleanup {
close $srv
rename bgerror {}
rename zlibRead {}
} -result {error {invalid block type}}
+
+test zlib-11.1 "Bug #3390073: mis-appled gzip filtering" -setup {
+ set file [makeFile {} test.input]
+} -constraints zlib -body {
+ set f [open $file wb]
+ puts -nonewline [zlib push gzip $f] [string repeat "hello" 1000]
+ close $f
+ set f [open $file rb]
+ set d [read $f]
+ close $f
+ set d [zlib gunzip $d]
+ list [regexp -all "hello" $d] [string length [regsub -all "hello" $d {}]]
+} -cleanup {
+ removeFile $file
+} -result {1000 0}
+test zlib-11.2 "Bug #3390073: mis-appled gzip filtering" -setup {
+ set file [makeFile {} test.input]
+} -constraints zlib -body {
+ set f [open $file wb]
+ puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \
+ [string repeat "hello" 1000]
+ close $f
+ set f [open $file rb]
+ set d [read $f]
+ close $f
+ set d [zlib gunzip $d -header h]
+ list [regexp -all "hello" $d] [dict get $h filename] \
+ [string length [regsub -all "hello" $d {}]]
+} -cleanup {
+ removeFile $file
+} -result {1000 /foo/bar 0}
+test zlib-11.3 {Bug 3595576 variant} -setup {
+ set file [makeFile {} test.input]
+} -constraints zlib -body {
+ set f [open $file wb]
+ puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \
+ [string repeat "hello" 1000]
+ close $f
+ set f [open $file rb]
+ set d [read $f]
+ close $f
+ zlib gunzip $d -header noSuchNs::foo
+} -cleanup {
+ removeFile $file
+} -returnCodes error -result {can't set "noSuchNs::foo": parent namespace doesn't exist}
::tcltest::cleanupTests
return
diff --git a/tools/.cvsignore b/tools/.cvsignore
deleted file mode 100644
index 83004c8..0000000
--- a/tools/.cvsignore
+++ /dev/null
@@ -1,7 +0,0 @@
-autom4te.cache
-config.status
-Makefile
-man2tcl
-*.hpj
-*.rtf
-*.cnt
diff --git a/tools/Makefile.in b/tools/Makefile.in
index 8f453da..6034fe9 100644
--- a/tools/Makefile.in
+++ b/tools/Makefile.in
@@ -6,8 +6,6 @@
#
# HTML: 1. Build the html target on Unix
-# RCS: @(#) $Id: Makefile.in,v 1.11 2007/12/13 15:28:40 dgp Exp $
-
TCL = tcl@TCL_VERSION@
TK = tk@TCL_VERSION@
VER = @TCL_WIN_VERSION@
@@ -66,4 +64,4 @@ clean:
-rm -f man2tcl *.o *.cnt *.rtf
helpfile:
- hcw /c /e tcl.hpj \ No newline at end of file
+ hcw /c /e tcl.hpj
diff --git a/tools/README b/tools/README
index 821b2b3..f4bf627 100644
--- a/tools/README
+++ b/tools/README
@@ -23,6 +23,3 @@ Generating Windows Help Files:
this converts the Nroff to RTF files.
2) On Windows, convert the RTF to a Help doc, do
nmake helpfile
-
-Generating Windows binary distribution.
-Update and compile the WYSE tcl.wse configuration.
diff --git a/tools/checkLibraryDoc.tcl b/tools/checkLibraryDoc.tcl
index 23d3ec3..6d147ac 100755
--- a/tools/checkLibraryDoc.tcl
+++ b/tools/checkLibraryDoc.tcl
@@ -18,8 +18,6 @@
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
-#
-# RCS: @(#) $Id: checkLibraryDoc.tcl,v 1.8 2010/07/01 21:28:15 nijtmans Exp $
lappend auto_path "c:/program\ files/tclpro1.2/win32-ix86/bin"
diff --git a/tools/configure b/tools/configure
index 3221c85..3d30039 100755
--- a/tools/configure
+++ b/tools/configure
@@ -1,414 +1,81 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.65.
-#
-#
-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
-# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation,
-# Inc.
-#
+# Generated by GNU Autoconf 2.59.
#
+# Copyright (C) 2003 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
-## -------------------- ##
-## M4sh Initialization. ##
-## -------------------- ##
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
-# Be more Bourne compatible
-DUALCASE=1; export DUALCASE # for MKS sh
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+# Be Bourne compatible
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
emulate sh
NULLCMD=:
- # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+ # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
- setopt NO_GLOB_SUBST
-else
- case `(set -o) 2>/dev/null` in #(
- *posix*) :
- set -o posix ;; #(
- *) :
- ;;
-esac
+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+ set -o posix
fi
+DUALCASE=1; export DUALCASE # for MKS sh
-
-as_nl='
-'
-export as_nl
-# Printing a long string crashes Solaris 7 /usr/bin/printf.
-as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
-# Prefer a ksh shell builtin over an external printf program on Solaris,
-# but without wasting forks for bash or zsh.
-if test -z "$BASH_VERSION$ZSH_VERSION" \
- && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
- as_echo='print -r --'
- as_echo_n='print -rn --'
-elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
- as_echo='printf %s\n'
- as_echo_n='printf %s'
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
else
- if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
- as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
- as_echo_n='/usr/ucb/echo -n'
- else
- as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
- as_echo_n_body='eval
- arg=$1;
- case $arg in #(
- *"$as_nl"*)
- expr "X$arg" : "X\\(.*\\)$as_nl";
- arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
- esac;
- expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
- '
- export as_echo_n_body
- as_echo_n='sh -c $as_echo_n_body as_echo'
- fi
- export as_echo_body
- as_echo='sh -c $as_echo_body as_echo'
-fi
-
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- PATH_SEPARATOR=:
- (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
- (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
- PATH_SEPARATOR=';'
- }
+ as_unset=false
fi
-# IFS
-# We need space, tab and new line, in precisely that order. Quoting is
-# there to prevent editors from complaining about space-tab.
-# (If _AS_PATH_WALK were called with IFS unset, it would disable word
-# splitting by setting IFS to empty value.)
-IFS=" "" $as_nl"
-
-# Find who we are. Look in the path if we contain no directory separator.
-case $0 in #((
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
- done
-IFS=$as_save_IFS
-
- ;;
-esac
-# We did not find ourselves, most probably we were run as `sh COMMAND'
-# in which case we are not to be found in the path.
-if test "x$as_myself" = x; then
- as_myself=$0
-fi
-if test ! -f "$as_myself"; then
- $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
- exit 1
-fi
-
-# Unset variables that we do not need and which cause bugs (e.g. in
-# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
-# suppresses any "Segmentation fault" message there. '((' could
-# trigger a bug in pdksh 5.2.14.
-for as_var in BASH_ENV ENV MAIL MAILPATH
-do eval test x\${$as_var+set} = xset \
- && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
-done
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
PS1='$ '
PS2='> '
PS4='+ '
# NLS nuisances.
-LC_ALL=C
-export LC_ALL
-LANGUAGE=C
-export LANGUAGE
-
-# CDPATH.
-(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
-
-if test "x$CONFIG_SHELL" = x; then
- as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
- emulate sh
- NULLCMD=:
- # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
- # is contrary to our usage. Disable this feature.
- alias -g '\${1+\"\$@\"}'='\"\$@\"'
- setopt NO_GLOB_SUBST
-else
- case \`(set -o) 2>/dev/null\` in #(
- *posix*) :
- set -o posix ;; #(
- *) :
- ;;
-esac
-fi
-"
- as_required="as_fn_return () { (exit \$1); }
-as_fn_success () { as_fn_return 0; }
-as_fn_failure () { as_fn_return 1; }
-as_fn_ret_success () { return 0; }
-as_fn_ret_failure () { return 1; }
-
-exitcode=0
-as_fn_success || { exitcode=1; echo as_fn_success failed.; }
-as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
-as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
-as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
-if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
-
-else
- exitcode=1; echo positional parameters were not saved.
-fi
-test x\$exitcode = x0 || exit 1"
- as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
- as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
- eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
- test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1"
- if (eval "$as_required") 2>/dev/null; then :
- as_have_required=yes
-else
- as_have_required=no
-fi
- if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
-
-else
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-as_found=false
-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- as_found=:
- case $as_dir in #(
- /*)
- for as_base in sh bash ksh sh5; do
- # Try only shells that exist, to save several forks.
- as_shell=$as_dir/$as_base
- if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
- { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
- CONFIG_SHELL=$as_shell as_have_required=yes
- if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
- break 2
-fi
-fi
- done;;
- esac
- as_found=false
-done
-$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
- { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
- CONFIG_SHELL=$SHELL as_have_required=yes
-fi; }
-IFS=$as_save_IFS
-
-
- if test "x$CONFIG_SHELL" != x; then :
- # We cannot yet assume a decent shell, so we have to provide a
- # neutralization value for shells without unset; and this also
- # works around shells that cannot unset nonexistent variables.
- BASH_ENV=/dev/null
- ENV=/dev/null
- (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"}
-fi
-
- if test x$as_have_required = xno; then :
- $as_echo "$0: This script requires a shell more modern than all"
- $as_echo "$0: the shells that I found on your system."
- if test x${ZSH_VERSION+set} = xset ; then
- $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
- $as_echo "$0: be upgraded to zsh 4.3.4 or later."
+ if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+ eval $as_var=C; export $as_var
else
- $as_echo "$0: Please tell bug-autoconf@gnu.org about your system,
-$0: including any error possibly output before this
-$0: message. Then install a modern shell, or manually run
-$0: the script under such a shell if you do have one."
+ $as_unset $as_var
fi
- exit 1
-fi
-fi
-fi
-SHELL=${CONFIG_SHELL-/bin/sh}
-export SHELL
-# Unset more variables known to interfere with behavior of common tools.
-CLICOLOR_FORCE= GREP_OPTIONS=
-unset CLICOLOR_FORCE GREP_OPTIONS
-
-## --------------------- ##
-## M4sh Shell Functions. ##
-## --------------------- ##
-# as_fn_unset VAR
-# ---------------
-# Portably unset VAR.
-as_fn_unset ()
-{
- { eval $1=; unset $1;}
-}
-as_unset=as_fn_unset
-
-# as_fn_set_status STATUS
-# -----------------------
-# Set $? to STATUS, without forking.
-as_fn_set_status ()
-{
- return $1
-} # as_fn_set_status
-
-# as_fn_exit STATUS
-# -----------------
-# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
-as_fn_exit ()
-{
- set +e
- as_fn_set_status $1
- exit $1
-} # as_fn_exit
-
-# as_fn_mkdir_p
-# -------------
-# Create "$as_dir" as a directory, including parents if necessary.
-as_fn_mkdir_p ()
-{
-
- case $as_dir in #(
- -*) as_dir=./$as_dir;;
- esac
- test -d "$as_dir" || eval $as_mkdir_p || {
- as_dirs=
- while :; do
- case $as_dir in #(
- *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
- *) as_qdir=$as_dir;;
- esac
- as_dirs="'$as_qdir' $as_dirs"
- as_dir=`$as_dirname -- "$as_dir" ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_dir" : 'X\(//\)[^/]' \| \
- X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
-$as_echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
- s//\1/
- q
- }
- /^X\(\/\/\)[^/].*/{
- s//\1/
- q
- }
- /^X\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'`
- test -d "$as_dir" && break
- done
- test -z "$as_dirs" || eval "mkdir $as_dirs"
- } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir"
-
-
-} # as_fn_mkdir_p
-# as_fn_append VAR VALUE
-# ----------------------
-# Append the text in VALUE to the end of the definition contained in VAR. Take
-# advantage of any shell optimizations that allow amortized linear growth over
-# repeated appends, instead of the typical quadratic growth present in naive
-# implementations.
-if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
- eval 'as_fn_append ()
- {
- eval $1+=\$2
- }'
-else
- as_fn_append ()
- {
- eval $1=\$$1\$2
- }
-fi # as_fn_append
-
-# as_fn_arith ARG...
-# ------------------
-# Perform arithmetic evaluation on the ARGs, and store the result in the
-# global $as_val. Take advantage of shells that can avoid forks. The arguments
-# must be portable across $(()) and expr.
-if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
- eval 'as_fn_arith ()
- {
- as_val=$(( $* ))
- }'
-else
- as_fn_arith ()
- {
- as_val=`expr "$@" || test $? -eq 1`
- }
-fi # as_fn_arith
-
-
-# as_fn_error ERROR [LINENO LOG_FD]
-# ---------------------------------
-# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
-# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
-# script with status $?, using 1 if that was 0.
-as_fn_error ()
-{
- as_status=$?; test $as_status -eq 0 && as_status=1
- if test "$3"; then
- as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3
- fi
- $as_echo "$as_me: error: $1" >&2
- as_fn_exit $as_status
-} # as_fn_error
+done
-if expr a : '\(a\)' >/dev/null 2>&1 &&
- test "X`expr 00001 : '.*\(...\)'`" = X001; then
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
as_expr=expr
else
as_expr=false
fi
-if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
as_basename=basename
else
as_basename=false
fi
-if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
- as_dirname=dirname
-else
- as_dirname=false
-fi
-as_me=`$as_basename -- "$0" ||
+# Name of the executable.
+as_me=`$as_basename "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)' \| . 2>/dev/null ||
-$as_echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{
- s//\1/
- q
- }
- /^X\/\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\/\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'`
+ X"$0" : 'X\(/\)$' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+ /^X\/\(\/\/\)$/{ s//\1/; q; }
+ /^X\/\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+
+# PATH needs CR, and LINENO needs CR and PATH.
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
@@ -416,107 +83,146 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conf$$.sh
+ echo "exit 0" >>conf$$.sh
+ chmod +x conf$$.sh
+ if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conf$$.sh
+fi
- as_lineno_1=$LINENO as_lineno_1a=$LINENO
- as_lineno_2=$LINENO as_lineno_2a=$LINENO
- eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
- test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
- # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-)
- sed -n '
- p
- /[$]LINENO/=
- ' <$as_myself |
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" || {
+ # Find who we are. Look in the path if we contain no path at all
+ # relative or not.
+ case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+
+ ;;
+ esac
+ # We did not find ourselves, most probably we were run as `sh COMMAND'
+ # in which case we are not to be found in the path.
+ if test "x$as_myself" = x; then
+ as_myself=$0
+ fi
+ if test ! -f "$as_myself"; then
+ { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
+ { (exit 1); exit 1; }; }
+ fi
+ case $CONFIG_SHELL in
+ '')
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for as_base in sh bash ksh sh5; do
+ case $as_dir in
+ /*)
+ if ("$as_dir/$as_base" -c '
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
+ $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
+ $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
+ CONFIG_SHELL=$as_dir/$as_base
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ fi;;
+ esac
+ done
+done
+;;
+ esac
+
+ # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+ # uniformly replaced by the line number. The first 'sed' inserts a
+ # line-number line before each line; the second 'sed' does the real
+ # work. The second script uses 'N' to pair each line-number line
+ # with the numbered line, and appends trailing '-' during
+ # substitution so that $LINENO is not a special case at line end.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
sed '
- s/[$]LINENO.*/&-/
- t lineno
- b
- :lineno
N
- :loop
- s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
t loop
- s/-\n.*//
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
' >$as_me.lineno &&
- chmod +x "$as_me.lineno" ||
- { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
+ chmod +x $as_me.lineno ||
+ { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
+ { (exit 1); exit 1; }; }
# Don't try to exec as it changes $[0], causing all sort of problems
# (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensitive to this).
- . "./$as_me.lineno"
+ # original and so on. Autoconf is especially sensible to this).
+ . ./$as_me.lineno
# Exit status is that of the last command.
exit
}
-ECHO_C= ECHO_N= ECHO_T=
-case `echo -n x` in #(((((
--n*)
- case `echo 'xy\c'` in
- *c*) ECHO_T=' ';; # ECHO_T is single tab character.
- xy) ECHO_C='\c';;
- *) echo `echo ksh88 bug on AIX 6.1` > /dev/null
- ECHO_T=' ';;
- esac;;
-*)
- ECHO_N='-n';;
+
+case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+ *c*,-n*) ECHO_N= ECHO_C='
+' ECHO_T=' ' ;;
+ *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+ *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
esac
-rm -f conf$$ conf$$.exe conf$$.file
-if test -d conf$$.dir; then
- rm -f conf$$.dir/conf$$.file
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
else
- rm -f conf$$.dir
- mkdir conf$$.dir 2>/dev/null
+ as_expr=false
fi
-if (echo >conf$$.file) 2>/dev/null; then
- if ln -s conf$$.file conf$$ 2>/dev/null; then
- as_ln_s='ln -s'
- # ... but there are two gotchas:
- # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
- # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
- # In both cases, we have to default to `cp -p'.
- ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
- as_ln_s='cp -p'
- elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
- else
+
+rm -f conf$$ conf$$.exe conf$$.file
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+ # We could just check for DJGPP; but this test a) works b) is more generic
+ # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+ if test -f conf$$.exe; then
+ # Don't use ln at all; we don't have any links
as_ln_s='cp -p'
+ else
+ as_ln_s='ln -s'
fi
+elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
else
as_ln_s='cp -p'
fi
-rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
-rmdir conf$$.dir 2>/dev/null
+rm -f conf$$ conf$$.exe conf$$.file
if mkdir -p . 2>/dev/null; then
- as_mkdir_p='mkdir -p "$as_dir"'
+ as_mkdir_p=:
else
test -d ./-p && rmdir ./-p
as_mkdir_p=false
fi
-if test -x / >/dev/null 2>&1; then
- as_test_x='test -x'
-else
- if ls -dL / >/dev/null 2>&1; then
- as_ls_L_option=L
- else
- as_ls_L_option=
- fi
- as_test_x='
- eval sh -c '\''
- if test -d "$1"; then
- test -d "$1/.";
- else
- case $1 in #(
- -*)set "./$1";;
- esac;
- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
- ???[sx]*):;;*)false;;esac;fi
- '\'' sh
- '
-fi
-as_executable_p=$as_test_x
+as_executable_p="test -f"
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -525,25 +231,38 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-test -n "$DJDIR" || exec 7<&0 </dev/null
-exec 6>&1
+# IFS
+# We need space, tab and new line, in precisely that order.
+as_nl='
+'
+IFS=" $as_nl"
+
+# CDPATH.
+$as_unset CDPATH
+
# Name of the host.
# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
# so uname gets run too.
ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+exec 6>&1
+
#
# Initializations.
#
ac_default_prefix=/usr/local
-ac_clean_files=
ac_config_libobj_dir=.
-LIBOBJS=
cross_compiling=no
subdirs=
MFLAGS=
MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+
+# Maximum number of lines to put in a shell here document.
+# This variable seems obsolete. It should probably be removed, and
+# only ac_max_sed_lines should be used.
+: ${ac_max_here_lines=38}
# Identity of this package.
PACKAGE_NAME=
@@ -551,70 +270,14 @@ PACKAGE_TARNAME=
PACKAGE_VERSION=
PACKAGE_STRING=
PACKAGE_BUGREPORT=
-PACKAGE_URL=
ac_unique_file="man2tcl.c"
-ac_subst_vars='LTLIBOBJS
-LIBOBJS
-TCL_BIN_DIR
-TCL_SRC_DIR
-TCL_PATCH_LEVEL
-TCL_VERSION
-CC
-TCL_WIN_VERSION
-target_alias
-host_alias
-build_alias
-LIBS
-ECHO_T
-ECHO_N
-ECHO_C
-DEFS
-mandir
-localedir
-libdir
-psdir
-pdfdir
-dvidir
-htmldir
-infodir
-docdir
-oldincludedir
-includedir
-localstatedir
-sharedstatedir
-sysconfdir
-datadir
-datarootdir
-libexecdir
-sbindir
-bindir
-program_transform_name
-prefix
-exec_prefix
-PACKAGE_URL
-PACKAGE_BUGREPORT
-PACKAGE_STRING
-PACKAGE_VERSION
-PACKAGE_TARNAME
-PACKAGE_NAME
-PATH_SEPARATOR
-SHELL'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS TCL_WIN_VERSION CC TCL_VERSION TCL_PATCH_LEVEL TCL_SRC_DIR TCL_BIN_DIR LIBOBJS LTLIBOBJS'
ac_subst_files=''
-ac_user_opts='
-enable_option_checking
-with_tcl
-'
- ac_precious_vars='build_alias
-host_alias
-target_alias'
-
# Initialize some variables set by options.
ac_init_help=
ac_init_version=false
-ac_unrecognized_opts=
-ac_unrecognized_sep=
# The variables have the same names as the options, with
# dashes changed to underlines.
cache_file=/dev/null
@@ -637,48 +300,34 @@ x_libraries=NONE
# and all the variables that are supposed to be based on exec_prefix
# by default will actually change.
# Use braces instead of parens because sh, perl, etc. also accept them.
-# (The list follows the same order as the GNU Coding Standards.)
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
-datarootdir='${prefix}/share'
-datadir='${datarootdir}'
+datadir='${prefix}/share'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
includedir='${prefix}/include'
oldincludedir='/usr/include'
-docdir='${datarootdir}/doc/${PACKAGE}'
-infodir='${datarootdir}/info'
-htmldir='${docdir}'
-dvidir='${docdir}'
-pdfdir='${docdir}'
-psdir='${docdir}'
-libdir='${exec_prefix}/lib'
-localedir='${datarootdir}/locale'
-mandir='${datarootdir}/man'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
ac_prev=
-ac_dashdash=
for ac_option
do
# If the previous option needs an argument, assign it.
if test -n "$ac_prev"; then
- eval $ac_prev=\$ac_option
+ eval "$ac_prev=\$ac_option"
ac_prev=
continue
fi
- case $ac_option in
- *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
- *) ac_optarg=yes ;;
- esac
+ ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
# Accept the important Cygnus configure options, so we can diagnose typos.
- case $ac_dashdash$ac_option in
- --)
- ac_dashdash=yes ;;
+ case $ac_option in
-bindir | --bindir | --bindi | --bind | --bin | --bi)
ac_prev=bindir ;;
@@ -700,59 +349,33 @@ do
--config-cache | -C)
cache_file=config.cache ;;
- -datadir | --datadir | --datadi | --datad)
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
ac_prev=datadir ;;
- -datadir=* | --datadir=* | --datadi=* | --datad=*)
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
datadir=$ac_optarg ;;
- -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
- | --dataroo | --dataro | --datar)
- ac_prev=datarootdir ;;
- -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
- | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
- datarootdir=$ac_optarg ;;
-
-disable-* | --disable-*)
- ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+ ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
- as_fn_error "invalid feature name: $ac_useropt"
- ac_useropt_orig=$ac_useropt
- ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
- case $ac_user_opts in
- *"
-"enable_$ac_useropt"
-"*) ;;
- *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
- ac_unrecognized_sep=', ';;
- esac
- eval enable_$ac_useropt=no ;;
-
- -docdir | --docdir | --docdi | --doc | --do)
- ac_prev=docdir ;;
- -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
- docdir=$ac_optarg ;;
-
- -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
- ac_prev=dvidir ;;
- -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
- dvidir=$ac_optarg ;;
+ expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+ { (exit 1); exit 1; }; }
+ ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+ eval "enable_$ac_feature=no" ;;
-enable-* | --enable-*)
- ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+ ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
- as_fn_error "invalid feature name: $ac_useropt"
- ac_useropt_orig=$ac_useropt
- ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
- case $ac_user_opts in
- *"
-"enable_$ac_useropt"
-"*) ;;
- *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
- ac_unrecognized_sep=', ';;
+ expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+ { (exit 1); exit 1; }; }
+ ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+ case $ac_option in
+ *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) ac_optarg=yes ;;
esac
- eval enable_$ac_useropt=\$ac_optarg ;;
+ eval "enable_$ac_feature='$ac_optarg'" ;;
-exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
| --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
@@ -779,12 +402,6 @@ do
-host=* | --host=* | --hos=* | --ho=*)
host_alias=$ac_optarg ;;
- -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
- ac_prev=htmldir ;;
- -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
- | --ht=*)
- htmldir=$ac_optarg ;;
-
-includedir | --includedir | --includedi | --included | --include \
| --includ | --inclu | --incl | --inc)
ac_prev=includedir ;;
@@ -809,16 +426,13 @@ do
| --libexe=* | --libex=* | --libe=*)
libexecdir=$ac_optarg ;;
- -localedir | --localedir | --localedi | --localed | --locale)
- ac_prev=localedir ;;
- -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
- localedir=$ac_optarg ;;
-
-localstatedir | --localstatedir | --localstatedi | --localstated \
- | --localstate | --localstat | --localsta | --localst | --locals)
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
ac_prev=localstatedir ;;
-localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
- | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
localstatedir=$ac_optarg ;;
-mandir | --mandir | --mandi | --mand | --man | --ma | --m)
@@ -883,16 +497,6 @@ do
| --progr-tra=* | --program-tr=* | --program-t=*)
program_transform_name=$ac_optarg ;;
- -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
- ac_prev=pdfdir ;;
- -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
- pdfdir=$ac_optarg ;;
-
- -psdir | --psdir | --psdi | --psd | --ps)
- ac_prev=psdir ;;
- -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
- psdir=$ac_optarg ;;
-
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
@@ -943,36 +547,26 @@ do
ac_init_version=: ;;
-with-* | --with-*)
- ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+ ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
- as_fn_error "invalid package name: $ac_useropt"
- ac_useropt_orig=$ac_useropt
- ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
- case $ac_user_opts in
- *"
-"with_$ac_useropt"
-"*) ;;
- *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
- ac_unrecognized_sep=', ';;
+ expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid package name: $ac_package" >&2
+ { (exit 1); exit 1; }; }
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case $ac_option in
+ *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) ac_optarg=yes ;;
esac
- eval with_$ac_useropt=\$ac_optarg ;;
+ eval "with_$ac_package='$ac_optarg'" ;;
-without-* | --without-*)
- ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+ ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
- as_fn_error "invalid package name: $ac_useropt"
- ac_useropt_orig=$ac_useropt
- ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
- case $ac_user_opts in
- *"
-"with_$ac_useropt"
-"*) ;;
- *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
- ac_unrecognized_sep=', ';;
- esac
- eval with_$ac_useropt=no ;;
+ expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid package name: $ac_package" >&2
+ { (exit 1); exit 1; }; }
+ ac_package=`echo $ac_package | sed 's/-/_/g'`
+ eval "with_$ac_package=no" ;;
--x)
# Obsolete; use --with-x.
@@ -992,25 +586,26 @@ do
| --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
x_libraries=$ac_optarg ;;
- -*) as_fn_error "unrecognized option: \`$ac_option'
-Try \`$0 --help' for more information."
+ -*) { echo "$as_me: error: unrecognized option: $ac_option
+Try \`$0 --help' for more information." >&2
+ { (exit 1); exit 1; }; }
;;
*=*)
ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
# Reject names that are not valid shell variable names.
- case $ac_envvar in #(
- '' | [0-9]* | *[!_$as_cr_alnum]* )
- as_fn_error "invalid variable name: \`$ac_envvar'" ;;
- esac
- eval $ac_envvar=\$ac_optarg
+ expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
+ { (exit 1); exit 1; }; }
+ ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
+ eval "$ac_envvar='$ac_optarg'"
export $ac_envvar ;;
*)
# FIXME: should be removed in autoconf 3.0.
- $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+ echo "$as_me: WARNING: you should use --build, --host, --target" >&2
expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
- $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+ echo "$as_me: WARNING: invalid host type: $ac_option" >&2
: ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
;;
@@ -1019,36 +614,31 @@ done
if test -n "$ac_prev"; then
ac_option=--`echo $ac_prev | sed 's/_/-/g'`
- as_fn_error "missing argument to $ac_option"
+ { echo "$as_me: error: missing argument to $ac_option" >&2
+ { (exit 1); exit 1; }; }
fi
-if test -n "$ac_unrecognized_opts"; then
- case $enable_option_checking in
- no) ;;
- fatal) as_fn_error "unrecognized options: $ac_unrecognized_opts" ;;
- *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
- esac
-fi
-
-# Check all directory arguments for consistency.
-for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
- datadir sysconfdir sharedstatedir localstatedir includedir \
- oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
- libdir localedir mandir
+# Be sure to have absolute paths.
+for ac_var in exec_prefix prefix
do
- eval ac_val=\$$ac_var
- # Remove trailing slashes.
+ eval ac_val=$`echo $ac_var`
case $ac_val in
- */ )
- ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
- eval $ac_var=\$ac_val;;
+ [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
+ *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; };;
esac
- # Be sure to have absolute directory names.
+done
+
+# Be sure to have absolute paths.
+for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
+ localstatedir libdir includedir oldincludedir infodir mandir
+do
+ eval ac_val=$`echo $ac_var`
case $ac_val in
- [\\/$]* | ?:[\\/]* ) continue;;
- NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
+ [\\/$]* | ?:[\\/]* ) ;;
+ *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; };;
esac
- as_fn_error "expected an absolute directory name for --$ac_var: $ac_val"
done
# There might be people who depend on the old broken behavior: `$host'
@@ -1062,7 +652,7 @@ target=$target_alias
if test "x$host_alias" != x; then
if test "x$build_alias" = x; then
cross_compiling=maybe
- $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
+ echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
If a cross compiler is detected then cross compile mode will be used." >&2
elif test "x$build_alias" != "x$host_alias"; then
cross_compiling=yes
@@ -1075,72 +665,54 @@ test -n "$host_alias" && ac_tool_prefix=$host_alias-
test "$silent" = yes && exec 6>/dev/null
-ac_pwd=`pwd` && test -n "$ac_pwd" &&
-ac_ls_di=`ls -di .` &&
-ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
- as_fn_error "working directory cannot be determined"
-test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
- as_fn_error "pwd does not report name of working directory"
-
-
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
ac_srcdir_defaulted=yes
- # Try the directory containing this script, then the parent directory.
- ac_confdir=`$as_dirname -- "$as_myself" ||
-$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_myself" : 'X\(//\)[^/]' \| \
- X"$as_myself" : 'X\(//\)$' \| \
- X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
-$as_echo X"$as_myself" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
- s//\1/
- q
- }
- /^X\(\/\/\)[^/].*/{
- s//\1/
- q
- }
- /^X\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'`
+ # Try the directory containing this script, then its parent.
+ ac_confdir=`(dirname "$0") 2>/dev/null ||
+$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$0" : 'X\(//\)[^/]' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$0" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
srcdir=$ac_confdir
- if test ! -r "$srcdir/$ac_unique_file"; then
+ if test ! -r $srcdir/$ac_unique_file; then
srcdir=..
fi
else
ac_srcdir_defaulted=no
fi
-if test ! -r "$srcdir/$ac_unique_file"; then
- test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
- as_fn_error "cannot find sources ($ac_unique_file) in $srcdir"
-fi
-ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
-ac_abs_confdir=`(
- cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error "$ac_msg"
- pwd)`
-# When building in place, set srcdir=.
-if test "$ac_abs_confdir" = "$ac_pwd"; then
- srcdir=.
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
+ { (exit 1); exit 1; }; }
+ else
+ { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
+ { (exit 1); exit 1; }; }
+ fi
fi
-# Remove unnecessary trailing slashes from srcdir.
-# Double slashes in file names in object file debugging info
-# mess up M-x gdb in Emacs.
-case $srcdir in
-*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
-esac
-for ac_var in $ac_precious_vars; do
- eval ac_env_${ac_var}_set=\${${ac_var}+set}
- eval ac_env_${ac_var}_value=\$${ac_var}
- eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
- eval ac_cv_env_${ac_var}_value=\$${ac_var}
-done
+(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
+ { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
+ { (exit 1); exit 1; }; }
+srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
+ac_env_build_alias_set=${build_alias+set}
+ac_env_build_alias_value=$build_alias
+ac_cv_env_build_alias_set=${build_alias+set}
+ac_cv_env_build_alias_value=$build_alias
+ac_env_host_alias_set=${host_alias+set}
+ac_env_host_alias_value=$host_alias
+ac_cv_env_host_alias_set=${host_alias+set}
+ac_cv_env_host_alias_value=$host_alias
+ac_env_target_alias_set=${target_alias+set}
+ac_env_target_alias_value=$target_alias
+ac_cv_env_target_alias_set=${target_alias+set}
+ac_cv_env_target_alias_value=$target_alias
#
# Report the --help message.
@@ -1169,11 +741,14 @@ Configuration:
-n, --no-create do not create output files
--srcdir=DIR find the sources in DIR [configure dir or \`..']
+_ACEOF
+
+ cat <<_ACEOF
Installation directories:
--prefix=PREFIX install architecture-independent files in PREFIX
- [$ac_default_prefix]
+ [$ac_default_prefix]
--exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
- [PREFIX]
+ [PREFIX]
By default, \`make install' will install all the files in
\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
@@ -1183,25 +758,18 @@ for instance \`--prefix=\$HOME'.
For better control, use the options below.
Fine tuning of the installation directories:
- --bindir=DIR user executables [EPREFIX/bin]
- --sbindir=DIR system admin executables [EPREFIX/sbin]
- --libexecdir=DIR program executables [EPREFIX/libexec]
- --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
- --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
- --localstatedir=DIR modifiable single-machine data [PREFIX/var]
- --libdir=DIR object code libraries [EPREFIX/lib]
- --includedir=DIR C header files [PREFIX/include]
- --oldincludedir=DIR C header files for non-gcc [/usr/include]
- --datarootdir=DIR read-only arch.-independent data root [PREFIX/share]
- --datadir=DIR read-only architecture-independent data [DATAROOTDIR]
- --infodir=DIR info documentation [DATAROOTDIR/info]
- --localedir=DIR locale-dependent data [DATAROOTDIR/locale]
- --mandir=DIR man documentation [DATAROOTDIR/man]
- --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE]
- --htmldir=DIR html documentation [DOCDIR]
- --dvidir=DIR dvi documentation [DOCDIR]
- --pdfdir=DIR pdf documentation [DOCDIR]
- --psdir=DIR ps documentation [DOCDIR]
+ --bindir=DIR user executables [EPREFIX/bin]
+ --sbindir=DIR system admin executables [EPREFIX/sbin]
+ --libexecdir=DIR program executables [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data [PREFIX/var]
+ --libdir=DIR object code libraries [EPREFIX/lib]
+ --includedir=DIR C header files [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc [/usr/include]
+ --infodir=DIR info documentation [PREFIX/info]
+ --mandir=DIR man documentation [PREFIX/man]
_ACEOF
cat <<\_ACEOF
@@ -1217,93 +785,119 @@ Optional Packages:
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
--with-tcl=DIR use Tcl $DEF_VER binaries from DIR
-Report bugs to the package provider.
_ACEOF
-ac_status=$?
fi
if test "$ac_init_help" = "recursive"; then
# If there are subdirs, report their specific --help.
+ ac_popdir=`pwd`
for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
- test -d "$ac_dir" ||
- { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
- continue
+ test -d $ac_dir || continue
ac_builddir=.
-case "$ac_dir" in
-.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
-*)
- ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
- # A ".." for each directory in $ac_dir_suffix.
- ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
- case $ac_top_builddir_sub in
- "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
- *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
- esac ;;
-esac
-ac_abs_top_builddir=$ac_pwd
-ac_abs_builddir=$ac_pwd$ac_dir_suffix
-# for backward compatibility:
-ac_top_builddir=$ac_top_build_prefix
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
case $srcdir in
- .) # We are building in place.
+ .) # No --srcdir option. We are building in place.
ac_srcdir=.
- ac_top_srcdir=$ac_top_builddir_sub
- ac_abs_top_srcdir=$ac_pwd ;;
- [\\/]* | ?:[\\/]* ) # Absolute name.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir
- ac_abs_top_srcdir=$srcdir ;;
- *) # Relative name.
- ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_build_prefix$srcdir
- ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
esac
-ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
-
- cd "$ac_dir" || { ac_status=$?; continue; }
- # Check for guested configure.
- if test -f "$ac_srcdir/configure.gnu"; then
- echo &&
- $SHELL "$ac_srcdir/configure.gnu" --help=recursive
- elif test -f "$ac_srcdir/configure"; then
- echo &&
- $SHELL "$ac_srcdir/configure" --help=recursive
+
+# Do not use `cd foo && pwd` to compute absolute paths, because
+# the directories may not exist.
+case `pwd` in
+.) ac_abs_builddir="$ac_dir";;
+*)
+ case "$ac_dir" in
+ .) ac_abs_builddir=`pwd`;;
+ [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+ *) ac_abs_builddir=`pwd`/"$ac_dir";;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_builddir=${ac_top_builddir}.;;
+*)
+ case ${ac_top_builddir}. in
+ .) ac_abs_top_builddir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_srcdir=$ac_srcdir;;
+*)
+ case $ac_srcdir in
+ .) ac_abs_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+ *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_srcdir=$ac_top_srcdir;;
+*)
+ case $ac_top_srcdir in
+ .) ac_abs_top_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+ esac;;
+esac
+
+ cd $ac_dir
+ # Check for guested configure; otherwise get Cygnus style configure.
+ if test -f $ac_srcdir/configure.gnu; then
+ echo
+ $SHELL $ac_srcdir/configure.gnu --help=recursive
+ elif test -f $ac_srcdir/configure; then
+ echo
+ $SHELL $ac_srcdir/configure --help=recursive
+ elif test -f $ac_srcdir/configure.ac ||
+ test -f $ac_srcdir/configure.in; then
+ echo
+ $ac_configure --help
else
- $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
- fi || ac_status=$?
- cd "$ac_pwd" || { ac_status=$?; break; }
+ echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+ fi
+ cd $ac_popdir
done
fi
-test -n "$ac_init_help" && exit $ac_status
+test -n "$ac_init_help" && exit 0
if $ac_init_version; then
cat <<\_ACEOF
-configure
-generated by GNU Autoconf 2.65
-Copyright (C) 2009 Free Software Foundation, Inc.
+Copyright (C) 2003 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
- exit
+ exit 0
fi
-
-## ------------------------ ##
-## Autoconf initialization. ##
-## ------------------------ ##
-cat >config.log <<_ACEOF
+exec 5>config.log
+cat >&5 <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by $as_me, which was
-generated by GNU Autoconf 2.65. Invocation command line was
+generated by GNU Autoconf 2.59. Invocation command line was
$ $0 $@
_ACEOF
-exec 5>>config.log
{
cat <<_ASUNAME
## --------- ##
@@ -1322,7 +916,7 @@ uname -v = `(uname -v) 2>/dev/null || echo unknown`
/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`
/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`
/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
-/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown`
+hostinfo = `(hostinfo) 2>/dev/null || echo unknown`
/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`
/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`
/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`
@@ -1334,9 +928,8 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- $as_echo "PATH: $as_dir"
- done
-IFS=$as_save_IFS
+ echo "PATH: $as_dir"
+done
} >&5
@@ -1358,6 +951,7 @@ _ACEOF
ac_configure_args=
ac_configure_args0=
ac_configure_args1=
+ac_sep=
ac_must_keep_next=false
for ac_pass in 1 2
do
@@ -1368,13 +962,13 @@ do
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
continue ;;
- *\'*)
- ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
esac
case $ac_pass in
- 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
+ 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
2)
- as_fn_append ac_configure_args1 " '$ac_arg'"
+ ac_configure_args1="$ac_configure_args1 '$ac_arg'"
if test $ac_must_keep_next = true; then
ac_must_keep_next=false # Got value, back to normal.
else
@@ -1390,19 +984,21 @@ do
-* ) ac_must_keep_next=true ;;
esac
fi
- as_fn_append ac_configure_args " '$ac_arg'"
+ ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
+ # Get rid of the leading space.
+ ac_sep=" "
;;
esac
done
done
-{ ac_configure_args0=; unset ac_configure_args0;}
-{ ac_configure_args1=; unset ac_configure_args1;}
+$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
+$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
# When interrupted or exit'd, cleanup temporary files, and complete
# config.log. We remove comments because anyway the quotes in there
# would cause problems or look ugly.
-# WARNING: Use '\'' to represent an apostrophe within the trap.
-# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
+# WARNING: Be sure not to use single quotes in there, as some shells,
+# such as our DU 5.0 friend, will then `close' the trap.
trap 'exit_status=$?
# Save into config.log some information that might help in debugging.
{
@@ -1415,35 +1011,20 @@ trap 'exit_status=$?
_ASBOX
echo
# The following way of writing the cache mishandles newlines in values,
-(
- for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
- eval ac_val=\$$ac_var
- case $ac_val in #(
- *${as_nl}*)
- case $ac_var in #(
- *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
-$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
- esac
- case $ac_var in #(
- _ | IFS | as_nl) ;; #(
- BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
- *) { eval $ac_var=; unset $ac_var;} ;;
- esac ;;
- esac
- done
+{
(set) 2>&1 |
- case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
- *${as_nl}ac_space=\ *)
+ case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
sed -n \
- "s/'\''/'\''\\\\'\'''\''/g;
- s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
- ;; #(
+ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
+ ;;
*)
- sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+ sed -n \
+ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
;;
- esac |
- sort
-)
+ esac;
+}
echo
cat <<\_ASBOX
@@ -1454,28 +1035,22 @@ _ASBOX
echo
for ac_var in $ac_subst_vars
do
- eval ac_val=\$$ac_var
- case $ac_val in
- *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
- esac
- $as_echo "$ac_var='\''$ac_val'\''"
+ eval ac_val=$`echo $ac_var`
+ echo "$ac_var='"'"'$ac_val'"'"'"
done | sort
echo
if test -n "$ac_subst_files"; then
cat <<\_ASBOX
-## ------------------- ##
-## File substitutions. ##
-## ------------------- ##
+## ------------- ##
+## Output files. ##
+## ------------- ##
_ASBOX
echo
for ac_var in $ac_subst_files
do
- eval ac_val=\$$ac_var
- case $ac_val in
- *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
- esac
- $as_echo "$ac_var='\''$ac_val'\''"
+ eval ac_val=$`echo $ac_var`
+ echo "$ac_var='"'"'$ac_val'"'"'"
done | sort
echo
fi
@@ -1487,26 +1062,26 @@ _ASBOX
## ----------- ##
_ASBOX
echo
- cat confdefs.h
+ sed "/^$/d" confdefs.h | sort
echo
fi
test "$ac_signal" != 0 &&
- $as_echo "$as_me: caught signal $ac_signal"
- $as_echo "$as_me: exit $exit_status"
+ echo "$as_me: caught signal $ac_signal"
+ echo "$as_me: exit $exit_status"
} >&5
- rm -f core *.core core.conftest.* &&
- rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
+ rm -f core *.core &&
+ rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
exit $exit_status
-' 0
+ ' 0
for ac_signal in 1 2 13 15; do
- trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
+ trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
done
ac_signal=0
# confdefs.h avoids OS command line length limits that DEFS can exceed.
-rm -f -r conftest* confdefs.h
-
-$as_echo "/* confdefs.h */" > confdefs.h
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo >confdefs.h
# Predefined preprocessor variables.
@@ -1514,128 +1089,112 @@ cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
_ACEOF
+
cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
_ACEOF
+
cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
_ACEOF
+
cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
_ACEOF
-cat >>confdefs.h <<_ACEOF
-#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
-_ACEOF
cat >>confdefs.h <<_ACEOF
-#define PACKAGE_URL "$PACKAGE_URL"
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
_ACEOF
# Let the site file select an alternate cache file if it wants to.
-# Prefer an explicitly selected file to automatically selected ones.
-ac_site_file1=NONE
-ac_site_file2=NONE
-if test -n "$CONFIG_SITE"; then
- ac_site_file1=$CONFIG_SITE
-elif test "x$prefix" != xNONE; then
- ac_site_file1=$prefix/share/config.site
- ac_site_file2=$prefix/etc/config.site
-else
- ac_site_file1=$ac_default_prefix/share/config.site
- ac_site_file2=$ac_default_prefix/etc/config.site
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
fi
-for ac_site_file in "$ac_site_file1" "$ac_site_file2"
-do
- test "x$ac_site_file" = xNONE && continue
- if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
-$as_echo "$as_me: loading site script $ac_site_file" >&6;}
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
+echo "$as_me: loading site script $ac_site_file" >&6;}
sed 's/^/| /' "$ac_site_file" >&5
. "$ac_site_file"
fi
done
if test -r "$cache_file"; then
- # Some versions of bash will fail to source /dev/null (special files
- # actually), so we avoid doing that. DJGPP emulates it as a regular file.
- if test /dev/null != "$cache_file" && test -f "$cache_file"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
-$as_echo "$as_me: loading cache $cache_file" >&6;}
+ # Some versions of bash will fail to source /dev/null (special
+ # files actually), so we avoid doing that.
+ if test -f "$cache_file"; then
+ { echo "$as_me:$LINENO: loading cache $cache_file" >&5
+echo "$as_me: loading cache $cache_file" >&6;}
case $cache_file in
- [\\/]* | ?:[\\/]* ) . "$cache_file";;
- *) . "./$cache_file";;
+ [\\/]* | ?:[\\/]* ) . $cache_file;;
+ *) . ./$cache_file;;
esac
fi
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
-$as_echo "$as_me: creating cache $cache_file" >&6;}
+ { echo "$as_me:$LINENO: creating cache $cache_file" >&5
+echo "$as_me: creating cache $cache_file" >&6;}
>$cache_file
fi
# Check that the precious variables saved in the cache have kept the same
# value.
ac_cache_corrupted=false
-for ac_var in $ac_precious_vars; do
+for ac_var in `(set) 2>&1 |
+ sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
eval ac_old_set=\$ac_cv_env_${ac_var}_set
eval ac_new_set=\$ac_env_${ac_var}_set
- eval ac_old_val=\$ac_cv_env_${ac_var}_value
- eval ac_new_val=\$ac_env_${ac_var}_value
+ eval ac_old_val="\$ac_cv_env_${ac_var}_value"
+ eval ac_new_val="\$ac_env_${ac_var}_value"
case $ac_old_set,$ac_new_set in
set,)
- { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
-$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+ { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
ac_cache_corrupted=: ;;
,set)
- { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
-$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+ { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
ac_cache_corrupted=: ;;
,);;
*)
if test "x$ac_old_val" != "x$ac_new_val"; then
- # differences in whitespace do not lead to failure.
- ac_old_val_w=`echo x $ac_old_val`
- ac_new_val_w=`echo x $ac_new_val`
- if test "$ac_old_val_w" != "$ac_new_val_w"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
-$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
- ac_cache_corrupted=:
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
-$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
- eval $ac_var=\$ac_old_val
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5
-$as_echo "$as_me: former value: \`$ac_old_val'" >&2;}
- { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5
-$as_echo "$as_me: current value: \`$ac_new_val'" >&2;}
+ { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
+echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+ { echo "$as_me:$LINENO: former value: $ac_old_val" >&5
+echo "$as_me: former value: $ac_old_val" >&2;}
+ { echo "$as_me:$LINENO: current value: $ac_new_val" >&5
+echo "$as_me: current value: $ac_new_val" >&2;}
+ ac_cache_corrupted=:
fi;;
esac
# Pass precious variables to config.status.
if test "$ac_new_set" = set; then
case $ac_new_val in
- *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
*) ac_arg=$ac_var=$ac_new_val ;;
esac
case " $ac_configure_args " in
*" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
- *) as_fn_append ac_configure_args " '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
esac
fi
done
if $ac_cache_corrupted; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
- { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
-$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
- as_fn_error "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
+ { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
+echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+ { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
+echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
+ { (exit 1); exit 1; }; }
fi
-## -------------------- ##
-## Main body of script. ##
-## -------------------- ##
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
@@ -1645,7 +1204,23 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
-# RCS: @(#) $Id: configure,v 1.5 2010/06/09 13:51:51 nijtmans Exp $
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Recover information that Tcl computed with its configure script.
@@ -1657,18 +1232,22 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
DEF_VER=8.6
-# Check whether --with-tcl was given.
-if test "${with_tcl+set}" = set; then :
- withval=$with_tcl; TCL_BIN_DIR=$withval
+# Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ TCL_BIN_DIR=$withval
else
TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`
-fi
-
+fi;
if test ! -d $TCL_BIN_DIR; then
- as_fn_error "Tcl directory $TCL_BIN_DIR doesn't exist" "$LINENO" 5
+ { { echo "$as_me:$LINENO: error: Tcl directory $TCL_BIN_DIR doesn't exist" >&5
+echo "$as_me: error: Tcl directory $TCL_BIN_DIR doesn't exist" >&2;}
+ { (exit 1); exit 1; }; }
fi
if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
- as_fn_error "There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" "$LINENO" 5
+ { { echo "$as_me:$LINENO: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" >&5
+echo "$as_me: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" >&2;}
+ { (exit 1); exit 1; }; }
fi
. $TCL_BIN_DIR/tclConfig.sh
@@ -1682,8 +1261,7 @@ CC=$TCL_CC
-ac_config_files="$ac_config_files Makefile tcl.hpj"
-
+ ac_config_files="$ac_config_files Makefile tcl.hpj"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
@@ -1702,59 +1280,39 @@ _ACEOF
# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
-# So, we kill variables containing newlines.
+# So, don't put newlines in cache variables' values.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
-(
- for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
- eval ac_val=\$$ac_var
- case $ac_val in #(
- *${as_nl}*)
- case $ac_var in #(
- *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
-$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
- esac
- case $ac_var in #(
- _ | IFS | as_nl) ;; #(
- BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
- *) { eval $ac_var=; unset $ac_var;} ;;
- esac ;;
- esac
- done
-
+{
(set) 2>&1 |
- case $as_nl`(ac_space=' '; set) 2>&1` in #(
- *${as_nl}ac_space=\ *)
- # `set' does not quote correctly, so add quotes: double-quote
- # substitution turns \\\\ into \\, and sed turns \\ into \.
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote
+ # substitution turns \\\\ into \\, and sed turns \\ into \).
sed -n \
"s/'/'\\\\''/g;
s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
- ;; #(
+ ;;
*)
# `set' quotes correctly as required by POSIX, so do not add quotes.
- sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+ sed -n \
+ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
;;
- esac |
- sort
-) |
+ esac;
+} |
sed '
- /^ac_cv_env_/b end
t clear
- :clear
+ : clear
s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
t end
- s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
- :end' >>confcache
-if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
- if test -w "$cache_file"; then
- test "x$cache_file" != "x/dev/null" &&
- { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
-$as_echo "$as_me: updating cache $cache_file" >&6;}
+ /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+ : end' >>confcache
+if diff $cache_file confcache >/dev/null 2>&1; then :; else
+ if test -w $cache_file; then
+ test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
cat confcache >$cache_file
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
-$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
+ echo "not updating unwritable cache $cache_file"
fi
fi
rm -f confcache
@@ -1763,54 +1321,63 @@ test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+# VPATH may cause trouble with some makes, so we remove $(srcdir),
+# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=/{
+s/:*\$(srcdir):*/:/;
+s/:*\${srcdir}:*/:/;
+s/:*@srcdir@:*/:/;
+s/^\([^=]*=[ ]*\):*/\1/;
+s/:*$//;
+s/^[^=]*=[ ]*$//;
+}'
+fi
+
# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
#
# If the first sed substitution is executed (which looks for macros that
-# take arguments), then branch to the quote section. Otherwise,
+# take arguments), then we branch to the quote section. Otherwise,
# look for a macro that doesn't take arguments.
-ac_script='
-:mline
-/\\$/{
- N
- s,\\\n,,
- b mline
-}
+cat >confdef2opt.sed <<\_ACEOF
t clear
-:clear
-s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g
+: clear
+s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g
t quote
-s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g
+s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g
t quote
-b any
-:quote
-s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g
-s/\[/\\&/g
-s/\]/\\&/g
-s/\$/$$/g
-H
-:any
-${
- g
- s/^\n//
- s/\n/ /g
- p
-}
-'
-DEFS=`sed -n "$ac_script" confdefs.h`
+d
+: quote
+s,[ `~#$^&*(){}\\|;'"<>?],\\&,g
+s,\[,\\&,g
+s,\],\\&,g
+s,\$,$$,g
+p
+_ACEOF
+# We use echo to avoid assuming a particular line-breaking character.
+# The extra dot is to prevent the shell from consuming trailing
+# line-breaks from the sub-command output. A line-break within
+# single-quotes doesn't work because, if this script is created in a
+# platform that uses two characters for line-breaks (e.g., DOS), tr
+# would break.
+ac_LF_and_DOT=`echo; echo .`
+DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'`
+rm -f confdef2opt.sed
ac_libobjs=
ac_ltlibobjs=
for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
# 1. Remove the extension, and $U if already installed.
- ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
- ac_i=`$as_echo "$ac_i" | sed "$ac_script"`
- # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR
- # will be set to the directory where LIBOBJS objects are built.
- as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
- as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
+ ac_i=`echo "$ac_i" |
+ sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
+ # 2. Add them.
+ ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"
+ ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'
done
LIBOBJS=$ac_libobjs
@@ -1819,13 +1386,11 @@ LTLIBOBJS=$ac_ltlibobjs
: ${CONFIG_STATUS=./config.status}
-ac_write_fail=0
ac_clean_files_save=$ac_clean_files
ac_clean_files="$ac_clean_files $CONFIG_STATUS"
-{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
-$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
-as_write_fail=0
-cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
+{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
+echo "$as_me: creating $CONFIG_STATUS" >&6;}
+cat >$CONFIG_STATUS <<_ACEOF
#! $SHELL
# Generated by $as_me.
# Run this file to recreate the current configuration.
@@ -1835,252 +1400,81 @@ cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
debug=false
ac_cs_recheck=false
ac_cs_silent=false
-
SHELL=\${CONFIG_SHELL-$SHELL}
-export SHELL
-_ASEOF
-cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
-## -------------------- ##
-## M4sh Initialization. ##
-## -------------------- ##
-
-# Be more Bourne compatible
-DUALCASE=1; export DUALCASE # for MKS sh
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
emulate sh
NULLCMD=:
- # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+ # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
- setopt NO_GLOB_SUBST
-else
- case `(set -o) 2>/dev/null` in #(
- *posix*) :
- set -o posix ;; #(
- *) :
- ;;
-esac
+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+ set -o posix
fi
+DUALCASE=1; export DUALCASE # for MKS sh
-
-as_nl='
-'
-export as_nl
-# Printing a long string crashes Solaris 7 /usr/bin/printf.
-as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
-# Prefer a ksh shell builtin over an external printf program on Solaris,
-# but without wasting forks for bash or zsh.
-if test -z "$BASH_VERSION$ZSH_VERSION" \
- && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
- as_echo='print -r --'
- as_echo_n='print -rn --'
-elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
- as_echo='printf %s\n'
- as_echo_n='printf %s'
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
else
- if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
- as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
- as_echo_n='/usr/ucb/echo -n'
- else
- as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
- as_echo_n_body='eval
- arg=$1;
- case $arg in #(
- *"$as_nl"*)
- expr "X$arg" : "X\\(.*\\)$as_nl";
- arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
- esac;
- expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
- '
- export as_echo_n_body
- as_echo_n='sh -c $as_echo_n_body as_echo'
- fi
- export as_echo_body
- as_echo='sh -c $as_echo_body as_echo'
-fi
-
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- PATH_SEPARATOR=:
- (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
- (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
- PATH_SEPARATOR=';'
- }
+ as_unset=false
fi
-# IFS
-# We need space, tab and new line, in precisely that order. Quoting is
-# there to prevent editors from complaining about space-tab.
-# (If _AS_PATH_WALK were called with IFS unset, it would disable word
-# splitting by setting IFS to empty value.)
-IFS=" "" $as_nl"
-
-# Find who we are. Look in the path if we contain no directory separator.
-case $0 in #((
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
- done
-IFS=$as_save_IFS
-
- ;;
-esac
-# We did not find ourselves, most probably we were run as `sh COMMAND'
-# in which case we are not to be found in the path.
-if test "x$as_myself" = x; then
- as_myself=$0
-fi
-if test ! -f "$as_myself"; then
- $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
- exit 1
-fi
-
-# Unset variables that we do not need and which cause bugs (e.g. in
-# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
-# suppresses any "Segmentation fault" message there. '((' could
-# trigger a bug in pdksh 5.2.14.
-for as_var in BASH_ENV ENV MAIL MAILPATH
-do eval test x\${$as_var+set} = xset \
- && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
-done
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
PS1='$ '
PS2='> '
PS4='+ '
# NLS nuisances.
-LC_ALL=C
-export LC_ALL
-LANGUAGE=C
-export LANGUAGE
-
-# CDPATH.
-(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
-
-
-# as_fn_error ERROR [LINENO LOG_FD]
-# ---------------------------------
-# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
-# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
-# script with status $?, using 1 if that was 0.
-as_fn_error ()
-{
- as_status=$?; test $as_status -eq 0 && as_status=1
- if test "$3"; then
- as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
+do
+ if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+ eval $as_var=C; export $as_var
+ else
+ $as_unset $as_var
fi
- $as_echo "$as_me: error: $1" >&2
- as_fn_exit $as_status
-} # as_fn_error
-
-
-# as_fn_set_status STATUS
-# -----------------------
-# Set $? to STATUS, without forking.
-as_fn_set_status ()
-{
- return $1
-} # as_fn_set_status
-
-# as_fn_exit STATUS
-# -----------------
-# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
-as_fn_exit ()
-{
- set +e
- as_fn_set_status $1
- exit $1
-} # as_fn_exit
-
-# as_fn_unset VAR
-# ---------------
-# Portably unset VAR.
-as_fn_unset ()
-{
- { eval $1=; unset $1;}
-}
-as_unset=as_fn_unset
-# as_fn_append VAR VALUE
-# ----------------------
-# Append the text in VALUE to the end of the definition contained in VAR. Take
-# advantage of any shell optimizations that allow amortized linear growth over
-# repeated appends, instead of the typical quadratic growth present in naive
-# implementations.
-if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
- eval 'as_fn_append ()
- {
- eval $1+=\$2
- }'
-else
- as_fn_append ()
- {
- eval $1=\$$1\$2
- }
-fi # as_fn_append
-
-# as_fn_arith ARG...
-# ------------------
-# Perform arithmetic evaluation on the ARGs, and store the result in the
-# global $as_val. Take advantage of shells that can avoid forks. The arguments
-# must be portable across $(()) and expr.
-if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
- eval 'as_fn_arith ()
- {
- as_val=$(( $* ))
- }'
-else
- as_fn_arith ()
- {
- as_val=`expr "$@" || test $? -eq 1`
- }
-fi # as_fn_arith
-
+done
-if expr a : '\(a\)' >/dev/null 2>&1 &&
- test "X`expr 00001 : '.*\(...\)'`" = X001; then
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
as_expr=expr
else
as_expr=false
fi
-if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
as_basename=basename
else
as_basename=false
fi
-if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
- as_dirname=dirname
-else
- as_dirname=false
-fi
-as_me=`$as_basename -- "$0" ||
+# Name of the executable.
+as_me=`$as_basename "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)' \| . 2>/dev/null ||
-$as_echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{
- s//\1/
- q
- }
- /^X\/\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\/\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'`
+ X"$0" : 'X\(/\)$' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+ /^X\/\(\/\/\)$/{ s//\1/; q; }
+ /^X\/\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+
+# PATH needs CR, and LINENO needs CR and PATH.
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
@@ -2088,123 +1482,148 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits
-ECHO_C= ECHO_N= ECHO_T=
-case `echo -n x` in #(((((
--n*)
- case `echo 'xy\c'` in
- *c*) ECHO_T=' ';; # ECHO_T is single tab character.
- xy) ECHO_C='\c';;
- *) echo `echo ksh88 bug on AIX 6.1` > /dev/null
- ECHO_T=' ';;
- esac;;
-*)
- ECHO_N='-n';;
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conf$$.sh
+ echo "exit 0" >>conf$$.sh
+ chmod +x conf$$.sh
+ if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conf$$.sh
+fi
+
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" || {
+ # Find who we are. Look in the path if we contain no path at all
+ # relative or not.
+ case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+
+ ;;
+ esac
+ # We did not find ourselves, most probably we were run as `sh COMMAND'
+ # in which case we are not to be found in the path.
+ if test "x$as_myself" = x; then
+ as_myself=$0
+ fi
+ if test ! -f "$as_myself"; then
+ { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
+echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ case $CONFIG_SHELL in
+ '')
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for as_base in sh bash ksh sh5; do
+ case $as_dir in
+ /*)
+ if ("$as_dir/$as_base" -c '
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
+ $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
+ $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
+ CONFIG_SHELL=$as_dir/$as_base
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ fi;;
+ esac
+ done
+done
+;;
+ esac
+
+ # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+ # uniformly replaced by the line number. The first 'sed' inserts a
+ # line-number line before each line; the second 'sed' does the real
+ # work. The second script uses 'N' to pair each line-number line
+ # with the numbered line, and appends trailing '-' during
+ # substitution so that $LINENO is not a special case at line end.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
+ ' >$as_me.lineno &&
+ chmod +x $as_me.lineno ||
+ { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
+echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
+ { (exit 1); exit 1; }; }
+
+ # Don't try to exec as it changes $[0], causing all sort of problems
+ # (the dirname of $[0] is not the place where we might find the
+ # original and so on. Autoconf is especially sensible to this).
+ . ./$as_me.lineno
+ # Exit status is that of the last command.
+ exit
+}
+
+
+case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+ *c*,-n*) ECHO_N= ECHO_C='
+' ECHO_T=' ' ;;
+ *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+ *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
esac
-rm -f conf$$ conf$$.exe conf$$.file
-if test -d conf$$.dir; then
- rm -f conf$$.dir/conf$$.file
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
else
- rm -f conf$$.dir
- mkdir conf$$.dir 2>/dev/null
+ as_expr=false
fi
-if (echo >conf$$.file) 2>/dev/null; then
- if ln -s conf$$.file conf$$ 2>/dev/null; then
- as_ln_s='ln -s'
- # ... but there are two gotchas:
- # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
- # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
- # In both cases, we have to default to `cp -p'.
- ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
- as_ln_s='cp -p'
- elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
- else
+
+rm -f conf$$ conf$$.exe conf$$.file
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+ # We could just check for DJGPP; but this test a) works b) is more generic
+ # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+ if test -f conf$$.exe; then
+ # Don't use ln at all; we don't have any links
as_ln_s='cp -p'
+ else
+ as_ln_s='ln -s'
fi
+elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
else
as_ln_s='cp -p'
fi
-rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
-rmdir conf$$.dir 2>/dev/null
-
-
-# as_fn_mkdir_p
-# -------------
-# Create "$as_dir" as a directory, including parents if necessary.
-as_fn_mkdir_p ()
-{
-
- case $as_dir in #(
- -*) as_dir=./$as_dir;;
- esac
- test -d "$as_dir" || eval $as_mkdir_p || {
- as_dirs=
- while :; do
- case $as_dir in #(
- *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
- *) as_qdir=$as_dir;;
- esac
- as_dirs="'$as_qdir' $as_dirs"
- as_dir=`$as_dirname -- "$as_dir" ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_dir" : 'X\(//\)[^/]' \| \
- X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
-$as_echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
- s//\1/
- q
- }
- /^X\(\/\/\)[^/].*/{
- s//\1/
- q
- }
- /^X\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'`
- test -d "$as_dir" && break
- done
- test -z "$as_dirs" || eval "mkdir $as_dirs"
- } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir"
-
+rm -f conf$$ conf$$.exe conf$$.file
-} # as_fn_mkdir_p
if mkdir -p . 2>/dev/null; then
- as_mkdir_p='mkdir -p "$as_dir"'
+ as_mkdir_p=:
else
test -d ./-p && rmdir ./-p
as_mkdir_p=false
fi
-if test -x / >/dev/null 2>&1; then
- as_test_x='test -x'
-else
- if ls -dL / >/dev/null 2>&1; then
- as_ls_L_option=L
- else
- as_ls_L_option=
- fi
- as_test_x='
- eval sh -c '\''
- if test -d "$1"; then
- test -d "$1/.";
- else
- case $1 in #(
- -*)set "./$1";;
- esac;
- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
- ???[sx]*):;;*)false;;esac;fi
- '\'' sh
- '
-fi
-as_executable_p=$as_test_x
+as_executable_p="test -f"
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -2213,20 +1632,31 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+# IFS
+# We need space, tab and new line, in precisely that order.
+as_nl='
+'
+IFS=" $as_nl"
+
+# CDPATH.
+$as_unset CDPATH
+
exec 6>&1
-## ----------------------------------- ##
-## Main body of $CONFIG_STATUS script. ##
-## ----------------------------------- ##
-_ASEOF
-test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
-
-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
-# Save the log message, to keep $0 and so on meaningful, and to
+
+# Open the log real soon, to keep \$[0] and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
-# values after options handling.
-ac_log="
+# values after options handling. Logging --version etc. is OK.
+exec 5>>config.log
+{
+ echo
+ sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+} >&5
+cat >&5 <<_CSEOF
+
This file was extended by $as_me, which was
-generated by GNU Autoconf 2.65. Invocation command line was
+generated by GNU Autoconf 2.59. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
CONFIG_HEADERS = $CONFIG_HEADERS
@@ -2234,110 +1664,124 @@ generated by GNU Autoconf 2.65. Invocation command line was
CONFIG_COMMANDS = $CONFIG_COMMANDS
$ $0 $@
-on `(hostname || uname -n) 2>/dev/null | sed 1q`
-"
-
+_CSEOF
+echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
+echo >&5
_ACEOF
-case $ac_config_files in *"
-"*) set x $ac_config_files; shift; ac_config_files=$*;;
-esac
+# Files that config.status was made for.
+if test -n "$ac_config_files"; then
+ echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
+fi
+if test -n "$ac_config_headers"; then
+ echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
+fi
+if test -n "$ac_config_links"; then
+ echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
+fi
-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
-# Files that config.status was made for.
-config_files="$ac_config_files"
+if test -n "$ac_config_commands"; then
+ echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
+fi
-_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
ac_cs_usage="\
-\`$as_me' instantiates files and other configuration actions
-from templates according to the current configuration. Unless the files
-and actions are specified as TAGs, all are instantiated by default.
+\`$as_me' instantiates files from templates according to the
+current configuration.
-Usage: $0 [OPTION]... [TAG]...
+Usage: $0 [OPTIONS] [FILE]...
-h, --help print this help, then exit
- -V, --version print version number and configuration settings, then exit
- --config print configuration, then exit
- -q, --quiet, --silent
- do not print progress messages
+ -V, --version print version number, then exit
+ -q, --quiet do not print progress messages
-d, --debug don't remove temporary files
--recheck update $as_me by reconfiguring in the same conditions
- --file=FILE[:TEMPLATE]
- instantiate the configuration file FILE
+ --file=FILE[:TEMPLATE]
+ instantiate the configuration file FILE
Configuration files:
$config_files
-Report bugs to the package provider."
-
+Report bugs to <bug-autoconf@gnu.org>."
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
-ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
+
+cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_version="\\
config.status
-configured by $0, generated by GNU Autoconf 2.65,
- with options \\"\$ac_cs_config\\"
+configured by $0, generated by GNU Autoconf 2.59,
+ with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
-Copyright (C) 2009 Free Software Foundation, Inc.
+Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
-
-ac_pwd='$ac_pwd'
-srcdir='$srcdir'
-test -n "\$AWK" || AWK=awk
+srcdir=$srcdir
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
-# The default lists apply if the user does not specify any file.
+cat >>$CONFIG_STATUS <<\_ACEOF
+# If no file are specified by the user, then we need to provide default
+# value. By we need to know if files were specified by the user.
ac_need_defaults=:
while test $# != 0
do
case $1 in
--*=*)
- ac_option=`expr "X$1" : 'X\([^=]*\)='`
- ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
+ ac_option=`expr "x$1" : 'x\([^=]*\)='`
+ ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
ac_shift=:
;;
- *)
+ -*)
ac_option=$1
ac_optarg=$2
ac_shift=shift
;;
+ *) # This is not an option, so the user has probably given explicit
+ # arguments.
+ ac_option=$1
+ ac_need_defaults=false;;
esac
case $ac_option in
# Handling of the options.
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
-recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
ac_cs_recheck=: ;;
- --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
- $as_echo "$ac_cs_version"; exit ;;
- --config | --confi | --conf | --con | --co | --c )
- $as_echo "$ac_cs_config"; exit ;;
- --debug | --debu | --deb | --de | --d | -d )
+ --version | --vers* | -V )
+ echo "$ac_cs_version"; exit 0 ;;
+ --he | --h)
+ # Conflict between --help and --header
+ { { echo "$as_me:$LINENO: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&5
+echo "$as_me: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&2;}
+ { (exit 1); exit 1; }; };;
+ --help | --hel | -h )
+ echo "$ac_cs_usage"; exit 0 ;;
+ --debug | --d* | -d )
debug=: ;;
--file | --fil | --fi | --f )
$ac_shift
- case $ac_optarg in
- *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
- esac
- as_fn_append CONFIG_FILES " '$ac_optarg'"
+ CONFIG_FILES="$CONFIG_FILES $ac_optarg"
+ ac_need_defaults=false;;
+ --header | --heade | --head | --hea )
+ $ac_shift
+ CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
ac_need_defaults=false;;
- --he | --h | --help | --hel | -h )
- $as_echo "$ac_cs_usage"; exit ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil | --si | --s)
ac_cs_silent=: ;;
# This is an error.
- -*) as_fn_error "unrecognized option: \`$1'
-Try \`$0 --help' for more information." ;;
+ -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&5
+echo "$as_me: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&2;}
+ { (exit 1); exit 1; }; } ;;
- *) as_fn_append ac_config_targets " $1"
- ac_need_defaults=false ;;
+ *) ac_config_targets="$ac_config_targets $1" ;;
esac
shift
@@ -2351,45 +1795,31 @@ if $ac_cs_silent; then
fi
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+cat >>$CONFIG_STATUS <<_ACEOF
if \$ac_cs_recheck; then
- set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
- shift
- \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
- CONFIG_SHELL='$SHELL'
- export CONFIG_SHELL
- exec "\$@"
+ echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
+ exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
fi
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
-exec 5>>config.log
-{
- echo
- sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
-## Running $as_me. ##
-_ASBOX
- $as_echo "$ac_log"
-} >&5
-_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
-# Handling of arguments.
+
+
+cat >>$CONFIG_STATUS <<\_ACEOF
for ac_config_target in $ac_config_targets
do
- case $ac_config_target in
- "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
- "tcl.hpj") CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;
-
- *) as_fn_error "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
+ case "$ac_config_target" in
+ # Handling of arguments.
+ "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
+ "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;
+ *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
+echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
+ { (exit 1); exit 1; }; };;
esac
done
-
# If the user did not use the arguments to specify the items to instantiate,
# then the envvar interface is used. Set only those that are not.
# We use the long form for the default assignment because of an extremely
@@ -2399,403 +1829,323 @@ if $ac_need_defaults; then
fi
# Have a temporary directory for convenience. Make it in the build tree
-# simply because there is no reason against having it here, and in addition,
+# simply because there is no reason to put it here, and in addition,
# creating and moving files from /tmp can sometimes cause problems.
-# Hook for its removal unless debugging.
-# Note that there is a small window in which the directory will not be cleaned:
-# after its creation but before its name has been assigned to `$tmp'.
+# Create a temporary directory, and hook for its removal unless debugging.
$debug ||
{
- tmp=
- trap 'exit_status=$?
- { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status
-' 0
- trap 'as_fn_exit 1' 1 2 13 15
+ trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
+ trap '{ (exit 1); exit 1; }' 1 2 13 15
}
+
# Create a (secure) tmp directory for tmp files.
{
- tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
+ tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
test -n "$tmp" && test -d "$tmp"
} ||
{
- tmp=./conf$$-$RANDOM
- (umask 077 && mkdir "$tmp")
-} || as_fn_error "cannot create a temporary directory in ." "$LINENO" 5
-
-# Set up the scripts for CONFIG_FILES section.
-# No need to generate them if there are no CONFIG_FILES.
-# This happens for instance with `./config.status config.h'.
-if test -n "$CONFIG_FILES"; then
-
-
-ac_cr=`echo X | tr X '\015'`
-# On cygwin, bash can eat \r inside `` if the user requested igncr.
-# But we know of no other shell where ac_cr would be empty at this
-# point, so we can use a bashism as a fallback.
-if test "x$ac_cr" = x; then
- eval ac_cr=\$\'\\r\'
-fi
-ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`
-if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
- ac_cs_awk_cr='\r'
-else
- ac_cs_awk_cr=$ac_cr
-fi
-
-echo 'BEGIN {' >"$tmp/subs1.awk" &&
-_ACEOF
-
-
+ tmp=./confstat$$-$RANDOM
+ (umask 077 && mkdir $tmp)
+} ||
{
- echo "cat >conf$$subs.awk <<_ACEOF" &&
- echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
- echo "_ACEOF"
-} >conf$$subs.sh ||
- as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5
-ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'`
-ac_delim='%!_!# '
-for ac_last_try in false false false false false :; do
- . ./conf$$subs.sh ||
- as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5
-
- ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
- if test $ac_delim_n = $ac_delim_num; then
- break
- elif $ac_last_try; then
- as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5
- else
- ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
- fi
-done
-rm -f conf$$subs.sh
-
-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
-cat >>"\$tmp/subs1.awk" <<\\_ACAWK &&
-_ACEOF
-sed -n '
-h
-s/^/S["/; s/!.*/"]=/
-p
-g
-s/^[^!]*!//
-:repl
-t repl
-s/'"$ac_delim"'$//
-t delim
-:nl
-h
-s/\(.\{148\}\)..*/\1/
-t more1
-s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
-p
-n
-b repl
-:more1
-s/["\\]/\\&/g; s/^/"/; s/$/"\\/
-p
-g
-s/.\{148\}//
-t nl
-:delim
-h
-s/\(.\{148\}\)..*/\1/
-t more2
-s/["\\]/\\&/g; s/^/"/; s/$/"/
-p
-b
-:more2
-s/["\\]/\\&/g; s/^/"/; s/$/"\\/
-p
-g
-s/.\{148\}//
-t delim
-' <conf$$subs.awk | sed '
-/^[^""]/{
- N
- s/\n//
+ echo "$me: cannot create a temporary directory in ." >&2
+ { (exit 1); exit 1; }
}
-' >>$CONFIG_STATUS || ac_write_fail=1
-rm -f conf$$subs.awk
-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
-_ACAWK
-cat >>"\$tmp/subs1.awk" <<_ACAWK &&
- for (key in S) S_is_set[key] = 1
- FS = ""
-}
-{
- line = $ 0
- nfields = split(line, field, "@")
- substed = 0
- len = length(field[1])
- for (i = 2; i < nfields; i++) {
- key = field[i]
- keylen = length(key)
- if (S_is_set[key]) {
- value = S[key]
- line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
- len += length(value) + length(field[++i])
- substed = 1
- } else
- len += 1 + keylen
- }
-
- print line
-}
-
-_ACAWK
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
-if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
- sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
-else
- cat
-fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \
- || as_fn_error "could not setup config files machinery" "$LINENO" 5
_ACEOF
-# VPATH may cause trouble with some makes, so we remove $(srcdir),
-# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
-# trailing colons and then remove the whole line if VPATH becomes empty
-# (actually we leave an empty line to preserve line numbers).
-if test "x$srcdir" = x.; then
- ac_vpsub='/^[ ]*VPATH[ ]*=/{
-s/:*\$(srcdir):*/:/
-s/:*\${srcdir}:*/:/
-s/:*@srcdir@:*/:/
-s/^\([^=]*=[ ]*\):*/\1/
-s/:*$//
-s/^[^=]*=[ ]*$//
-}'
-fi
-
-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
-fi # test -n "$CONFIG_FILES"
+cat >>$CONFIG_STATUS <<_ACEOF
+#
+# CONFIG_FILES section.
+#
-eval set X " :F $CONFIG_FILES "
-shift
-for ac_tag
-do
- case $ac_tag in
- :[FHLC]) ac_mode=$ac_tag; continue;;
- esac
- case $ac_mode$ac_tag in
- :[FHL]*:*);;
- :L* | :C*:*) as_fn_error "invalid tag \`$ac_tag'" "$LINENO" 5;;
- :[FH]-) ac_tag=-:-;;
- :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
- esac
- ac_save_IFS=$IFS
- IFS=:
- set x $ac_tag
- IFS=$ac_save_IFS
- shift
- ac_file=$1
- shift
+# No need to generate the scripts if there are no CONFIG_FILES.
+# This happens for instance when ./config.status config.h
+if test -n "\$CONFIG_FILES"; then
+ # Protect against being on the right side of a sed subst in config.status.
+ sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
+ s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
+s,@SHELL@,$SHELL,;t t
+s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
+s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t
+s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
+s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
+s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t
+s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
+s,@exec_prefix@,$exec_prefix,;t t
+s,@prefix@,$prefix,;t t
+s,@program_transform_name@,$program_transform_name,;t t
+s,@bindir@,$bindir,;t t
+s,@sbindir@,$sbindir,;t t
+s,@libexecdir@,$libexecdir,;t t
+s,@datadir@,$datadir,;t t
+s,@sysconfdir@,$sysconfdir,;t t
+s,@sharedstatedir@,$sharedstatedir,;t t
+s,@localstatedir@,$localstatedir,;t t
+s,@libdir@,$libdir,;t t
+s,@includedir@,$includedir,;t t
+s,@oldincludedir@,$oldincludedir,;t t
+s,@infodir@,$infodir,;t t
+s,@mandir@,$mandir,;t t
+s,@build_alias@,$build_alias,;t t
+s,@host_alias@,$host_alias,;t t
+s,@target_alias@,$target_alias,;t t
+s,@DEFS@,$DEFS,;t t
+s,@ECHO_C@,$ECHO_C,;t t
+s,@ECHO_N@,$ECHO_N,;t t
+s,@ECHO_T@,$ECHO_T,;t t
+s,@LIBS@,$LIBS,;t t
+s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t
+s,@CC@,$CC,;t t
+s,@TCL_VERSION@,$TCL_VERSION,;t t
+s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t
+s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t
+s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t
+s,@LIBOBJS@,$LIBOBJS,;t t
+s,@LTLIBOBJS@,$LTLIBOBJS,;t t
+CEOF
- case $ac_mode in
- :L) ac_source=$1;;
- :[FH])
- ac_file_inputs=
- for ac_f
- do
- case $ac_f in
- -) ac_f="$tmp/stdin";;
- *) # Look for the file first in the build tree, then in the source tree
- # (if the path is not absolute). The absolute path cannot be DOS-style,
- # because $ac_f cannot contain `:'.
- test -f "$ac_f" ||
- case $ac_f in
- [\\/$]*) false;;
- *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
- esac ||
- as_fn_error "cannot find input file: \`$ac_f'" "$LINENO" 5;;
- esac
- case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
- as_fn_append ac_file_inputs " '$ac_f'"
- done
+_ACEOF
- # Let's still pretend it is `configure' which instantiates (i.e., don't
- # use $as_me), people would be surprised to read:
- # /* config.h. Generated by config.status. */
- configure_input='Generated from '`
- $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
- `' by configure.'
- if test x"$ac_file" != x-; then
- configure_input="$ac_file. $configure_input"
- { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
-$as_echo "$as_me: creating $ac_file" >&6;}
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ # Split the substitutions into bite-sized pieces for seds with
+ # small command number limits, like on Digital OSF/1 and HP-UX.
+ ac_max_sed_lines=48
+ ac_sed_frag=1 # Number of current file.
+ ac_beg=1 # First line for current file.
+ ac_end=$ac_max_sed_lines # Line after last line for current file.
+ ac_more_lines=:
+ ac_sed_cmds=
+ while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
+ else
+ sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
fi
- # Neutralize special characters interpreted by sed in replacement strings.
- case $configure_input in #(
- *\&* | *\|* | *\\* )
- ac_sed_conf_input=`$as_echo "$configure_input" |
- sed 's/[\\\\&|]/\\\\&/g'`;; #(
- *) ac_sed_conf_input=$configure_input;;
- esac
+ if test ! -s $tmp/subs.frag; then
+ ac_more_lines=false
+ else
+ # The purpose of the label and of the branching condition is to
+ # speed up the sed processing (if there are no `@' at all, there
+ # is no need to browse any of the substitutions).
+ # These are the two extra sed commands mentioned above.
+ (echo ':t
+ /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
+ fi
+ ac_sed_frag=`expr $ac_sed_frag + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_lines`
+ fi
+ done
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+ fi
+fi # test -n "$CONFIG_FILES"
- case $ac_tag in
- *:-:* | *:-) cat >"$tmp/stdin" \
- || as_fn_error "could not create $ac_file" "$LINENO" 5 ;;
- esac
- ;;
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case $ac_file in
+ - | *:- | *:-:* ) # input from stdin
+ cat >$tmp/stdin
+ ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ * ) ac_file_in=$ac_file.in ;;
esac
- ac_dir=`$as_dirname -- "$ac_file" ||
+ # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
+ ac_dir=`(dirname "$ac_file") 2>/dev/null ||
$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$ac_file" : 'X\(//\)[^/]' \| \
X"$ac_file" : 'X\(//\)$' \| \
- X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
-$as_echo X"$ac_file" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
- s//\1/
- q
- }
- /^X\(\/\/\)[^/].*/{
- s//\1/
- q
- }
- /^X\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'`
- as_dir="$ac_dir"; as_fn_mkdir_p
+ X"$ac_file" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$ac_file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ { if $as_mkdir_p; then
+ mkdir -p "$ac_dir"
+ else
+ as_dir="$ac_dir"
+ as_dirs=
+ while test ! -d "$as_dir"; do
+ as_dirs="$as_dir $as_dirs"
+ as_dir=`(dirname "$as_dir") 2>/dev/null ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ done
+ test ! -n "$as_dirs" || mkdir $as_dirs
+ fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
+echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
+ { (exit 1); exit 1; }; }; }
+
ac_builddir=.
-case "$ac_dir" in
-.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
-*)
- ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
- # A ".." for each directory in $ac_dir_suffix.
- ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
- case $ac_top_builddir_sub in
- "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
- *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
- esac ;;
-esac
-ac_abs_top_builddir=$ac_pwd
-ac_abs_builddir=$ac_pwd$ac_dir_suffix
-# for backward compatibility:
-ac_top_builddir=$ac_top_build_prefix
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
case $srcdir in
- .) # We are building in place.
+ .) # No --srcdir option. We are building in place.
ac_srcdir=.
- ac_top_srcdir=$ac_top_builddir_sub
- ac_abs_top_srcdir=$ac_pwd ;;
- [\\/]* | ?:[\\/]* ) # Absolute name.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir
- ac_abs_top_srcdir=$srcdir ;;
- *) # Relative name.
- ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_build_prefix$srcdir
- ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
esac
-ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+# Do not use `cd foo && pwd` to compute absolute paths, because
+# the directories may not exist.
+case `pwd` in
+.) ac_abs_builddir="$ac_dir";;
+*)
+ case "$ac_dir" in
+ .) ac_abs_builddir=`pwd`;;
+ [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+ *) ac_abs_builddir=`pwd`/"$ac_dir";;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_builddir=${ac_top_builddir}.;;
+*)
+ case ${ac_top_builddir}. in
+ .) ac_abs_top_builddir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_srcdir=$ac_srcdir;;
+*)
+ case $ac_srcdir in
+ .) ac_abs_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+ *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_srcdir=$ac_top_srcdir;;
+*)
+ case $ac_top_srcdir in
+ .) ac_abs_top_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+ esac;;
+esac
- case $ac_mode in
- :F)
- #
- # CONFIG_FILE
- #
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
-# If the template does not know about datarootdir, expand it.
-# FIXME: This hack should be removed a few years after 2.60.
-ac_datarootdir_hack=; ac_datarootdir_seen=
-ac_sed_dataroot='
-/datarootdir/ {
- p
- q
-}
-/@datadir@/p
-/@docdir@/p
-/@infodir@/p
-/@localedir@/p
-/@mandir@/p'
-case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
-*datarootdir*) ac_datarootdir_seen=yes;;
-*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
-$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
-_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
- ac_datarootdir_hack='
- s&@datadir@&$datadir&g
- s&@docdir@&$docdir&g
- s&@infodir@&$infodir&g
- s&@localedir@&$localedir&g
- s&@mandir@&$mandir&g
- s&\\\${datarootdir}&$datarootdir&g' ;;
-esac
+ if test x"$ac_file" != x-; then
+ { echo "$as_me:$LINENO: creating $ac_file" >&5
+echo "$as_me: creating $ac_file" >&6;}
+ rm -f "$ac_file"
+ fi
+ # Let's still pretend it is `configure' which instantiates (i.e., don't
+ # use $as_me), people would be surprised to read:
+ # /* config.h. Generated by config.status. */
+ if test x"$ac_file" = x-; then
+ configure_input=
+ else
+ configure_input="$ac_file. "
+ fi
+ configure_input=$configure_input"Generated from `echo $ac_file_in |
+ sed 's,.*/,,'` by configure."
+
+ # First look for the input files in the build tree, otherwise in the
+ # src tree.
+ ac_file_inputs=`IFS=:
+ for f in $ac_file_in; do
+ case $f in
+ -) echo $tmp/stdin ;;
+ [\\/$]*)
+ # Absolute (can't be DOS-style, as IFS=:)
+ test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ echo "$f";;
+ *) # Relative
+ if test -f "$f"; then
+ # Build tree
+ echo "$f"
+ elif test -f "$srcdir/$f"; then
+ # Source tree
+ echo "$srcdir/$f"
+ else
+ # /dev/null tree
+ { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ fi;;
+ esac
+ done` || { (exit 1); exit 1; }
_ACEOF
-
-# Neutralize VPATH when `$srcdir' = `.'.
-# Shell code in configure.ac might set extrasub.
-# FIXME: do we really want to maintain this feature?
-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
-ac_sed_extra="$ac_vpsub
+cat >>$CONFIG_STATUS <<_ACEOF
+ sed "$ac_vpsub
$extrasub
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+cat >>$CONFIG_STATUS <<\_ACEOF
:t
/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
-s|@configure_input@|$ac_sed_conf_input|;t t
-s&@top_builddir@&$ac_top_builddir_sub&;t t
-s&@top_build_prefix@&$ac_top_build_prefix&;t t
-s&@srcdir@&$ac_srcdir&;t t
-s&@abs_srcdir@&$ac_abs_srcdir&;t t
-s&@top_srcdir@&$ac_top_srcdir&;t t
-s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
-s&@builddir@&$ac_builddir&;t t
-s&@abs_builddir@&$ac_abs_builddir&;t t
-s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
-$ac_datarootdir_hack
-"
-eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \
- || as_fn_error "could not create $ac_file" "$LINENO" 5
-
-test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
- { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } &&
- { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } &&
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
-which seems to be undefined. Please make sure it is defined." >&5
-$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
-which seems to be undefined. Please make sure it is defined." >&2;}
-
- rm -f "$tmp/stdin"
- case $ac_file in
- -) cat "$tmp/out" && rm -f "$tmp/out";;
- *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";;
- esac \
- || as_fn_error "could not create $ac_file" "$LINENO" 5
- ;;
-
-
-
- esac
+s,@configure_input@,$configure_input,;t t
+s,@srcdir@,$ac_srcdir,;t t
+s,@abs_srcdir@,$ac_abs_srcdir,;t t
+s,@top_srcdir@,$ac_top_srcdir,;t t
+s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
+s,@builddir@,$ac_builddir,;t t
+s,@abs_builddir@,$ac_abs_builddir,;t t
+s,@top_builddir@,$ac_top_builddir,;t t
+s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
+" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
+ rm -f $tmp/stdin
+ if test x"$ac_file" != x-; then
+ mv $tmp/out $ac_file
+ else
+ cat $tmp/out
+ rm -f $tmp/out
+ fi
-done # for ac_tag
+done
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
-as_fn_exit 0
+{ (exit 0); exit 0; }
_ACEOF
+chmod +x $CONFIG_STATUS
ac_clean_files=$ac_clean_files_save
-test $ac_write_fail = 0 ||
- as_fn_error "write failure creating $CONFIG_STATUS" "$LINENO" 5
-
# configure is writing to config.log, and then calls config.status.
# config.status does its own redirection, appending to config.log.
@@ -2815,10 +2165,6 @@ if test "$no_create" != yes; then
exec 5>>config.log
# Use ||, not &&, to avoid exiting from the if with $? = 1, which
# would make configure fail if this is the last instruction.
- $ac_cs_success || as_fn_exit $?
-fi
-if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
-$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
+ $ac_cs_success || { (exit 1); exit 1; }
fi
diff --git a/tools/configure.in b/tools/configure.in
index 7585c64..6aebcaa 100644
--- a/tools/configure.in
+++ b/tools/configure.in
@@ -3,7 +3,6 @@ dnl generate the file "configure", which is run to configure the
dnl Makefile in this directory.
AC_INIT(man2tcl.c)
AC_PREREQ(2.59)
-# RCS: @(#) $Id: configure.in,v 1.12 2010/06/09 13:51:51 nijtmans Exp $
# Recover information that Tcl computed with its configure script.
diff --git a/tools/encoding/big5.txt b/tools/encoding/big5.txt
index 33e5226..5cc9e81 100644
--- a/tools/encoding/big5.txt
+++ b/tools/encoding/big5.txt
@@ -7,8 +7,6 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: big5.txt,v 1.2 1999/04/16 00:47:43 stanton Exp $
-#
# NOTE: this table has been modified to include the 7-bit ASCII
# characters that are allowed in BIG5 files.
#
diff --git a/tools/encoding/gb2312.txt b/tools/encoding/gb2312.txt
index b9a1629..fc9f6f0 100644
--- a/tools/encoding/gb2312.txt
+++ b/tools/encoding/gb2312.txt
@@ -7,8 +7,6 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: gb2312.txt,v 1.2 1999/04/16 00:47:55 stanton Exp $
-#
# NOTE: this table has been modified to include the 7-bit ASCII
# characters that are allowed in GB2312 files.
#
diff --git a/tools/findBadExternals.tcl b/tools/findBadExternals.tcl
index 6696801..7592f17 100755
--- a/tools/findBadExternals.tcl
+++ b/tools/findBadExternals.tcl
@@ -14,9 +14,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: findBadExternals.tcl,v 1.1 2005/11/04 19:37:57 kennykb Exp $
-#
#----------------------------------------------------------------------
proc main {argc argv} {
diff --git a/tools/fix_tommath_h.tcl b/tools/fix_tommath_h.tcl
index d621192..04bf857 100755
--- a/tools/fix_tommath_h.tcl
+++ b/tools/fix_tommath_h.tcl
@@ -7,9 +7,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: fix_tommath_h.tcl,v 1.8 2010/07/01 21:28:15 nijtmans Exp $
-#
#----------------------------------------------------------------------
set f [open [lindex $argv 0] r]
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 3e896a1..93e0a9a 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -9,8 +9,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: genStubs.tcl,v 1.44 2010/09/15 07:33:56 nijtmans Exp $
package require Tcl 8.4
@@ -281,18 +279,26 @@ proc genStubs::rewriteFile {file text} {
# Results:
# Returns the original text inside an appropriate #ifdef.
-proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
+proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} {
set text ""
switch $plat {
win {
- append text "#ifdef __WIN32__ /* WIN */\n${iftxt}"
+ append text "#if defined(__WIN32__)"
+ if {$withCygwin} {
+ append text " || defined(__CYGWIN__)"
+ }
+ append text " /* WIN */\n${iftxt}"
if {$eltxt ne ""} {
append text "#else /* WIN */\n${eltxt}"
}
append text "#endif /* WIN */\n"
}
unix {
- append text "#if !defined(__WIN32__) && !defined(MAC_OSX_TCL)\
+ append text "#if !defined(__WIN32__)"
+ if {$withCygwin} {
+ append text " && !defined(__CYGWIN__)"
+ }
+ append text " && !defined(MAC_OSX_TCL)\
/* UNIX */\n${iftxt}"
if {$eltxt ne ""} {
append text "#else /* UNIX */\n${eltxt}"
@@ -314,7 +320,11 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
append text "#endif /* AQUA */\n"
}
x11 {
- append text "#if !(defined(__WIN32__) || defined(MAC_OSX_TK))\
+ append text "#if !(defined(__WIN32__)"
+ if {$withCygwin} {
+ append text " || defined(__CYGWIN__)"
+ }
+ append text " || defined(MAC_OSX_TK))\
/* X11 */\n${iftxt}"
if {$eltxt ne ""} {
append text "#else /* X11 */\n${eltxt}"
@@ -491,6 +501,9 @@ proc genStubs::makeDecl {name decl index} {
set sep ", "
}
append line ", ...)"
+ if {[lindex $args end] eq "{const char *} format"} {
+ append line " TCL_FORMAT_PRINTF(" [expr [llength $args] - 1] ", " [llength $args] ")"
+ }
}
default {
set sep "("
@@ -567,8 +580,8 @@ proc genStubs::makeSlot {name decl index} {
append text $rtype " *" $lfname "; /* $index */\n"
return $text
}
- if {[string range $rtype end-7 end] eq "CALLBACK"} {
- append text [string trim [string range $rtype 0 end-8]] " (CALLBACK *" $lfname ") "
+ if {[string range $rtype end-8 end] eq "__stdcall"} {
+ append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "
} else {
append text $rtype " (*" $lfname ") "
}
@@ -588,6 +601,9 @@ proc genStubs::makeSlot {name decl index} {
set sep ", "
}
append text ", ...)"
+ if {[lindex $args end] eq "{const char *} format"} {
+ append text " TCL_FORMAT_PRINTF(" [expr [llength $args] - 1] ", " [llength $args] ")"
+ }
}
default {
set sep "("
@@ -795,7 +811,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
eval {append temp} $skipString
}
}
- append text [addPlatformGuard $plat $temp]
+ append text [addPlatformGuard $plat $temp {} true]
}
## win ##
if {$block(win)} {
@@ -809,10 +825,10 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
eval {append temp} $skipString
}
}
- append text [addPlatformGuard $plat $temp]
+ append text [addPlatformGuard $plat $temp {} true]
}
## macosx ##
- if {$block(macosx) && !$block(aqua) && !$block(x11)} {
+ if {($block(unix) || $block(macosx)) && !$block(aqua) && !$block(x11)} {
set temp {}
set lastNum -1
foreach plat {unix macosx} {
@@ -881,7 +897,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
} else {
eval {set etxt} $skipString
append temp [addPlatformGuard $plat [$slotProc \
- $name $stubs($name,$plat,$i) $i] $etxt]
+ $name $stubs($name,$plat,$i) $i] $etxt true]
}
set emit 1
break
@@ -891,7 +907,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
eval {append temp} $skipString
}
}
- append text [addPlatformGuard x11 $temp]
+ append text [addPlatformGuard x11 $temp {} true]
}
}
}
@@ -970,7 +986,7 @@ proc genStubs::emitHeader {name} {
emitDeclarations $name text
if {[info exists hooks($name)]} {
- append text "\ntypedef struct ${capName}StubHooks {\n"
+ append text "\ntypedef struct {\n"
foreach hook $hooks($name) {
set capHook [string toupper [string index $hook 0]]
append capHook [string range $hook 1 end]
@@ -984,7 +1000,11 @@ proc genStubs::emitHeader {name} {
append text " int epoch;\n"
append text " int revision;\n"
}
- append text " const struct ${capName}StubHooks *hooks;\n\n"
+ if {[info exists hooks($name)]} {
+ append text " const ${capName}StubHooks *hooks;\n\n"
+ } else {
+ append text " void *hooks;\n\n"
+ }
emitSlots $name text
diff --git a/tools/index.tcl b/tools/index.tcl
index 2e52d60..71329c2 100644
--- a/tools/index.tcl
+++ b/tools/index.tcl
@@ -8,9 +8,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: index.tcl,v 1.6 2010/07/01 21:28:15 nijtmans Exp $
-#
# Global variables used by these scripts:
#
diff --git a/tools/installData.tcl b/tools/installData.tcl
index 8f6bc2d..4b43f1e 100644
--- a/tools/installData.tcl
+++ b/tools/installData.tcl
@@ -15,9 +15,6 @@ exec tclsh "$0" ${1+"$@"}
# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: installData.tcl,v 1.3 2010/05/21 12:11:59 nijtmans Exp $
-#
#----------------------------------------------------------------------
proc copyDir {d1 d2} {
diff --git a/tools/loadICU.tcl b/tools/loadICU.tcl
index 8bf0d72..5b09e2c 100755
--- a/tools/loadICU.tcl
+++ b/tools/loadICU.tcl
@@ -25,9 +25,6 @@
# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: loadICU.tcl,v 1.4 2010/06/16 10:31:15 nijtmans Exp $
-#
#----------------------------------------------------------------------
# Calculate the Chinese numerals from zero to ninety-nine.
diff --git a/tools/man2help.tcl b/tools/man2help.tcl
index ba2a545..018fa84 100644
--- a/tools/man2help.tcl
+++ b/tools/man2help.tcl
@@ -5,9 +5,6 @@
# entries.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
-#
-# RCS: @(#) $Id: man2help.tcl,v 1.16 2007/12/13 15:28:40 dgp Exp $
-#
#
# PASS 1
diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl
index 34d6416..fe4e7ad 100644
--- a/tools/man2help2.tcl
+++ b/tools/man2help2.tcl
@@ -8,9 +8,6 @@
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: man2help2.tcl,v 1.21 2010/07/01 21:28:15 nijtmans Exp $
-#
# Global variables used by these scripts:
#
diff --git a/tools/man2html.tcl b/tools/man2html.tcl
index 386396f..fa57b03 100644
--- a/tools/man2html.tcl
+++ b/tools/man2html.tcl
@@ -10,9 +10,6 @@ package require Tcl 8.4
# man2tcl program to generate a HTML files from Tcl manual entries.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
-#
-# SCCS: @(#) man2html.tcl 1.5 96/04/11 20:21:43
-#
# sarray -
diff --git a/tools/man2html1.tcl b/tools/man2html1.tcl
index 59dc396..f2b2e43 100644
--- a/tools/man2html1.tcl
+++ b/tools/man2html1.tcl
@@ -4,9 +4,6 @@
# man page to html conversion process. It is sourced by h.tcl.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
-#
-# SCCS: @(#) man2html1.tcl 1.2 96/03/21 10:48:29
-#
package require Tcl 8.4
diff --git a/tools/man2html2.tcl b/tools/man2html2.tcl
index 057c7c8..163196e 100644
--- a/tools/man2html2.tcl
+++ b/tools/man2html2.tcl
@@ -5,9 +5,6 @@
# page to html conversion process. It is sourced by man2html.tcl.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
-#
-# $Id: man2html2.tcl,v 1.13 2007/12/13 15:28:40 dgp Exp $
-#
package require Tcl 8.4
diff --git a/tools/man2tcl.c b/tools/man2tcl.c
index 3169177..8e59bea 100644
--- a/tools/man2tcl.c
+++ b/tools/man2tcl.c
@@ -14,8 +14,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: man2tcl.c,v 1.17 2008/10/24 00:40:08 patthoyts Exp $
*/
static char sccsid[] = "@(#) man2tcl.c 1.3 95/08/12 17:34:08";
diff --git a/tools/mkdepend.tcl b/tools/mkdepend.tcl
index e43b2b6..de5fdba 100644
--- a/tools/mkdepend.tcl
+++ b/tools/mkdepend.tcl
@@ -25,9 +25,6 @@
# Modified heavily by David Gravereaux <davygrvy@pobox.com> about 9/17/2006.
# Original can be found @
# http://web.archive.org/web/20070616205924/http://www.doc.ic.ac.uk/~np2/software/mkdepend.html
-#
-#==============================================================================
-# RCS: @(#) $Id: mkdepend.tcl,v 1.6 2007/12/13 15:28:40 dgp Exp $
#==============================================================================
array set mode_data {}
diff --git a/tools/regexpTestLib.tcl b/tools/regexpTestLib.tcl
index b57a71e..d84a012 100644
--- a/tools/regexpTestLib.tcl
+++ b/tools/regexpTestLib.tcl
@@ -5,9 +5,6 @@
# Spencer's test suite to tcl test files.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
-#
-# SCCS: @(#) regexpTestLib.tcl 1.4 98/01/22 14:48:34
-#
proc readInputFile {} {
global inFileName
diff --git a/tools/str2c b/tools/str2c
index c151c0f..cff7ba2 100644
--- a/tools/str2c
+++ b/tools/str2c
@@ -4,8 +4,6 @@
#
# 1997/10 -- dl
#
-# $Id: str2c,v 1.3 2009/03/25 23:22:37 nijtmans Exp $
-#
# restart with tclsh \
exec tclsh "$0" ${1+"$@"}
@@ -38,7 +36,7 @@ static char data\[\]=\"[translate $r]\";"
puts "/*
* Multi parts read only string generated by str2c
*/
-static CONST char * CONST data\[\]= {"
+static const char * const data\[\]= {"
set n 1
for {set i 0} {$i<$lg} {incr i $MAX} {
set part [string range $r $i [expr $i+$MAX-1]]
@@ -50,7 +48,7 @@ static CONST char * CONST data\[\]= {"
}
puts "\tNULL\t/* End of data marker */\n};"
puts "\n/* use for instance with:
- CONST char * CONST *chunk;
+ const char * const *chunk;
for (chunk=data; *chunk; chunk++) {
Tcl_AppendResult(interp, *chunk, (char *) NULL);
}
diff --git a/tools/tcl.wse.in b/tools/tcl.wse.in
deleted file mode 100644
index e2a636d..0000000
--- a/tools/tcl.wse.in
+++ /dev/null
@@ -1,2376 +0,0 @@
-Document Type: WSE
-item: Global
- Version=6.01
- Title=Tcl 8.6 for Windows Installation
- Flags=00010100
- Languages=65 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
- Japanese Font Name=MS Gothic
- Japanese Font Size=10
- Start Gradient=0 0 255
- End Gradient=0 0 0
- Windows Flags=00000000000000010010110000001000
- Log Pathname=%MAINDIR%\INSTALL.LOG
- Message Font=MS Sans Serif
- Font Size=8
- Disk Label=tcl8.6b1
- Disk Filename=setup
- Patch Flags=0000000000000001
- Patch Threshold=85
- Patch Memory=4000
- Variable Name1=_SYS_
- Variable Default1=C:\WINDOWS\SYSTEM
- Variable Flags1=00001000
- Variable Name2=_ODBC16_
- Variable Default2=C:\WINDOWS\SYSTEM
- Variable Flags2=00001000
- Variable Name3=_WISE_
- Variable Default3=${__WISE__}
- Variable Flags3=00001000
-end
-item: Open/Close INSTALL.LOG
- Flags=00000001
-end
-item: Check if File/Dir Exists
- Pathname=%SYS%
- Flags=10000100
-end
-item: Set Variable
- Variable=SYS
- Value=%WIN%
-end
-item: End Block
-end
-item: Set Variable
- Variable=VER
- Value=8.6
-end
-item: Set Variable
- Variable=PATCHLEVEL
- Value=${__TCL_PATCH_LEVEL__}
-end
-item: Set Variable
- Variable=APPTITLE
- Value=Tcl/Tk %PATCHLEVEL% for Windows
-end
-item: Set Variable
- Variable=URL
- Value=http://www.tcl.tk/
-end
-item: Set Variable
- Variable=GROUP
- Value=Tcl
-end
-item: Set Variable
- Variable=DISABLED
- Value=!
-end
-item: Set Variable
- Variable=MAINDIR
- Value=Tcl
-end
-item: Check Configuration
- Flags=10111011
-end
-item: Get Registry Key Value
- Variable=PROGRAM_FILES
- Key=SOFTWARE\Microsoft\Windows\CurrentVersion
- Default=C:\Program Files
- Value Name=ProgramFilesDir
- Flags=00000100
-end
-item: Set Variable
- Variable=MAINDIR
- Value=%PROGRAM_FILES%\%MAINDIR%
-end
-item: Set Variable
- Variable=EXPLORER
- Value=1
-end
-item: Else Statement
-end
-item: Set Variable
- Variable=MAINDIR
- Value=C:\%MAINDIR%
-end
-item: End Block
-end
-item: Set Variable
- Variable=BACKUP
- Value=%MAINDIR%\BACKUP
-end
-item: Set Variable
- Variable=DOBACKUP
- Value=B
-end
-item: Set Variable
- Variable=BRANDING
- Value=0
-end
-remarked item: If/While Statement
- Variable=BRANDING
- Value=1
-end
-remarked item: Read INI Value
- Variable=NAME
- Pathname=%INST%\CUSTDATA.INI
- Section=Registration
- Item=Name
-end
-remarked item: Read INI Value
- Variable=COMPANY
- Pathname=%INST%\CUSTDATA.INI
- Section=Registration
- Item=Company
-end
-remarked item: If/While Statement
- Variable=NAME
-end
-remarked item: Set Variable
- Variable=DOBRAND
- Value=1
-end
-remarked item: End Block
-end
-remarked item: End Block
-end
-item: Set Variable
- Variable=TYPE
- Value=C
-end
-item: Set Variable
- Variable=COMPONENTS
- Value=ABC
-end
-item: Wizard Block
- Direction Variable=DIRECTION
- Display Variable=DISPLAY
- X Position=0
- Y Position=0
- Filler Color=8421440
- Flags=00000001
-end
-item: Custom Dialog Set
- Name=Splash
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Bienvenue
- Title German=Willkommen
- Title Portuguese=Bem-vindo
- Title Spanish=Bienvenido
- Title Italian=Benvenuto
- Title Danish=Velkommen
- Title Dutch=Welkom
- Title Norwegian=Velkommen
- Title Swedish=Välkommen
- Width=273
- Height=250
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=166 214 208 228
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- end
- item: Push Button
- Rectangle=212 214 254 228
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=Cancel
- end
- item: Static
- Rectangle=0 0 268 233
- Action=2
- Enabled Color=00000000000000001111111111111111
- Create Flags=01010000000000000000000000001011
- Pathname=${__TCLBASEDIR__}\tools\white.bmp
- end
- item: Static
- Rectangle=5 5 268 215
- Destination Dialog=1
- Action=2
- Enabled Color=00000000000000001111111111111111
- Create Flags=01010000000000000000000000001011
- Pathname=${__TCLBASEDIR__}\tools\tclSplash.bmp
- end
- end
-end
-item: End Block
-end
-item: Wizard Block
- Direction Variable=DIRECTION
- Display Variable=DISPLAY
- Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP
- X Position=9
- Y Position=10
- Filler Color=8421440
- Dialog=Welcome
- Dialog=Select Destination Directory
- Dialog=Select Installation Type
- Dialog=Select Components
- Dialog=Select Program Manager Group
- Variable=
- Variable=
- Variable=
- Variable=TYPE
- Variable=EXPLORER
- Value=
- Value=
- Value=
- Value=C
- Value=1
- Compare=0
- Compare=0
- Compare=0
- Compare=1
- Compare=0
- Flags=00000011
-end
-item: Custom Dialog Set
- Name=Welcome
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Welcome!
- Text French=Bienvenue !
- Text German=Willkommen!
- Text Spanish=¡Bienvenido!
- Text Italian=Benvenuti!
- end
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- Text French=&Suite >
- Text German=&Weiter >
- Text Spanish=&Siguiente >
- Text Italian=&Avanti >
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DISABLED
- Value=!
- Create Flags=01010000000000010000000000000000
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=85 41 255 130
- Create Flags=01010000000000000000000000000000
- Text=This installation program will install %APPTITLE%.
- Text=
- Text=Press the Next button to start the installation. You can press the Exit Setup button now if you do not want to install %APPTITLE% at this time.
- Text=
- Text=It is strongly recommended that you exit all Windows programs before running this installation program.
- Text French=Ce programme d'installation va installer %APPTITLE%.
- Text French=
- Text French=Cliquez sur le bouton Suite pour démarrer l'installation. Vous pouvez cliquer sur le bouton Quitter l'installation si vous ne voulez pas installer %APPTITLE% tout de suite.
- Text German=Mit diesem Installationsprogramm wird %APPTITLE% installiert.
- Text German=
- Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Abbrechen", um die Installation von %APPTITLE% abzubrechen.
- Text Spanish=Este programa de instalación instalará %APPTITLE%.
- Text Spanish=
- Text Spanish=Presione el botón Siguiente para iniciar la instalación. Puede presionar el botón Salir de instalación si no desea instalar %APPTITLE% en este momento.
- Text Italian=Questo programma installerà %APPTITLE%.
- Text Italian=
- Text Italian=Per avvviare l'installazione premere il pulsante Avanti. Se non si desidera installare %APPTITLE% ora, premere il pulsante Esci dall'installazione.
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- end
-end
-item: Custom Dialog Set
- Name=Select Destination Directory
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- Text French=&Suite >
- Text German=&Weiter >
- Text Spanish=&Siguiente >
- Text Italian=&Avanti >
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DIRECTION
- Value=B
- Create Flags=01010000000000010000000000000000
- Flags=0000000000000001
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Select Destination Directory
- Text French=Sélectionner le répertoire de destination
- Text German=Zielverzeichnis wählen
- Text Spanish=Seleccione el directorio de destino
- Text Italian=Selezionare Directory di destinazione
- end
- item: Static
- Rectangle=86 39 256 114
- Create Flags=01010000000000000000000000000000
- Text=Please select the directory where the %APPTITLE% files are to be installed.
- Text=
- Text=To install in the default directory below, click Next.
- Text=
- Text=To install in a different directory, click Browse and select another directory.
- Text French=Veuillez sélectionner le répertoire dans lequel les fichiers %APPTITLE% doivent être installés.
- Text German=Geben Sie an, in welchem Verzeichnis die %APPTITLE%-Dateien installiert werden sollen.
- Text Spanish=Por favor seleccione el directorio donde desee instalar los archivos de %APPTITLE%.
- Text Italian=Selezionare la directory dove verranno installati i file %APPTITLE%.
- end
- item: Static
- Rectangle=86 130 256 157
- Action=1
- Create Flags=01010000000000000000000000000111
- end
- item: Push Button
- Rectangle=205 138 250 153
- Variable=MAINDIR_SAVE
- Value=%MAINDIR%
- Destination Dialog=1
- Action=2
- Create Flags=01010000000000010000000000000000
- Text=Browse
- Text French=Parcourir
- Text German=Durchsuchen
- Text Spanish=Buscar
- Text Italian=Sfoglie
- end
- item: Static
- Rectangle=91 140 198 151
- Create Flags=01010000000000000000000000000000
- Text=%MAINDIR%
- Text French=%MAINDIR%
- Text German=%MAINDIR%
- Text Spanish=%MAINDIR%
- Text Italian=%MAINDIR%
- end
- end
- item: Dialog
- Title=Select Destination Directory
- Title French=Sélectionner le répertoire de destination
- Title German=Zielverzeichnis wählen
- Title Spanish=Seleccione el directorio de destino
- Title Italian=Selezionare Directory di destinazione
- Width=221
- Height=173
- Font Name=Helv
- Font Size=8
- item: Listbox
- Rectangle=5 5 163 149
- Variable=MAINDIR
- Create Flags=01010000100000010000000101000000
- Flags=0000110000100010
- Text=%MAINDIR%
- Text French=%MAINDIR%
- Text German=%MAINDIR%
- Text Spanish=%MAINDIR%
- Text Italian=%MAINDIR%
- end
- item: Push Button
- Rectangle=167 6 212 21
- Create Flags=01010000000000010000000000000001
- Text=OK
- Text French=OK
- Text German=OK
- Text Spanish=Aceptar
- Text Italian=OK
- end
- item: Push Button
- Rectangle=167 25 212 40
- Variable=MAINDIR
- Value=%MAINDIR_SAVE%
- Create Flags=01010000000000010000000000000000
- Flags=0000000000000001
- Text=Cancel
- Text French=Annuler
- Text German=Abbrechen
- Text Spanish=Cancelar
- Text Italian=Annulla
- end
- end
-end
-remarked item: Custom Dialog Set
- Name=Select Installation Type
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- Text French=&Suite >
- Text German=&Weiter >
- Text Spanish=&Siguiente >
- Text Italian=&Avanti >
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DIRECTION
- Value=B
- Create Flags=01010000000000010000000000000000
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Select Installation Type
- Text French=Sélectionner les composants
- Text German=Komponenten auswählen
- Text Spanish=Seleccione componentes
- Text Italian=Selezionare i componenti
- end
- item: Static
- Rectangle=194 162 242 172
- Variable=COMPONENTS
- Value=MAINDIR
- Create Flags=01010000000000000000000000000010
- end
- item: Static
- Rectangle=194 153 242 162
- Variable=COMPONENTS
- Create Flags=01010000000000000000000000000010
- end
- item: Static
- Rectangle=107 153 196 164
- Create Flags=01010000000000000000000000000000
- Text=Disk Space Required:
- Text French=Espace disque requis :
- Text German=Notwendiger Speicherplatz:
- Text Spanish=Espacio requerido en el disco:
- Text Italian=Spazio su disco necessario:
- end
- item: Static
- Rectangle=107 162 196 172
- Create Flags=01010000000000000000000000000000
- Text=Disk Space Remaining:
- Text French=Espace disque disponible :
- Text German=Verbleibender Speicherplatz:
- Text Spanish=Espacio en disco disponible:
- Text Italian=Spazio su disco disponibile:
- end
- item: Static
- Rectangle=86 145 256 175
- Action=1
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 42 256 61
- Create Flags=01010000000000000000000000000000
- Text=Choose which type of installation to perform by selecting one of the buttons below.
- Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous.
- Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken.
- Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo.
- Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti.
- end
- item: Radio Button
- Rectangle=86 74 256 128
- Variable=TYPE
- Create Flags=01010000000000010000000000001001
- Text=&Full Installation (Recommended)
- Text=&Minimal Installation
- Text=C&ustom Installation
- Text=
- end
- end
-end
-item: Custom Dialog Set
- Name=Select Components
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- Text French=&Suite >
- Text German=&Weiter >
- Text Spanish=&Siguiente >
- Text Italian=&Avanti >
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DIRECTION
- Value=B
- Create Flags=01010000000000010000000000000000
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Select Components
- Text French=Sélectionner les composants
- Text German=Komponenten auswählen
- Text Spanish=Seleccione componentes
- Text Italian=Selezionare i componenti
- end
- item: Checkbox
- Rectangle=86 75 256 129
- Variable=COMPONENTS
- Create Flags=01010000000000010000000000000011
- Flags=0000000000000110
- Text=Tcl Run-Time Files
- Text=Example Scripts
- Text=Help Files
- Text=Header and Library Files
- Text=
- Text French=Tcl Run-Time Files
- Text French=Example Scripts
- Text French=Help Files
- Text French=Header and Library Files
- Text French=
- Text German=Tcl Run-Time Files
- Text German=Example Scripts
- Text German=Help Files
- Text German=Header and Library Files
- Text German=
- Text Spanish=Tcl Run-Time Files
- Text Spanish=Example Scripts
- Text Spanish=Help Files
- Text Spanish=Header and Library Files
- Text Spanish=
- Text Italian=Tcl Run-Time Files
- Text Italian=Example Scripts
- Text Italian=Help Files
- Text Italian=Header and Library Files
- Text Italian=
- end
- item: Static
- Rectangle=194 162 242 172
- Variable=COMPONENTS
- Value=MAINDIR
- Create Flags=01010000000000000000000000000010
- end
- item: Static
- Rectangle=194 153 242 162
- Variable=COMPONENTS
- Create Flags=01010000000000000000000000000010
- end
- item: Static
- Rectangle=107 153 196 164
- Create Flags=01010000000000000000000000000000
- Text=Disk Space Required:
- Text French=Espace disque requis :
- Text German=Notwendiger Speicherplatz:
- Text Spanish=Espacio requerido en el disco:
- Text Italian=Spazio su disco necessario:
- end
- item: Static
- Rectangle=107 162 196 172
- Create Flags=01010000000000000000000000000000
- Text=Disk Space Remaining:
- Text French=Espace disque disponible :
- Text German=Verbleibender Speicherplatz:
- Text Spanish=Espacio en disco disponible:
- Text Italian=Spazio su disco disponibile:
- end
- item: Static
- Rectangle=86 145 256 175
- Action=1
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 42 256 61
- Create Flags=01010000000000000000000000000000
- Text=Choose which components to install by checking the boxes below.
- Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous.
- Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken.
- Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo.
- Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti.
- end
- end
-end
-item: Custom Dialog Set
- Name=Select Program Manager Group
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- Text French=&Suite >
- Text German=&Weiter >
- Text Spanish=&Siguiente >
- Text Italian=&Avanti >
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DIRECTION
- Value=B
- Create Flags=01010000000000010000000000000000
- Flags=0000000000000001
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Select ProgMan Group
- Text French=Sélectionner le groupe du Gestionnaire de programme
- Text German=Bestimmung der Programm-Managergruppe
- Text Spanish=Seleccione grupo del Administrador de programas
- Text Italian=Selezionare il gruppo ProgMan
- end
- item: Static
- Rectangle=86 44 256 68
- Create Flags=01010000000000000000000000000000
- Text=Enter the name of the Program Manager group to add the %APPTITLE% icons to:
- Text French=Entrez le nom du groupe du Gestionnaire de programme dans lequel vous souhaitez ajouter les icônes de %APPTITLE% :
- Text German=Geben Sie den Namen der Programmgruppe ein, der das Symbol %APPTITLE% hinzugefügt werden soll:
- Text Spanish=Escriba el nombre del grupo del Administrador de programas en el que desea agregar los iconos de %APPTITLE%:
- Text Italian=Inserire il nome del gruppo Program Manager per aggiungere le icone %APPTITLE% a:
- end
- item: Combobox
- Rectangle=86 69 256 175
- Variable=GROUP
- Create Flags=01010000000000010000001000000001
- Flags=0000000000000001
- Text=%GROUP%
- Text French=%GROUP%
- Text German=%GROUP%
- Text Spanish=%GROUP%
- Text Italian=%GROUP%
- end
- end
-end
-item: Custom Dialog Set
- Name=Start Installation
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- Text French=&Suite >
- Text German=&Weiter >
- Text Spanish=&Siguiente >
- Text Italian=&Avanti >
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DIRECTION
- Value=B
- Create Flags=01010000000000010000000000000000
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Ready to Install!
- Text French=Prêt à installer !
- Text German=Installationsbereit!
- Text Spanish=¡Preparado para la instalación!
- Text Italian=Pronto per l'installazione!
- end
- item: Static
- Rectangle=86 42 256 102
- Create Flags=01010000000000000000000000000000
- Text=You are now ready to install %APPTITLE%.
- Text=
- Text=Press the Next button to begin the installation or the Back button to reenter the installation information.
- Text French=Vous êtes maintenant prêt à installer les fichiers %APPTITLE%.
- Text French=
- Text French=Cliquez sur le bouton Suite pour commencer l'installation ou sur le bouton Retour pour entrer les informations d'installation à nouveau.
- Text German=Sie können %APPTITLE% nun installieren.
- Text German=
- Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Zurück", um die Installationsinformationen neu einzugeben.
- Text Spanish=Ya está listo para instalar %APPTITLE%.
- Text Spanish=
- Text Spanish=Presione el botón Siguiente para comenzar la instalación o presione Atrás para volver a ingresar la información para la instalación.
- Text Italian=Ora è possibile installare %APPTITLE%.
- Text Italian=
- Text Italian=Premere il pulsante Avanti per avviare l'installazione o il pulsante Indietro per reinserire le informazioni di installazione.
- end
- end
-end
-item: If/While Statement
- Variable=DISPLAY
- Value=Select Destination Directory
-end
-item: Set Variable
- Variable=BACKUP
- Value=%MAINDIR%\BACKUP
-end
-item: End Block
-end
-item: End Block
-end
-item: If/While Statement
- Variable=TYPE
- Value=B
-end
-item: Set Variable
- Variable=COMPONENTS
- Value=A
-end
-item: End Block
-end
-item: If/While Statement
- Variable=DOBACKUP
- Value=A
-end
-item: Set Variable
- Variable=BACKUPDIR
- Value=%BACKUP%
-end
-item: End Block
-end
-remarked item: If/While Statement
- Variable=BRANDING
- Value=1
-end
-remarked item: If/While Statement
- Variable=DOBRAND
- Value=1
-end
-remarked item: Edit INI File
- Pathname=%INST%\CUSTDATA.INI
- Settings=[Registration]
- Settings=NAME=%NAME%
- Settings=COMPANY=%COMPANY%
- Settings=
-end
-remarked item: End Block
-end
-remarked item: End Block
-end
-item: Set Variable
- Variable=MAINDIRSHORT
- Value=%MAINDIR%
- Flags=00010100
-end
-item: Open/Close INSTALL.LOG
-end
-item: Check Disk Space
- Component=COMPONENTS
-end
-item: Install File
- Source=${__TCLBASEDIR__}\license.txt
- Destination=%MAINDIR%\license.txt
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\Readme.txt
- Destination=%MAINDIR%\Readme.txt
- Flags=0000000000000010
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=D
- Flags=00001010
-end
-item: Install File
- Source=${__TKBASEDIR__}\win\release\tk85.lib
- Destination=%MAINDIR%\lib\tk85.lib
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\win\release\tkstub85.lib
- Destination=%MAINDIR%\lib\tkstub85.lib
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tcl85.lib
- Destination=%MAINDIR%\lib\tcl85.lib
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tclstub85.lib
- Destination=%MAINDIR%\lib\tclstub85.lib
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\Xutil.h
- Destination=%MAINDIR%\include\X11\Xutil.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\Xlib.h
- Destination=%MAINDIR%\include\X11\Xlib.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\Xfuncproto.h
- Destination=%MAINDIR%\include\X11\Xfuncproto.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\Xatom.h
- Destination=%MAINDIR%\include\X11\Xatom.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\X.h
- Destination=%MAINDIR%\include\X11\X.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\keysymdef.h
- Destination=%MAINDIR%\include\X11\keysymdef.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\keysym.h
- Destination=%MAINDIR%\include\X11\keysym.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\cursorfont.h
- Destination=%MAINDIR%\include\X11\cursorfont.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\generic\tk.h
- Destination=%MAINDIR%\include\tk.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\generic\tkDecls.h
- Destination=%MAINDIR%\include\tkDecls.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\generic\tkPlatDecls.h
- Destination=%MAINDIR%\include\tkPlatDecls.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\generic\tkIntXlibDecls.h
- Destination=%MAINDIR%\include\tkIntXlibDecls.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\generic\tcl.h
- Destination=%MAINDIR%\include\tcl.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\generic\tclDecls.h
- Destination=%MAINDIR%\include\tclDecls.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\generic\tclPlatDecls.h
- Destination=%MAINDIR%\include\tclPlatDecls.h
- Flags=0000000000000010
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=A
- Flags=00001010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\msgcat\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.4\pkgIndex.tcl
- Flags=0000000010000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\msgcat\msgcat.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.4\msgcat.tcl
- Flags=0000000010000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\tcltest\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\tcltest2.0\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\tcltest\tcltest.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\tcltest2.0\tcltest.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\symbol.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\symbol.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\shiftjis.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\shiftjis.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macUkraine.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macUkraine.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macTurkish.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macTurkish.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macThai.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macThai.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macRomania.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRomania.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macRoman.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRoman.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macJapan.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macJapan.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macIceland.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macIceland.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macGreek.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macGreek.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macDingbats.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macDingbats.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macCyrillic.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCyrillic.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macCroatian.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCroatian.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macCentEuro.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCentEuro.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\ksc5601.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\ksc5601.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\koi8-r.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\koi8-r.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\jis0212.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0212.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\jis0208.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0208.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\jis0201.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0201.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-15.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-15.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-9.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-9.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-8.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-8.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-7.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-7.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-6.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-6.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-5.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-5.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-4.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-4.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-3.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-3.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-2.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-2.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-1.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-1.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso2022.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso2022-kr.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-kr.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso2022-jp.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-jp.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\gb2312.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb2312.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\gb1988.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb1988.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\gb12345.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb12345.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\euc-cn.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-cn.enc
- Flags=0000000010000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\euc-jp.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-jp.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\euc-kr.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-kr.enc
- Flags=0000000010000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\dingbats.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\dingbats.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp950.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp950.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp949.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp949.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp936.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp936.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp932.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp932.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp874.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp874.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp869.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp869.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp866.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp866.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp865.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp865.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp864.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp864.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp863.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp863.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp862.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp862.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp861.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp861.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp860.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp860.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp857.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp857.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp855.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp855.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp852.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp852.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp850.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp850.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp775.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp775.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp737.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp737.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp437.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp437.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1258.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1258.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1257.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1257.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1256.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1256.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1255.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1255.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1254.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1254.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1253.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1253.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1252.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1252.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1251.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1251.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1250.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1250.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\ascii.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\ascii.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\big5.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\big5.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\opt\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\opt\optparse.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\http\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\http2.4\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\http\http.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\msgbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\msgbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\optMenu.tcl
- Destination=%MAINDIR%\lib\tk%VER%\optMenu.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\clrpick.tcl
- Destination=%MAINDIR%\lib\tk%VER%\clrpick.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\entry.tcl
- Destination=%MAINDIR%\lib\tk%VER%\entry.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\spinbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\spinbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\comdlg.tcl
- Destination=%MAINDIR%\lib\tk%VER%\comdlg.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\bgerror.tcl
- Destination=%MAINDIR%\lib\tk%VER%\bgerror.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\obsolete.tcl
- Destination=%MAINDIR%\lib\tk%VER%\obsolete.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\button.tcl
- Destination=%MAINDIR%\lib\tk%VER%\button.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\xmfbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\xmfbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\console.tcl
- Destination=%MAINDIR%\lib\tk%VER%\console.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\listbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\listbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\menu.tcl
- Destination=%MAINDIR%\lib\tk%VER%\menu.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\dialog.tcl
- Destination=%MAINDIR%\lib\tk%VER%\dialog.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\focus.tcl
- Destination=%MAINDIR%\lib\tk%VER%\focus.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\palette.tcl
- Destination=%MAINDIR%\lib\tk%VER%\palette.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\tkfbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\tkfbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\tk.tcl
- Destination=%MAINDIR%\lib\tk%VER%\tk.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\text.tcl
- Destination=%MAINDIR%\lib\tk%VER%\text.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\tearoff.tcl
- Destination=%MAINDIR%\lib\tk%VER%\tearoff.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\tclIndex
- Destination=%MAINDIR%\lib\tk%VER%\tclIndex
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\scrlbar.tcl
- Destination=%MAINDIR%\lib\tk%VER%\scrlbar.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\scale.tcl
- Destination=%MAINDIR%\lib\tk%VER%\scale.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\safetk.tcl
- Destination=%MAINDIR%\lib\tk%VER%\safetk.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\http1.0\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\http1.0\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\http1.0\http.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\http1.0\http.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\reg\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tclreg10.dll
- Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\tclreg10.dll
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\dde\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\dde1.2\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tcldde12.dll
- Destination=%MAINDIR%\lib\tcl%VER%\dde1.2\tcldde12.dll
- Flags=0000000000000010
-end
-item: Install File
- Source=C:\WINNT\SYSTEM32\Msvcrt.dll
- Destination=%MAINDIR%\bin\msvcrt.dll
- Flags=0010001000000011
-end
-item: Install File
- Source=${__TKBASEDIR__}\win\release\wish85.exe
- Destination=%MAINDIR%\bin\wish85.exe
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tclsh85.exe
- Destination=%MAINDIR%\bin\tclsh85.exe
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tclpip85.dll
- Destination=%MAINDIR%\bin\tclpip85.dll
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tcl85.dll
- Destination=%MAINDIR%\bin\tcl85.dll
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\win\release\tk85.dll
- Destination=%MAINDIR%\bin\tk85.dll
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\auto.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\auto.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\history.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\history.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\init.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\init.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\package.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\package.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\parray.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\parray.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\safe.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\safe.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\tclIndex
- Destination=%MAINDIR%\lib\tcl%VER%\tclIndex
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\word.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\word.tcl
- Flags=0000000000000010
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=B
- Flags=00001010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\tai-ku.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\tai-ku.gif
- Flags=0000000010000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\teapot.ppm
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\teapot.ppm
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\tcllogo.gif
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\tcllogo.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\pattern.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\pattern.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\noletter.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\noletter.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\letters.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\letters.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\gray25.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\gray25.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\flagup.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagup.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\flagdown.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagdown.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\face.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\face.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\earthris.gif
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\earthris.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\earth.gif
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\earth.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\vscale.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\vscale.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\twind.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\twind.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\text.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\text.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\style.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\style.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\states.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\states.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\search.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\search.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\sayings.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\sayings.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\ruler.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\ruler.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\radio.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\radio.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\puzzle.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\puzzle.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\plot.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\plot.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\msgbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\msgbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\menubu.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\menubu.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\menu.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\menu.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\label.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\label.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\items.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\items.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\image2.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\image2.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\image1.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\image1.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\icon.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\icon.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\hscale.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\hscale.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\form.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\form.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\ixset
- Destination=%MAINDIR%\lib\tk%VER%\demos\ixset.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\rolodex
- Destination=%MAINDIR%\lib\tk%VER%\demos\rolodex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\square
- Destination=%MAINDIR%\lib\tk%VER%\demos\square.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\Readme
- Destination=%MAINDIR%\lib\tk%VER%\demos\Readme
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\hello
- Destination=%MAINDIR%\lib\tk%VER%\demos\hello.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\tclIndex
- Destination=%MAINDIR%\lib\tk%VER%\demos\tclIndex
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\browse
- Destination=%MAINDIR%\lib\tk%VER%\demos\browse.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\timer
- Destination=%MAINDIR%\lib\tk%VER%\demos\timer.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\widget
- Destination=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\tcolor
- Destination=%MAINDIR%\lib\tk%VER%\demos\tcolor.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\rmt
- Destination=%MAINDIR%\lib\tk%VER%\demos\rmt.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\floor.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\floor.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\filebox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\filebox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\pwrdLogo75.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo75.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\pwrdLogo200.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo200.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\pwrdLogo175.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo175.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\pwrdLogo150.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo150.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\pwrdLogo100.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo100.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\logoMed.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\logoMed.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\logoLarge.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\logoLarge.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\logo64.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\logo64.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\logo100.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\logo100.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\Readme
- Destination=%MAINDIR%\lib\tk%VER%\images\Readme
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\arrow.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\arrow.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\bind.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\bind.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\bitmap.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\bitmap.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\button.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\button.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\check.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\check.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\clrpick.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\clrpick.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\colors.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\colors.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\cscroll.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\cscroll.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\ctext.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\ctext.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\dialog1.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\dialog1.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\dialog2.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\dialog2.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\entry1.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\entry1.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\entry2.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\entry2.tcl
- Flags=0000000000000010
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=C
- Flags=00001010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\tools\tcl85.cnt
- Destination=%MAINDIR%\doc\tcl85.cnt
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\tools\tcl85.hlp
- Destination=%MAINDIR%\doc\tcl85.hlp
- Flags=0000000000000010
-end
-item: End Block
-end
-item: Set Variable
- Variable=MAINDIR
- Value=%MAINDIR%
- Flags=00010100
-end
-item: Include Script
- Pathname=\\pop\tools\1.2\win32-ix86\wise\INCLUDE\uninstal.wse
-end
-item: Check Configuration
- Flags=10111011
-end
-item: Get Registry Key Value
- Variable=GROUPDIR
- Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders
- Default=%WIN%\Start Menu\Programs
- Value Name=Programs
- Flags=00000010
-end
-item: Set Variable
- Variable=GROUP
- Value=%GROUPDIR%\%GROUP%
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=A
- Flags=00001010
-end
-item: Create Shortcut
- Source=%MAINDIR%\bin\wish85.exe
- Destination=%GROUP%\Wish.lnk
- Working Directory=%MAINDIR%
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=A
- Flags=00001010
-end
-item: Create Shortcut
- Source=%MAINDIR%\bin\tclsh85.exe
- Destination=%GROUP%\Tclsh.lnk
- Working Directory=%MAINDIR%
- Key Type=1536
- Flags=00000001
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=C
- Flags=00001010
-end
-item: Create Shortcut
- Source=%MAINDIR%\doc\tcl85.hlp
- Destination=%GROUP%\Tcl Help.lnk
- Working Directory=%MAINDIR%
-end
-item: End Block
-end
-item: Create Shortcut
- Source=%MAINDIR%\Readme.txt
- Destination=%GROUP%\Readme.lnk
- Working Directory=%MAINDIR%
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=B
- Flags=00001010
-end
-item: Create Shortcut
- Source=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
- Destination=%GROUP%\Widget Tour.lnk
- Working Directory=%MAINDIR%
- Key Type=1536
- Flags=00000001
-end
-item: End Block
-end
-item: Else Statement
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=B
- Flags=00001010
-end
-item: Add ProgMan Icon
- Group=%GROUP%
- Icon Name=Widget Tour
- Command Line=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
- Icon Pathname=%MAINDIR%\bin\wish85.exe
- Default Directory=%MAINDIR%
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=C
- Flags=00001010
-end
-item: Add ProgMan Icon
- Group=%GROUP%
- Icon Name=Tcl Help
- Command Line=%MAINDIR%\doc\tcl85.hlp
- Default Directory=%MAINDIR%
-end
-item: End Block
-end
-item: Add ProgMan Icon
- Group=%GROUP%
- Icon Name=Readme
- Command Line=%MAINDIR%\Readme.txt
- Default Directory=%MAINDIR%
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=A
- Flags=00001010
-end
-item: Add ProgMan Icon
- Group=%GROUP%
- Icon Name=Wish
- Command Line=%MAINDIR%\bin\wish85.exe
- Default Directory=%MAINDIR%
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=A
- Flags=00001010
-end
-item: Add ProgMan Icon
- Group=%GROUP%
- Icon Name=Tclsh
- Command Line=%MAINDIR%\bin\tclsh85.exe
- Default Directory=%MAINDIR%
-end
-item: End Block
-end
-item: End Block
-end
-item: Self-Register OCXs/DLLs
- Description=Updating System Configuration, Please Wait...
-end
-item: Edit Registry
- Total Keys=1
- Key=SOFTWARE\Scriptics\Tcl\%VER%
- New Value=%MAINDIR%
- Value Name=Root
- Root=2
-end
-item: Edit Registry
- Total Keys=1
- Key=TclScript\DefaultIcon
- New Value=%MAINDIR%\bin\tk85.dll
-end
-item: Edit Registry
- Total Keys=1
- Key=.tcl
- New Value=TclScript
-end
-item: Edit Registry
- Total Keys=1
- Key=TclScript
- New Value=TclScript
-end
-item: Edit Registry
- Total Keys=1
- Key=TclScript\shell\open\command
- New Value=%MAINDIRSHORT%\bin\wish85.exe "%%1" %%*
-end
-item: Edit Registry
- Total Keys=1
- Key=TclScript\shell\edit
- New Value=&Edit
-end
-item: Edit Registry
- Total Keys=1
- Key=TclScript\shell\edit\command
- New Value=notepad "%%1"
-end
-item: Add Directory to Path
- Directory=%MAINDIR%\bin
-end
-item: Check Configuration
- Flags=10111011
-end
-item: Set Variable
- Variable=TO_SCRIPTICS
- Value=A
-end
-item: Else Statement
-end
-item: Set Variable
- Variable=TO_SCRIPTICS
-end
-item: End Block
-end
-item: Wizard Block
- Direction Variable=DIRECTION
- Display Variable=DISPLAY
- Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP
- X Position=9
- Y Position=10
- Filler Color=8421440
- Flags=00000011
-end
-item: Custom Dialog Set
- Name=Finished
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Finish
- Text French=&Fin
- Text German=&Weiter
- Text Spanish=&Terminar
- Text Italian=&Fine
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DISABLED
- Value=!
- Create Flags=01010000000000010000000000000000
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Variable=DISABLED
- Value=!
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Installation Completed!
- Text French=Installation terminée !
- Text German=Die Installation ist abgeschlossen!
- Text Spanish=¡Instalación terminada!
- Text Italian=Installazione completata!
- end
- item: Static
- Rectangle=86 42 256 153
- Create Flags=01010000000000000000000000000000
- Text=%APPTITLE% has been successfully installed.
- Text=
- Text=Click the Finish button to exit this installation.
- Text=
- Text=You can learn more about Tcl/Tk %VER%, including release notes, updates, tutorials, and more at %URL%. Check the box below to start your web browser and go there now.
- Text=
- Text=The installer may ask you to reboot your computer, this is to update your PATH and is not necessary to do immediately.
- Text French=%APPTITLE% est maintenant installé.
- Text French=
- Text French=Cliquez sur le bouton Fin pour quitter l'installation.
- Text German=%APPTITLE% wurde erfolgreich installiert.
- Text German=
- Text German=Klicken Sie auf "Weiter", um die Installation zu beenden.
- Text Spanish=%APPTITLE% se ha instalado con éxito.
- Text Spanish=
- Text Spanish=Presione el botón Terminar para salir de esta instalación.
- Text Italian=L'installazione %APPTITLE% è stata portata a termine con successo.
- Text Italian=
- Text Italian=Premere il pulsante Fine per uscire dall'installazione.
- end
- item: Checkbox
- Rectangle=88 143 245 157
- Variable=TO_SCRIPTICS
- Enabled Color=00000000000000001111111111111111
- Create Flags=01010000000000010000000000000011
- Text=Show me important information about
- Text=
- end
- item: Static
- Rectangle=99 156 245 170
- Enabled Color=00000000000000001111111111111111
- Create Flags=01010000000000000000000000000000
- Text=Tcl/Tk %VER% and TclPro
- end
- end
-end
-item: End Block
-end
-item: Check Configuration
- Flags=10111011
-end
-item: If/While Statement
- Variable=TO_SCRIPTICS
- Value=A
- Flags=00000010
-end
-item: Execute Program
- Command Line=%URL%
-end
-item: End Block
-end
-item: Execute Program
- Pathname=explorer
- Command Line=%GROUP%
-end
-item: End Block
-end
diff --git a/tools/tclSplash.bmp b/tools/tclSplash.bmp
deleted file mode 100644
index db8a17e..0000000
--- a/tools/tclSplash.bmp
+++ /dev/null
Binary files differ
diff --git a/tools/tclZIC.tcl b/tools/tclZIC.tcl
index d66f5e4..005919a 100755
--- a/tools/tclZIC.tcl
+++ b/tools/tclZIC.tcl
@@ -28,9 +28,6 @@
# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: tclZIC.tcl,v 1.11 2009/11/18 21:45:36 nijtmans Exp $
-#
#----------------------------------------------------------------------
package require Tcl 8.5
@@ -397,6 +394,9 @@ proc parseON {on} {
#----------------------------------------------------------------------
proc onDayOfMonth {day year month} {
+ scan $day %d day
+ scan $year %d year
+ scan $month %d month
set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
[dict create era CE year $year month $month dayOfMonth $day] \
2361222]
diff --git a/tools/tclmin.wse b/tools/tclmin.wse
deleted file mode 100644
index 2fd8185..0000000
--- a/tools/tclmin.wse
+++ /dev/null
@@ -1,247 +0,0 @@
-Document Type: WSE
-item: Global
- Version=5.0
- Flags=00000100
- Split=1420
- Languages=65 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
- Japanese Font Name=MS Gothic
- Japanese Font Size=10
- Start Gradient=0 0 255
- End Gradient=0 0 0
- Windows Flags=00000000000000010010110000001000
- Message Font=MS Sans Serif
- Font Size=8
- Disk Filename=SETUP
- Patch Flags=0000000000000001
- Patch Threshold=85
- Patch Memory=4000
-end
-item: Remark
- Text=-------
-end
-item: Remark
- Text=Tcl 8.0 Minimal Installation
-end
-item: Remark
- Text=-------
-end
-item: Install File
- Source=n:\dist\tcl8.0\library\opt0.4\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\library\opt0.4\optparse.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\library\http\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\http2.4\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\library\http\http.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\library\safe.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\safe.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\library\history.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\history.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\msgbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\msgbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\optMenu.tcl
- Destination=%MAINDIR%\lib\tk%VER%\optMenu.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\clrpick.tcl
- Destination=%MAINDIR%\lib\tk%VER%\clrpick.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\entry.tcl
- Destination=%MAINDIR%\lib\tk%VER%\entry.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\comdlg.tcl
- Destination=%MAINDIR%\lib\tk%VER%\comdlg.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\bgerror.tcl
- Destination=%MAINDIR%\lib\tk%VER%\bgerror.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\obsolete.tcl
- Destination=%MAINDIR%\lib\tk%VER%\obsolete.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\button.tcl
- Destination=%MAINDIR%\lib\tk%VER%\button.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\xmfbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\xmfbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\console.tcl
- Destination=%MAINDIR%\lib\tk%VER%\console.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\listbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\listbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\menu.tcl
- Destination=%MAINDIR%\lib\tk%VER%\menu.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\dialog.tcl
- Destination=%MAINDIR%\lib\tk%VER%\dialog.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\focus.tcl
- Destination=%MAINDIR%\lib\tk%VER%\focus.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\palette.tcl
- Destination=%MAINDIR%\lib\tk%VER%\palette.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\tkfbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\tkfbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\tk.tcl
- Destination=%MAINDIR%\lib\tk%VER%\tk.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\text.tcl
- Destination=%MAINDIR%\lib\tk%VER%\text.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\tearoff.tcl
- Destination=%MAINDIR%\lib\tk%VER%\tearoff.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\tclIndex
- Destination=%MAINDIR%\lib\tk%VER%\tclIndex
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\scrlbar.tcl
- Destination=%MAINDIR%\lib\tk%VER%\scrlbar.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\scale.tcl
- Destination=%MAINDIR%\lib\tk%VER%\scale.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\library\safetk.tcl
- Destination=%MAINDIR%\lib\tk%VER%\safetk.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\library\http1.0\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\http1.0\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\library\http1.0\http.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\http1.0\http.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\win\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\win\tclreg80.dll
- Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\tclreg80.dll
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\win\Tcl1680.dll
- Destination=%SYS32%\Tcl1680.dll
- Flags=0000001000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\win\tcl80.dll
- Destination=%SYS32%\tcl80.dll
- Flags=0000001000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\win\tclpip80.dll
- Destination=%SYS32%\tclpip80.dll
- Flags=0000001000000010
-end
-item: Install File
- Source=n:\dist\Bc45\Bin\cw3215.dll
- Destination=%SYS32%\cw3215.dll
- Flags=0000001000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\win\tk80.dll
- Destination=%SYS32%\tk80.dll
- Flags=0000001000000010
-end
-item: Install File
- Source=n:\dist\tk8.0\win\wish80.exe
- Destination=%MAINDIR%\bin\wish80.exe
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\win\tclsh80.exe
- Destination=%MAINDIR%\bin\tclsh80.exe
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\library\tclIndex
- Destination=%MAINDIR%\lib\tcl%VER%\tclIndex
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\library\init.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\init.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\library\parray.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\parray.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=n:\dist\tcl8.0\library\word.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\word.tcl
- Flags=0000000000000010
-end
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl
index a910777..d02bcb6 100644
--- a/tools/tcltk-man2html-utils.tcl
+++ b/tools/tcltk-man2html-utils.tcl
@@ -4,9 +4,7 @@
## by Tcl and Tk; they do not cope with arbitrary nroff markup.
##
## Copyright (c) 1995-1997 Roger E. Critchlow Jr
-## Copyright (c) 2004-2010 Donal K. Fellows
-##
-## CVS: $Id: tcltk-man2html-utils.tcl,v 1.7 2010/09/03 09:38:53 dkf Exp $
+## Copyright (c) 2004-2011 Donal K. Fellows
set ::manual(report-level) 1
@@ -37,7 +35,7 @@ proc fatal {msg} {
uplevel 1 [list manerror $msg]
exit 1
}
-
+
##
## templating
##
@@ -48,6 +46,7 @@ proc indexfile {} {
return "contents.htm"
}
}
+
proc copyright {copyright {level {}}} {
# We don't actually generate a separate copyright page anymore
#set page "${level}copyright.htm"
@@ -56,6 +55,7 @@ proc copyright {copyright {level {}}} {
set who [string map {@ (at)} [lrange $copyright 2 end]]
return "Copyright &copy; [htmlize-text $who]"
}
+
proc copyout {copyrights {level {}}} {
set out "<div class=\"copy\">"
foreach c $copyrights {
@@ -64,12 +64,15 @@ proc copyout {copyrights {level {}}} {
append out "</div>"
return $out
}
+
proc CSS {{level ""}} {
return "<link rel=\"stylesheet\" href=\"${level}$::CSSFILE\" type=\"text/css\" media=\"all\">\n"
}
+
proc DOCTYPE {} {
return "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">"
}
+
proc htmlhead {title header args} {
set level ""
if {[lindex $args end] eq "../[indexfile]"} {
@@ -95,7 +98,7 @@ proc htmlhead {title header args} {
}
return $out
}
-
+
##
## parsing
##
@@ -112,6 +115,7 @@ proc htmlize-text {text {charmap {}}} {
# contains some extras for use in nroff->html processing
# build on the list passed in, if any
lappend charmap \
+ "&ndash;" "&ndash;" \
{&} {&amp;} \
{\\} "&#92;" \
{\e} "&#92;" \
@@ -145,8 +149,8 @@ proc process-text {text} {
{\fP} {\fR} \
{\.} . \
{\(bu} "&#8226;" \
+ {\*(qo} "&ocirc;" \
]
- lappend charmap {\o'o^'} {&ocirc;} ; # o-circumflex in re_syntax.n
lappend charmap {\-\|\-} -- ; # two hyphens
lappend charmap {\-} - ; # a hyphen
@@ -188,6 +192,7 @@ proc process-text {text} {
}
return $text
}
+
##
## pass 2 text input and matching
##
@@ -196,10 +201,12 @@ proc open-text {} {
set manual(text-length) [llength $manual(text)]
set manual(text-pointer) 0
}
+
proc more-text {} {
global manual
return [expr {$manual(text-pointer) < $manual(text-length)}]
}
+
proc next-text {} {
global manual
if {[more-text]} {
@@ -210,14 +217,17 @@ proc next-text {} {
manerror "read past end of text"
error "fatal"
}
+
proc is-a-directive {line} {
return [string match .* $line]
}
+
proc split-directive {line opname restname} {
upvar 1 $opname op $restname rest
set op [string range $line 0 2]
set rest [string trim [string range $line 3 end]]
}
+
proc next-op-is {op restname} {
global manual
upvar 1 $restname rest
@@ -231,12 +241,14 @@ proc next-op-is {op restname} {
}
return 0
}
+
proc backup-text {n} {
global manual
if {$manual(text-pointer)-$n >= 0} {
incr manual(text-pointer) -$n
}
}
+
proc match-text args {
global manual
set nargs [llength $args]
@@ -276,11 +288,13 @@ proc match-text args {
}
return 1
}
+
proc expand-next-text {n} {
global manual
return [join [lrange $manual(text) $manual(text-pointer) \
[expr {$manual(text-pointer)+$n-1}]] \n\n]
}
+
##
## pass 2 output
##
@@ -288,7 +302,7 @@ proc man-puts {text} {
global manual
lappend manual(output-$manual(wing-file)-$manual(name)) $text
}
-
+
##
## build hypertext links to tables of contents
##
@@ -301,6 +315,7 @@ proc long-toc {text} {
"<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>"
return "<A NAME=\"$here\">$text</A>"
}
+
proc option-toc {name class switch} {
global manual
# Special case handling, oh we hate it but must do it
@@ -328,6 +343,7 @@ proc option-toc {name class switch} {
"<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>"
return "<A NAME=\"$here\">$switch</A>"
}
+
proc std-option-toc {name page} {
global manual
if {[info exists manual(standard-option-$page-$name)]} {
@@ -341,6 +357,7 @@ proc std-option-toc {name page} {
lappend manual(section-toc) "<DD><A HREF=\"$page.htm#$other\">$name</A>"
return "<A HREF=\"$page.htm#$other\">$name</A>"
}
+
##
## process the widget option section
## in widget and options man pages
@@ -412,7 +429,7 @@ proc output-widget-options {rest} {
man-puts </DL>
lappend manual(section-toc) </DL>
}
-
+
##
## process .RS lists
##
@@ -456,7 +473,7 @@ proc output-RS-list {} {
}
man-puts </DL>
}
-
+
##
## process .IP lists which may be plain indents,
## numeric lists, or definition lists
@@ -491,6 +508,16 @@ proc output-IP-list {context code rest} {
man-puts <P>
}
set dl "<DL class=\"[string tolower $manual(section)]\">"
+ set enddl "</DL>"
+ if {$code eq ".IP"} {
+ if {[regexp {^\[[\da-f]+\]|\(?[\da-f]+\)$} $rest]} {
+ set dl "<OL class=\"[string tolower $manual(section)]\">"
+ set enddl "</OL>"
+ } elseif {"&#8226;" eq $rest} {
+ set dl "<UL class=\"[string tolower $manual(section)]\">"
+ set enddl "</UL>"
+ }
+ }
man-puts $dl
lappend manual(section-toc) $dl
backup-text 1
@@ -506,11 +533,14 @@ proc output-IP-list {context code rest} {
output-IP-list .IP $code $rest
continue
}
- if {$manual(section) eq "ARGUMENTS" || \
- [regexp {^\[\d+\]$} $rest]} {
+ if {$manual(section) eq "ARGUMENTS"} {
man-puts "$para<DT>$rest<DD>"
+ } elseif {[regexp {^\[([\da-f]+)\]$} $rest -> value]} {
+ man-puts "$para<LI value=\"$value\">"
+ } elseif {[regexp {^\(?([\da-f]+)\)$} $rest -> value]} {
+ man-puts "$para<LI value=\"$value\">"
} elseif {"&#8226;" eq $rest} {
- man-puts "$para<DT><DD>$rest&nbsp;"
+ man-puts "$para<LI>"
} else {
man-puts "$para<DT>[long-toc $rest]<DD>"
}
@@ -544,14 +574,13 @@ proc output-IP-list {context code rest} {
} elseif {[match-text @rest .RE]} {
# gad, this is getting ridiculous
if {!$accept_RE} {
- man-puts "</DL><P>$rest<DL>"
+ man-puts "$enddl<P>$rest$dl"
backup-text 1
set para {}
break
- } else {
- man-puts "<P>$rest"
- incr accept_RE -1
}
+ man-puts "<P>$rest"
+ incr accept_RE -1
} elseif {$accept_RE} {
output-directive $line
} else {
@@ -576,13 +605,14 @@ proc output-IP-list {context code rest} {
}
set para <P>
}
- man-puts "$para</DL>"
- lappend manual(section-toc) </DL>
+ man-puts "$para$enddl"
+ lappend manual(section-toc) $enddl
if {$accept_RE} {
manerror "missing .RE in output-IP-list"
}
}
}
+
##
## handle the NAME section lines
## there's only one line in the NAME section,
@@ -606,38 +636,53 @@ proc output-name {line} {
lappend manual(wing-toc) $name
lappend manual(name-$name) $manual(wing-file)/$manual(name)
}
+ set manual(tooltip-$manual(wing-file)/$manual(name).htm) $line
}
+
##
## build a cross-reference link if appropriate
##
proc cross-reference {ref} {
global manual remap_link_target
global ensemble_commands exclude_refs_map exclude_when_followed_by_map
- set lref [string tolower $ref]
- if {[string match "Tcl_*" $ref] || [string match "Tk_*" $ref]} {
- set lref $ref
+ set manname $manual(name)
+ set mantail $manual(tail)
+ if {[string match "Tcl_*" $ref] || [string match "Tk_*" $ref] || [string match "Ttk_*" $ref] || [string match "Itcl_*" $ref] || [string match "Tdbc_*" $ref]} {
+ regexp {^\w+} $ref lref
+ ##
+ ## apply a link remapping if available
+ ##
+ if {[info exists remap_link_target($lref)]} {
+ set lref $remap_link_target($lref)
+ }
} elseif {$ref eq "Tcl"} {
set lref $ref
} elseif {
[regexp {^[A-Z0-9 ?!]+$} $ref]
- && [info exists manual($manual(name)-id-$ref)]
+ && [info exists manual($manname-id-$ref)]
} {
- return "<A HREF=\"#$manual($manual(name)-id-$ref)\">$ref</A>"
- }
- ##
- ## apply a link remapping if available
- ##
- if {[info exists remap_link_target($lref)]} {
- set lref $remap_link_target($lref)
+ return "<A HREF=\"#$manual($manname-id-$ref)\">$ref</A>"
+ } else {
+ set lref [string tolower $ref]
+ ##
+ ## apply a link remapping if available
+ ##
+ if {[info exists remap_link_target($lref)]} {
+ set lref $remap_link_target($lref)
+ }
}
##
## nothing to reference
##
if {![info exists manual(name-$lref)]} {
foreach name $ensemble_commands {
- if {[regexp "^$name \[a-z0-9]*\$" $lref] && \
- [info exists manual(name-$name)] && \
- $manual(tail) ne "$name.n"} {
+ if {
+ [regexp "^$name \[a-z0-9]*\$" $lref] &&
+ [info exists manual(name-$name)] &&
+ $mantail ne "$name.n" &&
+ (![info exists exclude_refs_map($mantail)] ||
+ $manual(name-$name) ni $exclude_refs_map($mantail))
+ } {
return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>"
}
}
@@ -646,43 +691,45 @@ proc cross-reference {ref} {
}
return $ref
}
+ set manref $manual(name-$lref)
##
## would be a self reference
##
- foreach name $manual(name-$lref) {
- if {"$manual(wing-file)/$manual(name)" in $name} {
+ foreach name $manref {
+ if {"$manual(wing-file)/$manname" in $name} {
return $ref
}
}
##
## multiple choices for reference
##
- if {[llength $manual(name-$lref)] > 1} {
- set tcl_i [lsearch -glob $manual(name-$lref) *TclCmd*]
- set tcl_ref [lindex $manual(name-$lref) $tcl_i]
- set tk_i [lsearch -glob $manual(name-$lref) *TkCmd*]
- set tk_ref [lindex $manual(name-$lref) $tk_i]
+ if {[llength $manref] > 1} {
+ set tcl_i [lsearch -glob $manref *TclCmd*]
if {$tcl_i >= 0 && $manual(wing-file) eq "TclCmd"
|| $manual(wing-file) eq "TclLib"} {
+ set tcl_ref [lindex $manref $tcl_i]
return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
}
+ set tk_i [lsearch -glob $manref *TkCmd*]
if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd"
|| $manual(wing-file) eq "TkLib"} {
+ set tk_ref [lindex $manref $tk_i]
return "<A HREF=\"../$tk_ref.htm\">$ref</A>"
}
- if {$lref eq "exit" && $manual(tail) eq "tclsh.1" && $tcl_i >= 0} {
+ if {$lref eq "exit" && $mantail eq "tclsh.1" && $tcl_i >= 0} {
+ set tcl_ref [lindex $manref $tcl_i]
return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
}
- puts stderr "multiple cross reference to $ref in $manual(name-$lref) from $manual(wing-file)/$manual(tail)"
+ puts stderr "multiple cross reference to $ref in $manref from $manual(wing-file)/$mantail"
return $ref
}
##
## exceptions, sigh, to the rule
##
- if {[info exists exclude_when_followed_by_map($manual(tail))]} {
- upvar 1 tail tail
+ if {[info exists exclude_when_followed_by_map($mantail)]} {
+ upvar 1 text tail
set following_word [lindex [regexp -inline {\S+} $tail] 0]
- foreach {this that} $exclude_when_followed_by_map($manual(tail)) {
+ foreach {this that} $exclude_when_followed_by_map($mantail) {
# only a ref if $this is not followed by $that
if {$lref eq $this && [string match $that* $following_word]} {
return $ref
@@ -690,16 +737,17 @@ proc cross-reference {ref} {
}
}
if {
- [info exists exclude_refs_map($manual(tail))]
- && $lref in $exclude_refs_map($manual(tail))
+ [info exists exclude_refs_map($mantail)]
+ && $lref in $exclude_refs_map($mantail)
} {
return $ref
}
##
## return the cross reference
##
- return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>"
+ return "<A HREF=\"../$manref.htm\">$ref</A>"
}
+
##
## reference generation errors
##
@@ -708,156 +756,162 @@ proc reference-error {msg text} {
puts stderr "$manual(tail): $msg: {$text}"
return $text
}
+
##
## insert as many cross references into this text string as are appropriate
##
proc insert-cross-references {text} {
global manual
- ##
- ## we identify cross references by:
- ## ``quotation''
- ## <B>emboldening</B>
- ## Tcl_ prefix
- ## Tk_ prefix
- ## [a-zA-Z0-9]+ manual entry
- ## and we avoid messing with already anchored text
- ##
- ##
- ## find where each item lives
- ##
- array set offset [list \
- anchor [string first {<A } $text] \
- end-anchor [string first {</A>} $text] \
- quote [string first {``} $text] \
- end-quote [string first {''} $text] \
- bold [string first {<B>} $text] \
- end-bold [string first {</B>} $text] \
- tcl [string first {Tcl_} $text] \
- tk [string first {Tk_} $text] \
- Tcl1 [string first {Tcl manual entry} $text] \
- Tcl2 [string first {Tcl overview manual entry} $text] \
- ]
- ##
- ## accumulate a list
- ##
- foreach name [array names offset] {
- if {$offset($name) >= 0} {
- set invert($offset($name)) $name
- lappend offsets $offset($name)
- }
- }
- ##
- ## if nothing, then we're done.
- ##
- if {![info exists offsets]} {
- return $text
- }
- ##
- ## sort the offsets
- ##
- set offsets [lsort -integer $offsets]
- ##
- ## see which we want to use
- ##
- switch -exact -- $invert([lindex $offsets 0]) {
- anchor {
- if {$offset(end-anchor) < 0} {
- return [reference-error {Missing end anchor} $text]
+ set result ""
+
+ while 1 {
+ ##
+ ## we identify cross references by:
+ ## ``quotation''
+ ## <B>emboldening</B>
+ ## Tcl_ prefix
+ ## Tk_ prefix
+ ## [a-zA-Z0-9]+ manual entry
+ ## and we avoid messing with already anchored text
+ ##
+ ##
+ ## find where each item lives - EXPENSIVE - and accumulate a list
+ ##
+ unset -nocomplain offsets
+ foreach {name pattern} {
+ anchor {<A } end-anchor {</A>}
+ quote {``} end-quote {''}
+ bold {<B>} end-bold {</B>}
+ c.tcl {Tcl_}
+ c.tk {Tk_}
+ c.ttk {Ttk_}
+ c.tdbc {Tdbc_}
+ c.itcl {Itcl_}
+ Tcl1 {Tcl manual entry}
+ Tcl2 {Tcl overview manual entry}
+ url {http://}
+ } {
+ set o [string first $pattern $text]
+ if {[set offset($name) $o] >= 0} {
+ set invert($o) $name
+ lappend offsets $o
}
- set head [string range $text 0 $offset(end-anchor)]
- set tail [string range $text [expr {$offset(end-anchor)+1}] end]
- return $head[insert-cross-references $tail]
}
- quote {
- if {$offset(end-quote) < 0} {
- return [reference-error "Missing end quote" $text]
- }
- if {$invert([lindex $offsets 1]) eq "tk"} {
- set offsets [lreplace $offsets 1 1]
- }
- if {$invert([lindex $offsets 1]) eq "tcl"} {
- set offsets [lreplace $offsets 1 1]
+ ##
+ ## if nothing, then we're done.
+ ##
+ if {![info exists offsets]} {
+ return [append result $text]
+ }
+ ##
+ ## sort the offsets
+ ##
+ set offsets [lsort -integer $offsets]
+ ##
+ ## see which we want to use
+ ##
+ switch -exact -- $invert([lindex $offsets 0]) {
+ anchor {
+ if {$offset(end-anchor) < 0} {
+ return [reference-error {Missing end anchor} $text]
+ }
+ append result [string range $text 0 $offset(end-anchor)]
+ set text [string range $text[set text ""] \
+ [expr {$offset(end-anchor)+1}] end]
+ continue
}
- switch -exact -- $invert([lindex $offsets 1]) {
- end-quote {
- set head [string range $text 0 [expr {$offset(quote)-1}]]
- set body [string range $text [expr {$offset(quote)+2}] \
- [expr {$offset(end-quote)-1}]]
- set tail [string range $text \
- [expr {$offset(end-quote)+2}] end]
- return "$head``[cross-reference $body]''[insert-cross-references $tail]"
+ quote {
+ if {$offset(end-quote) < 0} {
+ return [reference-error "Missing end quote" $text]
}
- bold -
- anchor {
- set head [string range $text \
- 0 [expr {$offset(end-quote)+1}]]
- set tail [string range $text \
- [expr {$offset(end-quote)+2}] end]
- return "$head[insert-cross-references $tail]"
+ if {$invert([lindex $offsets 1]) in {tcl tk ttk}} {
+ set offsets [lreplace $offsets 1 1]
}
+ switch -exact -- $invert([lindex $offsets 1]) {
+ end-quote {
+ append result [string range $text 0 [expr {$offset(quote)-1}]]
+ set body [string range $text [expr {$offset(quote)+2}] \
+ [expr {$offset(end-quote)-1}]]
+ set text [string range $text[set text ""] \
+ [expr {$offset(end-quote)+2}] end]
+ append result `` [cross-reference $body] ''
+ continue
+ }
+ bold - anchor {
+ append result [string range $text \
+ 0 [expr {$offset(end-quote)+1}]]
+ set text [string range $text[set text ""] \
+ [expr {$offset(end-quote)+2}] end]
+ continue
+ }
+ }
+ return [reference-error "Uncaught quote case" $text]
}
- return [reference-error "Uncaught quote case" $text]
- }
- bold {
- if {$offset(end-bold) < 0} {
- return $text
- }
- if {$invert([lindex $offsets 1]) eq "tk"} {
- set offsets [lreplace $offsets 1 1]
- }
- if {$invert([lindex $offsets 1]) eq "tcl"} {
- set offsets [lreplace $offsets 1 1]
- }
- switch -exact -- $invert([lindex $offsets 1]) {
- end-bold {
- set head [string range $text 0 [expr {$offset(bold)-1}]]
- set body [string range $text [expr {$offset(bold)+3}] \
- [expr {$offset(end-bold)-1}]]
- set tail [string range $text \
- [expr {$offset(end-bold)+4}] end]
- return "$head<B>[cross-reference $body]</B>[insert-cross-references $tail]"
+ bold {
+ if {$offset(end-bold) < 0} {
+ return [append result $text]
}
- anchor {
- set head [string range $text \
- 0 [expr {$offset(end-bold)+3}]]
- set tail [string range $text \
- [expr {$offset(end-bold)+4}] end]
- return "$head[insert-cross-references $tail]"
+ if {[string match "c.*" $invert([lindex $offsets 1])]} {
+ set offsets [lreplace $offsets 1 1]
+ }
+ switch -exact -- $invert([lindex $offsets 1]) {
+ url - end-bold {
+ append result \
+ [string range $text 0 [expr {$offset(bold)-1}]]
+ set body [string range $text [expr {$offset(bold)+3}] \
+ [expr {$offset(end-bold)-1}]]
+ set text [string range $text[set text ""] \
+ [expr {$offset(end-bold)+4}] end]
+ regsub {http://[\w/.]+} $body {<A HREF="&">&</A>} body
+ append result <B> [cross-reference $body] </B>
+ continue
+ }
+ anchor {
+ append result \
+ [string range $text 0 [expr {$offset(end-bold)+3}]]
+ set text [string range $text[set text ""] \
+ [expr {$offset(end-bold)+4}] end]
+ continue
+ }
+ default {
+ return [reference-error "Uncaught bold case" $text]
+ }
}
}
- return [reference-error "Uncaught bold case" $text]
- }
- tk {
- set head [string range $text 0 [expr {$offset(tk)-1}]]
- set tail [string range $text $offset(tk) end]
- if {![regexp {^(Tk_\w+)(.*)$} $tail all body tail]} {
- return [reference-error "Tk regexp failed" $text]
+ c.tk - c.ttk - c.tcl - c.tdbc - c.itcl {
+ append result [string range $text 0 \
+ [expr {[lindex $offsets 0]-1}]]
+ regexp -indices -start [lindex $offsets 0] {\w+} $text range
+ set body [string range $text {*}$range]
+ set text [string range $text[set text ""] \
+ [expr {[lindex $range 1]+1}] end]
+ append result [cross-reference $body]
+ continue
}
- return $head[cross-reference $body][insert-cross-references $tail]
- }
- tcl {
- set head [string range $text 0 [expr {$offset(tcl)-1}]]
- set tail [string range $text $offset(tcl) end]
- if {![regexp {^(Tcl_\w+)(.*)$} $tail all body tail]} {
- return [reference-error {Tcl regexp failed} $text]
+ Tcl1 - Tcl2 {
+ set off [lindex $offsets 0]
+ append result [string range $text 0 [expr {$off-1}]]
+ set text [string range $text[set text ""] [expr {$off+3}] end]
+ append result [cross-reference Tcl]
+ continue
+ }
+ url {
+ set off [lindex $offsets 0]
+ append result [string range $text 0 [expr {$off-1}]]
+ regexp -indices -start $off {http://[\w/.]+} $text range
+ set url [string range $text {*}$range]
+ append result "<A HREF=\"$url\">" $url "</A>"
+ set text [string range $text[set text ""] \
+ [expr {[lindex $range 1]+1}] end]
+ continue
+ }
+ end-anchor - end-bold - end-quote {
+ return [reference-error "Out of place $invert([lindex $offsets 0])" $text]
}
- return $head[cross-reference $body][insert-cross-references $tail]
- }
- Tcl1 -
- Tcl2 {
- set off [lindex $offsets 0]
- set head [string range $text 0 [expr {$off-1}]]
- set body Tcl
- set tail [string range $text [expr {$off+3}] end]
- return $head[cross-reference $body][insert-cross-references $tail]
- }
- end-anchor -
- end-bold -
- end-quote {
- return [reference-error "Out of place $invert([lindex $offsets 0])" $text]
}
}
}
+
##
## process formatting directives
##
@@ -890,7 +944,9 @@ proc output-directive {line} {
set line [next-text]
if {[is-a-directive $line]} {
backup-text 1
- output-name [join $names { }]
+ if {[llength $names]} {
+ output-name [join $names { }]
+ }
return
}
lappend names [string trim $line]
@@ -1034,25 +1090,17 @@ proc output-directive {line} {
output-IP-list .IP .IP $rest
return
}
- .PP {
+ .PP - .sp {
man-puts <P>
}
.RS {
output-RS-list
return
}
- .RE {
- manerror "unexpected .RE"
- return
- }
.br {
man-puts <BR>
return
}
- .DE {
- manerror "unexpected .DE"
- return
- }
.DS {
if {[next-op-is .ta rest]} {
# skip the leading .ta directive if it is there
@@ -1080,16 +1128,6 @@ proc output-directive {line} {
}
return
}
- .CE {
- manerror "unexpected .CE"
- return
- }
- .sp {
- man-puts <P>
- }
- .ta {
- manerror "ignoring $line"
- }
.nf {
if {[match-text @more .fi]} {
foreach more [split $more \n] {
@@ -1145,13 +1183,11 @@ proc output-directive {line} {
manerror "ignoring $line"
}
}
- .fi {
- manerror "ignoring $line"
+ .RE - .DE - .CE {
+ manerror "unexpected $code"
+ return
}
- .na -
- .ad -
- .UL -
- .ne {
+ .ta - .fi - .na - .ad - .UL - .ie - .el - .ne {
manerror "ignoring $line"
}
default {
@@ -1159,6 +1195,7 @@ proc output-directive {line} {
}
}
}
+
##
## merge copyright listings
##
@@ -1196,7 +1233,373 @@ proc merge-copyrights {l1 l2} {
}
return [lsort -dictionary $merge]
}
+
+##
+## foreach of the man pages in the section specified by
+## sectionDescriptor, convert manpages into hypertext in
+## the directory specified by outputDir.
+##
+proc make-manpage-section {outputDir sectionDescriptor} {
+ global manual overall_title tcltkdesc verbose
+ global excluded_pages forced_index_pages process_first_patterns
+
+ set LQ \u201c
+ set RQ \u201d
+ lassign $sectionDescriptor \
+ manual(wing-glob) \
+ manual(wing-name) \
+ manual(wing-file) \
+ manual(wing-description)
+ set manual(wing-copyrights) {}
+ makedirhier $outputDir/$manual(wing-file)
+ set manual(wing-toc-fp) [open $outputDir/$manual(wing-file)/[indexfile] w]
+ # whistle
+ puts stderr "scanning section $manual(wing-name)"
+ # put the entry for this section into the short table of contents
+ if {[regexp {^(.+), version (.+)$} $manual(wing-name) -> name version]} {
+ puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/[indexfile]\" TITLE=\"version $version\">$name</A></DT><DD>$manual(wing-description)</DD>"
+ } else {
+ puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/[indexfile]\">$manual(wing-name)</A></DT><DD>$manual(wing-description)</DD>"
+ }
+ # initialize the wing table of contents
+ puts $manual(wing-toc-fp) [htmlhead $manual(wing-name) \
+ $manual(wing-name) $overall_title "../[indexfile]"]
+ # initialize the short table of contents for this section
+ set manual(wing-toc) {}
+ # initialize the man directory for this section
+ makedirhier $outputDir/$manual(wing-file)
+ # initialize the long table of contents for this section
+ set manual(long-toc-n) 1
+ # get the manual pages for this section
+ set manual(pages) [lsort -dictionary [glob -nocomplain $manual(wing-glob)]]
+ # Some pages have to go first so that their links override others
+ foreach pat $process_first_patterns {
+ set n [lsearch -glob $manual(pages) $pat]
+ if {$n >= 0} {
+ set f [lindex $manual(pages) $n]
+ puts stderr "shuffling [file tail $f] to front of processing queue"
+ set manual(pages) \
+ [linsert [lreplace $manual(pages) $n $n] 0 $f]
+ }
+ }
+ # set manual(pages) [lrange $manual(pages) 0 5]
+ foreach manual_page $manual(pages) {
+ set manual(page) [file normalize $manual_page]
+ # whistle
+ if {$verbose} {
+ puts stderr "scanning page $manual(page)"
+ } else {
+ puts -nonewline stderr .
+ }
+ set manual(tail) [file tail $manual(page)]
+ set manual(name) [file root $manual(tail)]
+ set manual(section) {}
+ if {$manual(name) in $excluded_pages} {
+ # obsolete
+ if {!$verbose} {
+ puts stderr ""
+ }
+ manerror "discarding $manual(name)"
+ continue
+ }
+ set manual(infp) [open $manual(page)]
+ set manual(text) {}
+ set manual(partial-text) {}
+ foreach p {.RS .DS .CS .SO} {
+ set manual($p) 0
+ }
+ set manual(stack) {}
+ set manual(section) {}
+ set manual(section-toc) {}
+ set manual(section-toc-n) 1
+ set manual(copyrights) {}
+ lappend manual(all-pages) $manual(wing-file)/$manual(tail)
+ lappend manual(all-page-domains) $manual(wing-name)
+ manreport 100 $manual(name)
+ while {[gets $manual(infp) line] >= 0} {
+ manreport 100 $line
+ if {[regexp {^[`'][/\\]} $line]} {
+ if {[regexp {Copyright (?:\(c\)|\\\(co).*$} $line copyright]} {
+ lappend manual(copyrights) $copyright
+ }
+ # comment
+ continue
+ }
+ if {"$line" eq {'}} {
+ # comment
+ continue
+ }
+ if {![parse-directive $line code rest]} {
+ addbuffer $line
+ continue
+ }
+ switch -exact -- $code {
+ .if - .nr - .ti - .in - .ie - .el -
+ .ad - .na - .so - .ne - .AS - .HS - .VE - .VS - . {
+ # ignore
+ continue
+ }
+ }
+ switch -exact -- $code {
+ .SH - .SS {
+ flushbuffer
+ if {[llength $rest] == 0} {
+ gets $manual(infp) rest
+ }
+ lappend manual(text) "$code [unquote $rest]"
+ }
+ .TH {
+ flushbuffer
+ lappend manual(text) "$code [unquote $rest]"
+ }
+ .QW {
+ lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \
+ inQuote afterwards
+ addbuffer $LQ [unquote $inQuote] $RQ [unquote $afterwards]
+ }
+ .PQ {
+ lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \
+ inQuote punctuation afterwards
+ addbuffer ( $LQ [unquote $inQuote] $RQ \
+ [unquote $punctuation] ) [unquote $afterwards]
+ }
+ .QR {
+ lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \
+ rangeFrom rangeTo afterwards
+ addbuffer $LQ [unquote $rangeFrom] "&ndash;" \
+ [unquote $rangeTo] $RQ [unquote $afterwards]
+ }
+ .MT {
+ addbuffer $LQ$RQ
+ }
+ .HS - .UL - .ta {
+ flushbuffer
+ lappend manual(text) "$code [unquote $rest]"
+ }
+ .BS - .BE - .br - .fi - .sp - .nf {
+ flushbuffer
+ if {$rest ne ""} {
+ if {!$verbose} {
+ puts stderr ""
+ }
+ manerror "unexpected argument: $line"
+ }
+ lappend manual(text) $code
+ }
+ .AP {
+ flushbuffer
+ lappend manual(text) [concat .IP [process-text \
+ "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]
+ }
+ .IP {
+ flushbuffer
+ regexp {^(.*) +\d+$} $rest all rest
+ lappend manual(text) ".IP [process-text \
+ [unquote [string trim $rest]]]"
+ }
+ .TP {
+ flushbuffer
+ while {[is-a-directive [set next [gets $manual(infp)]]]} {
+ if {!$verbose} {
+ puts stderr ""
+ }
+ manerror "ignoring $next after .TP"
+ }
+ if {"$next" ne {'}} {
+ lappend manual(text) ".IP [process-text $next]"
+ }
+ }
+ .OP {
+ flushbuffer
+ lassign $rest cmdName dbName dbClass
+ lappend manual(text) [concat .OP [process-text \
+ "\\fB$cmdName\\fR \\fB$dbName\\fR \\fB$dbClass\\fR"]]
+ }
+ .PP - .LP {
+ flushbuffer
+ lappend manual(text) {.PP}
+ }
+ .RS {
+ flushbuffer
+ incr manual(.RS)
+ lappend manual(text) $code
+ }
+ .RE {
+ flushbuffer
+ incr manual(.RS) -1
+ lappend manual(text) $code
+ }
+ .SO {
+ flushbuffer
+ incr manual(.SO)
+ if {[llength $rest] == 0} {
+ lappend manual(text) "$code options"
+ } else {
+ lappend manual(text) "$code [unquote $rest]"
+ }
+ }
+ .SE {
+ flushbuffer
+ incr manual(.SO) -1
+ lappend manual(text) $code
+ }
+ .DS {
+ flushbuffer
+ incr manual(.DS)
+ lappend manual(text) $code
+ }
+ .DE {
+ flushbuffer
+ incr manual(.DS) -1
+ lappend manual(text) $code
+ }
+ .CS {
+ flushbuffer
+ incr manual(.CS)
+ lappend manual(text) $code
+ }
+ .CE {
+ flushbuffer
+ incr manual(.CS) -1
+ lappend manual(text) $code
+ }
+ .de {
+ while {[gets $manual(infp) line] >= 0} {
+ if {[string match "..*" $line]} {
+ break
+ }
+ }
+ }
+ .. {
+ if {!$verbose} {
+ puts stderr ""
+ }
+ error "found .. outside of .de"
+ }
+ default {
+ if {!$verbose} {
+ puts stderr ""
+ }
+ flushbuffer
+ manerror "unrecognized format directive: $line"
+ }
+ }
+ }
+ flushbuffer
+ close $manual(infp)
+ # fixups
+ if {$manual(.RS) != 0} {
+ if {!$verbose} {
+ puts stderr ""
+ }
+ puts "unbalanced .RS .RE"
+ }
+ if {$manual(.DS) != 0} {
+ if {!$verbose} {
+ puts stderr ""
+ }
+ puts "unbalanced .DS .DE"
+ }
+ if {$manual(.CS) != 0} {
+ if {!$verbose} {
+ puts stderr ""
+ }
+ puts "unbalanced .CS .CE"
+ }
+ if {$manual(.SO) != 0} {
+ if {!$verbose} {
+ puts stderr ""
+ }
+ puts "unbalanced .SO .SE"
+ }
+ # output conversion
+ open-text
+ set haserror 0
+ if {[next-op-is .HS rest]} {
+ set manual($manual(wing-file)-$manual(name)-title) \
+ "[join [lrange $rest 1 end] { }] [lindex $rest 0] manual page"
+ } elseif {[next-op-is .TH rest]} {
+ set manual($manual(wing-file)-$manual(name)-title) \
+ "[lindex $rest 0] manual page - [join [lrange $rest 4 end] { }]"
+ } else {
+ set haserror 1
+ if {!$verbose} {
+ puts stderr ""
+ }
+ manerror "no .HS or .TH record found"
+ }
+ if {!$haserror} {
+ while {[more-text]} {
+ set line [next-text]
+ if {[is-a-directive $line]} {
+ output-directive $line
+ } else {
+ man-puts $line
+ }
+ }
+ man-puts [copyout $manual(copyrights) "../"]
+ set manual(wing-copyrights) [merge-copyrights \
+ $manual(wing-copyrights) $manual(copyrights)]
+ }
+ #
+ # make the long table of contents for this page
+ #
+ set manual(toc-$manual(wing-file)-$manual(name)) \
+ [concat <DL> $manual(section-toc) </DL>]
+ }
+ if {!$verbose} {
+ puts stderr ""
+ }
+
+ #
+ # make the wing table of contents for the section
+ #
+ set width 0
+ foreach name $manual(wing-toc) {
+ if {[string length $name] > $width} {
+ set width [string length $name]
+ }
+ }
+ set perline [expr {118 / $width}]
+ set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}]
+ set n 0
+ catch {unset rows}
+ foreach name [lsort -dictionary $manual(wing-toc)] {
+ set tail $manual(name-$name)
+ if {[llength $tail] > 1} {
+ manerror "$name is defined in more than one file: $tail"
+ set tail [lindex $tail [expr {[llength $tail]-1}]]
+ }
+ set tail [file tail $tail]
+ if {[info exists manual(tooltip-$manual(wing-file)/$tail.htm)]} {
+ set tooltip $manual(tooltip-$manual(wing-file)/$tail.htm)
+ set tooltip [string map {[ {\[} ] {\]} $ {\$} \\ \\\\} $tooltip]
+ regsub {^[^-]+-\s*(.)} $tooltip {[string totitle \1]} tooltip
+ append rows([expr {$n%$nrows}]) \
+ "<td> <a href=\"$tail.htm\" title=\"[subst $tooltip]\">$name</a> </td>"
+ } else {
+ append rows([expr {$n%$nrows}]) \
+ "<td> <a href=\"$tail.htm\">$name</a> </td>"
+ }
+ incr n
+ }
+ puts $manual(wing-toc-fp) <table>
+ foreach row [lsort -integer [array names rows]] {
+ puts $manual(wing-toc-fp) <tr>$rows($row)</tr>
+ }
+ puts $manual(wing-toc-fp) </table>
+
+ #
+ # insert wing copyrights
+ #
+ puts $manual(wing-toc-fp) [copyout $manual(wing-copyrights) "../"]
+ puts $manual(wing-toc-fp) "</BODY></HTML>"
+ close $manual(wing-toc-fp)
+ set manual(merge-copyrights) \
+ [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)]
+}
+
proc makedirhier {dir} {
try {
if {![file isdirectory $dir]} {
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index 258ee20..f392bce 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -1,8 +1,12 @@
-#!/bin/sh
-# The next line is executed by /bin/sh, but not tcl \
-exec tclsh "$0" ${1+"$@"}
+#!/usr/bin/env tclsh
-package require Tcl 8.6
+if {[catch {package require Tcl 8.6} msg]} {
+ puts stderr "ERROR: $msg"
+ puts stderr "If running this script from 'make html', set the\
+ NATIVE_TCLSH environment\nvariable to point to an installed\
+ tclsh8.6 (or the equivalent tclsh86.exe\non Windows)."
+ exit 1
+}
# Convert Ousterhout format man pages into highly crosslinked hypertext.
#
@@ -17,10 +21,8 @@ package require Tcl 8.6
#
# Copyright (c) 1995-1997 Roger E. Critchlow Jr
# Copyright (c) 2004-2010 Donal K. Fellows
-#
-# CVS: $Id: tcltk-man2html.tcl,v 1.49 2010/09/03 09:38:53 dkf Exp $
-regexp {\d+\.\d+} {$Revision: 1.49 $} ::Version
+set ::Version "50/8.6"
set ::CSSFILE "docs.css"
##
@@ -263,362 +265,36 @@ proc make-man-pages {html args} {
puts $manual(short-toc-fp) "<DL class=\"keylist\">"
set manual(merge-copyrights) {}
- set LQ \u201c
- set RQ \u201d
-
foreach arg $args {
# preprocess to set up subheader for the rest of the files
if {![llength $arg]} {
continue
}
- set name [lindex $arg 1]
- set file [lindex $arg 2]
+ lassign $arg -> name file
+ if {[regexp {(.*)(?: Package)? Commands(?:, version .*)?} $name -> pkg]} {
+ set name "$pkg Commands"
+ } elseif {[regexp {(.*)(?: Package)? C API(?:, version .*)?} $name -> pkg]} {
+ set name "$pkg C API"
+ }
lappend manual(subheader) $name $file
}
- foreach arg $args {
- if {![llength $arg]} {
- continue
- }
- set manual(wing-glob) [lindex $arg 0]
- set manual(wing-name) [lindex $arg 1]
- set manual(wing-file) [lindex $arg 2]
- set manual(wing-description) [lindex $arg 3]
- set manual(wing-copyrights) {}
- makedirhier $html/$manual(wing-file)
- set manual(wing-toc-fp) [open $html/$manual(wing-file)/[indexfile] w]
- # whistle
- puts stderr "scanning section $manual(wing-name)"
- # put the entry for this section into the short table of contents
- puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/[indexfile]\">$manual(wing-name)</A></DT><DD>$manual(wing-description)</DD>"
- # initialize the wing table of contents
- puts $manual(wing-toc-fp) [htmlhead $manual(wing-name) \
- $manual(wing-name) $overall_title "../[indexfile]"]
- # initialize the short table of contents for this section
- set manual(wing-toc) {}
- # initialize the man directory for this section
- makedirhier $html/$manual(wing-file)
- # initialize the long table of contents for this section
- set manual(long-toc-n) 1
- # get the manual pages for this section
- set manual(pages) [lsort -dictionary [glob -nocomplain $manual(wing-glob)]]
- # Some pages have to go first so that their links override others
- foreach pat $process_first_patterns {
- set n [lsearch -glob $manual(pages) $pat]
- if {$n >= 0} {
- set f [lindex $manual(pages) $n]
- puts stderr "shuffling [file tail $f] to front of processing queue"
- set manual(pages) \
- [linsert [lreplace $manual(pages) $n $n] 0 $f]
- }
- }
- # set manual(pages) [lrange $manual(pages) 0 5]
- foreach manual_page $manual(pages) {
- set manual(page) [file normalize $manual_page]
- # whistle
- if {$verbose} {
- puts stderr "scanning page $manual(page)"
- } else {
- puts -nonewline stderr .
- }
- set manual(tail) [file tail $manual(page)]
- set manual(name) [file root $manual(tail)]
- set manual(section) {}
- if {$manual(name) in $excluded_pages} {
- # obsolete
- if {!$verbose} {
- puts stderr ""
- }
- manerror "discarding $manual(name)"
- continue
- }
- set manual(infp) [open $manual(page)]
- set manual(text) {}
- set manual(partial-text) {}
- foreach p {.RS .DS .CS .SO} {
- set manual($p) 0
- }
- set manual(stack) {}
- set manual(section) {}
- set manual(section-toc) {}
- set manual(section-toc-n) 1
- set manual(copyrights) {}
- lappend manual(all-pages) $manual(wing-file)/$manual(tail)
- manreport 100 $manual(name)
- while {[gets $manual(infp) line] >= 0} {
- manreport 100 $line
- if {[regexp {^[`'][/\\]} $line]} {
- if {[regexp {Copyright (?:\(c\)|\\\(co).*$} $line copyright]} {
- lappend manual(copyrights) $copyright
- }
- # comment
- continue
- }
- if {"$line" eq {'}} {
- # comment
- continue
- }
- if {![parse-directive $line code rest]} {
- addbuffer $line
- continue
- }
- switch -exact -- $code {
- .if - .nr - .ti - .in -
- .ad - .na - .so - .ne - .AS - .VE - .VS - . {
- # ignore
- continue
- }
- }
- switch -exact -- $code {
- .SH - .SS {
- flushbuffer
- if {[llength $rest] == 0} {
- gets $manual(infp) rest
- }
- lappend manual(text) "$code [unquote $rest]"
- }
- .TH {
- flushbuffer
- lappend manual(text) "$code [unquote $rest]"
- }
- .QW {
- set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
- addbuffer $LQ [unquote [lindex $rest 0]] $RQ \
- [unquote [lindex $rest 1]]
- }
- .PQ {
- set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
- addbuffer ( $LQ [unquote [lindex $rest 0]] $RQ \
- [unquote [lindex $rest 1]] ) \
- [unquote [lindex $rest 2]]
- }
- .QR {
- set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
- addbuffer $LQ [unquote [lindex $rest 0]] - \
- [unquote [lindex $rest 1]] $RQ \
- [unquote [lindex $rest 2]]
- }
- .MT {
- addbuffer $LQ$RQ
- }
- .HS - .UL - .ta {
- flushbuffer
- lappend manual(text) "$code [unquote $rest]"
- }
- .BS - .BE - .br - .fi - .sp - .nf {
- flushbuffer
- if {"$rest" ne {}} {
- if {!$verbose} {
- puts stderr ""
- }
- manerror "unexpected argument: $line"
- }
- lappend manual(text) $code
- }
- .AP {
- flushbuffer
- lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]
- }
- .IP {
- flushbuffer
- regexp {^(.*) +\d+$} $rest all rest
- lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]"
- }
- .TP {
- flushbuffer
- while {[is-a-directive [set next [gets $manual(infp)]]]} {
- if {!$verbose} {
- puts stderr ""
- }
- manerror "ignoring $next after .TP"
- }
- if {"$next" ne {'}} {
- lappend manual(text) ".IP [process-text $next]"
- }
- }
- .OP {
- flushbuffer
- lappend manual(text) [concat .OP [process-text \
- "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]
- }
- .PP - .LP {
- flushbuffer
- lappend manual(text) {.PP}
- }
- .RS {
- flushbuffer
- incr manual(.RS)
- lappend manual(text) $code
- }
- .RE {
- flushbuffer
- incr manual(.RS) -1
- lappend manual(text) $code
- }
- .SO {
- flushbuffer
- incr manual(.SO)
- if {[llength $rest] == 0} {
- lappend manual(text) "$code options"
- } else {
- lappend manual(text) "$code [unquote $rest]"
- }
- }
- .SE {
- flushbuffer
- incr manual(.SO) -1
- lappend manual(text) $code
- }
- .DS {
- flushbuffer
- incr manual(.DS)
- lappend manual(text) $code
- }
- .DE {
- flushbuffer
- incr manual(.DS) -1
- lappend manual(text) $code
- }
- .CS {
- flushbuffer
- incr manual(.CS)
- lappend manual(text) $code
- }
- .CE {
- flushbuffer
- incr manual(.CS) -1
- lappend manual(text) $code
- }
- .de {
- while {[gets $manual(infp) line] >= 0} {
- if {[string match "..*" $line]} {
- break
- }
- }
- }
- .. {
- if {!$verbose} {
- puts stderr ""
- }
- error "found .. outside of .de"
- }
- default {
- if {!$verbose} {
- puts stderr ""
- }
- flushbuffer
- manerror "unrecognized format directive: $line"
- }
- }
- }
- flushbuffer
- close $manual(infp)
- # fixups
- if {$manual(.RS) != 0} {
- if {!$verbose} {
- puts stderr ""
- }
- puts "unbalanced .RS .RE"
- }
- if {$manual(.DS) != 0} {
- if {!$verbose} {
- puts stderr ""
- }
- puts "unbalanced .DS .DE"
- }
- if {$manual(.CS) != 0} {
- if {!$verbose} {
- puts stderr ""
- }
- puts "unbalanced .CS .CE"
- }
- if {$manual(.SO) != 0} {
- if {!$verbose} {
- puts stderr ""
- }
- puts "unbalanced .SO .SE"
- }
- # output conversion
- open-text
- set haserror 0
- if {[next-op-is .HS rest]} {
- set manual($manual(wing-file)-$manual(name)-title) \
- "[join [lrange $rest 1 end] { }] [lindex $rest 0] manual page"
- } elseif {[next-op-is .TH rest]} {
- set manual($manual(wing-file)-$manual(name)-title) \
- "[lindex $rest 0] manual page - [join [lrange $rest 4 end] { }]"
- } else {
- set haserror 1
- if {!$verbose} {
- puts stderr ""
- }
- manerror "no .HS or .TH record found"
- }
- if {!$haserror} {
- while {[more-text]} {
- set line [next-text]
- if {[is-a-directive $line]} {
- output-directive $line
- } else {
- man-puts $line
- }
- }
- man-puts [copyout $manual(copyrights) "../"]
- set manual(wing-copyrights) [merge-copyrights \
- $manual(wing-copyrights) $manual(copyrights)]
- }
- #
- # make the long table of contents for this page
- #
- set manual(toc-$manual(wing-file)-$manual(name)) \
- [concat <DL> $manual(section-toc) </DL>]
- }
- if {!$verbose} {
- puts stderr ""
- }
- #
- # make the wing table of contents for the section
- #
- set width 0
- foreach name $manual(wing-toc) {
- if {[string length $name] > $width} {
- set width [string length $name]
- }
- }
- set perline [expr {118 / $width}]
- set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}]
- set n 0
- catch {unset rows}
- foreach name [lsort -dictionary $manual(wing-toc)] {
- set tail $manual(name-$name)
- if {[llength $tail] > 1} {
- manerror "$name is defined in more than one file: $tail"
- set tail [lindex $tail [expr {[llength $tail]-1}]]
- }
- set tail [file tail $tail]
- append rows([expr {$n%$nrows}]) \
- "<td> <a href=\"$tail.htm\">$name</a> </td>"
- incr n
- }
- puts $manual(wing-toc-fp) <table>
- foreach row [lsort -integer [array names rows]] {
- puts $manual(wing-toc-fp) <tr>$rows($row)</tr>
+ ##
+ ## parse the manpages in a section of the docs (split by
+ ## package) and construct formatted manpages
+ ##
+ foreach arg $args {
+ if {[llength $arg]} {
+ make-manpage-section $html $arg
}
- puts $manual(wing-toc-fp) </table>
-
- #
- # insert wing copyrights
- #
- puts $manual(wing-toc-fp) [copyout $manual(wing-copyrights) "../"]
- puts $manual(wing-toc-fp) "</BODY></HTML>"
- close $manual(wing-toc-fp)
- set manual(merge-copyrights) [merge-copyrights \
- $manual(merge-copyrights) $manual(wing-copyrights)]
}
##
## build the keyword index.
##
+ if {!$verbose} {
+ puts stderr "Assembling index"
+ }
file delete -force -- $html/Keywords
makedirhier $html/Keywords
set keyfp [open $html/Keywords/[indexfile] w]
@@ -658,7 +334,15 @@ proc make-man-pages {html args} {
foreach man $manual(keyword-$k) {
set name [lindex $man 0]
set file [lindex $man 1]
- lappend refs "<A HREF=\"../$file\">$name</A>"
+ if {[info exists manual(tooltip-$file)]} {
+ set tooltip $manual(tooltip-$file)
+ if {[string match {*[<>""]*} $tooltip]} {
+ manerror "bad tooltip for $file: \"$tooltip\""
+ }
+ lappend refs "<A HREF=\"../$file\" TITLE=\"$tooltip\">$name</A>"
+ } else {
+ lappend refs "<A HREF=\"../$file\">$name</A>"
+ }
}
puts $afp "[join $refs {, }]</DD>"
}
@@ -688,9 +372,9 @@ proc make-man-pages {html args} {
##
unset manual(section)
if {!$verbose} {
- puts stderr "Rescanning [llength $manual(all-pages)] pages to build cross links"
+ puts stderr "Rescanning [llength $manual(all-pages)] pages to build cross links and write out"
}
- foreach path $manual(all-pages) {
+ foreach path $manual(all-pages) wing_name $manual(all-page-domains) {
set manual(wing-file) [file dirname $path]
set manual(tail) [file tail $path]
set manual(name) [file root $manual(tail)]
@@ -714,7 +398,7 @@ proc make-man-pages {html args} {
}
set outfd [open $html/$manual(wing-file)/$manual(name).htm w]
puts $outfd [htmlhead "$manual($manual(wing-file)-$manual(name)-title)" \
- $manual(name) $manual(wing-file) "[indexfile]" \
+ $manual(name) $wing_name "[indexfile]" \
$overall_title "../[indexfile]"]
if {($ntext > 60) && ($ntoc > 32)} {
foreach item $toc {
@@ -750,9 +434,18 @@ proc make-man-pages {html args} {
##
## Helper for assembling the descriptions of base packages (i.e., Tcl and Tk).
##
-proc plus-base {var glob name dir desc} {
+proc plus-base {var root glob name dir desc} {
global tcltkdir
if {$var} {
+ if {[file exists $tcltkdir/$root/README]} {
+ set f [open $tcltkdir/$root/README]
+ set d [read $f]
+ close $f
+ if {[regexp {This is the \w+ (\S+) source distribution} $d -> version]} {
+ append name ", version $version"
+ }
+ }
+ set glob $root/$glob
return [list $tcltkdir/$glob $name $dir $desc]
}
}
@@ -767,24 +460,31 @@ proc plus-pkgs {type args} {
}
if {!$build_tcl} return
set result {}
- foreach {dir name} $args {
- set globpat $tcltkdir/$tcldir/pkgs/$dir/doc/*.$type
- if {![llength [glob -nocomplain $globpat]]} {
+ set pkgsdir $tcltkdir/$tcldir/pkgs
+ foreach {dir name version} $args {
+ set globpat $pkgsdir/$dir/doc/*.$type
+ if {![llength [glob -type f -nocomplain $globpat]]} {
# Fallback for manpages generated using doctools
- set globpat $tcltkdir/$tcldir/pkgs/$dir/doc/man/*.$type
- if {![llength [glob -nocomplain $globpat]]} {
+ set globpat $pkgsdir/$dir/doc/man/*.$type
+ if {![llength [glob -type f -nocomplain $globpat]]} {
continue
}
}
switch $type {
n {
set title "$name Package Commands"
+ if {$version ne ""} {
+ append title ", version $version"
+ }
set dir [string totitle $dir]Cmd
set desc \
"The additional commands provided by the $name package."
}
3 {
- set title "$name Package Library"
+ set title "$name Package C API"
+ if {$version ne ""} {
+ append title ", version $version"
+ }
set dir [string totitle $dir]Lib
set desc \
"The additional C functions provided by the $name package."
@@ -806,35 +506,92 @@ set ensemble_commands {
after array binary chan clock dde dict encoding file history info interp
memory namespace package registry self string trace update zlib
clipboard console font grab grid image option pack place selection tk
- tkwait ttk::style winfo wm
+ tkwait ttk::style winfo wm itcl::delete itcl::find itcl::is
}
array set remap_link_target {
stdin Tcl_GetStdChannel
stdout Tcl_GetStdChannel
stderr Tcl_GetStdChannel
- safe {Safe&nbsp;Base}
style ttk::style
{style map} ttk::style
+ {tk busy} busy
+ library auto_execok
+ safe-tcl safe
+ tclvars env
+ tcl_break catch
+ tcl_continue catch
+ tcl_error catch
+ tcl_ok catch
+ tcl_return catch
+ int() mathfunc
+ wide() mathfunc
+ packagens pkg::create
+ pkgMkIndex pkg_mkIndex
+ pkg_mkIndex pkg_mkIndex
+ Tcl_Obj Tcl_NewObj
+ Tcl_ObjType Tcl_RegisterObjType
+ Tcl_OpenFileChannelProc Tcl_FSOpenFileChannel
+ errorinfo env
+ errorcode env
+ tcl_pkgpath env
+ Tcl_Command Tcl_CreateObjCommand
+ Tcl_CmdProc Tcl_CreateObjCommand
+ Tcl_CmdDeleteProc Tcl_CreateObjCommand
+ Tcl_ObjCmdProc Tcl_CreateObjCommand
+ Tcl_Channel Tcl_OpenFileChannel
+ Tcl_WideInt Tcl_NewIntObj
+ Tcl_ChannelType Tcl_CreateChannel
+ Tcl_DString Tcl_DStringInit
+ Tcl_Namespace Tcl_AppendExportList
+ Tcl_Object Tcl_NewObjectInstance
+ Tcl_Class Tcl_GetObjectAsClass
+ Tcl_Event Tcl_QueueEvent
+ Tcl_Time Tcl_GetTime
+ Tcl_ThreadId Tcl_CreateThread
+ Tk_Window Tk_WindowId
+ Tk_3DBorder Tk_Get3DBorder
+ Tk_Anchor Tk_GetAnchor
+ Tk_Cursor Tk_GetCursor
+ Tk_Dash Tk_GetDash
+ Tk_Font Tk_GetFont
+ Tk_Image Tk_GetImage
+ Tk_ImageMaster Tk_GetImage
+ Tk_ItemType Tk_CreateItemType
+ Tk_Justify Tk_GetJustify
+ Ttk_Theme Ttk_GetTheme
}
array set exclude_refs_map {
+ bind.n {button destroy option}
clock.n {next}
history.n {exec}
next.n {unknown}
zlib.n {binary close filename text}
canvas.n {bitmap text}
+ console.n {eval}
checkbutton.n {image}
clipboard.n {string}
+ entry.n {string}
+ event.n {return}
+ font.n {menu}
+ getOpenFile.n {file open text}
+ grab.n {global}
+ interp.n {time}
menu.n {checkbutton radiobutton}
+ messageBox.n {error info}
options.n {bitmap image set}
radiobutton.n {image}
+ safe.n {join split}
+ scale.n {label variable}
scrollbar.n {set}
selection.n {string}
tcltest.n {error}
tkvars.n {tk}
+ tkwait.n {variable}
+ tm.n {exec}
ttk_checkbutton.n {variable}
ttk_combobox.n {selection}
ttk_entry.n {focus variable}
- ttk_intro.n {focus}
+ ttk_intro.n {focus text}
ttk_label.n {font text}
ttk_labelframe.n {text}
ttk_menubutton.n {flush}
@@ -863,6 +620,9 @@ array set exclude_when_followed_by_map {
ttk_image.n {
image imageSpec
}
+ fontchooser.n {
+ tk fontchooser
+ }
}
try {
@@ -887,8 +647,44 @@ try {
append appdir "$tkdir"
}
- # Get the list of packages to try, and what their human-readable
- # names are.
+
+ # When building docs for Tcl, try to build docs for bundled packages too
+ set packageBuildList {}
+ if {$build_tcl} {
+ set pkgsDir [file join $tcltkdir $tcldir pkgs]
+ set subdirs [glob -nocomplain -types d -tails -directory $pkgsDir *]
+
+ foreach dir [lsort $subdirs] {
+ # Parse the subdir name into (name, version) as fallback...
+ set description [split $dir -]
+ if {2 != [llength $description]} {
+ regexp {([^0-9]*)(.*)} $dir -> n v
+ set description [list $n $v]
+ }
+
+ # ... but try to extract (name, version) from subdir contents
+ try {
+ set f [open [file join $pkgsDir $dir configure.in]]
+ foreach line [split [read $f] \n] {
+ if {2 == [scan $line \
+ { AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} {
+ set description [list $n $v]
+ break
+ }
+ }
+ } finally {
+ catch {close $f; unset f}
+ }
+
+ if {[file exists [file join $pkgsDir $dir configure]]} {
+ # Looks like a package, record our best extraction attempt
+ lappend packageBuildList $dir {*}$description
+ }
+ }
+ }
+
+ # Get the list of packages to try, and what their human-readable names
+ # are. Note that the package directory list should be version-less.
try {
set packageDirNameMap {}
if {$build_tcl} {
@@ -907,7 +703,15 @@ try {
set packageDirNameMap {
itcl {[incr Tcl]}
tdbc {TDBC}
- Thread Thread
+ thread Thread
+ }
+ }
+
+ # Convert to human readable names, if applicable
+ for {set idx 0} {$idx < [llength $packageBuildList]} {incr idx 3} {
+ lassign [lrange $packageBuildList $idx $idx+2] d n v
+ if {[dict exists $packageDirNameMap $n]} {
+ lset packageBuildList $idx+1 [dict get $packageDirNameMap $n]
}
}
@@ -917,23 +721,23 @@ try {
make-man-pages $webdir \
[list $tcltkdir/{$appdir}/doc/*.1 "$tcltkdesc Applications" UserCmd \
"The interpreters which implement $cmdesc."] \
- [plus-base $build_tcl $tcldir/doc/*.n {Tcl Commands} TclCmd \
+ [plus-base $build_tcl $tcldir doc/*.n {Tcl Commands} TclCmd \
"The commands which the <B>tclsh</B> interpreter implements."] \
- [plus-base $build_tk $tkdir/doc/*.n {Tk Commands} TkCmd \
+ [plus-base $build_tk $tkdir doc/*.n {Tk Commands} TkCmd \
"The additional commands which the <B>wish</B> interpreter implements."] \
- {*}[plus-pkgs n {*}$packageDirNameMap] \
- [plus-base $build_tcl $tcldir/doc/*.3 {Tcl Library} TclLib \
+ {*}[plus-pkgs n {*}$packageBuildList] \
+ [plus-base $build_tcl $tcldir doc/*.3 {Tcl C API} TclLib \
"The C functions which a Tcl extended C program may use."] \
- [plus-base $build_tk $tkdir/doc/*.3 {Tk Library} TkLib \
+ [plus-base $build_tk $tkdir doc/*.3 {Tk C API} TkLib \
"The additional C functions which a Tk extended C program may use."] \
- {*}[plus-pkgs 3 {*}$packageDirNameMap]
+ {*}[plus-pkgs 3 {*}$packageBuildList]
} on error {msg opts} {
# On failure make sure we show what went wrong. We're not supposed
# to get here though; it represents a bug in the script.
puts $msg\n[dict get $opts -errorinfo]
exit 1
}
-
+
# Local-Variables:
# mode: tcl
# End:
diff --git a/tools/uniClass.tcl b/tools/uniClass.tcl
index 1840851..32b40e9 100644
--- a/tools/uniClass.tcl
+++ b/tools/uniClass.tcl
@@ -13,22 +13,36 @@ exec tclsh "$0" ${1+"$@"}
#
proc emitRange {first last} {
- global ranges numranges chars numchars
+ global ranges numranges chars numchars extchars extranges
if {$first < ($last-1)} {
- append ranges [format "{0x%04x, 0x%04x}, " \
+ if {!$extranges && ($first) > 0xffff} {
+ set extranges 1
+ set numranges 0
+ set ranges [string trimright $ranges " \n\r\t,"]
+ append ranges "\n#if TCL_UTF_MAX > 4\n ,"
+ }
+ append ranges [format "{0x%x, 0x%x}, " \
$first $last]
if {[incr numranges] % 4 == 0} {
+ set ranges [string trimright $ranges]
append ranges "\n "
}
} else {
- append chars [format "0x%04x, " $first]
+ if {!$extchars && ($first) > 0xffff} {
+ set extchars 1
+ set numchars 0
+ set chars [string trimright $chars " \n\r\t,"]
+ append chars "\n#if TCL_UTF_MAX > 4\n ,"
+ }
+ append chars [format "0x%x, " $first]
incr numchars
if {$numchars % 9 == 0} {
+ set chars [string trimright $chars]
append chars "\n "
}
if {$first != $last} {
- append chars [format "0x%04x, " $last]
+ append chars [format "0x%x, " $last]
incr numchars
if {$numchars % 9 == 0} {
append chars "\n "
@@ -38,7 +52,7 @@ proc emitRange {first last} {
}
proc genTable {type} {
- global first last ranges numranges chars numchars
+ global first last ranges numranges chars numchars extchars extranges
set first -2
set last -2
@@ -46,8 +60,14 @@ proc genTable {type} {
set numranges 0
set chars " "
set numchars 0
+ set extchars 0
+ set extranges 0
- for {set i 0} {$i <= 0xFFFF} {incr i} {
+ for {set i 0} {$i <= 0x10ffff} {incr i} {
+ if {$i == 0xd800} {
+ # Skip surrogates
+ set i 0xdc00
+ }
if {[string is $type [format %c $i]]} {
if {$i == ($last + 1)} {
set last $i
@@ -63,18 +83,24 @@ proc genTable {type} {
emitRange $first $last
set ranges [string trimright $ranges "\t\n ,"]
+ if {$extranges} {
+ append ranges "\n#endif"
+ }
set chars [string trimright $chars "\t\n ,"]
+ if {$extchars} {
+ append chars "\n#endif"
+ }
if {$ranges ne ""} {
- puts "static crange ${type}RangeTable\[\] = {\n$ranges\n};\n"
+ puts "static const crange ${type}RangeTable\[\] = {\n$ranges\n};\n"
puts "#define NUM_[string toupper $type]_RANGE (sizeof(${type}RangeTable)/sizeof(crange))\n"
} else {
puts "/* no contiguous ranges of $type characters */\n"
}
if {$chars ne ""} {
- puts "static chr ${type}CharTable\[\] = {\n$chars\n};\n"
+ puts "static const chr ${type}CharTable\[\] = {\n$chars\n};\n"
puts "#define NUM_[string toupper $type]_CHAR (sizeof(${type}CharTable)/sizeof(chr))\n"
} else {
- puts "/* no singletons of $type characters */\n"
+ puts "/*\n * no singletons of $type characters.\n */\n"
}
}
@@ -87,6 +113,7 @@ puts "/*
foreach {type desc} {
alpha "alphabetic characters"
+ control "control characters"
digit "decimal digit characters"
punct "punctuation characters"
space "white space characters"
@@ -94,7 +121,7 @@ foreach {type desc} {
upper "uppercase characters"
graph "unicode print characters excluding space"
} {
- puts "/* Unicode: $desc */\n"
+ puts "/*\n * Unicode: $desc.\n */\n"
genTable $type
}
diff --git a/tools/uniParse.tcl b/tools/uniParse.tcl
index 7560e6b..e33b3c7 100644
--- a/tools/uniParse.tcl
+++ b/tools/uniParse.tcl
@@ -4,12 +4,10 @@
# corresponding tclUniData.c file with compressed character
# data tables. The input to this program should be the latest
# UnicodeData file from:
-# ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData-Latest.txt
+# ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData.txt
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
-#
-# RCS: @(#) $Id: uniParse.tcl,v 1.6 2010/07/01 21:28:15 nijtmans Exp $
namespace eval uni {
@@ -32,45 +30,38 @@ namespace eval uni {
Cc Cf Co Cs Pc Pd Ps Pe Pi Pf Po Sm Sc Sk So
}; # Ordered list of character categories, must
# match the enumeration in the header file.
-
- variable titleCount 0; # Count of the number of title case
- # characters. This value is used in the
- # regular expression code to allocate enough
- # space for the title case variants.
}
proc uni::getValue {items index} {
variable categories
- variable titleCount
# Extract character info
set category [lindex $items 2]
- if {[scan [lindex $items 12] %4x toupper] == 1} {
+ if {[scan [lindex $items 12] %x toupper] == 1} {
set toupper [expr {$index - $toupper}]
} else {
- set toupper {}
+ set toupper 0
}
- if {[scan [lindex $items 13] %4x tolower] == 1} {
+ if {[scan [lindex $items 13] %x tolower] == 1} {
set tolower [expr {$tolower - $index}]
} else {
- set tolower {}
+ set tolower 0
}
- if {[scan [lindex $items 14] %4x totitle] == 1} {
+ if {[scan [lindex $items 14] %x totitle] == 1} {
set totitle [expr {$index - $totitle}]
+ } elseif {$tolower} {
+ set totitle 0
} else {
- set totitle {}
+ set totitle $toupper
}
set categoryIndex [lsearch -exact $categories $category]
if {$categoryIndex < 0} {
- puts "Unexpected character category: $index($category)"
- set categoryIndex 0
- } elseif {$category eq "Lt"} {
- incr titleCount
+ error "Unexpected character category: $index($category)"
}
- return "$categoryIndex,$toupper,$tolower,$totitle"
+ return [list $categoryIndex $toupper $tolower $totitle]
}
proc uni::getGroup {value} {
@@ -87,13 +78,14 @@ proc uni::getGroup {value} {
proc uni::addPage {info} {
variable pMap
variable pages
+ variable shift
set pIndex [lsearch -exact $pages $info]
if {$pIndex == -1} {
set pIndex [llength $pages]
lappend pages $info
}
- lappend pMap $pIndex
+ lappend pMap [expr {$pIndex << $shift}]
return
}
@@ -102,22 +94,31 @@ proc uni::buildTables {data} {
variable pMap {}
variable pages {}
- variable groups {{0,,,}}
+ variable groups {{0 0 0 0}}
+ variable next 0
set info {} ;# temporary page info
set mask [expr {(1 << $shift) - 1}]
- set next 0
-
foreach line [split $data \n] {
if {$line eq ""} {
- set line "FFFF;;Cn;0;ON;;;;;N;;;;;\n"
+ if {!($next & $mask)} {
+ # next character is already on page boundary
+ continue
+ }
+ # fill remaining page
+ set line [format %X [expr {($next-1)|$mask}]]
+ append line ";;Cn;0;ON;;;;;N;;;;;\n"
}
set items [split $line \;]
- scan [lindex $items 0] %4x index
- set index [format 0x%0.4x $index]
+ scan [lindex $items 0] %x index
+ if {$index > 0x2ffff} then {
+ # Ignore non-BMP characters, as long as Tcl doesn't support them
+ continue
+ }
+ set index [format %d $index]
set gIndex [getGroup [getValue $items $index]]
@@ -140,15 +141,11 @@ proc uni::buildTables {data} {
# Enter all assigned characters up to the current character
for {set i $next} {$i <= $index} {incr i} {
- # Split character index into offset and page number
- set offset [expr {$i & $mask}]
- set page [expr {($i >> $shift)}]
-
# Add the group index to the info for the current page
lappend info $gIndex
# If this is the last entry in the page, add the page
- if {$offset == $mask} {
+ if {($i & $mask) == $mask} {
addPage $info
set info {}
}
@@ -164,7 +161,7 @@ proc uni::main {} {
variable pages
variable groups
variable shift
- variable titleCount
+ variable next
if {$argc != 2} {
puts stderr "\nusage: $argv0 <datafile> <outdir>\n"
@@ -176,9 +173,8 @@ proc uni::main {} {
buildTables $data
puts "X = [llength $pMap] Y= [llength $pages] A= [llength $groups]"
- set size [expr {[llength $pMap] + [llength $pages]*(1<<$shift)}]
- puts "shift = 6, space = $size"
- puts "title case count = $titleCount"
+ set size [expr {[llength $pMap]*2 + ([llength $pages]<<$shift)}]
+ puts "shift = $shift, space = $size"
set f [open [file join [lindex $argv 1] tclUniData.c] w]
fconfigure $f -translation lf
@@ -191,8 +187,6 @@ proc uni::main {} {
*
* Copyright (c) 1998 by Scriptics Corporation.
* All rights reserved.
- *
- * RCS: @(#) \$Id\$
*/
/*
@@ -209,10 +203,18 @@ proc uni::main {} {
* to the same alternate page number.
*/
-static unsigned char pageMap\[\] = {"
+static const unsigned short pageMap\[\] = {"
set line " "
set last [expr {[llength $pMap] - 1}]
for {set i 0} {$i <= $last} {incr i} {
+ if {$i == [expr {0x10000 >> $shift}]} {
+ set line [string trimright $line " \t,"]
+ puts $f $line
+ set lastpage [expr {[lindex $line end] >> $shift}]
+ puts stdout "lastpage: $lastpage"
+ puts $f "#if TCL_UTF_MAX > 3"
+ set line " ,"
+ }
append line [lindex $pMap $i]
if {$i != $last} {
append line ", "
@@ -223,6 +225,7 @@ static unsigned char pageMap\[\] = {"
}
}
puts $f $line
+ puts $f "#endif /* TCL_UTF_MAX > 3 */"
puts $f "};
/*
@@ -231,12 +234,17 @@ static unsigned char pageMap\[\] = {"
* set of character attributes.
*/
-static unsigned char groupMap\[\] = {"
+static const unsigned char groupMap\[\] = {"
set line " "
set lasti [expr {[llength $pages] - 1}]
for {set i 0} {$i <= $lasti} {incr i} {
set page [lindex $pages $i]
set lastj [expr {[llength $page] - 1}]
+ if {$i == ($lastpage + 1)} {
+ puts $f [string trimright $line " \t,"]
+ puts $f "#if TCL_UTF_MAX > 3"
+ set line " ,"
+ }
for {set j 0} {$j <= $lastj} {incr j} {
append line [lindex $page $j]
if {$j != $lastj || $i != $lasti} {
@@ -249,6 +257,7 @@ static unsigned char groupMap\[\] = {"
}
}
puts $f $line
+ puts $f "#endif /* TCL_UTF_MAX > 3 */"
puts $f "};
/*
@@ -264,39 +273,49 @@ static unsigned char groupMap\[\] = {"
* 101 = sub delta for upper, sub 1 for title
* 110 = sub delta for upper, add delta for lower
*
- * Bits 8-21 Reserved for future use.
- *
- * Bits 22-31 Case delta: delta for case conversions. This should be the
+ * Bits 8-31 Case delta: delta for case conversions. This should be the
* highest field so we can easily sign extend.
*/
-static int groups\[\] = {"
+static const int groups\[\] = {"
set line " "
set last [expr {[llength $groups] - 1}]
for {set i 0} {$i <= $last} {incr i} {
- foreach {type toupper tolower totitle} [split [lindex $groups $i] ,] {}
+ foreach {type toupper tolower totitle} [lindex $groups $i] {}
# Compute the case conversion type and delta
- if {$totitle ne ""} {
+ if {$totitle} {
if {$totitle == $toupper} {
# subtract delta for title or upper
set case 4
set delta $toupper
- } elseif {$toupper ne ""} {
+ if {$tolower} {
+ error "New case conversion type needed: $toupper $tolower $totitle"
+ }
+ } elseif {$toupper} {
# subtract delta for upper, subtract 1 for title
set case 5
set delta $toupper
+ if {($totitle != 1) || $tolower} {
+ error "New case conversion type needed: $toupper $tolower $totitle"
+ }
} else {
# add delta for lower, add 1 for title
set case 3
set delta $tolower
+ if {$totitle != -1} {
+ error "New case conversion type needed: $toupper $tolower $totitle"
+ }
}
- } elseif {$toupper ne ""} {
+ } elseif {$toupper} {
# subtract delta for upper, add delta for lower
set case 6
set delta $toupper
- } elseif {$tolower ne ""} {
+ if {$tolower != $toupper} {
+ error "New case conversion type needed: $toupper $tolower $totitle"
+ }
+ } elseif {$tolower} {
# add delta for lower
set case 2
set delta $tolower
@@ -306,9 +325,7 @@ static int groups\[\] = {"
set delta 0
}
- set val [expr {($delta << 22) | ($case << 5) | $type}]
-
- append line [format "%d" $val]
+ append line [expr {($delta << 8) | ($case << 5) | $type}]
if {$i != $last} {
append line ", "
}
@@ -318,15 +335,19 @@ static int groups\[\] = {"
}
}
puts $f $line
- puts $f "};
+ puts -nonewline $f "};
+
+#if TCL_UTF_MAX > 3
+# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1fffff) >= [format 0x%x $next])
+#else
+# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1f0000) != 0)
+#endif
/*
* The following constants are used to determine the category of a
* Unicode character.
*/
-#define UNICODE_CATEGORY_MASK 0X1F
-
enum {
UNASSIGNED,
UPPERCASE_LETTER,
@@ -366,16 +387,16 @@ enum {
* to do sign extension on right shifts.
*/
-#define GetCaseType(info) (((info) & 0xE0) >> 5)
-#define GetCategory(info) ((info) & 0x1F)
-#define GetDelta(info) (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22)))
+#define GetCaseType(info) (((info) & 0xe0) >> 5)
+#define GetCategory(ch) (GetUniCharInfo(ch) & 0x1f)
+#define GetDelta(info) ((info) >> 8)
/*
* This macro extracts the information about a character from the
* Unicode character tables.
*/
-#define GetUniCharInfo(ch) (groups\[groupMap\[(pageMap\[(((int)(ch)) & 0xffff) >> OFFSET_BITS\] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
+#define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xffff) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
"
close $f
diff --git a/unix/.cvsignore b/unix/.cvsignore
deleted file mode 100644
index 84db0f4..0000000
--- a/unix/.cvsignore
+++ /dev/null
@@ -1,22 +0,0 @@
-pkgs
-Makefile
-config.status
-*.a
-*.plist
-*.dylib
-*.exe
-tclConfig.sh
-autom4te.cache
-tcl.pc
-cat
-dltest.marker
-longfile
-tclsh
-tcltest
-test1
-test2
-confdefs.h
-*.so
-pkg
-*.dll
-xttest
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 8128521..df05759 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -3,8 +3,6 @@
# a template for a Makefile; to generate the actual Makefile, run
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
-#
-# RCS: @(#) $Id: Makefile.in,v 1.307 2010/09/22 13:35:26 dgp Exp $
VERSION = @TCL_VERSION@
MAJOR_VERSION = @TCL_MAJOR_VERSION@
@@ -49,6 +47,7 @@ BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir)
# Directory in which to install libtcl.so or libtcl.a:
LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir)
+DLL_INSTALL_DIR = @DLL_INSTALL_DIR@
# Path name to use when installing library scripts.
SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY)
@@ -155,10 +154,11 @@ SHELL = @MAKEFILE_SHELL@
INSTALL_STRIP_PROGRAM = -s
INSTALL_STRIP_LIBRARY = -S -x
-INSTALL = $(UNIX_DIR)/install-sh -c
+INSTALL = $(SHELL) $(UNIX_DIR)/install-sh -c
INSTALL_PROGRAM = ${INSTALL}
INSTALL_LIBRARY = ${INSTALL}
INSTALL_DATA = ${INSTALL} -m 644
+INSTALL_DATA_DIR = ${INSTALL} -d -m 755
# NATIVE_TCLSH is the name of a tclsh executable that is available *BEFORE*
# running make for the first time. Certain build targets (make genstubs) need
@@ -238,7 +238,7 @@ DLTEST_DIR = @TCL_SRC_DIR@/unix/dltest
# Must be absolute to so the corresponding tcltest's tcl_library is absolute.
TCL_BUILDTIME_LIBRARY = @TCL_SRC_DIR@/library
-ZLIB_DIR = @ZLIB_DIR@
+ZLIB_DIR = ${COMPAT_DIR}/zlib
ZLIB_INCLUDE = @ZLIB_INCLUDE@
CC = @CC@
@@ -259,7 +259,6 @@ INSTALL_TZDATA = @INSTALL_TZDATA@
#--------------------------------------------------------------------------
GDB = gdb
-DDD = ddd
TRACE = strace
TRACE_OPTS =
VALGRIND = valgrind
@@ -308,7 +307,8 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
tclStrToD.o tclThread.o \
tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
- tclTomMathInterface.o
+ tclTomMathInterface.o \
+ tclAssembly.o
OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
tclOOMethod.o tclOOStubInit.o
@@ -316,17 +316,19 @@ OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \
bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
- bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o bn_mp_copy.o \
+ bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
+ bn_mp_cnt_lsb.o bn_mp_copy.o \
bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_3.o \
bn_mp_exch.o bn_mp_expt_d.o bn_mp_grow.o bn_mp_init.o \
bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
- bn_mp_init_size.o bn_mp_karatsuba_mul.o \
+ bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_karatsuba_mul.o \
bn_mp_karatsuba_sqr.o \
bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \
bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
bn_mp_radix_size.o bn_mp_radix_smap.o \
- bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_shrink.o \
+ bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
+ bn_mp_shrink.o \
bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \
@@ -383,6 +385,7 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/regfree.c \
$(GENERIC_DIR)/regerror.c \
$(GENERIC_DIR)/tclAlloc.c \
+ $(GENERIC_DIR)/tclAssembly.c \
$(GENERIC_DIR)/tclAsync.c \
$(GENERIC_DIR)/tclBasic.c \
$(GENERIC_DIR)/tclBinary.c \
@@ -451,6 +454,7 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/tclTrace.c \
$(GENERIC_DIR)/tclUtil.c \
$(GENERIC_DIR)/tclVar.c \
+ $(GENERIC_DIR)/tclAssembly.c \
$(GENERIC_DIR)/tclZlib.c
OO_SRCS = \
@@ -465,7 +469,7 @@ OO_SRCS = \
STUB_SRCS = \
$(GENERIC_DIR)/tclStubLib.c \
$(GENERIC_DIR)/tclTomMathStubLib.c \
- $(GENERIC_DIR)/tclOOStubLib.o
+ $(GENERIC_DIR)/tclOOStubLib.c
TOMMATH_SRCS = \
$(TOMMATH_DIR)/bncore.c \
@@ -482,6 +486,7 @@ TOMMATH_SRCS = \
$(TOMMATH_DIR)/bn_mp_cmp_d.c \
$(TOMMATH_DIR)/bn_mp_cmp_mag.c \
$(TOMMATH_DIR)/bn_mp_copy.c \
+ $(TOMMATH_DIR)/bn_mp_cnt_lsb.c \
$(TOMMATH_DIR)/bn_mp_count_bits.c \
$(TOMMATH_DIR)/bn_mp_div.c \
$(TOMMATH_DIR)/bn_mp_div_d.c \
@@ -495,6 +500,7 @@ TOMMATH_SRCS = \
$(TOMMATH_DIR)/bn_mp_init_copy.c \
$(TOMMATH_DIR)/bn_mp_init_multi.c \
$(TOMMATH_DIR)/bn_mp_init_set.c \
+ $(TOMMATH_DIR)/bn_mp_init_set_int.c \
$(TOMMATH_DIR)/bn_mp_init_size.c \
$(TOMMATH_DIR)/bn_mp_karatsuba_mul.c \
$(TOMMATH_DIR)/bn_mp_karatsuba_sqr.c \
@@ -512,6 +518,7 @@ TOMMATH_SRCS = \
$(TOMMATH_DIR)/bn_mp_read_radix.c \
$(TOMMATH_DIR)/bn_mp_rshd.c \
$(TOMMATH_DIR)/bn_mp_set.c \
+ $(TOMMATH_DIR)/bn_mp_set_int.c \
$(TOMMATH_DIR)/bn_mp_shrink.c \
$(TOMMATH_DIR)/bn_mp_sqr.c \
$(TOMMATH_DIR)/bn_mp_sqrt.c \
@@ -607,6 +614,10 @@ doc:
${LIB_FILE}: ${OBJS} ${STUB_LIB_FILE}
rm -f $@
@MAKE_LIB@
+ @if test "x$(DLL_INSTALL_DIR)" = "x$(BIN_INSTALL_DIR)"; then\
+ cp ${ZLIB_DIR}/win32/zlib1.dll .;\
+ fi
+
${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
rm -f $@
@@ -731,12 +742,8 @@ shell: ${TCL_EXE}
gdb: ${TCL_EXE}
$(SHELL_ENV) $(GDB) ./${TCL_EXE}
-# This target can be used to run tclsh inside ddd
-ddd: ${TCL_EXE}
- $(SHELL_ENV) $(DDD) ./${TCL_EXE}
-
valgrind: ${TCL_EXE} ${TCLTEST_EXE}
- $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl -singleproc 1 $(TESTFLAGS)
+ $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind $(TESTFLAGS)
valgrindshell: ${TCL_EXE}
$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCL_EXE} $(SCRIPT)
@@ -751,7 +758,13 @@ trace-test: ${TCLTEST_EXE}
# Installation rules
#--------------------------------------------------------------------------
-INSTALL_TARGETS = install-binaries install-libraries install-doc install-packages @EXTRA_INSTALL@
+INSTALL_BASE_TARGETS = install-binaries install-libraries install-msgs $(INSTALL_TZDATA)
+INSTALL_DOC_TARGETS = install-doc
+INSTALL_PACKAGE_TARGETS = install-packages
+INSTALL_DEV_TARGETS = install-headers
+INSTALL_EXTRA_TARGETS = @EXTRA_INSTALL@
+INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \
+ $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS)
install: $(INSTALL_TARGETS)
@@ -770,93 +783,80 @@ install-binaries: binaries
do \
if [ ! -d "$$i" ] ; then \
echo "Making directory $$i"; \
- mkdir -p "$$i"; \
- chmod 755 "$$i"; \
+ $(INSTALL_DATA_DIR) "$$i"; \
else true; \
fi; \
done;
- @if test ! -x $(UNIX_DIR)/install-sh; then \
- chmod +x $(UNIX_DIR)/install-sh; \
- fi
- @echo "Installing $(LIB_FILE) to @DLL_INSTALL_DIR@/"
+ @if test "x$(DLL_INSTALL_DIR)" = "x$(BIN_INSTALL_DIR)"; then\
+ echo "Installing zlib1.dll to $(BIN_INSTALL_DIR)/";\
+ $(INSTALL_LIBRARY) zlib1.dll "$(BIN_INSTALL_DIR)";\
+ chmod 555 "$(BIN_INSTALL_DIR)/zlib1.dll";\
+ fi
+ @echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/"
@@INSTALL_LIB@
- @chmod 555 "@DLL_INSTALL_DIR@"/$(LIB_FILE)
+ @chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)"
@echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
- @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)"/tclsh$(VERSION)${EXE_SUFFIX}
+ @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
@echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/"
- @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)"/tclConfig.sh
+ @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh"
@echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/"
@$(INSTALL_DATA) $(UNIX_DIR)/tclooConfig.sh \
- "$(CONFIG_INSTALL_DIR)"/tclooConfig.sh
+ "$(CONFIG_INSTALL_DIR)/tclooConfig.sh"
@if test "$(STUB_LIB_FILE)" != "" ; then \
echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
@INSTALL_STUB_LIB@ ; \
fi
@EXTRA_INSTALL_BINARIES@
@echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/"
- @mkdir -p $(LIB_INSTALL_DIR)/pkgconfig
+ @$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig
@$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc
-install-libraries: libraries $(INSTALL_TZDATA) install-msgs
- @for i in "$(INCLUDE_INSTALL_DIR)" "$(SCRIPT_INSTALL_DIR)"; \
+install-libraries: libraries
+ @for i in "$(SCRIPT_INSTALL_DIR)"; \
do \
if [ ! -d "$$i" ] ; then \
echo "Making directory $$i"; \
- mkdir -p "$$i"; \
- chmod 755 "$$i"; \
+ $(INSTALL_DATA_DIR) "$$i"; \
else true; \
fi; \
done;
- @for i in opt0.4 http1.0 encoding ../tcl8 ../tcl8/8.3 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
+ @for i in opt0.4 http1.0 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
do \
if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
- mkdir -p "$(SCRIPT_INSTALL_DIR)"/$$i; \
- chmod 755 "$(SCRIPT_INSTALL_DIR)"/$$i; \
+ $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
else true; \
fi; \
done;
- @if test ! -x $(UNIX_DIR)/install-sh; then \
- chmod +x $(UNIX_DIR)/install-sh; \
- fi
- @echo "Installing header files";
- @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
- $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
- $(GENERIC_DIR)/tclPlatDecls.h \
- $(GENERIC_DIR)/tclTomMath.h \
- $(GENERIC_DIR)/tclTomMathDecls.h ; \
- do \
- $(INSTALL_DATA) $$i "$(INCLUDE_INSTALL_DIR)"; \
- done;
- @echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
+ @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/";
@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \
$(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; \
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
done;
- @echo "Installing library http1.0 directory";
+ @echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/";
@for i in $(TOP_DIR)/library/http1.0/*.tcl ; \
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
done;
- @echo "Installing package http 2.8.2 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.2.tm;
- @echo "Installing library opt0.4 directory";
+ @echo "Installing package http 2.8.5 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.5.tm;
+ @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
@for i in $(TOP_DIR)/library/opt/*.tcl ; \
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
done;
- @echo "Installing package msgcat 1.4.3 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.3.tm;
- @echo "Installing package tcltest 2.3.2 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.2.tm;
+ @echo "Installing package msgcat 1.5.0 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.0.tm;
+ @echo "Installing package tcltest 2.3.5 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.5.tm;
- @echo "Installing package platform 1.0.9 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.9.tm;
+ @echo "Installing package platform 1.0.10 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.10.tm;
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;
- @echo "Installing library encoding directory";
+ @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/";
@for i in $(TOP_DIR)/library/encoding/*.enc ; do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/encoding; \
done;
@@ -867,55 +867,78 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
fi
install-tzdata: ${NATIVE_TCLSH}
- @echo "Installing time zone data"
+ @echo "Installing time zone files to $(SCRIPT_INSTALL_DIR)/tzdata/"
@${NATIVE_TCLSH} $(TOOL_DIR)/installData.tcl \
$(TOP_DIR)/library/tzdata "$(SCRIPT_INSTALL_DIR)"/tzdata
-install-msgs: ${NATIVE_TCLSH}
- @echo "Installing message catalogs"
- @${NATIVE_TCLSH} $(TOOL_DIR)/installData.tcl \
- $(TOP_DIR)/library/msgs "$(SCRIPT_INSTALL_DIR)"/msgs
+install-msgs:
+ @for i in msgs; \
+ do \
+ if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
+ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
+ $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing message catalog files to $(SCRIPT_INSTALL_DIR)/msgs/"
+ @for i in $(TOP_DIR)/library/msgs/*.msg ; do \
+ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/msgs; \
+ done;
install-doc: doc
@for i in "$(MAN_INSTALL_DIR)" "$(MAN1_INSTALL_DIR)" "$(MAN3_INSTALL_DIR)" "$(MANN_INSTALL_DIR)" ; \
do \
if [ ! -d "$$i" ] ; then \
echo "Making directory $$i"; \
- mkdir -p "$$i"; \
- chmod 755 "$$i"; \
+ $(INSTALL_DATA_DIR) "$$i"; \
else true; \
fi; \
done;
- @echo "Installing and cross-linking top-level (.1) docs";
+ @echo "Installing and cross-linking top-level (.1) docs to $(MAN1_INSTALL_DIR)/";
@for i in $(TOP_DIR)/doc/*.1; do \
$(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN1_INSTALL_DIR)"; \
done
- @echo "Installing and cross-linking C API (.3) docs";
+ @echo "Installing and cross-linking C API (.3) docs to $(MAN3_INSTALL_DIR)/";
@for i in $(TOP_DIR)/doc/*.3; do \
$(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN3_INSTALL_DIR)"; \
done
- @echo "Installing and cross-linking command (.n) docs";
+ @echo "Installing and cross-linking command (.n) docs to $(MANN_INSTALL_DIR)/";
@for i in $(TOP_DIR)/doc/*.n; do \
$(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MANN_INSTALL_DIR)"; \
done
+install-headers:
+ @for i in "$(INCLUDE_INSTALL_DIR)"; \
+ do \
+ if [ ! -d "$$i" ] ; then \
+ echo "Making directory $$i"; \
+ $(INSTALL_DATA_DIR) "$$i"; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
+ @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
+ $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
+ $(GENERIC_DIR)/tclPlatDecls.h \
+ $(GENERIC_DIR)/tclTomMath.h \
+ $(GENERIC_DIR)/tclTomMathDecls.h ; \
+ do \
+ $(INSTALL_DATA) $$i "$(INCLUDE_INSTALL_DIR)"; \
+ done;
+
# Optional target to install private headers
-install-private-headers: libraries
+install-private-headers:
@for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
do \
if [ ! -d "$$i" ] ; then \
echo "Making directory $$i"; \
- mkdir -p "$$i"; \
- chmod 755 "$$i"; \
+ $(INSTALL_DATA_DIR) "$$i"; \
else true; \
fi; \
done;
- @if test ! -x $(UNIX_DIR)/install-sh; then \
- chmod +x $(UNIX_DIR)/install-sh; \
- fi
- @echo "Installing private header files";
+ @echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/";
@for i in $(GENERIC_DIR)/tclInt.h $(GENERIC_DIR)/tclIntDecls.h \
$(GENERIC_DIR)/tclIntPlatDecls.h $(GENERIC_DIR)/tclPort.h \
$(GENERIC_DIR)/tclOOInt.h $(GENERIC_DIR)/tclOOIntDecls.h \
@@ -977,6 +1000,7 @@ COMPILEHDR=$(GENERIC_DIR)/tclCompile.h
FSHDR=$(GENERIC_DIR)/tclFileSystem.h
IOHDR=$(GENERIC_DIR)/tclIO.h
MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
+PARSEHDR=$(GENERIC_DIR)/tclParse.h
NREHDR=$(GENERIC_DIR)/tclInt.h
regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
@@ -996,11 +1020,11 @@ regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c
tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
$(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c
-# On Unix we want to use the normal malloc/free implementation, so we
-# specifically set the USE_TCLALLOC flag.
-
tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c
- $(CC) -c $(CC_SWITCHES) -DUSE_TCLALLOC=0 $(GENERIC_DIR)/tclAlloc.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c
+
+tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR)
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c
tclAsync.o: $(GENERIC_DIR)/tclAsync.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c
@@ -1173,7 +1197,7 @@ tclOOMethod.o: $(GENERIC_DIR)/tclOOMethod.c
tclOOStubInit.o: $(GENERIC_DIR)/tclOOStubInit.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOStubInit.c
-tclParse.o: $(GENERIC_DIR)/tclParse.c
+tclParse.o: $(GENERIC_DIR)/tclParse.c $(PARSEHDR)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclParse.c
tclPanic.o: $(GENERIC_DIR)/tclPanic.c
@@ -1197,7 +1221,7 @@ tclPkg.o: $(GENERIC_DIR)/tclPkg.c
# prefix/exec_prefix but all the different paths individually.
tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c
- $(CC) -c $(CC_SWITCHES) \
+ $(CC) -c $(CC_SWITCHES) \
-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR)\"" \
-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR)\"" \
-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR)\"" \
@@ -1245,7 +1269,7 @@ tclStubInit.o: $(GENERIC_DIR)/tclStubInit.c
tclTrace.o: $(GENERIC_DIR)/tclTrace.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTrace.c
-tclUtil.o: $(GENERIC_DIR)/tclUtil.c
+tclUtil.o: $(GENERIC_DIR)/tclUtil.c $(PARSEHDR)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtil.c
tclUtf.o: $(GENERIC_DIR)/tclUtf.c $(GENERIC_DIR)/tclUniData.c
@@ -1255,7 +1279,7 @@ tclVar.o: $(GENERIC_DIR)/tclVar.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c
tclZlib.o: $(GENERIC_DIR)/tclZlib.c
- $(CC) -c $(ZLIB_INCLUDE) $(CC_SWITCHES) $(GENERIC_DIR)/tclZlib.c
+ $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c
tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS)
$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c
@@ -1326,6 +1350,9 @@ bn_mp_cmp_d.o: $(TOMMATH_DIR)/bn_mp_cmp_d.c $(MATHHDRS)
bn_mp_cmp_mag.o: $(TOMMATH_DIR)/bn_mp_cmp_mag.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_cmp_mag.c
+bn_mp_cnt_lsb.o: $(TOMMATH_DIR)/bn_mp_cnt_lsb.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_cnt_lsb.c
+
bn_mp_copy.o: $(TOMMATH_DIR)/bn_mp_copy.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_copy.c
@@ -1368,6 +1395,9 @@ bn_mp_init_multi.o: $(TOMMATH_DIR)/bn_mp_init_multi.c $(MATHHDRS)
bn_mp_init_set.o: $(TOMMATH_DIR)/bn_mp_init_set.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_set.c
+bn_mp_init_set_int.o: $(TOMMATH_DIR)/bn_mp_init_set_int.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_set_int.c
+
bn_mp_init_size.o:$(TOMMATH_DIR)/bn_mp_init_size.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_size.c
@@ -1419,6 +1449,9 @@ bn_mp_rshd.o: $(TOMMATH_DIR)/bn_mp_rshd.c $(MATHHDRS)
bn_mp_set.o: $(TOMMATH_DIR)/bn_mp_set.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set.c
+bn_mp_set_int.o: $(TOMMATH_DIR)/bn_mp_set_int.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_int.c
+
bn_mp_shrink.o: $(TOMMATH_DIR)/bn_mp_shrink.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_shrink.c
@@ -1518,6 +1551,10 @@ tclMacOSXFCmd.o: $(MAC_OSX_DIR)/tclMacOSXFCmd.c
tclMacOSXNotify.o: $(MAC_OSX_DIR)/tclMacOSXNotify.c
$(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXNotify.c
+# The following is a CYGWIN only source:
+tclWinError.o: $(TOP_DIR)/win/tclWinError.c
+ $(CC) -c $(CC_SWITCHES) $(TOP_DIR)/win/tclWinError.c
+
# DTrace support
$(TCL_OBJS) $(STUB_LIB_OBJS) $(TCLSH_OBJS) $(TCLTEST_OBJS) $(XTTEST_OBJS): @DTRACE_HDR@
@@ -1584,6 +1621,9 @@ strtoul.o: $(COMPAT_DIR)/strtoul.c
waitpid.o: $(COMPAT_DIR)/waitpid.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/waitpid.c
+fake-rfc2553.o: $(COMPAT_DIR)/fake-rfc2553.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fake-rfc2553.c
+
# For building zlib, only used in some build configurations
Zadler32.o: $(ZLIB_DIR)/adler32.c
$(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/adler32.c
@@ -1661,7 +1701,7 @@ packages: configure-packages ${STUB_LIB_FILE}
pkg=`basename $$i`; \
if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
echo "Building package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) --no-print-directory; ) || exit $$?; \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) || exit $$?; \
fi; \
fi; \
done
@@ -1672,7 +1712,7 @@ install-packages: packages
pkg=`basename $$i`; \
if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
echo "Installing package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) --no-print-directory install \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE) install \
"DESTDIR=$(INSTALL_ROOT)"; ) || exit $$?; \
fi; \
fi; \
@@ -1683,10 +1723,8 @@ test-packages: tcltest packages
if [ -d $$i ]; then \
pkg=`basename $$i`; \
if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- echo ""; \
- echo ""; \
echo "Testing package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) --no-print-directory \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE) \
"@LD_LIBRARY_PATH_VAR@=../..:$${@LD_LIBRARY_PATH_VAR@}" \
"TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" \
"TCLLIBPATH=../../pkgs" test \
@@ -1700,7 +1738,7 @@ clean-packages:
if [ -d $$i ]; then \
pkg=`basename $$i`; \
if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) --no-print-directory clean; ) \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \
fi; \
fi; \
done
@@ -1710,7 +1748,7 @@ distclean-packages:
if [ -d $$i ]; then \
pkg=`basename $$i`; \
if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) --no-print-directory distclean; ) \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \
fi; \
rm -rf $(PKG_DIR)/$$pkg; \
fi; \
@@ -1724,7 +1762,7 @@ dist-packages: configure-packages
if [ -d $$i ]; then \
pkg=`basename $$i`; \
if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) --no-print-directory dist \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE) dist \
"DIST_ROOT=$(DISTROOT)/pkgs"; ) || exit $$?; \
fi; \
fi; \
@@ -1847,13 +1885,13 @@ checkexports: $(TCL_LIB_FILE)
# system.
#
-rpm: all /bin/rpm
+rpm: all
rm -f THIS.TCL.SPEC
echo "%define _builddir `pwd`" > THIS.TCL.SPEC
echo "%define _rpmdir `pwd`/RPMS" >> THIS.TCL.SPEC
cat tcl.spec >> THIS.TCL.SPEC
mkdir -p RPMS/i386
- rpm -bb THIS.TCL.SPEC
+ rpmbuild -bb THIS.TCL.SPEC
mv RPMS/i386/*.rpm .
rm -rf RPMS THIS.TCL.SPEC
@@ -1890,7 +1928,6 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
$(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix
chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
chmod 775 $(DISTDIR)/unix/ldAix
- chmod +x $(DISTDIR)/unix/install-sh
mkdir $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
@@ -1975,11 +2012,9 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
cp -p $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \
$(TOOL_DIR)/configure $(TOOL_DIR)/configure.in \
$(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \
- $(TOOL_DIR)/tcl.wse.in $(TOOL_DIR)/*.bmp \
- $(TOOL_DIR)/tcl.hpj.in \
+ $(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \
$(DISTDIR)/tools
- $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/tools/tcl.hpj.in \
- $(DISTDIR)/tools/tcl.wse.in
+ $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/tools/tcl.hpj.in
mkdir $(DISTDIR)/libtommath
cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \
$(DISTDIR)/libtommath
@@ -1989,33 +2024,11 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
tar -C $(DISTDIR)/pkgs -xzf "$$i"; \
done
-#
-# The following target can only be used for non-patch releases. Use the
-# "allpatch" target below for patch releases.
-#
-
alldist: dist
rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME)
cd $(DISTROOT); tar cf $(DISTNAME)-src.tar $(DISTNAME); \
gzip -9 $(DISTNAME)-src.tar; zip -qr8 $(ZIPNAME) $(DISTNAME)
-#
-# The target below is similar to "alldist" except it works for patch releases.
-# It is needed because patch releases are peculiar: the patch designation
-# appears in the name of the compressed file (e.g. tcl8.0p1.tar.gz) but the
-# extracted source directory doesn't include the patch designation (e.g.,
-# tcl8.0).
-#
-
-allpatch: dist
- rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME)
- mv $(DISTROOT)/tcl${VERSION} $(DISTROOT)/old
- mv $(DISTROOT)/$(DISTNAME) $(DISTROOT)/tcl${VERSION}
- cd $(DISTROOT); tar cf $(DISTNAME)-src.tar tcl${VERSION}; \
- gzip -9 $(DISTNAME)-src.tar; zip -r8 $(ZIPNAME) tcl${VERSION}
- mv $(DISTROOT)/tcl${VERSION} $(DISTROOT)/$(DISTNAME)
- mv $(DISTROOT)/old $(DISTROOT)/tcl${VERSION}
-
#--------------------------------------------------------------------------
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
@@ -2048,14 +2061,16 @@ BUILD_HTML = \
# 'make' from getting confused when someone makes an error in a rule.
#--------------------------------------------------------------------------
-.PHONY: all binaries libraries doc packages tclLibObjs objs tcltest-real test
-.PHONY: test-tcl gdb-test runtest ro-test shell gdb ddd valgrind valgrindshell
-.PHONY: topDirName gendate gentommath_h install install-strip install-binaries
-.PHONY: install-libraries install-tzdata install-msgs install-doc clean dist
-.PHONY: install-private-headers distclean depend xttest configure-packages rpm
-.PHONY: packages install-packages test-packages clean-packages dist-packages
-.PHONY: distclean-packages genstubs checkstubs checkdoc checkuchar dist html
-.PHONY: checkexports alldist allpatch html-tcl html-tk
+.PHONY: all binaries libraries objs doc html html-tcl html-tk test runtest
+.PHONY: install install-strip install-binaries install-libraries
+.PHONY: install-headers install-private-headers install-doc
+.PHONY: clean distclean depend genstubs checkstubs checkexports checkuchar
+.PHONY: shell gdb valgrind valgrindshell dist alldist rpm
+.PHONY: tclLibObjs tcltest-real test-tcl gdb-test ro-test trace-test xttest
+.PHONY: topDirName gendate gentommath_h trace-shell checkdoc
+.PHONY: install-tzdata install-msgs
+.PHONY: packages configure-packages test-packages clean-packages
+.PHONY: dist-packages distclean-packages install-packages
#--------------------------------------------------------------------------
# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/unix/README b/unix/README
index 96063de..87b151a 100644
--- a/unix/README
+++ b/unix/README
@@ -1,8 +1,6 @@
Tcl UNIX README
---------------
-RCS: @(#) $Id: README,v 1.31 2008/02/12 10:07:19 dkf Exp $
-
This is the directory where you configure, compile, test, and install UNIX
versions of Tcl. This directory also contains source files for Tcl that are
specific to UNIX. Some of the files in this directory are used on the PC or
@@ -168,8 +166,3 @@ a test is failing consistently, please send us a bug report with as much
detail as you can manage. Please use the online database at
http://tcl.sourceforge.net/
-The Tcl test suite is very sensitive to proper implementation of ANSI C
-library procedures such as sprintf and sscanf. If the test suite generates
-errors, most likely they are due to non-conformance of your system's ANSI C
-library; such problems are unlikely to affect any real applications so it's
-probably safe to ignore them.
diff --git a/unix/configure b/unix/configure
index 21317c0..f778a7b 100755
--- a/unix/configure
+++ b/unix/configure
@@ -308,7 +308,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_DIR ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX'
ac_subst_files=''
# Initialize some variables set by options.
@@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL="b1.2"
+TCL_PATCH_LEVEL=".0"
VERSION=${TCL_VERSION}
#------------------------------------------------------------------------
@@ -1353,6 +1353,14 @@ if test -r "$cache_file" -a -f "$cache_file"; then
fi
#------------------------------------------------------------------------
+# Empty slate for bundled packages, to avoid stale configuration
+#------------------------------------------------------------------------
+#rm -Rf pkgs
+if test -f Makefile; then
+ make distclean-packages
+fi
+
+#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
@@ -6332,8 +6340,6 @@ fi
if test $zlib_ok = no; then
- ZLIB_DIR=\${COMPAT_DIR}/zlib
-
ZLIB_OBJS=\${ZLIB_OBJS}
ZLIB_SRCS=\${ZLIB_SRCS}
@@ -6479,7 +6485,7 @@ if test "${tcl_cv_cc_visibility_hidden+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
- if test "$GCC" = yes; then
+ if test "$SHARED_BUILD" = 1; then
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fvisibility=hidden -Werror"
cat >conftest.$ac_ext <<_ACEOF
@@ -6492,6 +6498,9 @@ cat >>conftest.$ac_ext <<_ACEOF
int
main ()
{
+#if !defined(__GNUC__) || __GNUC__ < 4
+#error visibility hidden is not supported for this compiler
+#endif
;
return 0;
@@ -6543,6 +6552,11 @@ echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6
CFLAGS="$CFLAGS -fvisibility=hidden"
+cat >>confdefs.h <<\_ACEOF
+#define MODULE_SCOPE extern
+_ACEOF
+
+
else
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
@@ -6741,6 +6755,8 @@ fi
# Step 3: set configuration options based on system name and version.
do64bit_ok=no
+ # default to '{$LIBS}' and set to "" on per-platform necessary basis
+ SHLIB_LD_LIBS='${LIBS}'
LDFLAGS_ORIG="$LDFLAGS"
# When ld needs options to work in 64-bit mode, put them in
# LDFLAGS_ARCH so they eventually end up in LDFLAGS even if [load]
@@ -6763,8 +6779,9 @@ else
fi
- # Extract the first word of "ar", so it can be a program name with args.
-set dummy ar; ac_word=$2
+ if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ar; ac_word=$2
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_AR+set}" = set; then
@@ -6780,7 +6797,7 @@ do
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_AR="ar"
+ ac_cv_prog_AR="${ac_tool_prefix}ar"
echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
@@ -6798,12 +6815,47 @@ else
echo "${ECHO_T}no" >&6
fi
- if test "${AR}" = ""; then
+fi
+if test -z "$ac_cv_prog_AR"; then
+ ac_ct_AR=$AR
+ # Extract the first word of "ar", so it can be a program name with args.
+set dummy ar; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_AR+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_AR"; then
+ ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_AR="ar"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
- { { echo "$as_me:$LINENO: error: Required archive tool 'ar' not found on PATH." >&5
-echo "$as_me: error: Required archive tool 'ar' not found on PATH." >&2;}
- { (exit 1); exit 1; }; }
+fi
+fi
+ac_ct_AR=$ac_cv_prog_ac_ct_AR
+if test -n "$ac_ct_AR"; then
+ echo "$as_me:$LINENO: result: $ac_ct_AR" >&5
+echo "${ECHO_T}$ac_ct_AR" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+ AR=$ac_ct_AR
+else
+ AR="$ac_cv_prog_AR"
fi
STLIB_LD='${AR} cr'
@@ -6836,9 +6888,6 @@ fi
LIBS="$LIBS -lc"
SHLIB_CFLAGS=""
- # Note: need the LIBS below, otherwise Tk won't find Tcl's
- # symbols when dynamically loaded into tclsh.
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
@@ -6913,7 +6962,6 @@ fi
BeOS*)
SHLIB_CFLAGS="-fPIC"
SHLIB_LD='${CC} -nostart'
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
@@ -6995,7 +7043,6 @@ fi
BSD/OS-2.1*|BSD/OS-3*)
SHLIB_CFLAGS=""
SHLIB_LD="shlicc -r"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
@@ -7005,7 +7052,6 @@ fi
BSD/OS-4.*)
SHLIB_CFLAGS="-export-dynamic -fPIC"
SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
@@ -7013,15 +7059,90 @@ fi
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
- CYGWIN_*)
+ CYGWIN_*|MINGW32*)
SHLIB_CFLAGS=""
SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".dll"
- DL_OBJS="tclLoadDl.o"
+ DL_OBJS="tclLoadDl.o tclWinError.o"
DL_LIBS="-ldl"
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
+ TCL_NEEDS_EXP_FILE=1
+ TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a'
+ TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,$@.a'
+ echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5
+echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6
+if test "${ac_cv_cygwin+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+ #ifdef __CYGWIN__
+ #error cygwin
+ #endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_cygwin=no
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_cygwin=yes
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5
+echo "${ECHO_T}$ac_cv_cygwin" >&6
+ if test "$ac_cv_cygwin" = "no"; then
+ { { echo "$as_me:$LINENO: error: ${CC} is not a cygwin compiler." >&5
+echo "$as_me: error: ${CC} is not a cygwin compiler." >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ if test "x${TCL_THREADS}" = "x0"; then
+ { { echo "$as_me:$LINENO: error: CYGWIN compile is only supported with --enable-threads" >&5
+echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then
+ { { echo "$as_me:$LINENO: error: Please configure and make the ../win directory first." >&5
+echo "$as_me: error: Please configure and make the ../win directory first." >&2;}
+ { (exit 1); exit 1; }; }
+ fi
;;
dgux*)
SHLIB_CFLAGS="-K PIC"
@@ -7036,7 +7157,6 @@ fi
Haiku*)
LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
SHLIB_CFLAGS="-fPIC"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}'
DL_OBJS="tclLoadDl.o"
@@ -7208,7 +7328,6 @@ fi
SHLIB_CFLAGS="+z"
SHLIB_LD="ld -b"
- SHLIB_LD_LIBS='${LIBS}'
DL_OBJS="tclLoadShl.o"
DL_LIBS="-ldld"
LDFLAGS="$LDFLAGS -Wl,-E"
@@ -7221,7 +7340,6 @@ fi
if test "$GCC" = yes; then
SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
else
@@ -7244,7 +7362,6 @@ fi
# 64-bit gcc in use. Fix flags for GNU ld.
do64bit_ok=yes
SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
if test $doRpath = yes; then
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
@@ -7358,7 +7475,6 @@ fi
IRIX-5.*)
SHLIB_CFLAGS=""
SHLIB_LD="ld -shared -rdata_shared"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -7380,7 +7496,6 @@ fi
IRIX-6.*)
SHLIB_CFLAGS=""
SHLIB_LD="ld -n32 -shared -rdata_shared"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -7422,7 +7537,6 @@ fi
IRIX64-6.*)
SHLIB_CFLAGS=""
SHLIB_LD="ld -n32 -shared -rdata_shared"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -7465,7 +7579,6 @@ fi
;;
Linux*)
SHLIB_CFLAGS="-fPIC"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
CFLAGS_OPTIMIZE="-O2"
@@ -7572,7 +7685,6 @@ fi
;;
GNU*)
SHLIB_CFLAGS="-fPIC"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
SHLIB_LD='${CC} -shared'
@@ -7588,7 +7700,6 @@ fi
;;
Lynx*)
SHLIB_CFLAGS="-fPIC"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
CFLAGS_OPTIMIZE=-02
SHLIB_LD='${CC} -shared'
@@ -7626,7 +7737,6 @@ fi
NetBSD-1.*|FreeBSD-[1-2].*)
SHLIB_CFLAGS="-fPIC"
SHLIB_LD="ld -Bshareable -x"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -7682,20 +7792,40 @@ fi
TCL_LIB_VERSIONS_OK=nodots
;;
OpenBSD-*)
- CFLAGS_OPTIMIZE='-O2'
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- if test $doRpath = yes; then
+ arch=`arch -s`
+ case "$arch" in
+ m88k|vax)
+ # Equivalent using configure option --disable-load
+ # Step 4 will set the necessary variables
+ DL_OBJS=""
+ SHLIB_LD_LIBS=""
+ ;;
+ *)
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ if test $doRpath = yes; then
- CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
- LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
- SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
+ ;;
+ esac
+ case "$arch" in
+ m88k|vax)
+ CFLAGS_OPTIMIZE="-O1"
+ ;;
+ sh)
+ CFLAGS_OPTIMIZE="-O0"
+ ;;
+ *)
+ CFLAGS_OPTIMIZE="-O2"
+ ;;
+ esac
echo "$as_me:$LINENO: checking for ELF" >&5
echo $ECHO_N "checking for ELF... $ECHO_C" >&6
if test "${tcl_cv_ld_elf+set}" = set; then
@@ -7735,10 +7865,10 @@ fi
if test "${TCL_THREADS}" = "1"; then
- # OpenBSD builds and links with -pthread, never -lpthread.
+ # On OpenBSD: Compile with -pthread
+ # Don't link with -lpthread
LIBS=`echo $LIBS | sed s/-lpthread//`
CFLAGS="$CFLAGS -pthread"
- SHLIB_CFLAGS="$SHLIB_CFLAGS -pthread"
fi
@@ -7751,7 +7881,6 @@ fi
# NetBSD 2.* has ELF and can use 'cc -shared' to build shared libs
SHLIB_CFLAGS="-fPIC"
SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -7785,7 +7914,6 @@ fi
SHLIB_CFLAGS="-fPIC"
SHLIB_LD="${CC} -shared"
TCL_SHLIB_LD_EXTRAS="-soname \$@"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -8039,7 +8167,6 @@ echo "${ECHO_T}$tcl_cv_ld_single_module" >&6
fi
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".dylib"
DL_OBJS="tclLoadDyld.o"
DL_LIBS=""
@@ -8122,6 +8249,7 @@ cat >>confdefs.h <<\_ACEOF
#define MODULE_SCOPE __private_extern__
_ACEOF
+ tcl_cv_cc_visibility_hidden=yes
fi
@@ -8329,6 +8457,7 @@ fi
LD_SEARCH_FLAGS=""
;;
OS/390-*)
+ SHLIB_LD_LIBS=""
CFLAGS_OPTIMIZE="" # Optimizer is buggy
cat >>confdefs.h <<\_ACEOF
@@ -8379,7 +8508,6 @@ else
fi
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -8501,11 +8629,6 @@ _ACEOF
SHLIB_CFLAGS="-KPIC"
-
- # Note: need the LIBS below, otherwise Tk won't find Tcl's
- # symbols when dynamically loaded into tclsh.
-
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
@@ -8637,7 +8760,7 @@ else
arch=`isainfo`
echo "$as_me:$LINENO: checking whether to use -lsunmath for fp rounding control" >&5
echo $ECHO_N "checking whether to use -lsunmath for fp rounding control... $ECHO_C" >&6
- if test "$arch" = "amd64 i386"; then
+ if test "$arch" = "amd64 i386" -o "$arch" = "i386"; then
echo "$as_me:$LINENO: result: yes" >&5
echo "${ECHO_T}yes" >&6
@@ -8794,11 +8917,6 @@ fi
fi
-
- # Note: need the LIBS below, otherwise Tk won't find Tcl's
- # symbols when dynamically loaded into tclsh.
-
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
@@ -8841,7 +8959,7 @@ else
fi
case $system in
- SunOS-5.[1-9][0-9]*)
+ SunOS-5.[1-9][0-9]*|SunOS-5.[7-9])
SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";;
*)
SHLIB_LD="/usr/ccs/bin/ld -G -z $textmode";;
@@ -8994,7 +9112,7 @@ fi
case $system in
AIX-*) ;;
BSD/OS*) ;;
- CYGWIN_*) ;;
+ CYGWIN_*|MINGW32_*) ;;
IRIX*) ;;
NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
Darwin-*) ;;
@@ -9004,6 +9122,22 @@ fi
fi
+ if test "$tcl_cv_cc_visibility_hidden" != yes; then
+
+
+cat >>confdefs.h <<\_ACEOF
+#define MODULE_SCOPE extern
+_ACEOF
+
+
+cat >>confdefs.h <<\_ACEOF
+#define NO_VIZ
+_ACEOF
+
+
+fi
+
+
if test "$SHARED_LIB_SUFFIX" = ""; then
SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'
@@ -9014,20 +9148,20 @@ fi
UNSHARED_LIB_SUFFIX='${VERSION}.a'
fi
- DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)"
+ DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)"
if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then
LIB_SUFFIX=${SHARED_LIB_SUFFIX}
- MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
+ MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${TCL_SHLIB_LD_EXTRAS} ${SHLIB_LD_LIBS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
if test "${SHLIB_SUFFIX}" = ".dll"; then
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"'
DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"
else
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
fi
@@ -9039,12 +9173,12 @@ else
if test "$RANLIB" = ""; then
MAKE_LIB='$(STLIB_LD) $@ ${OBJS}'
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
else
MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@'
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
fi
@@ -9061,7 +9195,7 @@ fi
else
MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@'
- INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)"/$(STUB_LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
+ INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
fi
@@ -9076,6 +9210,75 @@ fi
+ # See if the compiler supports casting to a union type.
+ # This is used to stop gcc from printing a compiler
+ # warning when initializing a union member.
+
+ echo "$as_me:$LINENO: checking for cast to union support" >&5
+echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6
+if test "${tcl_cv_cast_to_union+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ union foo { int i; double d; };
+ union foo f = (union foo) (int) 0;
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_cast_to_union=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_cast_to_union=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5
+echo "${ECHO_T}$tcl_cv_cast_to_union" >&6
+ if test "$tcl_cv_cast_to_union" = "yes"; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_CAST_TO_UNION 1
+_ACEOF
+
+ fi
+
# FIXME: This subst was left in only because the TCL_DL_LIBS
# entry in tclConfig.sh uses it. It is not clear why someone
# would use TCL_DL_LIBS instead of TCL_LIBS.
@@ -9132,6 +9335,11 @@ fi;
if test "$tcl_ok" = "no"; then
CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
+
+cat >>confdefs.h <<\_ACEOF
+#define NDEBUG 1
+_ACEOF
+
echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
@@ -9149,12 +9357,6 @@ echo "${ECHO_T}yes (standard debugging)" >&6
fi
- ### FIXME: Surely TCL_CFG_DEBUG should be set to whether we're debugging?
-
-cat >>confdefs.h <<\_ACEOF
-#define TCL_CFG_DEBUG 1
-_ACEOF
-
if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then
@@ -10930,9 +11132,18 @@ _ACEOF
fi
-echo "$as_me:$LINENO: checking for getaddrinfo" >&5
-echo $ECHO_N "checking for getaddrinfo... $ECHO_C" >&6
-if test "${ac_cv_func_getaddrinfo+set}" = set; then
+
+ NEED_FAKE_RFC2553=0
+
+
+
+
+for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
@@ -10941,12 +11152,12 @@ _ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
-/* Define getaddrinfo to an innocuous variant, in case <limits.h> declares getaddrinfo.
+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define getaddrinfo innocuous_getaddrinfo
+#define $ac_func innocuous_$ac_func
/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char getaddrinfo (); below.
+ which can conflict with char $ac_func (); below.
Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
<limits.h> exists even on freestanding compilers. */
@@ -10956,7 +11167,7 @@ cat >>conftest.$ac_ext <<_ACEOF
# include <assert.h>
#endif
-#undef getaddrinfo
+#undef $ac_func
/* Override any gcc2 internal prototype to avoid an error. */
#ifdef __cplusplus
@@ -10965,14 +11176,14 @@ extern "C"
#endif
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
-char getaddrinfo ();
+char $ac_func ();
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
-#if defined (__stub_getaddrinfo) || defined (__stub___getaddrinfo)
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
choke me
#else
-char (*f) () = getaddrinfo;
+char (*f) () = $ac_func;
#endif
#ifdef __cplusplus
}
@@ -10981,7 +11192,7 @@ char (*f) () = getaddrinfo;
int
main ()
{
-return f != getaddrinfo;
+return f != $ac_func;
;
return 0;
}
@@ -11008,44 +11219,269 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
- ac_cv_func_getaddrinfo=yes
+ eval "$as_ac_var=yes"
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-ac_cv_func_getaddrinfo=no
+eval "$as_ac_var=no"
fi
rm -f conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_func_getaddrinfo" >&5
-echo "${ECHO_T}$ac_cv_func_getaddrinfo" >&6
-if test $ac_cv_func_getaddrinfo = yes; then
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+else
+ NEED_FAKE_RFC2553=1
+fi
+done
- echo "$as_me:$LINENO: checking for working getaddrinfo" >&5
-echo $ECHO_N "checking for working getaddrinfo... $ECHO_C" >&6
-if test "${tcl_cv_api_getaddrinfo+set}" = set; then
+ echo "$as_me:$LINENO: checking for struct addrinfo" >&5
+echo $ECHO_N "checking for struct addrinfo... $ECHO_C" >&6
+if test "${ac_cv_type_struct_addrinfo+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
- cat >conftest.$ac_ext <<_ACEOF
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netdb.h>
+
+
+int
+main ()
+{
+if ((struct addrinfo *) 0)
+ return 0;
+if (sizeof (struct addrinfo))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_type_struct_addrinfo=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_type_struct_addrinfo=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_type_struct_addrinfo" >&5
+echo "${ECHO_T}$ac_cv_type_struct_addrinfo" >&6
+if test $ac_cv_type_struct_addrinfo = yes; then
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_ADDRINFO 1
+_ACEOF
+
+
+else
+ NEED_FAKE_RFC2553=1
+fi
+echo "$as_me:$LINENO: checking for struct in6_addr" >&5
+echo $ECHO_N "checking for struct in6_addr... $ECHO_C" >&6
+if test "${ac_cv_type_struct_in6_addr+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
- #include <netdb.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netdb.h>
+
+
+int
+main ()
+{
+if ((struct in6_addr *) 0)
+ return 0;
+if (sizeof (struct in6_addr))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_type_struct_in6_addr=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_type_struct_in6_addr=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_type_struct_in6_addr" >&5
+echo "${ECHO_T}$ac_cv_type_struct_in6_addr" >&6
+if test $ac_cv_type_struct_in6_addr = yes; then
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_IN6_ADDR 1
+_ACEOF
+
+
+else
+ NEED_FAKE_RFC2553=1
+fi
+echo "$as_me:$LINENO: checking for struct sockaddr_in6" >&5
+echo $ECHO_N "checking for struct sockaddr_in6... $ECHO_C" >&6
+if test "${ac_cv_type_struct_sockaddr_in6+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netdb.h>
+
int
main ()
{
+if ((struct sockaddr_in6 *) 0)
+ return 0;
+if (sizeof (struct sockaddr_in6))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_type_struct_sockaddr_in6=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_type_struct_sockaddr_in6=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_type_struct_sockaddr_in6" >&5
+echo "${ECHO_T}$ac_cv_type_struct_sockaddr_in6" >&6
+if test $ac_cv_type_struct_sockaddr_in6 = yes; then
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_SOCKADDR_IN6 1
+_ACEOF
+
+
+else
+ NEED_FAKE_RFC2553=1
+fi
+echo "$as_me:$LINENO: checking for struct sockaddr_storage" >&5
+echo $ECHO_N "checking for struct sockaddr_storage... $ECHO_C" >&6
+if test "${ac_cv_type_struct_sockaddr_storage+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netdb.h>
- const char *name, *port;
- struct addrinfo *aiPtr, hints;
- (void)getaddrinfo(name,port, &hints, &aiPtr);
- (void)freeaddrinfo(aiPtr);
+int
+main ()
+{
+if ((struct sockaddr_storage *) 0)
+ return 0;
+if (sizeof (struct sockaddr_storage))
+ return 0;
;
return 0;
}
@@ -11072,25 +11508,132 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
- tcl_cv_api_getaddrinfo=yes
+ ac_cv_type_struct_sockaddr_storage=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-tcl_cv_getaddrinfo=no
+ac_cv_type_struct_sockaddr_storage=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_getaddrinfo" >&5
-echo "${ECHO_T}$tcl_cv_api_getaddrinfo" >&6
- tcl_ok=$tcl_cv_api_getaddrinfo
- if test "$tcl_ok" = yes; then
+echo "$as_me:$LINENO: result: $ac_cv_type_struct_sockaddr_storage" >&5
+echo "${ECHO_T}$ac_cv_type_struct_sockaddr_storage" >&6
+if test $ac_cv_type_struct_sockaddr_storage = yes; then
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_SOCKADDR_STORAGE 1
+_ACEOF
+
+
+else
+ NEED_FAKE_RFC2553=1
+fi
+
+if test "x$NEED_FAKE_RFC2553" = "x1"; then
cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETADDRINFO 1
+#define NEED_FAKE_RFC2553 1
_ACEOF
- fi
+ case $LIBOBJS in
+ "fake-rfc2553.$ac_objext" | \
+ *" fake-rfc2553.$ac_objext" | \
+ "fake-rfc2553.$ac_objext "* | \
+ *" fake-rfc2553.$ac_objext "* ) ;;
+ *) LIBOBJS="$LIBOBJS fake-rfc2553.$ac_objext" ;;
+esac
+
+ echo "$as_me:$LINENO: checking for strlcpy" >&5
+echo $ECHO_N "checking for strlcpy... $ECHO_C" >&6
+if test "${ac_cv_func_strlcpy+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+/* Define strlcpy to an innocuous variant, in case <limits.h> declares strlcpy.
+ For example, HP-UX 11i <limits.h> declares gettimeofday. */
+#define strlcpy innocuous_strlcpy
+
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char strlcpy (); below.
+ Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ <limits.h> exists even on freestanding compilers. */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef strlcpy
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strlcpy ();
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_strlcpy) || defined (__stub___strlcpy)
+choke me
+#else
+char (*f) () = strlcpy;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != strlcpy;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_func_strlcpy=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_func_strlcpy=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_func_strlcpy" >&5
+echo "${ECHO_T}$ac_cv_func_strlcpy" >&6
fi
@@ -13859,7 +14402,12 @@ _ACEOF
# lack blkcnt_t.
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5
+if test "$ac_cv_cygwin" = "yes"; then
+ if test "x${SHARED_BUILD}" = "x1"; then
+ TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib"
+ fi
+else
+ echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5
echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6
if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
@@ -14078,6 +14626,7 @@ _ACEOF
fi
+fi
echo "$as_me:$LINENO: checking for blkcnt_t" >&5
echo $ECHO_N "checking for blkcnt_t... $ECHO_C" >&6
if test "${ac_cv_type_blkcnt_t+set}" = set; then
@@ -16157,112 +16706,12 @@ fi
# The code below deals with several issues related to gettimeofday:
# 1. Some systems don't provide a gettimeofday function at all
# (set NO_GETTOD if this is the case).
-# 2. SGI systems don't use the BSD form of the gettimeofday function,
-# but they have a BSDgettimeofday function that can be used instead.
-# 3. See if gettimeofday is declared in the <sys/time.h> header file.
+# 2. See if gettimeofday is declared in the <sys/time.h> header file.
# if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can
# declare it.
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for BSDgettimeofday" >&5
-echo $ECHO_N "checking for BSDgettimeofday... $ECHO_C" >&6
-if test "${ac_cv_func_BSDgettimeofday+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define BSDgettimeofday to an innocuous variant, in case <limits.h> declares BSDgettimeofday.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define BSDgettimeofday innocuous_BSDgettimeofday
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char BSDgettimeofday (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef BSDgettimeofday
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char BSDgettimeofday ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_BSDgettimeofday) || defined (__stub___BSDgettimeofday)
-choke me
-#else
-char (*f) () = BSDgettimeofday;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != BSDgettimeofday;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_BSDgettimeofday=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_BSDgettimeofday=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_BSDgettimeofday" >&5
-echo "${ECHO_T}$ac_cv_func_BSDgettimeofday" >&6
-if test $ac_cv_func_BSDgettimeofday = yes; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_BSDGETTIMEOFDAY 1
-_ACEOF
-
-else
-
- echo "$as_me:$LINENO: checking for gettimeofday" >&5
+echo "$as_me:$LINENO: checking for gettimeofday" >&5
echo $ECHO_N "checking for gettimeofday... $ECHO_C" >&6
if test "${ac_cv_func_gettimeofday+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
@@ -16356,12 +16805,11 @@ if test $ac_cv_func_gettimeofday = yes; then
:
else
+
cat >>confdefs.h <<\_ACEOF
#define NO_GETTOD 1
_ACEOF
-fi
-
fi
@@ -18811,6 +19259,81 @@ echo "$as_me:$LINENO: result: $tcl_ok" >&5
echo "${ECHO_T}$tcl_ok" >&6
#--------------------------------------------------------------------
+# The check below checks whether the cpuid instruction is usable.
+#--------------------------------------------------------------------
+
+echo "$as_me:$LINENO: checking whether the cpuid instruction is usable" >&5
+echo $ECHO_N "checking whether the cpuid instruction is usable... $ECHO_C" >&6
+if test "${tcl_cv_cpuid+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ int index,regsPtr[4];
+ __asm__ __volatile__("mov %%ebx, %%edi \n\t"
+ "cpuid \n\t"
+ "mov %%ebx, %%esi \n\t"
+ "mov %%edi, %%ebx \n\t"
+ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
+ : "a"(index) : "edi");
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_cpuid=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_cpuid=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_cpuid" >&5
+echo "${ECHO_T}$tcl_cv_cpuid" >&6
+if test $tcl_cv_cpuid = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_CPUID 1
+_ACEOF
+
+fi
+
+#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtcl as a shared library instead of a static library.
#--------------------------------------------------------------------
@@ -18917,8 +19440,8 @@ _ACEOF
HTML_DIR="${libdir}/Resources/Documentation/Reference/Tcl"
EXTRA_INSTALL="install-private-headers html-tcl"
EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)"/TclTOC.html'
- EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tcl-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"'
- EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"'
+ EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tcl-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"'
+ EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"'
EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Finalizing Tcl.framework" && rm -f "$(LIB_INSTALL_DIR)/../Current" && ln -s "$(VERSION)" "$(LIB_INSTALL_DIR)/../Current" && for f in "$(LIB_FILE)" tclConfig.sh Resources Headers PrivateHeaders; do rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/Current/$$f" "$(LIB_INSTALL_DIR)/../.."; done && f="$(STUB_LIB_FILE)" && rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/$(VERSION)/$$f" "$(LIB_INSTALL_DIR)/../.."'
# Don't use AC_DEFINE for the following as the framework version define
# needs to go into the Makefile even when using autoheader, so that we
@@ -19705,13 +20228,13 @@ s,@CPP@,$CPP,;t t
s,@EGREP@,$EGREP,;t t
s,@TCL_THREADS@,$TCL_THREADS,;t t
s,@TCLSH_PROG@,$TCLSH_PROG,;t t
-s,@ZLIB_DIR@,$ZLIB_DIR,;t t
s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t
s,@ZLIB_SRCS@,$ZLIB_SRCS,;t t
s,@ZLIB_INCLUDE@,$ZLIB_INCLUDE,;t t
s,@RANLIB@,$RANLIB,;t t
s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t
s,@AR@,$AR,;t t
+s,@ac_ct_AR@,$ac_ct_AR,;t t
s,@LIBOBJS@,$LIBOBJS,;t t
s,@TCL_LIBS@,$TCL_LIBS,;t t
s,@DL_LIBS@,$DL_LIBS,;t t
diff --git a/unix/configure.in b/unix/configure.in
index 0a97de6..087bb05 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -2,8 +2,6 @@
dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
-#
-# RCS: @(#) $Id: configure.in,v 1.214 2010/08/12 00:40:23 hobbs Exp $
AC_INIT([tcl],[8.6])
AC_PREREQ(2.59)
@@ -27,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [
TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL="b1.2"
+TCL_PATCH_LEVEL=".0"
VERSION=${TCL_VERSION}
#------------------------------------------------------------------------
@@ -45,6 +43,14 @@ if test -r "$cache_file" -a -f "$cache_file"; then
fi
#------------------------------------------------------------------------
+# Empty slate for bundled packages, to avoid stale configuration
+#------------------------------------------------------------------------
+#rm -Rf pkgs
+if test -f Makefile; then
+ make distclean-packages
+fi
+
+#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
@@ -157,7 +163,6 @@ AS_IF([test $zlib_ok = yes], [
zlib_ok=no
])])
AS_IF([test $zlib_ok = no], [
- AC_SUBST(ZLIB_DIR,[\${COMPAT_DIR}/zlib])
AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
AC_SUBST(ZLIB_SRCS,[\${ZLIB_SRCS}])
AC_SUBST(ZLIB_INCLUDE,[-I\${ZLIB_DIR}])
@@ -216,9 +221,9 @@ if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \
fi
AC_CHECK_FUNC(realpath, , [AC_DEFINE(NO_REALPATH, 1, [Do we have realpath()])])
-SC_TCL_GETADDRINFO
+SC_TCL_IPV6
-#--------------------------------------------------------------------
+#--------------------------------------------------------------------
# Look for thread-safe variants of some library functions.
#--------------------------------------------------------------------
@@ -300,7 +305,13 @@ SC_TIME_HANDLER
# lack blkcnt_t.
#--------------------------------------------------------------------
-AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize])
+if test "$ac_cv_cygwin" = "yes"; then
+ if test "x${SHARED_BUILD}" = "x1"; then
+ TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib"
+ fi
+else
+ AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize])
+fi
AC_CHECK_TYPES([blkcnt_t])
AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])
@@ -390,7 +401,7 @@ AC_CHECK_TYPE([intptr_t], [
for tcl_cv_intptr_t in "int" "long" "long long" none; do
if test "$tcl_cv_intptr_t" != none; then
AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
- [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])],
+ [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])],
[tcl_ok=yes], [tcl_ok=no])
test "$tcl_ok" = yes && break; fi
done])
@@ -406,7 +417,7 @@ AC_CHECK_TYPE([uintptr_t], [
none; do
if test "$tcl_cv_uintptr_t" != none; then
AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
- [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])],
+ [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])],
[tcl_ok=yes], [tcl_ok=no])
test "$tcl_ok" = yes && break; fi
done])
@@ -434,7 +445,7 @@ AC_CHECK_FUNC(opendir, , [AC_DEFINE(USE_DIRENT2_H, 1, [May we include <dirent2.h
#--------------------------------------------------------------------
AC_CACHE_CHECK([union wait], tcl_cv_union_wait, [
- AC_TRY_LINK([#include <sys/types.h>
+ AC_TRY_LINK([#include <sys/types.h>
#include <sys/wait.h>], [
union wait x;
WIFEXITED(x); /* Generates compiler error if WIFEXITED
@@ -466,16 +477,13 @@ fi
# The code below deals with several issues related to gettimeofday:
# 1. Some systems don't provide a gettimeofday function at all
# (set NO_GETTOD if this is the case).
-# 2. SGI systems don't use the BSD form of the gettimeofday function,
-# but they have a BSDgettimeofday function that can be used instead.
-# 3. See if gettimeofday is declared in the <sys/time.h> header file.
+# 2. See if gettimeofday is declared in the <sys/time.h> header file.
# if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can
# declare it.
#--------------------------------------------------------------------
-AC_CHECK_FUNC(BSDgettimeofday,
- [AC_DEFINE(HAVE_BSDGETTIMEOFDAY, 1, [Do we have BSDgettimeofday()?])], [
- AC_CHECK_FUNC(gettimeofday, , [AC_DEFINE(NO_GETTOD, 1, [Do we have gettimeofday()?])])
+AC_CHECK_FUNC(gettimeofday,[],[
+ AC_DEFINE(NO_GETTOD, 1, [Do we have gettimeofday()?])
])
AC_CACHE_CHECK([for gettimeofday declaration], tcl_cv_grep_gettimeofday, [
AC_EGREP_HEADER(gettimeofday, sys/time.h,
@@ -676,7 +684,7 @@ AC_ARG_WITH(tzdata,
# Any directories that get added here must also be added to the
# search path in ::tcl::clock::Initialize (library/clock.tcl).
#
-case $tcl_ok in
+case $tcl_ok in
no)
AC_MSG_RESULT([supplied by OS vendor])
;;
@@ -703,7 +711,7 @@ case $tcl_ok in
fi
;;
*)
- AC_MSG_ERROR([invalid argument: $tcl_ok])
+ AC_MSG_ERROR([invalid argument: $tcl_ok])
;;
esac
if test $tcl_ok = yes
@@ -750,6 +758,24 @@ fi
AC_MSG_RESULT([$tcl_ok])
#--------------------------------------------------------------------
+# The check below checks whether the cpuid instruction is usable.
+#--------------------------------------------------------------------
+
+AC_CACHE_CHECK([whether the cpuid instruction is usable], tcl_cv_cpuid, [
+ AC_TRY_LINK(, [
+ int index,regsPtr[4];
+ __asm__ __volatile__("mov %%ebx, %%edi \n\t"
+ "cpuid \n\t"
+ "mov %%ebx, %%esi \n\t"
+ "mov %%edi, %%ebx \n\t"
+ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
+ : "a"(index) : "edi");
+ ], tcl_cv_cpuid=yes, tcl_cv_cpuid=no)])
+if test $tcl_cv_cpuid = yes; then
+ AC_DEFINE(HAVE_CPUID, 1, [Is the cpuid instruction usable?])
+fi
+
+#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtcl as a shared library instead of a static library.
#--------------------------------------------------------------------
@@ -759,7 +785,7 @@ TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}
eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}"
# tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed
-# since on some platforms TCL_LIB_FILE contains shell escapes.
+# since on some platforms TCL_LIB_FILE contains shell escapes.
# (See also: TCL_TRIM_DOTS).
eval "TCL_LIB_FILE=${TCL_LIB_FILE}"
@@ -817,12 +843,12 @@ if test "$FRAMEWORK_BUILD" = "1" ; then
PRIVATE_INCLUDE_DIR="${libdir}/PrivateHeaders"
HTML_DIR="${libdir}/Resources/Documentation/Reference/Tcl"
EXTRA_INSTALL="install-private-headers html-tcl"
- EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)"/TclTOC.html'
- EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tcl-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"'
- EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"'
+ EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)"/TclTOC.html'
+ EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tcl-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"'
+ EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"'
EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Finalizing Tcl.framework" && rm -f "$(LIB_INSTALL_DIR)/../Current" && ln -s "$(VERSION)" "$(LIB_INSTALL_DIR)/../Current" && for f in "$(LIB_FILE)" tclConfig.sh Resources Headers PrivateHeaders; do rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/Current/$$f" "$(LIB_INSTALL_DIR)/../.."; done && f="$(STUB_LIB_FILE)" && rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/$(VERSION)/$$f" "$(LIB_INSTALL_DIR)/../.."'
- # Don't use AC_DEFINE for the following as the framework version define
- # needs to go into the Makefile even when using autoheader, so that we
+ # Don't use AC_DEFINE for the following as the framework version define
+ # needs to go into the Makefile even when using autoheader, so that we
# can pick up a potential make override of VERSION. Also, don't put this
# into CFLAGS as it should not go into tclConfig.sh
EXTRA_CC_SWITCHES='-DTCL_FRAMEWORK_VERSION=\"$(VERSION)\"'
diff --git a/unix/dltest/.cvsignore b/unix/dltest/.cvsignore
deleted file mode 100644
index 6ff1067..0000000
--- a/unix/dltest/.cvsignore
+++ /dev/null
@@ -1,5 +0,0 @@
-Makefile
-*.bundle
-*.dylib
-*.dll
-*.so
diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in
index 5ac2df0..01589d9 100644
--- a/unix/dltest/Makefile.in
+++ b/unix/dltest/Makefile.in
@@ -1,7 +1,6 @@
# This Makefile is used to create several test cases for Tcl's load
# command. It also illustrates how to take advantage of configuration
# exported by Tcl to set up Makefiles for shared libraries.
-# RCS: @(#) $Id: Makefile.in,v 1.21 2008/03/07 22:42:53 andreas_kupries Exp $
CC = @CC@
LIBS = @TCL_BUILD_STUB_LIB_SPEC@ @TCL_LIBS@
@@ -99,4 +98,4 @@ clean:
fi
distclean: clean
- rm -f Makefile \ No newline at end of file
+ rm -f Makefile
diff --git a/unix/dltest/README b/unix/dltest/README
index 3d85a9c..3210f13 100644
--- a/unix/dltest/README
+++ b/unix/dltest/README
@@ -2,5 +2,3 @@ This directory contains several files for testing Tcl's dynamic
loading/unloading capabilities. If shared libraries are supported
then the build system in the parent directory will create
the shared libs and load them into the tcltest executable.
-
-RCS: @(#) $Id: README,v 1.4 2004/02/24 22:58:48 dkf Exp $
diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c
index 3c12289..c4d3f32 100644
--- a/unix/dltest/pkga.c
+++ b/unix/dltest/pkga.c
@@ -8,10 +8,9 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: pkga.c,v 1.16 2010/03/28 03:17:50 dgp Exp $
*/
+#undef STATIC_BUILD
#include "tcl.h"
/*
diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c
index df0cde3..9884a64 100644
--- a/unix/dltest/pkgb.c
+++ b/unix/dltest/pkgb.c
@@ -9,10 +9,9 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: pkgb.c,v 1.13 2010/03/28 03:17:50 dgp Exp $
*/
+#undef STATIC_BUILD
#include "tcl.h"
/*
@@ -31,6 +30,8 @@ static int Pkgb_SubObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int Pkgb_UnsafeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+static int Pkgb_DemoObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
/*
*----------------------------------------------------------------------
@@ -94,7 +95,33 @@ Pkgb_UnsafeObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
+ return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL);
+}
+
+#if (TCL_MAJOR_VERSION > 8)
+const char *Tcl_GetDefaultEncodingDir(void)
+{
+ int numDirs;
+ Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath();
+
+ Tcl_ListObjLength(NULL, searchPath, &numDirs);
+ if (numDirs == 0) {
+ return NULL;
+ }
+ Tcl_ListObjIndex(NULL, searchPath, 0, &first);
+
+ return Tcl_GetString(first);
+}
+#endif
+
+static int
+Pkgb_DemoObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetDefaultEncodingDir(), -1));
return TCL_OK;
}
@@ -122,16 +149,16 @@ Pkgb_Init(
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-9.1", 0) == NULL) {
return TCL_ERROR;
}
- code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
+ code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);
- Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL,
- NULL);
+ Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "pkgb_demo", Pkgb_DemoObjCmd, NULL, NULL);
return TCL_OK;
}
@@ -159,10 +186,10 @@ Pkgb_SafeInit(
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-9.1", 0) == NULL) {
return TCL_ERROR;
}
- code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
+ code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
if (code != TCL_OK) {
return code;
}
diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c
index 3e4c4e6..557f21b 100644
--- a/unix/dltest/pkgc.c
+++ b/unix/dltest/pkgc.c
@@ -9,10 +9,9 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: pkgc.c,v 1.13 2010/03/28 03:17:50 dgp Exp $
*/
+#undef STATIC_BUILD
#include "tcl.h"
/*
diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c
index d713e2e..6e114e9 100644
--- a/unix/dltest/pkgd.c
+++ b/unix/dltest/pkgd.c
@@ -9,10 +9,9 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: pkgd.c,v 1.12 2010/03/28 03:17:50 dgp Exp $
*/
+#undef STATIC_BUILD
#include "tcl.h"
/*
diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c
index bd0d838..d616352 100644
--- a/unix/dltest/pkge.c
+++ b/unix/dltest/pkge.c
@@ -9,10 +9,9 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: pkge.c,v 1.14 2010/03/28 03:17:50 dgp Exp $
*/
+#undef STATIC_BUILD
#include "tcl.h"
/*
diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c
index e431deb..417bedb 100644
--- a/unix/dltest/pkgua.c
+++ b/unix/dltest/pkgua.c
@@ -9,10 +9,9 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: pkgua.c,v 1.11 2010/03/28 03:17:50 dgp Exp $
*/
+#undef STATIC_BUILD
#include "tcl.h"
/*
diff --git a/unix/install-sh b/unix/install-sh
index 8cff938..7c34c3f 100755
--- a/unix/install-sh
+++ b/unix/install-sh
@@ -1,124 +1,528 @@
#!/bin/sh
+# install - install a program, script, or datafile
+
+scriptversion=2011-04-20.01; # UTC
+# This originates from X11R5 (mit/util/scripts/install.sh), which was
+# later released in X11R6 (xc/config/util/install.sh) with the
+# following copyright and license.
#
-# install - install a program, script, or datafile
-# This comes from X11R5; it is not part of GNU.
+# Copyright (C) 1994 X Consortium
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
+# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
+# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+#
+# Except as contained in this notice, the name of the X Consortium shall not
+# be used in advertising or otherwise to promote the sale, use or other deal-
+# ings in this Software without prior written authorization from the X Consor-
+# tium.
+#
+#
+# FSF changes to this file are in the public domain.
#
-# $XConsortium: install.sh,v 1.2 89/12/18 14:47:22 jim Exp $
+# Calling this script install-sh is preferred over install.sh, to prevent
+# `make' implicit rules from creating a file called install from it
+# when there is no Makefile.
#
# This script is compatible with the BSD install script, but was written
# from scratch.
-#
+nl='
+'
+IFS=" "" $nl"
# set DOITPROG to echo to test this script
# Don't use :- since 4.3BSD and earlier shells don't like it.
-doit="${DOITPROG-}"
+doit=${DOITPROG-}
+if test -z "$doit"; then
+ doit_exec=exec
+else
+ doit_exec=$doit
+fi
+
+# Put in absolute file names if you don't have them in your path;
+# or use environment vars.
+chgrpprog=${CHGRPPROG-chgrp}
+chmodprog=${CHMODPROG-chmod}
+chownprog=${CHOWNPROG-chown}
+cmpprog=${CMPPROG-cmp}
+cpprog=${CPPROG-cp}
+mkdirprog=${MKDIRPROG-mkdir}
+mvprog=${MVPROG-mv}
+rmprog=${RMPROG-rm}
+stripprog=${STRIPPROG-strip}
-# put in absolute paths if you don't have them in your path; or use env. vars.
+posix_glob='?'
+initialize_posix_glob='
+ test "$posix_glob" != "?" || {
+ if (set -f) 2>/dev/null; then
+ posix_glob=
+ else
+ posix_glob=:
+ fi
+ }
+'
-mvprog="${MVPROG-mv}"
-cpprog="${CPPROG-cp}"
-chmodprog="${CHMODPROG-chmod}"
-chownprog="${CHOWNPROG-chown}"
-chgrpprog="${CHGRPPROG-chgrp}"
-stripprog="${STRIPPROG-strip}"
-rmprog="${RMPROG-rm}"
+posix_mkdir=
-instcmd="$mvprog"
-chmodcmd=""
-chowncmd=""
-chgrpcmd=""
-stripcmd=""
+# Desired mode of installed file.
+mode=0755
+
+chgrpcmd=
+chmodcmd=$chmodprog
+chowncmd=
+mvcmd=$mvprog
rmcmd="$rmprog -f"
-mvcmd="$mvprog"
-src=""
-dst=""
-
-while [ x"$1" != x ]; do
- case $1 in
- -c) instcmd="$cpprog"
- shift
- continue;;
-
- -m) chmodcmd="$chmodprog $2"
- shift
- shift
- continue;;
-
- -o) chowncmd="$chownprog $2"
- shift
- shift
- continue;;
-
- -g) chgrpcmd="$chgrpprog $2"
- shift
- shift
- continue;;
-
- -s) stripcmd="$stripprog"
- shift
- continue;;
-
- -S) stripcmd="$stripprog $2"
- shift
- shift
- continue;;
-
- *) if [ x"$src" = x ]
- then
- src=$1
- else
- dst=$1
- fi
- shift
- continue;;
- esac
+stripcmd=
+
+src=
+dst=
+dir_arg=
+dst_arg=
+
+copy_on_change=false
+no_target_directory=
+
+usage="\
+Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
+ or: $0 [OPTION]... SRCFILES... DIRECTORY
+ or: $0 [OPTION]... -t DIRECTORY SRCFILES...
+ or: $0 [OPTION]... -d DIRECTORIES...
+
+In the 1st form, copy SRCFILE to DSTFILE.
+In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
+In the 4th, create DIRECTORIES.
+
+Options:
+ --help display this help and exit.
+ --version display version info and exit.
+
+ -c (ignored)
+ -C install only if different (preserve the last data modification time)
+ -d create directories instead of installing files.
+ -g GROUP $chgrpprog installed files to GROUP.
+ -m MODE $chmodprog installed files to MODE.
+ -o USER $chownprog installed files to USER.
+ -s $stripprog installed files.
+ -S $stripprog installed files.
+ -t DIRECTORY install into DIRECTORY.
+ -T report an error if DSTFILE is a directory.
+
+Environment variables override the default commands:
+ CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
+ RMPROG STRIPPROG
+"
+
+while test $# -ne 0; do
+ case $1 in
+ -c) ;;
+
+ -C) copy_on_change=true;;
+
+ -d) dir_arg=true;;
+
+ -g) chgrpcmd="$chgrpprog $2"
+ shift;;
+
+ --help) echo "$usage"; exit $?;;
+
+ -m) mode=$2
+ case $mode in
+ *' '* | *' '* | *'
+'* | *'*'* | *'?'* | *'['*)
+ echo "$0: invalid mode: $mode" >&2
+ exit 1;;
+ esac
+ shift;;
+
+ -o) chowncmd="$chownprog $2"
+ shift;;
+
+ -s) stripcmd=$stripprog;;
+
+ -S) stripcmd="$stripprog $2"
+ shift;;
+
+ -t) dst_arg=$2
+ shift;;
+
+ -T) no_target_directory=true;;
+
+ --version) echo "$0 $scriptversion"; exit $?;;
+
+ --) shift
+ break;;
+
+ -*) echo "$0: invalid option: $1" >&2
+ exit 1;;
+
+ *) break;;
+ esac
+ shift
done
-if [ x"$src" = x ]
-then
- echo "install: no input file specified"
- exit 1
+if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
+ # When -d is used, all remaining arguments are directories to create.
+ # When -t is used, the destination is already specified.
+ # Otherwise, the last argument is the destination. Remove it from $@.
+ for arg
+ do
+ if test -n "$dst_arg"; then
+ # $@ is not empty: it contains at least $arg.
+ set fnord "$@" "$dst_arg"
+ shift # fnord
+ fi
+ shift # arg
+ dst_arg=$arg
+ done
fi
-if [ x"$dst" = x ]
-then
- echo "install: no destination specified"
- exit 1
+if test $# -eq 0; then
+ if test -z "$dir_arg"; then
+ echo "$0: no input file specified." >&2
+ exit 1
+ fi
+ # It's OK to call `install-sh -d' without argument.
+ # This can happen when creating conditional directories.
+ exit 0
fi
+if test -z "$dir_arg"; then
+ do_exit='(exit $ret); exit $ret'
+ trap "ret=129; $do_exit" 1
+ trap "ret=130; $do_exit" 2
+ trap "ret=141; $do_exit" 13
+ trap "ret=143; $do_exit" 15
-# If destination is a directory, append the input filename; if your system
-# does not like double slashes in filenames, you may need to add some logic
+ # Set umask so as not to create temps with too-generous modes.
+ # However, 'strip' requires both read and write access to temps.
+ case $mode in
+ # Optimize common cases.
+ *644) cp_umask=133;;
+ *755) cp_umask=22;;
-if [ -d "$dst" ]
-then
- dst="$dst/`basename "$src"`"
+ *[0-7])
+ if test -z "$stripcmd"; then
+ u_plus_rw=
+ else
+ u_plus_rw='% 200'
+ fi
+ cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
+ *)
+ if test -z "$stripcmd"; then
+ u_plus_rw=
+ else
+ u_plus_rw=,u+rw
+ fi
+ cp_umask=$mode$u_plus_rw;;
+ esac
fi
-# Make a temp file name in the proper directory.
+for src
+do
+ # Protect names starting with `-'.
+ case $src in
+ -*) src=./$src;;
+ esac
+
+ if test -n "$dir_arg"; then
+ dst=$src
+ dstdir=$dst
+ test -d "$dstdir"
+ dstdir_status=$?
+ else
+
+ # Waiting for this to be detected by the "$cpprog $src $dsttmp" command
+ # might cause directories to be created, which would be especially bad
+ # if $src (and thus $dsttmp) contains '*'.
+ if test ! -f "$src" && test ! -d "$src"; then
+ echo "$0: $src does not exist." >&2
+ exit 1
+ fi
+
+ if test -z "$dst_arg"; then
+ echo "$0: no destination specified." >&2
+ exit 1
+ fi
+
+ dst=$dst_arg
+ # Protect names starting with `-'.
+ case $dst in
+ -*) dst=./$dst;;
+ esac
+
+ # If destination is a directory, append the input filename; won't work
+ # if double slashes aren't ignored.
+ if test -d "$dst"; then
+ if test -n "$no_target_directory"; then
+ echo "$0: $dst_arg: Is a directory" >&2
+ exit 1
+ fi
+ dstdir=$dst
+ dst=$dstdir/`basename "$src"`
+ dstdir_status=0
+ else
+ # Prefer dirname, but fall back on a substitute if dirname fails.
+ dstdir=`
+ (dirname "$dst") 2>/dev/null ||
+ expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$dst" : 'X\(//\)[^/]' \| \
+ X"$dst" : 'X\(//\)$' \| \
+ X"$dst" : 'X\(/\)' \| . 2>/dev/null ||
+ echo X"$dst" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'
+ `
+
+ test -d "$dstdir"
+ dstdir_status=$?
+ fi
+ fi
+
+ obsolete_mkdir_used=false
+
+ if test $dstdir_status != 0; then
+ case $posix_mkdir in
+ '')
+ # Create intermediate dirs using mode 755 as modified by the umask.
+ # This is like FreeBSD 'install' as of 1997-10-28.
+ umask=`umask`
+ case $stripcmd.$umask in
+ # Optimize common cases.
+ *[2367][2367]) mkdir_umask=$umask;;
+ .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;
+
+ *[0-7])
+ mkdir_umask=`expr $umask + 22 \
+ - $umask % 100 % 40 + $umask % 20 \
+ - $umask % 10 % 4 + $umask % 2
+ `;;
+ *) mkdir_umask=$umask,go-w;;
+ esac
+
+ # With -d, create the new directory with the user-specified mode.
+ # Otherwise, rely on $mkdir_umask.
+ if test -n "$dir_arg"; then
+ mkdir_mode=-m$mode
+ else
+ mkdir_mode=
+ fi
+
+ posix_mkdir=false
+ case $umask in
+ *[123567][0-7][0-7])
+ # POSIX mkdir -p sets u+wx bits regardless of umask, which
+ # is incompatible with FreeBSD 'install' when (umask & 300) != 0.
+ ;;
+ *)
+ tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
+ trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0
-dstdir="`dirname "$dst"`"
-dsttmp="$dstdir"/#inst.$$#
+ if (umask $mkdir_umask &&
+ exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1
+ then
+ if test -z "$dir_arg" || {
+ # Check for POSIX incompatibilities with -m.
+ # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
+ # other-writeable bit of parent directory when it shouldn't.
+ # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
+ ls_ld_tmpdir=`ls -ld "$tmpdir"`
+ case $ls_ld_tmpdir in
+ d????-?r-*) different_mode=700;;
+ d????-?--*) different_mode=755;;
+ *) false;;
+ esac &&
+ $mkdirprog -m$different_mode -p -- "$tmpdir" && {
+ ls_ld_tmpdir_1=`ls -ld "$tmpdir"`
+ test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
+ }
+ }
+ then posix_mkdir=:
+ fi
+ rmdir "$tmpdir/d" "$tmpdir"
+ else
+ # Remove any dirs left behind by ancient mkdir implementations.
+ rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null
+ fi
+ trap '' 0;;
+ esac;;
+ esac
+
+ if
+ $posix_mkdir && (
+ umask $mkdir_umask &&
+ $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
+ )
+ then :
+ else
+
+ # The umask is ridiculous, or mkdir does not conform to POSIX,
+ # or it failed possibly due to a race condition. Create the
+ # directory the slow way, step by step, checking for races as we go.
+
+ case $dstdir in
+ /*) prefix='/';;
+ -*) prefix='./';;
+ *) prefix='';;
+ esac
+
+ eval "$initialize_posix_glob"
+
+ oIFS=$IFS
+ IFS=/
+ $posix_glob set -f
+ set fnord $dstdir
+ shift
+ $posix_glob set +f
+ IFS=$oIFS
-# Move or copy the file name to the temp name
+ prefixes=
-$doit $instcmd "$src" "$dsttmp"
+ for d
+ do
+ test -z "$d" && continue
-# and set any options; do chmod last to preserve setuid bits
+ prefix=$prefix$d
+ if test -d "$prefix"; then
+ prefixes=
+ else
+ if $posix_mkdir; then
+ (umask=$mkdir_umask &&
+ $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
+ # Don't fail if two instances are running concurrently.
+ test -d "$prefix" || exit 1
+ else
+ case $prefix in
+ *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) qprefix=$prefix;;
+ esac
+ prefixes="$prefixes '$qprefix'"
+ fi
+ fi
+ prefix=$prefix/
+ done
-if [ x"$chowncmd" != x ]; then $doit $chowncmd "$dsttmp"; fi
-if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd "$dsttmp"; fi
-if [ x"$stripcmd" != x ]; then $doit $stripcmd "$dsttmp"; fi
-if [ x"$chmodcmd" != x ]; then $doit $chmodcmd "$dsttmp"; fi
+ if test -n "$prefixes"; then
+ # Don't fail if two instances are running concurrently.
+ (umask $mkdir_umask &&
+ eval "\$doit_exec \$mkdirprog $prefixes") ||
+ test -d "$dstdir" || exit 1
+ obsolete_mkdir_used=true
+ fi
+ fi
+ fi
-# Now rename the file to the real destination.
+ if test -n "$dir_arg"; then
+ { test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
+ { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
+ { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
+ test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
+ else
-$doit $rmcmd "$dst"
-$doit $mvcmd "$dsttmp" "$dst"
+ # Make a couple of temp file names in the proper directory.
+ dsttmp=$dstdir/_inst.$$_
+ rmtmp=$dstdir/_rm.$$_
+ # Trap to clean up those temp files at exit.
+ trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
+
+ # Copy the file name to the temp name.
+ (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
+
+ # and set any options; do chmod last to preserve setuid bits.
+ #
+ # If any of these fail, we abort the whole thing. If we want to
+ # ignore errors from any of these, just make sure not to ignore
+ # errors from the above "$doit $cpprog $src $dsttmp" command.
+ #
+ { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
+ { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
+ { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
+ { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
+
+ # If -C, don't bother to copy if it wouldn't change the file.
+ if $copy_on_change &&
+ old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` &&
+ new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` &&
+
+ eval "$initialize_posix_glob" &&
+ $posix_glob set -f &&
+ set X $old && old=:$2:$4:$5:$6 &&
+ set X $new && new=:$2:$4:$5:$6 &&
+ $posix_glob set +f &&
+
+ test "$old" = "$new" &&
+ $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
+ then
+ rm -f "$dsttmp"
+ else
+ # Rename the file to the real destination.
+ $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
+
+ # The rename failed, perhaps because mv can't rename something else
+ # to itself, or perhaps because mv is so ancient that it does not
+ # support -f.
+ {
+ # Now remove or move aside any old file at destination location.
+ # We try this two ways since rm can't unlink itself on some
+ # systems and the destination file might be busy for other
+ # reasons. In this case, the final cleanup might fail but the new
+ # file should still install successfully.
+ {
+ test ! -f "$dst" ||
+ $doit $rmcmd -f "$dst" 2>/dev/null ||
+ { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
+ { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
+ } ||
+ { echo "$0: cannot unlink or rename $dst" >&2
+ (exit 1); exit 1
+ }
+ } &&
+
+ # Now rename the file to the real destination.
+ $doit $mvcmd "$dsttmp" "$dst"
+ }
+ fi || exit 1
+
+ trap '' 0
+ fi
+done
-exit 0
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "scriptversion="
+# time-stamp-format: "%:y-%02m-%02d.%02H"
+# time-stamp-time-zone: "UTC"
+# time-stamp-end: "; # UTC"
+# End:
diff --git a/unix/ldAix b/unix/ldAix
index e4ea518..51b2995 100755
--- a/unix/ldAix
+++ b/unix/ldAix
@@ -1,5 +1,5 @@
#!/bin/sh
-#
+#
# ldAix ldCmd ldArg ldArg ...
#
# This shell script provides a wrapper for ld under AIX in order to
@@ -9,8 +9,6 @@
# from the argument list, creates a .exp file describing all of the
# symbols exported by those files, and then invokes "ldCmd" to
# perform the real link.
-#
-# RCS: @(#) $Id: ldAix,v 1.5 2010/08/12 00:40:23 hobbs Exp $
# Extract from the arguments the names of all of the object files.
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index c86e994..b13fddd 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -120,8 +120,7 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [
if test x"${ac_cv_c_tclconfig}" = x ; then
TCL_BIN_DIR="# no Tcl configs found"
- AC_MSG_WARN([Can't find Tcl configuration definitions])
- exit 0
+ AC_MSG_ERROR([Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh])
else
no_tcl=
TCL_BIN_DIR="${ac_cv_c_tclconfig}"
@@ -251,8 +250,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [
if test x"${ac_cv_c_tkconfig}" = x ; then
TK_BIN_DIR="# no Tk configs found"
- AC_MSG_WARN([Can't find Tk configuration definitions])
- exit 0
+ AC_MSG_ERROR([Can't find Tk configuration definitions. Use --with-tk to specify a directory containing tkConfig.sh])
else
no_tk=
TK_BIN_DIR="${ac_cv_c_tkconfig}"
@@ -307,7 +305,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [
elif test "`uname -s`" = "Darwin"; then
# If Tcl was built as a framework, attempt to use the libraries
# from the framework at the given location so that linking works
- # against Tcl.framework installed in an arbitary location.
+ # against Tcl.framework installed in an arbitrary location.
case ${TCL_DEFS} in
*TCL_FRAMEWORK*)
if test -f "${TCL_BIN_DIR}/${TCL_LIB_FILE}"; then
@@ -390,7 +388,7 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [
elif test "`uname -s`" = "Darwin"; then
# If Tk was built as a framework, attempt to use the libraries
# from the framework at the given location so that linking works
- # against Tk.framework installed in an arbitary location.
+ # against Tk.framework installed in an arbitrary location.
case ${TK_DEFS} in
*TK_FRAMEWORK*)
if test -f "${TK_BIN_DIR}/${TK_LIB_FILE}"; then
@@ -740,6 +738,7 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [
if test "$tcl_ok" = "no"; then
CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
+ AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?])
AC_MSG_RESULT([no])
AC_DEFINE(TCL_CFG_OPTIMIZED, 1, [Is this an optimized build?])
else
@@ -751,8 +750,6 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [
fi
AC_SUBST(CFLAGS_DEFAULT)
AC_SUBST(LDFLAGS_DEFAULT)
- ### FIXME: Surely TCL_CFG_DEBUG should be set to whether we're debugging?
- AC_DEFINE(TCL_CFG_DEBUG, 1, [Is debugging enabled?])
if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then
AC_DEFINE(TCL_MEM_DEBUG, 1, [Is memory debugging enabled?])
@@ -1044,9 +1041,12 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AC_CACHE_CHECK([if compiler supports visibility "hidden"],
tcl_cv_cc_visibility_hidden, [
- AS_IF([test "$GCC" = yes], [
+ AS_IF([test "$SHARED_BUILD" = 1], [
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fvisibility=hidden -Werror"
- AC_TRY_COMPILE(,, tcl_cv_cc_visibility_hidden=yes,
+ AC_TRY_COMPILE(,[#if !defined(__GNUC__) || __GNUC__ < 4
+#error visibility hidden is not supported for this compiler
+#endif
+ ], tcl_cv_cc_visibility_hidden=yes,
tcl_cv_cc_visibility_hidden=no)
CFLAGS=$hold_cflags
], [
@@ -1055,6 +1055,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
])
AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [
CFLAGS="$CFLAGS -fvisibility=hidden"
+ AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])
], [
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
AC_TRY_LINK([
@@ -1095,6 +1096,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
# Step 3: set configuration options based on system name and version.
do64bit_ok=no
+ # default to '{$LIBS}' and set to "" on per-platform necessary basis
+ SHLIB_LD_LIBS='${LIBS}'
LDFLAGS_ORIG="$LDFLAGS"
# When ld needs options to work in 64-bit mode, put them in
# LDFLAGS_ARCH so they eventually end up in LDFLAGS even if [load]
@@ -1112,12 +1115,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
CFLAGS_OPTIMIZE=-O
CFLAGS_WARNING=""
])
-dnl FIXME: Replace AC_CHECK_PROG with AC_CHECK_TOOL once cross compiling is fixed.
-dnl AC_CHECK_TOOL(AR, ar)
- AC_CHECK_PROG(AR, ar, ar)
- AS_IF([test "${AR}" = ""], [
- AC_MSG_ERROR([Required archive tool 'ar' not found on PATH.])
- ])
+ AC_CHECK_TOOL(AR, ar)
STLIB_LD='${AR} cr'
LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
PLAT_OBJS=""
@@ -1141,9 +1139,6 @@ dnl AC_CHECK_TOOL(AR, ar)
])
LIBS="$LIBS -lc"
SHLIB_CFLAGS=""
- # Note: need the LIBS below, otherwise Tk won't find Tcl's
- # symbols when dynamically loaded into tclsh.
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
@@ -1194,7 +1189,6 @@ dnl AC_CHECK_TOOL(AR, ar)
BeOS*)
SHLIB_CFLAGS="-fPIC"
SHLIB_LD='${CC} -nostart'
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
@@ -1209,7 +1203,6 @@ dnl AC_CHECK_TOOL(AR, ar)
BSD/OS-2.1*|BSD/OS-3*)
SHLIB_CFLAGS=""
SHLIB_LD="shlicc -r"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
@@ -1219,7 +1212,6 @@ dnl AC_CHECK_TOOL(AR, ar)
BSD/OS-4.*)
SHLIB_CFLAGS="-export-dynamic -fPIC"
SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
@@ -1227,15 +1219,36 @@ dnl AC_CHECK_TOOL(AR, ar)
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
- CYGWIN_*)
+ CYGWIN_*|MINGW32*)
SHLIB_CFLAGS=""
SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".dll"
- DL_OBJS="tclLoadDl.o"
+ DL_OBJS="tclLoadDl.o tclWinError.o"
DL_LIBS="-ldl"
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
+ TCL_NEEDS_EXP_FILE=1
+ TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a'
+ TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,$[@].a'
+ AC_CACHE_CHECK(for Cygwin version of gcc,
+ ac_cv_cygwin,
+ AC_TRY_COMPILE([
+ #ifdef __CYGWIN__
+ #error cygwin
+ #endif
+ ], [],
+ ac_cv_cygwin=no,
+ ac_cv_cygwin=yes)
+ )
+ if test "$ac_cv_cygwin" = "no"; then
+ AC_MSG_ERROR([${CC} is not a cygwin compiler.])
+ fi
+ if test "x${TCL_THREADS}" = "x0"; then
+ AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads])
+ fi
+ if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then
+ AC_MSG_ERROR([Please configure and make the ../win directory first.])
+ fi
;;
dgux*)
SHLIB_CFLAGS="-K PIC"
@@ -1250,7 +1263,6 @@ dnl AC_CHECK_TOOL(AR, ar)
Haiku*)
LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
SHLIB_CFLAGS="-fPIC"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}'
DL_OBJS="tclLoadDl.o"
@@ -1272,7 +1284,6 @@ dnl AC_CHECK_TOOL(AR, ar)
AS_IF([test "$tcl_ok" = yes], [
SHLIB_CFLAGS="+z"
SHLIB_LD="ld -b"
- SHLIB_LD_LIBS='${LIBS}'
DL_OBJS="tclLoadShl.o"
DL_LIBS="-ldld"
LDFLAGS="$LDFLAGS -Wl,-E"
@@ -1282,7 +1293,6 @@ dnl AC_CHECK_TOOL(AR, ar)
])
AS_IF([test "$GCC" = yes], [
SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
], [
CFLAGS="$CFLAGS -z"
@@ -1299,7 +1309,6 @@ dnl AC_CHECK_TOOL(AR, ar)
# 64-bit gcc in use. Fix flags for GNU ld.
do64bit_ok=yes
SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
AS_IF([test $doRpath = yes], [
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
@@ -1331,7 +1340,6 @@ dnl AC_CHECK_TOOL(AR, ar)
IRIX-5.*)
SHLIB_CFLAGS=""
SHLIB_LD="ld -shared -rdata_shared"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -1343,7 +1351,6 @@ dnl AC_CHECK_TOOL(AR, ar)
IRIX-6.*)
SHLIB_CFLAGS=""
SHLIB_LD="ld -n32 -shared -rdata_shared"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -1370,7 +1377,6 @@ dnl AC_CHECK_TOOL(AR, ar)
IRIX64-6.*)
SHLIB_CFLAGS=""
SHLIB_LD="ld -n32 -shared -rdata_shared"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -1394,7 +1400,6 @@ dnl AC_CHECK_TOOL(AR, ar)
;;
Linux*)
SHLIB_CFLAGS="-fPIC"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
CFLAGS_OPTIMIZE="-O2"
@@ -1433,7 +1438,6 @@ dnl AC_CHECK_TOOL(AR, ar)
;;
GNU*)
SHLIB_CFLAGS="-fPIC"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
SHLIB_LD='${CC} -shared'
@@ -1446,7 +1450,6 @@ dnl AC_CHECK_TOOL(AR, ar)
;;
Lynx*)
SHLIB_CFLAGS="-fPIC"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
CFLAGS_OPTIMIZE=-02
SHLIB_LD='${CC} -shared'
@@ -1481,7 +1484,6 @@ dnl AC_CHECK_TOOL(AR, ar)
NetBSD-1.*|FreeBSD-[[1-2]].*)
SHLIB_CFLAGS="-fPIC"
SHLIB_LD="ld -Bshareable -x"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -1506,17 +1508,37 @@ dnl AC_CHECK_TOOL(AR, ar)
TCL_LIB_VERSIONS_OK=nodots
;;
OpenBSD-*)
- CFLAGS_OPTIMIZE='-O2'
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- AS_IF([test $doRpath = yes], [
- CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
- LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
- SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
+ arch=`arch -s`
+ case "$arch" in
+ m88k|vax)
+ # Equivalent using configure option --disable-load
+ # Step 4 will set the necessary variables
+ DL_OBJS=""
+ SHLIB_LD_LIBS=""
+ ;;
+ *)
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ AS_IF([test $doRpath = yes], [
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
+ ;;
+ esac
+ case "$arch" in
+ m88k|vax)
+ CFLAGS_OPTIMIZE="-O1"
+ ;;
+ sh)
+ CFLAGS_OPTIMIZE="-O0"
+ ;;
+ *)
+ CFLAGS_OPTIMIZE="-O2"
+ ;;
+ esac
AC_CACHE_CHECK([for ELF], tcl_cv_ld_elf, [
AC_EGREP_CPP(yes, [
#ifdef __ELF__
@@ -1527,10 +1549,10 @@ dnl AC_CHECK_TOOL(AR, ar)
LDFLAGS=-Wl,-export-dynamic
], [LDFLAGS=""])
AS_IF([test "${TCL_THREADS}" = "1"], [
- # OpenBSD builds and links with -pthread, never -lpthread.
+ # On OpenBSD: Compile with -pthread
+ # Don't link with -lpthread
LIBS=`echo $LIBS | sed s/-lpthread//`
CFLAGS="$CFLAGS -pthread"
- SHLIB_CFLAGS="$SHLIB_CFLAGS -pthread"
])
# OpenBSD doesn't do version numbers with dots.
UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
@@ -1541,7 +1563,6 @@ dnl AC_CHECK_TOOL(AR, ar)
# NetBSD 2.* has ELF and can use 'cc -shared' to build shared libs
SHLIB_CFLAGS="-fPIC"
SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -1569,7 +1590,6 @@ dnl AC_CHECK_TOOL(AR, ar)
SHLIB_CFLAGS="-fPIC"
SHLIB_LD="${CC} -shared"
TCL_SHLIB_LD_EXTRAS="-soname \$[@]"
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -1644,7 +1664,6 @@ dnl AC_CHECK_TOOL(AR, ar)
AS_IF([test $tcl_cv_ld_single_module = yes], [
SHLIB_LD="${SHLIB_LD} -Wl,-single_module"
])
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".dylib"
DL_OBJS="tclLoadDyld.o"
DL_LIBS=""
@@ -1666,6 +1685,7 @@ dnl AC_CHECK_TOOL(AR, ar)
AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [
AC_DEFINE(MODULE_SCOPE, [__private_extern__],
[Compiler support for module scope symbols])
+ tcl_cv_cc_visibility_hidden=yes
])
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
@@ -1738,6 +1758,7 @@ dnl AC_CHECK_TOOL(AR, ar)
LD_SEARCH_FLAGS=""
;;
OS/390-*)
+ SHLIB_LD_LIBS=""
CFLAGS_OPTIMIZE="" # Optimizer is buggy
AC_DEFINE(_OE_SOCKETS, 1, # needed in sys/socket.h
[Should OS/390 do the right thing with sockets?])
@@ -1775,7 +1796,6 @@ dnl AC_CHECK_TOOL(AR, ar)
], [
SHLIB_LD='ld -non_shared -expect_unresolved "*"'
])
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
@@ -1869,11 +1889,6 @@ dnl AC_CHECK_TOOL(AR, ar)
[Do we really want to follow the standard? Yes we do!])
SHLIB_CFLAGS="-KPIC"
-
- # Note: need the LIBS below, otherwise Tk won't find Tcl's
- # symbols when dynamically loaded into tclsh.
-
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
@@ -1953,7 +1968,7 @@ dnl AC_CHECK_TOOL(AR, ar)
AS_IF([test "$GCC" = yes],[use_sunmath=no],[
arch=`isainfo`
AC_MSG_CHECKING([whether to use -lsunmath for fp rounding control])
- AS_IF([test "$arch" = "amd64 i386"], [
+ AS_IF([test "$arch" = "amd64 i386" -o "$arch" = "i386"], [
AC_MSG_RESULT([yes])
MATH_LIBS="-lsunmath $MATH_LIBS"
AC_CHECK_HEADER(sunmath.h)
@@ -1963,11 +1978,6 @@ dnl AC_CHECK_TOOL(AR, ar)
use_sunmath=no
])
])
-
- # Note: need the LIBS below, otherwise Tk won't find Tcl's
- # symbols when dynamically loaded into tclsh.
-
- SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
@@ -1991,7 +2001,7 @@ dnl AC_CHECK_TOOL(AR, ar)
], [
AS_IF([test "$use_sunmath" = yes], [textmode=textoff],[textmode=text])
case $system in
- SunOS-5.[[1-9]][[0-9]]*)
+ SunOS-5.[[1-9]][[0-9]]*|SunOS-5.[[7-9]])
SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";;
*)
SHLIB_LD="/usr/ccs/bin/ld -G -z $textmode";;
@@ -2066,7 +2076,7 @@ dnl # preprocessing tests use only CPPFLAGS.
case $system in
AIX-*) ;;
BSD/OS*) ;;
- CYGWIN_*) ;;
+ CYGWIN_*|MINGW32_*) ;;
IRIX*) ;;
NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
Darwin-*) ;;
@@ -2074,30 +2084,36 @@ dnl # preprocessing tests use only CPPFLAGS.
*) SHLIB_CFLAGS="-fPIC" ;;
esac])
+ AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [
+ AC_DEFINE(MODULE_SCOPE, [extern],
+ [No Compiler support for module scope symbols])
+ AC_DEFINE(NO_VIZ, [], [No visibility attribute])
+ ])
+
AS_IF([test "$SHARED_LIB_SUFFIX" = ""], [
SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'])
AS_IF([test "$UNSHARED_LIB_SUFFIX" = ""], [
UNSHARED_LIB_SUFFIX='${VERSION}.a'])
- DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)"
+ DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)"
AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [
LIB_SUFFIX=${SHARED_LIB_SUFFIX}
- MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
+ MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${TCL_SHLIB_LD_EXTRAS} ${SHLIB_LD_LIBS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"'
DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"
], [
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
])
], [
LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
AS_IF([test "$RANLIB" = ""], [
MAKE_LIB='$(STLIB_LD) [$]@ ${OBJS}'
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
], [
MAKE_LIB='${STLIB_LD} [$]@ ${OBJS} ; ${RANLIB} [$]@'
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
])
])
@@ -2107,7 +2123,7 @@ dnl # preprocessing tests use only CPPFLAGS.
INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"'
], [
MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS} ; ${RANLIB} [$]@'
- INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)"/$(STUB_LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
+ INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
])
# Define TCL_LIBS now that we know what DL_LIBS is.
@@ -2117,6 +2133,25 @@ dnl # preprocessing tests use only CPPFLAGS.
TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}"])
AC_SUBST(TCL_LIBS)
+ # See if the compiler supports casting to a union type.
+ # This is used to stop gcc from printing a compiler
+ # warning when initializing a union member.
+
+ AC_CACHE_CHECK(for cast to union support,
+ tcl_cv_cast_to_union,
+ AC_TRY_COMPILE([],
+ [
+ union foo { int i; double d; };
+ union foo f = (union foo) (int) 0;
+ ],
+ tcl_cv_cast_to_union=yes,
+ tcl_cv_cast_to_union=no)
+ )
+ if test "$tcl_cv_cast_to_union" = "yes"; then
+ AC_DEFINE(HAVE_CAST_TO_UNION, 1,
+ [Defined when compiler supports casting to union type.])
+ fi
+
# FIXME: This subst was left in only because the TCL_DL_LIBS
# entry in tclConfig.sh uses it. It is not clear why someone
# would use TCL_DL_LIBS instead of TCL_LIBS.
@@ -2374,7 +2409,7 @@ closedir(d);
#
# Results:
#
-# Sets the the following vars:
+# Sets the following vars:
# XINCLUDES
# XLIBSW
#
@@ -3013,37 +3048,6 @@ AC_DEFUN([SC_TCL_GETHOSTBYNAME_R], [AC_CHECK_FUNC(gethostbyname_r, [
])])
#--------------------------------------------------------------------
-# SC_TCL_GETADDRINFO
-#
-# Check if we have 'getaddrinfo'
-#
-# Arguments:
-# None
-#
-# Results:
-# Might define the following vars:
-# HAVE_GETADDRINFO
-#
-#--------------------------------------------------------------------
-
-AC_DEFUN([SC_TCL_GETADDRINFO], [AC_CHECK_FUNC(getaddrinfo, [
- AC_CACHE_CHECK([for working getaddrinfo], tcl_cv_api_getaddrinfo, [
- AC_TRY_COMPILE([
- #include <netdb.h>
- ], [
- const char *name, *port;
- struct addrinfo *aiPtr, hints;
- (void)getaddrinfo(name,port, &hints, &aiPtr);
- (void)freeaddrinfo(aiPtr);
- ], tcl_cv_api_getaddrinfo=yes, tcl_cv_getaddrinfo=no)])
- tcl_ok=$tcl_cv_api_getaddrinfo
- if test "$tcl_ok" = yes; then
- AC_DEFINE(HAVE_GETADDRINFO, 1,
- [Define to 1 if getaddrinfo is available.])
- fi
-])])
-
-#--------------------------------------------------------------------
# SC_TCL_GETPWUID_R
#
# Check if we have MT-safe variant of getpwuid() and if yes,
@@ -3283,6 +3287,26 @@ AC_DEFUN([SC_TCL_GETGRNAM_R], [AC_CHECK_FUNC(getgrnam_r, [
fi
])])
+AC_DEFUN([SC_TCL_IPV6],[
+ NEED_FAKE_RFC2553=0
+ AC_CHECK_FUNCS(getnameinfo getaddrinfo freeaddrinfo gai_strerror,,[NEED_FAKE_RFC2553=1])
+ AC_CHECK_TYPES([
+ struct addrinfo,
+ struct in6_addr,
+ struct sockaddr_in6,
+ struct sockaddr_storage],,[NEED_FAKE_RFC2553=1],[[
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netdb.h>
+]])
+if test "x$NEED_FAKE_RFC2553" = "x1"; then
+ AC_DEFINE([NEED_FAKE_RFC2553], 1,
+ [Use compat implementation of getaddrinfo() and friends])
+ AC_LIBOBJ([fake-rfc2553])
+ AC_CHECK_FUNC(strlcpy)
+fi
+])
# Local Variables:
# mode: autoconf
# End:
diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in
index 9b090fa..8bf67cd 100644
--- a/unix/tcl.pc.in
+++ b/unix/tcl.pc.in
@@ -1,5 +1,4 @@
# tcl pkg-config source file
-# $Id: tcl.pc.in,v 1.1 2009/03/14 17:20:24 dkf Exp $
prefix=@prefix@
exec_prefix=@exec_prefix@
diff --git a/unix/tcl.spec b/unix/tcl.spec
index 09b37b1..27f7189 100644
--- a/unix/tcl.spec
+++ b/unix/tcl.spec
@@ -1,11 +1,10 @@
-# $Id: tcl.spec,v 1.43 2008/12/19 03:54:44 dgp Exp $
# This file is the basis for a binary Tcl RPM for Linux.
%{!?directory:%define directory /usr/local}
Name: tcl
Summary: Tcl scripting language development environment
-Version: 8.6b1
+Version: 8.6.0
Release: 2
License: BSD
Group: Development/Languages
diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c
index a74fec8..159bbd8 100644
--- a/unix/tclAppInit.c
+++ b/unix/tclAppInit.c
@@ -10,10 +10,10 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclAppInit.c,v 1.24 2010/09/23 21:40:46 nijtmans Exp $
*/
+#undef BUILD_tcl
+#undef STATIC_BUILD
#include "tcl.h"
#ifdef TCL_TEST
@@ -35,7 +35,11 @@ extern int Tclxttest_Init(Tcl_Interp *interp);
#ifndef TCL_LOCAL_APPINIT
#define TCL_LOCAL_APPINIT Tcl_AppInit
#endif
-extern int TCL_LOCAL_APPINIT(Tcl_Interp *interp);
+#ifndef MODULE_SCOPE
+# define MODULE_SCOPE extern
+#endif
+MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
+MODULE_SCOPE int main(int, char **);
/*
* The following #if block allows you to change how Tcl finds the startup
diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in
index debbd53..f171cce 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
@@ -13,8 +16,8 @@
/* Define to 1 if the system has the type `blkcnt_t'. */
#undef HAVE_BLKCNT_T
-/* Do we have BSDgettimeofday()? */
-#undef HAVE_BSDGETTIMEOFDAY
+/* Defined when compiler supports casting to union type. */
+#undef HAVE_CAST_TO_UNION
/* Define to 1 if you have the `chflags' function. */
#undef HAVE_CHFLAGS
@@ -28,10 +31,19 @@
/* Do we have access to Darwin CoreFoundation.framework? */
#undef HAVE_COREFOUNDATION
+/* Is the cpuid instruction usable? */
+#undef HAVE_CPUID
+
+/* Define to 1 if you have the `freeaddrinfo' function. */
+#undef HAVE_FREEADDRINFO
+
/* Do we have fts functions? */
#undef HAVE_FTS
-/* Define to 1 if getaddrinfo is available. */
+/* Define to 1 if you have the `gai_strerror' function. */
+#undef HAVE_GAI_STRERROR
+
+/* Define to 1 if you have the `getaddrinfo' function. */
#undef HAVE_GETADDRINFO
/* Define to 1 if you have the `getattrlist' function. */
@@ -79,6 +91,9 @@
/* Define to 1 if gethostbyname_r takes 6 args. */
#undef HAVE_GETHOSTBYNAME_R_6
+/* Define to 1 if you have the `getnameinfo' function. */
+#undef HAVE_GETNAMEINFO
+
/* Define to 1 if getpwnam_r is available. */
#undef HAVE_GETPWNAM_R
@@ -178,16 +193,28 @@
/* Define to 1 if you have the `strtol' function. */
#undef HAVE_STRTOL
+/* Define to 1 if the system has the type `struct addrinfo'. */
+#undef HAVE_STRUCT_ADDRINFO
+
/* Is 'struct dirent64' in <sys/types.h>? */
#undef HAVE_STRUCT_DIRENT64
+/* Define to 1 if the system has the type `struct in6_addr'. */
+#undef HAVE_STRUCT_IN6_ADDR
+
+/* Define to 1 if the system has the type `struct sockaddr_in6'. */
+#undef HAVE_STRUCT_SOCKADDR_IN6
+
+/* Define to 1 if the system has the type `struct sockaddr_storage'. */
+#undef HAVE_STRUCT_SOCKADDR_STORAGE
+
/* 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/filio.h> header file. */
@@ -244,12 +271,18 @@
/* Is this a Mac I see before me? */
#undef MAC_OSX_TCL
-/* Compiler support for module scope symbols */
+/* No Compiler support for module scope symbols */
#undef MODULE_SCOPE
/* Default libtommath precision. */
#undef MP_PREC
+/* Is no debugging enabled? */
+#undef NDEBUG
+
+/* Use compat implementation of getaddrinfo() and friends */
+#undef NEED_FAKE_RFC2553
+
/* Is Darwin CoreFoundation unavailable for 64-bit? */
#undef NO_COREFOUNDATION_64
@@ -307,6 +340,9 @@
/* Do we have <values.h>? */
#undef NO_VALUES_H
+/* No visibility attribute */
+#undef NO_VIZ
+
/* Do we have wait3() */
#undef NO_WAIT3
@@ -322,6 +358,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
@@ -334,9 +373,6 @@
/* What encoding should be used for embedded configuration info? */
#undef TCL_CFGVAL_ENCODING
-/* Is debugging enabled? */
-#undef TCL_CFG_DEBUG
-
/* Is this a 64-bit build? */
#undef TCL_CFG_DO64BIT
@@ -412,9 +448,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 Darwin SUSv3 extensions available? */
#undef _DARWIN_C_SOURCE
@@ -469,7 +513,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 d5569bc..d47e686 100644
--- a/unix/tclConfig.sh.in
+++ b/unix/tclConfig.sh.in
@@ -1,5 +1,5 @@
# tclConfig.sh --
-#
+#
# This shell script (for sh) is generated automatically by Tcl's
# configure script. It will create shell variables for most of
# the configuration options discovered by the configure script.
@@ -8,8 +8,6 @@
# out for themselves.
#
# The information in this file is specific to a single platform.
-#
-# RCS: @(#) $Id: tclConfig.sh.in,v 1.22 2010/08/12 00:40:24 hobbs Exp $
# Tcl's version number.
TCL_VERSION='@TCL_VERSION@'
diff --git a/unix/tclLoadAix.c b/unix/tclLoadAix.c
index b0dc640..88e6b50 100644
--- a/unix/tclLoadAix.c
+++ b/unix/tclLoadAix.c
@@ -17,8 +17,6 @@
* for any results of using the software, alterations are clearly marked
* as such, and this notice is not modified.
*
- * RCS: @(#) $Id: tclLoadAix.c,v 1.7 2008/10/26 12:45:04 dkf Exp $
- *
* Note: this file has been altered from the original in a few ways in order
* to work properly with Tcl.
*/
diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c
index 7bec84c..dc711f8 100644
--- a/unix/tclLoadDl.c
+++ b/unix/tclLoadDl.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclLoadDl.c,v 1.24 2010/06/21 11:23:23 nijtmans Exp $
*/
#include "tclInt.h"
@@ -21,17 +19,17 @@
/*
* In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined and this
- * argument to dlopen must always be 1. The RTLD_GLOBAL flag is needed on some
- * systems (e.g. SCO and UnixWare) but doesn't exist on others; if it doesn't
- * exist, set it to 0 so it has no effect.
+ * argument to dlopen must always be 1. The RTLD_LOCAL flag doesn't exist on
+ * some platforms; if it doesn't exist, set it to 0 so it has no effect.
+ * See [Bug #3216070]
*/
#ifndef RTLD_NOW
# define RTLD_NOW 1
#endif
-#ifndef RTLD_GLOBAL
-# define RTLD_GLOBAL 0
+#ifndef RTLD_LOCAL
+# define RTLD_LOCAL 0
#endif
/*
@@ -68,14 +66,16 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
void *handle;
Tcl_LoadHandle newHandle;
const char *native;
+ int dlopenflags = 0;
/*
* First try the full path the user gave us. This is particularly
@@ -84,7 +84,20 @@ TclpDlopen(
*/
native = Tcl_FSGetNativePath(pathPtr);
- handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL);
+ /*
+ * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
+ */
+ if (flags & TCL_LOAD_GLOBAL) {
+ dlopenflags |= RTLD_GLOBAL;
+ } else {
+ dlopenflags |= RTLD_LOCAL;
+ }
+ if (flags & TCL_LOAD_LAZY) {
+ dlopenflags |= RTLD_LAZY;
+ } else {
+ dlopenflags |= RTLD_NOW;
+ }
+ handle = dlopen(native, dlopenflags);
if (handle == NULL) {
/*
* Let the OS loader examine the binary search path for whatever
@@ -96,7 +109,10 @@ TclpDlopen(
const char *fileName = Tcl_GetString(pathPtr);
native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
- handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL);
+ /*
+ * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
+ */
+ handle = dlopen(native, dlopenflags);
Tcl_DStringFree(&ds);
}
@@ -108,11 +124,12 @@ TclpDlopen(
const char *errorStr = dlerror();
- Tcl_AppendResult(interp, "couldn't load file \"",
- Tcl_GetString(pathPtr), "\": ", errorStr, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't load file \"%s\": %s",
+ Tcl_GetString(pathPtr), errorStr));
return TCL_ERROR;
}
- newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle));
+ newHandle = ckalloc(sizeof(*newHandle));
newHandle->clientData = handle;
newHandle->findSymbolProcPtr = &FindSymbol;
newHandle->unloadFileProcPtr = &UnloadFile;
@@ -147,7 +164,7 @@ FindSymbol(
const char *native; /* Name of the library to be loaded, in
* system encoding */
Tcl_DString newName, ds; /* Buffers for converting the name to
- * system encoding and prepending an
+ * system encoding and prepending an
* underscore*/
void *handle = (void *) loadHandle->clientData;
/* Native handle to the loaded library */
@@ -164,16 +181,21 @@ FindSymbol(
proc = dlsym(handle, native); /* INTL: Native. */
if (proc == NULL) {
Tcl_DStringInit(&newName);
- Tcl_DStringAppend(&newName, "_", 1);
+ TclDStringAppendLiteral(&newName, "_");
native = Tcl_DStringAppend(&newName, native, -1);
proc = dlsym(handle, native); /* INTL: Native. */
Tcl_DStringFree(&newName);
}
Tcl_DStringFree(&ds);
if (proc == NULL && interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\": ",
- dlerror(), NULL);
+ const char *errorStr = dlerror();
+
+ if (!errorStr) {
+ errorStr = "unknown";
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot find symbol \"%s\": %s", symbol, errorStr));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol,
NULL);
}
@@ -204,10 +226,10 @@ UnloadFile(
* TclpDlopen(). The loadHandle is a token
* that represents the loaded file. */
{
- void *handle = (void *) loadHandle->clientData;
+ void *handle = loadHandle->clientData;
dlclose(handle);
- ckfree((char *) loadHandle);
+ ckfree(loadHandle);
}
/*
diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c
index 35f732d..50c283d 100644
--- a/unix/tclLoadDyld.c
+++ b/unix/tclLoadDyld.c
@@ -11,49 +11,41 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclLoadDyld.c,v 1.37 2010/04/05 07:38:08 dkf Exp $
*/
#include "tclInt.h"
#ifndef MODULE_SCOPE
-#define MODULE_SCOPE extern
+# define MODULE_SCOPE extern
#endif
-#ifndef TCL_DYLD_USE_DLFCN
/*
* Use preferred dlfcn API on 10.4 and later
*/
-# if !defined(NO_DLFCN_H) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1040
-# define TCL_DYLD_USE_DLFCN 1
-# else
+
+#ifndef TCL_DYLD_USE_DLFCN
+# ifdef NO_DLFCN_H
# define TCL_DYLD_USE_DLFCN 0
+# else
+# define TCL_DYLD_USE_DLFCN 1
# endif
#endif
-#ifndef TCL_DYLD_USE_NSMODULE
+
/*
* Use deprecated NSModule API only to support 10.3 and earlier:
*/
-# if MAC_OS_X_VERSION_MIN_REQUIRED < 1040
-# define TCL_DYLD_USE_NSMODULE 1
-# else
-# define TCL_DYLD_USE_NSMODULE 0
-# endif
+
+#ifndef TCL_DYLD_USE_NSMODULE
+# define TCL_DYLD_USE_NSMODULE 0
#endif
-#if TCL_DYLD_USE_DLFCN
-#include <dlfcn.h>
-#if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040
/*
- * Support for weakly importing dlfcn API.
+ * Use includes for the API we're using.
*/
-extern void *dlopen(const char *path, int mode) WEAK_IMPORT_ATTRIBUTE;
-extern void *dlsym(void *handle, const char *symbol) WEAK_IMPORT_ATTRIBUTE;
-extern int dlclose(void *handle) WEAK_IMPORT_ATTRIBUTE;
-extern char *dlerror(void) WEAK_IMPORT_ATTRIBUTE;
-#endif
-#endif
+
+#if TCL_DYLD_USE_DLFCN
+# include <dlfcn.h>
+#endif /* TCL_DYLD_USE_DLFCN */
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
#include <mach-o/dyld.h>
@@ -62,38 +54,23 @@ extern char *dlerror(void) WEAK_IMPORT_ATTRIBUTE;
#include <mach-o/arch.h>
#include <libkern/OSByteOrder.h>
#include <mach/mach.h>
-#include <stdbool.h>
typedef struct Tcl_DyldModuleHandle {
struct Tcl_DyldModuleHandle *nextPtr;
NSModule module;
} Tcl_DyldModuleHandle;
-#endif /* TCL_DYLD_USE_NSMODULE */
+#endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */
-typedef struct Tcl_DyldLoadHandle {
-#if TCL_DYLD_USE_DLFCN
+typedef struct {
void *dlHandle;
-#endif
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
const struct mach_header *dyldLibHeader;
Tcl_DyldModuleHandle *modulePtr;
#endif
} Tcl_DyldLoadHandle;
-#if (TCL_DYLD_USE_DLFCN && MAC_OS_X_VERSION_MIN_REQUIRED < 1040) || \
- defined(TCL_LOAD_FROM_MEMORY)
-MODULE_SCOPE long tclMacOSXDarwinRelease;
-#endif
-
-#ifdef TCL_DEBUG_LOAD
-#define TclLoadDbgMsg(m, ...) \
- do { \
- fprintf(stderr, "%s:%d: %s(): " m ".\n", \
- strrchr(__FILE__, '/')+1, __LINE__, __func__, \
- ##__VA_ARGS__); \
- } while (0)
-#else
-#define TclLoadDbgMsg(m, ...)
+#if TCL_DYLD_USE_DLFCN || defined(TCL_LOAD_FROM_MEMORY)
+MODULE_SCOPE long tclMacOSXDarwinRelease;
#endif
/*
@@ -104,7 +81,6 @@ static void * FindSymbol(Tcl_Interp *interp,
Tcl_LoadHandle loadHandle, const char *symbol);
static void UnloadFile(Tcl_LoadHandle handle);
-#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
/*
*----------------------------------------------------------------------
*
@@ -122,6 +98,7 @@ static void UnloadFile(Tcl_LoadHandle handle);
*----------------------------------------------------------------------
*/
+#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
static const char *
DyldOFIErrorMsg(
int err)
@@ -143,7 +120,7 @@ DyldOFIErrorMsg(
return "unknown error";
}
}
-#endif /* TCL_DYLD_USE_NSMODULE */
+#endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */
/*
*----------------------------------------------------------------------
@@ -171,16 +148,15 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
Tcl_DyldLoadHandle *dyldLoadHandle;
Tcl_LoadHandle newHandle;
-#if TCL_DYLD_USE_DLFCN
void *dlHandle = NULL;
-#endif
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
const struct mach_header *dyldLibHeader = NULL;
Tcl_DyldModuleHandle *modulePtr = NULL;
@@ -189,12 +165,14 @@ TclpDlopen(
NSLinkEditErrors editError;
int errorNumber;
const char *errorName, *objFileImageErrMsg = NULL;
-#endif
+#endif /* TCL_DYLD_USE_NSMODULE */
const char *errMsg = NULL;
int result;
Tcl_DString ds;
- char *fileName = NULL;
const char *nativePath, *nativeFileName = NULL;
+#if TCL_DYLD_USE_DLFCN
+ int dlopenflags = 0;
+#endif /* TCL_DYLD_USE_DLFCN */
/*
* First try the full path the user gave us. This is particularly
@@ -203,40 +181,44 @@ TclpDlopen(
*/
nativePath = Tcl_FSGetNativePath(pathPtr);
+ nativeFileName = Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr),
+ -1, &ds);
#if TCL_DYLD_USE_DLFCN
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 1040
- if (tclMacOSXDarwinRelease >= 8)
-#endif
- {
- dlHandle = dlopen(nativePath, RTLD_NOW | RTLD_GLOBAL);
- if (!dlHandle) {
- /*
- * Let the OS loader examine the binary search path for whatever
- * string the user gave us which hopefully refers to a file on the
- * binary path.
- */
+ /*
+ * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
+ */
- fileName = Tcl_GetString(pathPtr);
- nativeFileName = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
- dlHandle = dlopen(nativeFileName, RTLD_NOW | RTLD_GLOBAL);
- }
- if (dlHandle) {
- TclLoadDbgMsg("dlopen() successful");
- } else {
+ if (flags & TCL_LOAD_GLOBAL) {
+ dlopenflags |= RTLD_GLOBAL;
+ } else {
+ dlopenflags |= RTLD_LOCAL;
+ }
+ if (flags & TCL_LOAD_LAZY) {
+ dlopenflags |= RTLD_LAZY;
+ } else {
+ dlopenflags |= RTLD_NOW;
+ }
+ dlHandle = dlopen(nativePath, dlopenflags);
+ if (!dlHandle) {
+ /*
+ * Let the OS loader examine the binary search path for whatever string
+ * the user gave us which hopefully refers to a file on the binary
+ * path.
+ */
+
+ dlHandle = dlopen(nativeFileName, dlopenflags);
+ if (!dlHandle) {
errMsg = dlerror();
- TclLoadDbgMsg("dlopen() failed: %s", errMsg);
}
}
- if (!dlHandle)
#endif /* TCL_DYLD_USE_DLFCN */
- {
+
+ if (!dlHandle) {
#if TCL_DYLD_USE_NSMODULE
dyldLibHeader = NSAddImage(nativePath,
NSADDIMAGE_OPTION_RETURN_ON_ERROR);
- if (dyldLibHeader) {
- TclLoadDbgMsg("NSAddImage() successful");
- } else {
+ if (!dyldLibHeader) {
NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg);
if (editError == NSLinkEditFileAccessError) {
/*
@@ -245,20 +227,12 @@ TclpDlopen(
* which hopefully refers to a file on the binary path.
*/
- if (!fileName) {
- fileName = Tcl_GetString(pathPtr);
- nativeFileName = Tcl_UtfToExternalDString(NULL, fileName,
- -1, &ds);
- }
dyldLibHeader = NSAddImage(nativeFileName,
NSADDIMAGE_OPTION_WITH_SEARCHING |
NSADDIMAGE_OPTION_RETURN_ON_ERROR);
- if (dyldLibHeader) {
- TclLoadDbgMsg("NSAddImage() successful");
- } else {
+ if (!dyldLibHeader) {
NSLinkEditError(&editError, &errorNumber, &errorName,
&errMsg);
- TclLoadDbgMsg("NSAddImage() failed: %s", errMsg);
}
} else if ((editError == NSLinkEditFileFormatError
&& errorNumber == EBADMACHO)
@@ -275,50 +249,39 @@ TclpDlopen(
err = NSCreateObjectFileImageFromFile(nativePath,
&dyldObjFileImage);
if (err == NSObjectFileImageSuccess && dyldObjFileImage) {
- TclLoadDbgMsg("NSCreateObjectFileImageFromFile() "
- "successful");
- module = NSLinkModule(dyldObjFileImage, nativePath,
- NSLINKMODULE_OPTION_BINDNOW
- | NSLINKMODULE_OPTION_RETURN_ON_ERROR);
+ int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR;
+ if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE;
+ if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW;
+ module = NSLinkModule(dyldObjFileImage, nativePath, nsflags);
NSDestroyObjectFileImage(dyldObjFileImage);
if (module) {
- modulePtr = (Tcl_DyldModuleHandle *)
- ckalloc(sizeof(Tcl_DyldModuleHandle));
+ modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle));
modulePtr->module = module;
modulePtr->nextPtr = NULL;
- TclLoadDbgMsg("NSLinkModule() successful");
} else {
NSLinkEditError(&editError, &errorNumber, &errorName,
&errMsg);
- TclLoadDbgMsg("NSLinkModule() failed: %s", errMsg);
}
} else {
objFileImageErrMsg = DyldOFIErrorMsg(err);
- TclLoadDbgMsg("NSCreateObjectFileImageFromFile() failed: "
- "%s", objFileImageErrMsg);
}
}
}
#endif /* TCL_DYLD_USE_NSMODULE */
}
- if (0
-#if TCL_DYLD_USE_DLFCN
- || dlHandle
-#endif
+
+ if (dlHandle
#if TCL_DYLD_USE_NSMODULE
|| dyldLibHeader || modulePtr
-#endif
+#endif /* TCL_DYLD_USE_NSMODULE */
) {
- dyldLoadHandle = (Tcl_DyldLoadHandle *)
- ckalloc(sizeof(Tcl_DyldLoadHandle));
-#if TCL_DYLD_USE_DLFCN
+ dyldLoadHandle = ckalloc(sizeof(Tcl_DyldLoadHandle));
dyldLoadHandle->dlHandle = dlHandle;
-#endif
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
dyldLoadHandle->dyldLibHeader = dyldLibHeader;
dyldLoadHandle->modulePtr = modulePtr;
-#endif
- newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle));
+#endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */
+ newHandle = ckalloc(sizeof(*newHandle));
newHandle->clientData = dyldLoadHandle;
newHandle->findSymbolProcPtr = &FindSymbol;
newHandle->unloadFileProcPtr = &UnloadFile;
@@ -326,18 +289,23 @@ TclpDlopen(
*loadHandle = newHandle;
result = TCL_OK;
} else {
- Tcl_AppendResult(interp, errMsg, NULL);
+ Tcl_Obj *errObj = Tcl_NewObj();
+
+ if (errMsg != NULL) {
+ Tcl_AppendToObj(errObj, errMsg, -1);
+ }
#if TCL_DYLD_USE_NSMODULE
if (objFileImageErrMsg) {
- Tcl_AppendResult(interp, "\nNSCreateObjectFileImageFromFile() "
- "error: ", objFileImageErrMsg, NULL);
+ Tcl_AppendPrintfToObj(errObj,
+ "\nNSCreateObjectFileImageFromFile() error: %s",
+ objFileImageErrMsg);
}
-#endif
+#endif /* TCL_DYLD_USE_NSMODULE */
+ Tcl_SetObjResult(interp, errObj);
result = TCL_ERROR;
}
- if(fileName) {
- Tcl_DStringFree(&ds);
- }
+
+ Tcl_DStringFree(&ds);
return result;
}
@@ -370,18 +338,14 @@ FindSymbol(
const char *native;
native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
-#if TCL_DYLD_USE_DLFCN
if (dyldLoadHandle->dlHandle) {
+#if TCL_DYLD_USE_DLFCN
proc = dlsym(dyldLoadHandle->dlHandle, native);
- if (proc) {
- TclLoadDbgMsg("dlsym() successful");
- } else {
+ if (!proc) {
errMsg = dlerror();
- TclLoadDbgMsg("dlsym() failed: %s", errMsg);
}
- } else
#endif /* TCL_DYLD_USE_DLFCN */
- {
+ } else {
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
NSSymbol nsSymbol = NULL;
Tcl_DString newName;
@@ -391,20 +355,19 @@ FindSymbol(
*/
Tcl_DStringInit(&newName);
- Tcl_DStringAppend(&newName, "_", 1);
+ TclDStringAppendLiteral(&newName, "_");
native = Tcl_DStringAppend(&newName, native, -1);
if (dyldLoadHandle->dyldLibHeader) {
nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyldLibHeader,
native, NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW |
NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR);
if (nsSymbol) {
- TclLoadDbgMsg("NSLookupSymbolInImage() successful");
-#ifdef DYLD_SUPPORTS_DYLIB_UNLOADING
/*
* Until dyld supports unloading of MY_DYLIB binaries, the
* following is not needed.
*/
+#ifdef DYLD_SUPPORTS_DYLIB_UNLOADING
NSModule module = NSModuleForSymbol(nsSymbol);
Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr;
@@ -415,8 +378,7 @@ FindSymbol(
modulePtr = modulePtr->nextPtr;
}
if (modulePtr == NULL) {
- modulePtr = (Tcl_DyldModuleHandle *)
- ckalloc(sizeof(Tcl_DyldModuleHandle));
+ modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle));
modulePtr->module = module;
modulePtr->nextPtr = dyldLoadHandle->modulePtr;
dyldLoadHandle->modulePtr = modulePtr;
@@ -428,32 +390,21 @@ FindSymbol(
const char *errorName;
NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg);
- TclLoadDbgMsg("NSLookupSymbolInImage() failed: %s", errMsg);
}
} else if (dyldLoadHandle->modulePtr) {
nsSymbol = NSLookupSymbolInModule(
dyldLoadHandle->modulePtr->module, native);
- if (nsSymbol) {
- TclLoadDbgMsg("NSLookupSymbolInModule() successful");
- } else {
- TclLoadDbgMsg("NSLookupSymbolInModule() failed");
- }
}
if (nsSymbol) {
proc = NSAddressOfSymbol(nsSymbol);
- if (proc) {
- TclLoadDbgMsg("NSAddressOfSymbol() successful");
- } else {
- TclLoadDbgMsg("NSAddressOfSymbol() failed");
- }
}
Tcl_DStringFree(&newName);
#endif /* TCL_DYLD_USE_NSMODULE */
}
Tcl_DStringFree(&ds);
if (errMsg && (interp != NULL)) {
- Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\": ",
- errMsg, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot find symbol \"%s\": %s", symbol, errMsg));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol,
NULL);
}
@@ -488,41 +439,26 @@ UnloadFile(
{
Tcl_DyldLoadHandle *dyldLoadHandle = loadHandle->clientData;
-#if TCL_DYLD_USE_DLFCN
if (dyldLoadHandle->dlHandle) {
- int result;
-
- result = dlclose(dyldLoadHandle->dlHandle);
- if (!result) {
- TclLoadDbgMsg("dlclose() successful");
- } else {
- TclLoadDbgMsg("dlclose() failed: %s", dlerror());
- }
- } else
+#if TCL_DYLD_USE_DLFCN
+ (void) dlclose(dyldLoadHandle->dlHandle);
#endif /* TCL_DYLD_USE_DLFCN */
- {
+ } else {
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr;
while (modulePtr != NULL) {
- void *ptr;
- bool result;
+ void *ptr = modulePtr;
- result = NSUnLinkModule(modulePtr->module,
+ (void) NSUnLinkModule(modulePtr->module,
NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES);
- if (result) {
- TclLoadDbgMsg("NSUnLinkModule() successful");
- } else {
- TclLoadDbgMsg("NSUnLinkModule() failed");
- }
- ptr = modulePtr;
modulePtr = modulePtr->nextPtr;
ckfree(ptr);
}
#endif /* TCL_DYLD_USE_NSMODULE */
}
- ckfree((char *) dyldLoadHandle);
- ckfree((char *) loadHandle);
+ ckfree(dyldLoadHandle);
+ ckfree(loadHandle);
}
/*
@@ -555,7 +491,6 @@ TclGuessPackageName(
return 0;
}
-#ifdef TCL_LOAD_FROM_MEMORY
/*
*----------------------------------------------------------------------
*
@@ -572,6 +507,7 @@ TclGuessPackageName(
*----------------------------------------------------------------------
*/
+#ifdef TCL_LOAD_FROM_MEMORY
MODULE_SCOPE void *
TclpLoadMemoryGetBuffer(
Tcl_Interp *interp, /* Used for error reporting. */
@@ -596,6 +532,7 @@ TclpLoadMemoryGetBuffer(
}
return buffer;
}
+#endif /* TCL_LOAD_FROM_MEMORY */
/*
*----------------------------------------------------------------------
@@ -615,6 +552,7 @@ TclpLoadMemoryGetBuffer(
*----------------------------------------------------------------------
*/
+#ifdef TCL_LOAD_FROM_MEMORY
MODULE_SCOPE int
TclpLoadMemory(
Tcl_Interp *interp, /* Used for error reporting. */
@@ -627,10 +565,11 @@ TclpLoadMemory(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
Tcl_LoadHandle newHandle;
Tcl_DyldLoadHandle *dyldLoadHandle;
@@ -638,6 +577,7 @@ TclpLoadMemory(
Tcl_DyldModuleHandle *modulePtr;
NSModule module;
const char *objFileImageErrMsg = NULL;
+ int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR;
/*
* Try to create an object file image that we can load from.
@@ -657,7 +597,7 @@ TclpLoadMemory(
# define mh_size sizeof(struct mach_header_64)
# define mh_magic MH_MAGIC_64
# define arch_abi CPU_ARCH_ABI64
-#endif
+#endif /* __LP64__ */
if ((size_t) codeSize >= sizeof(struct fat_header)
&& fh->magic == OSSwapHostToBigInt32(FAT_MAGIC)) {
@@ -667,7 +607,6 @@ TclpLoadMemory(
* Fat binary, try to find mach_header for our architecture
*/
- TclLoadDbgMsg("Fat binary, %d archs", fh_nfat_arch);
if ((size_t) codeSize >= sizeof(struct fat_header) +
fh_nfat_arch * sizeof(struct fat_arch)) {
void *fatarchs = (char*)buffer + sizeof(struct fat_header);
@@ -680,22 +619,15 @@ TclpLoadMemory(
fa = NXFindBestFatArch(arch->cputype | arch_abi,
arch->cpusubtype, fatarchs, fh_nfat_arch);
if (fa) {
- TclLoadDbgMsg("NXFindBestFatArch() successful: "
- "local cputype %d subtype %d, "
- "fat cputype %d subtype %d",
- arch->cputype | arch_abi, arch->cpusubtype,
- fa->cputype, fa->cpusubtype);
- mh = (void*)((char*)buffer + fa->offset);
+ mh = (void *)((char *) buffer + fa->offset);
ms = fa->size;
} else {
- TclLoadDbgMsg("NXFindBestFatArch() failed");
err = NSObjectFileImageInappropriateFile;
}
if (fh->magic != FAT_MAGIC) {
swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder);
}
} else {
- TclLoadDbgMsg("Fat binary header failure");
err = NSObjectFileImageInappropriateFile;
}
} else {
@@ -703,26 +635,18 @@ TclpLoadMemory(
* Thin binary
*/
- TclLoadDbgMsg("Thin binary");
mh = buffer;
ms = codeSize;
}
if (ms && !(ms >= mh_size && mh->magic == mh_magic &&
mh->filetype == MH_BUNDLE)) {
- TclLoadDbgMsg("Inappropriate file: magic %x filetype %d",
- mh->magic, mh->filetype);
err = NSObjectFileImageInappropriateFile;
}
if (err == NSObjectFileImageSuccess) {
err = NSCreateObjectFileImageFromMemory(buffer, codeSize,
&dyldObjFileImage);
- if (err == NSObjectFileImageSuccess) {
- TclLoadDbgMsg("NSCreateObjectFileImageFromMemory() "
- "successful");
- } else {
+ if (err != NSObjectFileImageSuccess) {
objFileImageErrMsg = DyldOFIErrorMsg(err);
- TclLoadDbgMsg("NSCreateObjectFileImageFromMemory() failed: %s",
- objFileImageErrMsg);
}
} else {
objFileImageErrMsg = DyldOFIErrorMsg(err);
@@ -737,8 +661,9 @@ TclpLoadMemory(
if (dyldObjFileImage == NULL) {
vm_deallocate(mach_task_self(), (vm_address_t) buffer, size);
if (objFileImageErrMsg != NULL) {
- Tcl_AppendResult(interp, "NSCreateObjectFileImageFromMemory() "
- "error: ", objFileImageErrMsg, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "NSCreateObjectFileImageFromMemory() error: %s",
+ objFileImageErrMsg));
}
return TCL_ERROR;
}
@@ -747,19 +672,17 @@ TclpLoadMemory(
* Extract the module we want from the image of the object file.
*/
- module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]",
- NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_RETURN_ON_ERROR);
+ if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE;
+ if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW;
+ module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]", nsflags);
NSDestroyObjectFileImage(dyldObjFileImage);
- if (module) {
- TclLoadDbgMsg("NSLinkModule() successful");
- } else {
+ if (!module) {
NSLinkEditErrors editError;
int errorNumber;
const char *errorName, *errMsg;
NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg);
- TclLoadDbgMsg("NSLinkModule() failed: %s", errMsg);
- Tcl_AppendResult(interp, errMsg, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
return TCL_ERROR;
}
@@ -767,17 +690,14 @@ TclpLoadMemory(
* Stash the module reference within the load handle we create and return.
*/
- modulePtr = (Tcl_DyldModuleHandle *) ckalloc(sizeof(Tcl_DyldModuleHandle));
+ modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle));
modulePtr->module = module;
modulePtr->nextPtr = NULL;
- dyldLoadHandle = (Tcl_DyldLoadHandle *)
- ckalloc(sizeof(Tcl_DyldLoadHandle));
-#if TCL_DYLD_USE_DLFCN
+ dyldLoadHandle = ckalloc(sizeof(Tcl_DyldLoadHandle));
dyldLoadHandle->dlHandle = NULL;
-#endif
dyldLoadHandle->dyldLibHeader = NULL;
dyldLoadHandle->modulePtr = modulePtr;
- newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle));
+ newHandle = ckalloc(sizeof(*newHandle));
newHandle->clientData = dyldLoadHandle;
newHandle->findSymbolProcPtr = &FindSymbol;
newHandle->unloadFileProcPtr = &UnloadFile;
diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c
index 88b1568..eb0affa 100644
--- a/unix/tclLoadNext.c
+++ b/unix/tclLoadNext.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclLoadNext.c,v 1.18 2010/06/21 11:23:23 nijtmans Exp $
*/
#include "tclInt.h"
@@ -18,10 +16,9 @@
/* Static procedures defined within this file */
-static void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
- const char* symbol);
-static void UnloadFile(Tcl_LoadHandle loadHandle);
-
+static void * FindSymbol(Tcl_Interp *interp,
+ Tcl_LoadHandle loadHandle, const char* symbol);
+static void UnloadFile(Tcl_LoadHandle loadHandle);
/*
*----------------------------------------------------------------------
@@ -49,10 +46,11 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
Tcl_LoadHandle newHandle;
struct mach_header *header;
@@ -95,15 +93,15 @@ TclpDlopen(
char *data;
int len, maxlen;
- NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
- Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ",
- data, NULL);
+ NXGetMemoryBuffer(errorStream, &data, &len, &maxlen);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't load file \"%s\": %s", fileName, data));
NXCloseMemory(errorStream, NX_FREEBUFFER);
return TCL_ERROR;
}
NXCloseMemory(errorStream, NX_FREEBUFFER);
- newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle));
+ newHandle = ckalloc(sizeof(Tcl_LoadHandle));
newHandle->clientData = INT2PTR(1);
newHandle->findSymbolProcPtr = &FindSymbol;
newHandle->unloadFileProcPtr = &UnloadFile;
@@ -129,25 +127,25 @@ TclpDlopen(
*----------------------------------------------------------------------
*/
-static void*
+static void *
FindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
const char *symbol)
{
Tcl_PackageInitProc *proc = NULL;
+
if (symbol) {
char sym[strlen(symbol) + 2];
sym[0] = '_';
sym[1] = 0;
strcat(sym, symbol);
- rld_lookup(NULL, sym, (unsigned long *)&proc);
+ rld_lookup(NULL, sym, (unsigned long *) &proc);
}
if (proc == NULL && interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "cannot find symbol \"", symbol,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot find symbol \"%s\"", symbol));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
}
return proc;
@@ -177,7 +175,7 @@ UnloadFile(
* TclpDlopen(). The loadHandle is a token
* that represents the loaded file. */
{
- ckfree((char*) loadHandle);
+ ckfree(loadHandle);
}
/*
diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c
index 2810a7c..377ed28 100644
--- a/unix/tclLoadOSF.c
+++ b/unix/tclLoadOSF.c
@@ -30,19 +30,19 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclLoadOSF.c,v 1.17 2010/04/02 21:21:06 kennykb Exp $
*/
#include "tclInt.h"
#include <sys/types.h>
#include <loader.h>
-
-/* Static functions defined within this file */
-static void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
- const char* symbol);
-static void UnloadFile(Tcl_LoadHandle handle);
+/*
+ * Static functions defined within this file.
+ */
+
+static void * FindSymbol(Tcl_Interp *interp,
+ Tcl_LoadHandle loadHandle, const char* symbol);
+static void UnloadFile(Tcl_LoadHandle handle);
/*
*----------------------------------------------------------------------
@@ -70,10 +70,11 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
Tcl_LoadHandle newHandle;
ldr_module_t lm;
@@ -105,8 +106,9 @@ TclpDlopen(
}
if (lm == LDR_NULL_MODULE) {
- Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't load file \"%s\": %s",
+ fileName, Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -126,7 +128,7 @@ TclpDlopen(
} else {
pkg++;
}
- newHandle = (Tcl_LoadHandle*) ckalloc(sizeof(*newHandle));
+ newHandle = ckalloc(sizeof(*newHandle));
newHandle->clientData = pkg;
newHandle->findSymbolProcPtr = &FindSymbol;
newHandle->unloadFileProcPtr = &UnloadFile;
@@ -157,10 +159,11 @@ FindSymbol(
Tcl_LoadHandle loadHandle,
const char *symbol)
{
- void* retval = ldr_lookup_package((char *)loadHandle, symbol);
+ void *retval = ldr_lookup_package((char *) loadHandle, symbol);
+
if (retval == NULL && interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "cannot find symbol\"", symbol, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot find symbol \"%s\"", symbol));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
}
return retval;
@@ -190,7 +193,7 @@ UnloadFile(
* TclpDlopen(). The loadHandle is a token
* that represents the loaded file. */
{
- ckfree((char*) loadHandle);
+ ckfree(loadHandle);
}
/*
diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c
index a690dac..4be3d7b 100644
--- a/unix/tclLoadShl.c
+++ b/unix/tclLoadShl.c
@@ -9,29 +9,18 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclLoadShl.c,v 1.20 2010/04/02 21:21:06 kennykb Exp $
*/
#include <dl.h>
+#include "tclInt.h"
/*
- * On some HP machines, dl.h defines EXTERN; remove that definition.
+ * Static functions defined within this file.
*/
-#ifdef EXTERN
-# undef EXTERN
-#endif
-
-#include "tclInt.h"
-
-/* Static functions defined within this file */
-
-static void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
- const char* symbol);
-static void
-UnloadFile(Tcl_LoadHandle handle);
-
+static void * FindSymbol(Tcl_Interp *interp,
+ Tcl_LoadHandle loadHandle, const char *symbol);
+static void UnloadFile(Tcl_LoadHandle handle);
/*
*----------------------------------------------------------------------
@@ -59,10 +48,11 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
shl_t handle;
Tcl_LoadHandle newHandle;
@@ -102,11 +92,12 @@ TclpDlopen(
}
if (handle == NULL) {
- Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't load file \"%s\": %s",
+ fileName, Tcl_PosixError(interp)));
return TCL_ERROR;
}
- newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle));
+ newHandle = ckalloc(sizeof(*newHandle));
newHandle->clientData = handle;
newHandle->findSymbolProcPtr = &FindSymbol;
newHandle->unloadFileProcPtr = *unloadProcPtr = &UnloadFile;
@@ -138,7 +129,7 @@ FindSymbol(
{
Tcl_DString newName;
Tcl_PackageInitProc *proc = NULL;
- shl_t handle = (shl_t)(loadHandle->clientData);
+ shl_t handle = (shl_t) loadHandle->clientData;
/*
* Some versions of the HP system software still use "_" at the beginning
@@ -148,7 +139,7 @@ FindSymbol(
if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE,
(void *) &proc) != 0) {
Tcl_DStringInit(&newName);
- Tcl_DStringAppend(&newName, "_", 1);
+ TclDStringAppendLiteral(&newName, "_");
Tcl_DStringAppend(&newName, symbol, -1);
if (shl_findsym(&handle, Tcl_DStringValue(&newName),
(short) TYPE_PROCEDURE, (void *) &proc) != 0) {
@@ -157,9 +148,9 @@ FindSymbol(
Tcl_DStringFree(&newName);
}
if (proc == NULL && interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "cannot find symbol\"", symbol,
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot find symbol \"%s\": %s",
+ symbol, Tcl_PosixError(interp)));
}
return proc;
}
@@ -188,11 +179,10 @@ UnloadFile(
* TclpDlopen(). The loadHandle is a token
* that represents the loaded file. */
{
- shl_t handle;
+ shl_t handle = (shl_t) loadHandle->clientData;
- handle = (shl_t) (loadHandle -> clientData);
shl_unload(handle);
- ckfree((char*) loadHandle);
+ ckfree(loadHandle);
}
/*
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index 5609a15..9ee37f1 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUnixChan.c,v 1.106 2010/06/21 11:23:23 nijtmans Exp $
*/
#include "tclInt.h" /* Internal definitions for Tcl. */
@@ -138,9 +136,10 @@ typedef struct TtyAttrs {
#endif /* !SUPPORTS_TTY */
#define UNSUPPORTED_OPTION(detail) \
- if (interp) { \
- Tcl_AppendResult(interp, (detail), \
- " not supported for this platform", NULL); \
+ if (interp) { \
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf( \
+ "%s not supported for this platform", (detail))); \
+ Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL); \
}
/*
@@ -398,7 +397,7 @@ FileCloseProc(
errorCode = errno;
}
}
- ckfree((char *) fsPtr);
+ ckfree(fsPtr);
return errorCode;
}
@@ -698,9 +697,11 @@ TtySetOptionProc(
return TCL_ERROR;
} else {
if (interp) {
- Tcl_AppendResult(interp, "bad value for -handshake: "
- "must be one of xonxoff, rtscts, dtrdsr or none",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -handshake: must be one of"
+ " xonxoff, rtscts, dtrdsr or none", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
+ "VALUE", NULL);
}
return TCL_ERROR;
}
@@ -719,10 +720,13 @@ TtySetOptionProc(
return TCL_ERROR;
} else if (argc != 2) {
if (interp) {
- Tcl_AppendResult(interp, "bad value for -xchar: "
- "should be a list of two elements", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -xchar: should be a list of"
+ " two elements", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
+ "VALUE", NULL);
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
@@ -730,12 +734,12 @@ TtySetOptionProc(
Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds);
iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds);
- Tcl_DStringSetLength(&ds, 0);
+ TclDStringClear(&ds);
Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds);
iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds);
Tcl_DStringFree(&ds);
- ckfree((char *) argv);
+ ckfree(argv);
SETIOSTATE(fsPtr->fd, &iostate);
return TCL_OK;
@@ -770,17 +774,20 @@ TtySetOptionProc(
}
if ((argc % 2) == 1) {
if (interp) {
- Tcl_AppendResult(interp, "bad value for -ttycontrol: "
- "should be a list of signal,value pairs", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -ttycontrol: should be a list of"
+ " signal,value pairs", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
+ "VALUE", NULL);
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
GETCONTROL(fsPtr->fd, &control);
for (i = 0; i < argc-1; i += 2) {
if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
@@ -792,7 +799,7 @@ TtySetOptionProc(
}
#else /* !TIOCM_DTR */
UNSUPPORTED_OPTION("-ttycontrol DTR");
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
#endif /* TIOCM_DTR */
} else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) {
@@ -804,7 +811,7 @@ TtySetOptionProc(
}
#else /* !TIOCM_RTS*/
UNSUPPORTED_OPTION("-ttycontrol RTS");
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
#endif /* TIOCM_RTS*/
} else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
@@ -812,22 +819,24 @@ TtySetOptionProc(
SETBREAK(fsPtr->fd, flag);
#else /* !SETBREAK */
UNSUPPORTED_OPTION("-ttycontrol BREAK");
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
#endif /* SETBREAK */
} else {
if (interp) {
- Tcl_AppendResult(interp, "bad signal \"", argv[i],
- "\" for -ttycontrol: must be "
- "DTR, RTS or BREAK", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad signal \"%s\" for -ttycontrol: must be"
+ " DTR, RTS or BREAK", argv[i]));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
+ "VALUE", NULL);
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
} /* -ttycontrol options loop */
SETCONTROL(fsPtr->fd, &control);
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_OK;
}
@@ -909,7 +918,7 @@ TtyGetOptionProc(
Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds);
Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
- Tcl_DStringSetLength(&ds, 0);
+ TclDStringClear(&ds);
Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds);
Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
@@ -974,7 +983,7 @@ TtyGetOptionProc(
# define TtyGetBaud(speed) ((int) (speed))
#else /* !DIRECT_BAUD */
-static struct {int baud; unsigned long speed;} speeds[] = {
+static const struct {int baud; unsigned long speed;} speeds[] = {
#ifdef B0
{0, B0},
#endif
@@ -1381,8 +1390,9 @@ TtyParseMode(
stopPtr, &end);
if ((i != 4) || (mode[end] != '\0')) {
if (interp != NULL) {
- Tcl_AppendResult(interp, bad, ": should be baud,parity,data,stop",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s: should be baud,parity,data,stop", bad));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
}
return TCL_ERROR;
}
@@ -1404,27 +1414,32 @@ TtyParseMode(
#endif /* PAREXT|USE_TERMIO */
== NULL) {
if (interp != NULL) {
- Tcl_AppendResult(interp, bad, " parity: should be ",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s parity: should be %s", bad,
#if defined(PAREXT) || defined(USE_TERMIO)
- "n, o, e, m, or s",
+ "n, o, e, m, or s"
#else
- "n, o, or e",
+ "n, o, or e"
#endif /* PAREXT|USE_TERMIO */
- NULL);
+ ));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
}
return TCL_ERROR;
}
*parityPtr = parity;
if ((*dataPtr < 5) || (*dataPtr > 8)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, bad, " data: should be 5, 6, 7, or 8",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s data: should be 5, 6, 7, or 8", bad));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
}
return TCL_ERROR;
}
if ((*stopPtr < 0) || (*stopPtr > 2)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, bad, " stop: should be 1 or 2", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s stop: should be 1 or 2", bad));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
}
return TCL_ERROR;
}
@@ -1460,7 +1475,7 @@ TtyInit(
* initialized. */
int initialize)
{
- TtyState *ttyPtr = (TtyState *) ckalloc((unsigned) sizeof(TtyState));
+ TtyState *ttyPtr = ckalloc(sizeof(TtyState));
int stateUpdated = 0;
GETIOSTATE(fd, &ttyPtr->savedState);
@@ -1572,8 +1587,9 @@ TclpOpenFileChannel(
if (fd < 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open \"%s\": %s",
+ TclGetString(pathPtr), Tcl_PosixError(interp)));
}
return NULL;
}
@@ -1611,7 +1627,7 @@ TclpOpenFileChannel(
{
translation = NULL;
channelTypePtr = &fileChannelType;
- fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
+ fsPtr = ckalloc(sizeof(FileState));
}
fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
@@ -1681,12 +1697,13 @@ Tcl_MakeFileChannel(
sprintf(channelName, "serial%d", fd);
} else
#endif /* SUPPORTS_TTY */
- if ((getsockname(fd, &sockaddr, &sockaddrLen) == 0)
- && (sockaddrLen > 0) && (sockaddr.sa_family == AF_INET)) {
+ if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0)
+ && (sockaddrLen > 0)
+ && (sockaddr.sa_family == AF_INET || sockaddr.sa_family == AF_INET6)) {
return TclpMakeTcpClientChannelMode(INT2PTR(fd), mode);
} else {
channelTypePtr = &fileChannelType;
- fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
+ fsPtr = ckalloc(sizeof(FileState));
sprintf(channelName, "file%d", fd);
}
@@ -1830,12 +1847,16 @@ Tcl_GetOpenFile(
if (chan == NULL) {
return TCL_ERROR;
}
- if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) {
- Tcl_AppendResult(interp, "\"", chanID, "\" wasn't opened for writing",
+ if (forWriting && !(chanMode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" wasn't opened for writing", chanID));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_WRITABLE",
NULL);
return TCL_ERROR;
- } else if ((!forWriting) && ((chanMode & TCL_READABLE) == 0)) {
- Tcl_AppendResult(interp, "\"", chanID, "\" wasn't opened for reading",
+ } else if (!forWriting && !(chanMode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" wasn't opened for reading", chanID));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_READABLE",
NULL);
return TCL_ERROR;
}
@@ -1865,8 +1886,10 @@ Tcl_GetOpenFile(
f = fdopen(fd, (forWriting ? "w" : "r"));
if (f == NULL) {
- Tcl_AppendResult(interp, "cannot get a FILE * for \"", chanID,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot get a FILE * for \"%s\"", chanID));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL",
+ "FILE_FAILURE", NULL);
return TCL_ERROR;
}
*filePtr = f;
@@ -1874,8 +1897,10 @@ Tcl_GetOpenFile(
}
}
- Tcl_AppendResult(interp, "\"", chanID,
- "\" cannot be used to get a FILE *", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" cannot be used to get a FILE *", chanID));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NO_DESCRIPTOR",
+ NULL);
return TCL_ERROR;
}
diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c
index 28017dc..e201018 100644
--- a/unix/tclUnixCompat.c
+++ b/unix/tclUnixCompat.c
@@ -5,9 +5,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUnixCompat.c,v 1.18 2009/12/11 23:42:41 nijtmans Exp $
- *
*/
#include "tclInt.h"
@@ -16,8 +13,10 @@
#include <errno.h>
#include <string.h>
-/* See also: SC_BLOCKING_STYLE in unix/tcl.m4
+/*
+ * See also: SC_BLOCKING_STYLE in unix/tcl.m4
*/
+
#ifdef USE_FIONBIO
# ifdef HAVE_SYS_FILIO_H
# include <sys/filio.h> /* For FIONBIO. */
@@ -26,39 +25,6 @@
# include <sys/ioctl.h>
# endif
#endif /* USE_FIONBIO */
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclUnixSetBlockingMode --
- *
- * Set the blocking mode of a file descriptor.
- *
- * Results:
- *
- * 0 on success, -1 (with errno set) on error.
- *
- *---------------------------------------------------------------------------
- */
-int
-TclUnixSetBlockingMode(
- int fd, /* File descriptor */
- int mode) /* TCL_MODE_BLOCKING or TCL_MODE_NONBLOCKING */
-{
-#ifndef USE_FIONBIO
- int flags = fcntl(fd, F_GETFL);
-
- if (mode == TCL_MODE_BLOCKING) {
- flags &= ~O_NONBLOCK;
- } else {
- flags |= O_NONBLOCK;
- }
- return fcntl(fd, F_SETFL, flags);
-#else /* USE_FIONBIO */
- int state = (mode == TCL_MODE_NONBLOCKING);
- return ioctl(fd, FIONBIO, &state);
-#endif /* !USE_FIONBIO */
-}
/*
* Used to pad structures at size'd boundaries
@@ -85,10 +51,22 @@ TclUnixSetBlockingMode(
typedef struct ThreadSpecificData {
struct passwd pwd;
+#if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5)
+#define NEED_PW_CLEANER 1
+ char *pbuf;
+ int pbuflen;
+#else
char pbuf[2048];
+#endif
struct group grp;
+#if defined(HAVE_GETGRNAM_R_5) || defined(HAVE_GETGRGID_R_5)
+#define NEED_GR_CLEANER 1
+ char *gbuf;
+ int gbuflen;
+#else
char gbuf[2048];
+#endif
#if !defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR)
struct hostent hent;
@@ -121,20 +99,71 @@ static Tcl_Mutex compatLock;
#undef NEED_COPYPWD
#undef NEED_COPYSTRING
+#if !defined(HAVE_GETGRNAM_R_5) && !defined(HAVE_GETGRNAM_R_4)
+#define NEED_COPYGRP 1
+static int CopyGrp(struct group *tgtPtr, char *buf, int buflen);
+#endif
+
+#if !defined(HAVE_GETPWNAM_R_5) && !defined(HAVE_GETPWNAM_R_4)
+#define NEED_COPYPWD 1
+static int CopyPwd(struct passwd *tgtPtr, char *buf, int buflen);
+#endif
+
static int CopyArray(char **src, int elsize, char *buf,
int buflen);
-static int CopyGrp(struct group *tgtPtr, char *buf, int buflen);
static int CopyHostent(struct hostent *tgtPtr, char *buf,
int buflen);
-static int CopyPwd(struct passwd *tgtPtr, char *buf, int buflen);
static int CopyString(const char *src, char *buf, int buflen);
#endif
+
+#ifdef NEED_PW_CLEANER
+static void FreePwBuf(ClientData ignored);
+#endif
+#ifdef NEED_GR_CLEANER
+static void FreeGrBuf(ClientData ignored);
+#endif
#endif /* TCL_THREADS */
/*
*---------------------------------------------------------------------------
*
+ * TclUnixSetBlockingMode --
+ *
+ * Set the blocking mode of a file descriptor.
+ *
+ * Results:
+ *
+ * 0 on success, -1 (with errno set) on error.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclUnixSetBlockingMode(
+ int fd, /* File descriptor */
+ int mode) /* Either TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
+{
+#ifndef USE_FIONBIO
+ int flags = fcntl(fd, F_GETFL);
+
+ if (mode == TCL_MODE_BLOCKING) {
+ flags &= ~O_NONBLOCK;
+ } else {
+ flags |= O_NONBLOCK;
+ }
+ return fcntl(fd, F_SETFL, flags);
+#else /* USE_FIONBIO */
+ int state = (mode == TCL_MODE_NONBLOCKING);
+
+ return ioctl(fd, FIONBIO, &state);
+#endif /* !USE_FIONBIO */
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* TclpGetPwNam --
*
* Thread-safe wrappers for getpwnam(). See "man getpwnam" for more
@@ -161,14 +190,38 @@ TclpGetPwNam(
#if defined(HAVE_GETPWNAM_R_5)
struct passwd *pwPtr = NULL;
- return (getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf),
- &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL;
+ /*
+ * How to allocate a buffer of the right initial size. If you want the
+ * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt
+ * and weep.
+ */
+
+ if (tsdPtr->pbuf == NULL) {
+ tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX);
+ if (tsdPtr->pbuflen < 1) {
+ tsdPtr->pbuflen = 1024;
+ }
+ tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen);
+ Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
+ }
+ while (1) {
+ int e = getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen,
+ &pwPtr);
+
+ if (e == 0) {
+ break;
+ } else if (e != ERANGE) {
+ return NULL;
+ }
+ tsdPtr->pbuflen *= 2;
+ tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
+ }
+ return (pwPtr != NULL ? &tsdPtr->pwd : NULL);
#elif defined(HAVE_GETPWNAM_R_4)
return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));
#else
-#define NEED_COPYPWD 1
struct passwd *pwPtr;
Tcl_MutexLock(&compatLock);
@@ -217,14 +270,38 @@ TclpGetPwUid(
#if defined(HAVE_GETPWUID_R_5)
struct passwd *pwPtr = NULL;
- return (getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf),
- &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL;
+ /*
+ * How to allocate a buffer of the right initial size. If you want the
+ * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt
+ * and weep.
+ */
+
+ if (tsdPtr->pbuf == NULL) {
+ tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX);
+ if (tsdPtr->pbuflen < 1) {
+ tsdPtr->pbuflen = 1024;
+ }
+ tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen);
+ Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
+ }
+ while (1) {
+ int e = getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen,
+ &pwPtr);
+
+ if (e == 0) {
+ break;
+ } else if (e != ERANGE) {
+ return NULL;
+ }
+ tsdPtr->pbuflen *= 2;
+ tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
+ }
+ return (pwPtr != NULL ? &tsdPtr->pwd : NULL);
#elif defined(HAVE_GETPWUID_R_4)
return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));
#else
-#define NEED_COPYPWD 1
struct passwd *pwPtr;
Tcl_MutexLock(&compatLock);
@@ -247,6 +324,29 @@ TclpGetPwUid(
/*
*---------------------------------------------------------------------------
*
+ * FreePwBuf --
+ *
+ * Helper that is used to dispose of space allocated and referenced from
+ * the ThreadSpecificData for user entries. (Darn that baroque POSIX
+ * reentrant interface.)
+ *
+ *---------------------------------------------------------------------------
+ */
+
+#ifdef NEED_PW_CLEANER
+static void
+FreePwBuf(
+ ClientData ignored)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ ckfree(tsdPtr->pbuf);
+}
+#endif /* NEED_PW_CLEANER */
+
+/*
+ *---------------------------------------------------------------------------
+ *
* TclpGetGrNam --
*
* Thread-safe wrappers for getgrnam(). See "man getgrnam" for more
@@ -273,14 +373,38 @@ TclpGetGrNam(
#if defined(HAVE_GETGRNAM_R_5)
struct group *grPtr = NULL;
- return (getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf),
- &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL;
+ /*
+ * How to allocate a buffer of the right initial size. If you want the
+ * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt
+ * and weep.
+ */
+
+ if (tsdPtr->gbuf == NULL) {
+ tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX);
+ if (tsdPtr->gbuflen < 1) {
+ tsdPtr->gbuflen = 1024;
+ }
+ tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen);
+ Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
+ }
+ while (1) {
+ int e = getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen,
+ &grPtr);
+
+ if (e == 0) {
+ break;
+ } else if (e != ERANGE) {
+ return NULL;
+ }
+ tsdPtr->gbuflen *= 2;
+ tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
+ }
+ return (grPtr != NULL ? &tsdPtr->grp : NULL);
#elif defined(HAVE_GETGRNAM_R_4)
return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));
#else
-#define NEED_COPYGRP 1
struct group *grPtr;
Tcl_MutexLock(&compatLock);
@@ -329,14 +453,38 @@ TclpGetGrGid(
#if defined(HAVE_GETGRGID_R_5)
struct group *grPtr = NULL;
- return (getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf),
- &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL;
+ /*
+ * How to allocate a buffer of the right initial size. If you want the
+ * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt
+ * and weep.
+ */
+
+ if (tsdPtr->gbuf == NULL) {
+ tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX);
+ if (tsdPtr->gbuflen < 1) {
+ tsdPtr->gbuflen = 1024;
+ }
+ tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen);
+ Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
+ }
+ while (1) {
+ int e = getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen,
+ &grPtr);
+
+ if (e == 0) {
+ break;
+ } else if (e != ERANGE) {
+ return NULL;
+ }
+ tsdPtr->gbuflen *= 2;
+ tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
+ }
+ return (grPtr != NULL ? &tsdPtr->grp : NULL);
#elif defined(HAVE_GETGRGID_R_4)
return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));
#else
-#define NEED_COPYGRP 1
struct group *grPtr;
Tcl_MutexLock(&compatLock);
@@ -359,6 +507,29 @@ TclpGetGrGid(
/*
*---------------------------------------------------------------------------
*
+ * FreeGrBuf --
+ *
+ * Helper that is used to dispose of space allocated and referenced from
+ * the ThreadSpecificData for group entries. (Darn that baroque POSIX
+ * reentrant interface.)
+ *
+ *---------------------------------------------------------------------------
+ */
+
+#ifdef NEED_GR_CLEANER
+static void
+FreeGrBuf(
+ ClientData ignored)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ ckfree(tsdPtr->gbuf);
+}
+#endif /* NEED_GR_CLEANER */
+
+/*
+ *---------------------------------------------------------------------------
+ *
* TclpGetHostByName --
*
* Thread-safe wrappers for gethostbyname(). See "man gethostbyname" for
@@ -772,7 +943,7 @@ CopyArray(
#ifdef NEED_COPYSTRING
static int
CopyString(
- const char *src, /* String to copy. */
+ const char *src, /* String to copy. */
char *buf, /* Buffer to copy into. */
int buflen) /* Size of buffer. */
{
@@ -797,3 +968,48 @@ CopyString(
* fill-column: 78
* End:
*/
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * TclWinCPUID --
+ *
+ * Get CPU ID information on an Intel box under UNIX (either Linux or Cygwin)
+ *
+ * Results:
+ * Returns TCL_OK if successful, TCL_ERROR if CPUID is not supported.
+ *
+ * Side effects:
+ * If successful, stores EAX, EBX, ECX and EDX registers after the CPUID
+ * instruction in the four integers designated by 'regsPtr'
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclWinCPUID(
+ unsigned int index, /* Which CPUID value to retrieve. */
+ unsigned int *regsPtr) /* Registers after the CPUID. */
+{
+ int status = TCL_ERROR;
+
+ /* See: <http://en.wikipedia.org/wiki/CPUID> */
+#if defined(HAVE_CPUID)
+ __asm__ __volatile__("mov %%ebx, %%edi \n\t" /* save %ebx */
+ "cpuid \n\t"
+ "mov %%ebx, %%esi \n\t" /* save what cpuid just put in %ebx */
+ "mov %%edi, %%ebx \n\t" /* restore the old %ebx */
+ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
+ : "a"(index) : "edi");
+ status = TCL_OK;
+#endif
+ return status;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/unix/tclUnixEvent.c b/unix/tclUnixEvent.c
index b49c4bf..40aac6f 100644
--- a/unix/tclUnixEvent.c
+++ b/unix/tclUnixEvent.c
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUnixEvent.c,v 1.11 2009/04/10 18:02:37 das Exp $
*/
#include "tclInt.h"
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 3c9b78a..559992f 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -10,8 +10,6 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixFCmd.c,v 1.78 2010/08/14 17:13:02 nijtmans Exp $
- *
* Portions of this code were derived from NetBSD source code which has the
* following copyright notice:
*
@@ -49,7 +47,7 @@
#ifndef NO_FSTATFS
#include <sys/statfs.h>
#endif
-#endif
+#endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */
#ifdef HAVE_FTS
#include <fts.h>
#endif
@@ -64,6 +62,16 @@
#define DOTREE_F 3 /* regular file */
/*
+ * Fallback temporary file location the temporary file generation code. Can be
+ * overridden at compile time for when it is known that temp files can't be
+ * written to /tmp (hello, iOS!).
+ */
+
+#ifndef TCL_TEMPORARY_FILE_DIRECTORY
+#define TCL_TEMPORARY_FILE_DIRECTORY "/tmp"
+#endif
+
+/*
* Callbacks for file attributes code.
*/
@@ -114,7 +122,7 @@ typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
extern TclFileAttrProcs tclpFileAttrProcs[];
extern const char *const tclpFileAttrStrings[];
-#else
+#else /* !DJGPP */
enum {
UNIX_GROUP_ATTRIBUTE, UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE,
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
@@ -154,7 +162,7 @@ const TclFileAttrProcs tclpFileAttrProcs[] = {
{TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute},
#endif
};
-#endif
+#endif /* DJGPP */
/*
* This is the maximum number of consecutive readdir/unlink calls that can be
@@ -185,11 +193,13 @@ static int DoRemoveDirectory(Tcl_DString *pathPtr,
int recursive, Tcl_DString *errorPtr);
static int DoRenameFile(const char *src, const char *dst);
static int TraversalCopy(Tcl_DString *srcPtr,
- Tcl_DString *dstPtr, const Tcl_StatBuf *statBufPtr,
- int type, Tcl_DString *errorPtr);
+ Tcl_DString *dstPtr,
+ const Tcl_StatBuf *statBufPtr, int type,
+ Tcl_DString *errorPtr);
static int TraversalDelete(Tcl_DString *srcPtr,
- Tcl_DString *dstPtr, const Tcl_StatBuf *statBufPtr,
- int type, Tcl_DString *errorPtr);
+ Tcl_DString *dstPtr,
+ const Tcl_StatBuf *statBufPtr, int type,
+ Tcl_DString *errorPtr);
static int TraverseUnixTree(TraversalProc *traversalProc,
Tcl_DString *sourcePtr, Tcl_DString *destPtr,
Tcl_DString *errorPtr, int doRewind);
@@ -213,8 +223,8 @@ Realpath(
return realpath(path, resolved);
}
#else
-#define Realpath realpath
-#endif
+# define Realpath realpath
+#endif /* PURIFY */
#ifndef NO_REALPATH
#if defined(__APPLE__) && defined(TCL_THREADS) && \
@@ -227,16 +237,16 @@ Realpath(
*/
MODULE_SCOPE long tclMacOSXDarwinRelease;
-#define haveRealpath (tclMacOSXDarwinRelease >= 7)
+# define haveRealpath (tclMacOSXDarwinRelease >= 7)
#else
-#define haveRealpath 1
+# define haveRealpath 1
#endif
#endif /* NO_REALPATH */
#ifdef HAVE_FTS
#ifdef HAVE_STRUCT_STAT64
/* fts doesn't do stat64 */
-#define noFtsStat 1
+# define noFtsStat 1
#elif defined(__APPLE__) && defined(__LP64__) && \
defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \
MAC_OS_X_VERSION_MIN_REQUIRED < 1050
@@ -247,9 +257,9 @@ MODULE_SCOPE long tclMacOSXDarwinRelease;
*/
MODULE_SCOPE long tclMacOSXDarwinRelease;
-#define noFtsStat (tclMacOSXDarwinRelease < 9)
+# define noFtsStat (tclMacOSXDarwinRelease < 9)
#else
-#define noFtsStat 0
+# define noFtsStat 0
#endif
#endif /* HAVE_FTS */
@@ -469,7 +479,7 @@ DoCopyFile(
#endif
break;
}
-#endif
+#endif /* !DJGPP */
case S_IFBLK:
case S_IFCHR:
if (mknod(dst, statBufPtr->st_mode, /* INTL: Native. */
@@ -523,7 +533,7 @@ TclUnixCopyFile(
#define BINMODE |O_BINARY
#else
#define BINMODE
-#endif
+#endif /* DJGPP */
#define DEFAULT_COPY_BLOCK_SIZE 4069
@@ -967,11 +977,11 @@ TraverseUnixTree(
return result;
}
- Tcl_DStringAppend(sourcePtr, "/", 1);
+ TclDStringAppendLiteral(sourcePtr, "/");
sourceLen = Tcl_DStringLength(sourcePtr);
if (targetPtr != NULL) {
- Tcl_DStringAppend(targetPtr, "/", 1);
+ TclDStringAppendLiteral(targetPtr, "/");
targetLen = Tcl_DStringLength(targetPtr);
}
@@ -1039,7 +1049,7 @@ TraverseUnixTree(
}
#else /* HAVE_FTS */
paths[0] = source;
- fts = fts_open((char**)paths, FTS_PHYSICAL | FTS_NOCHDIR |
+ fts = fts_open((char **) paths, FTS_PHYSICAL | FTS_NOCHDIR |
(noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL);
if (fts == NULL) {
errfile = source;
@@ -1098,7 +1108,7 @@ TraverseUnixTree(
Tcl_DStringSetLength(targetPtr, targetLen);
}
}
-#endif /* HAVE_FTS */
+#endif /* !HAVE_FTS */
end:
if (errfile != NULL) {
@@ -1320,9 +1330,9 @@ GetGroupAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1374,9 +1384,9 @@ GetOwnerAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1387,11 +1397,9 @@ GetOwnerAttribute(
*attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid);
} else {
Tcl_DString ds;
- const char *utf;
- utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
- *attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
+ (void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
+ *attributePtrPtr = TclDStringToObj(&ds);
}
return TCL_OK;
}
@@ -1427,9 +1435,9 @@ GetPermissionsAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1480,9 +1488,12 @@ SetGroupAttribute(
if (groupPtr == NULL) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set group for file \"",
- TclGetString(fileName), "\": group \"", string,
- "\" does not exist", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set group for file \"%s\":"
+ " group \"%s\" does not exist",
+ TclGetString(fileName), string));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETGRP",
+ "NO_GROUP", NULL);
}
return TCL_ERROR;
}
@@ -1494,9 +1505,9 @@ SetGroupAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set group for file \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set group for file \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1544,9 +1555,12 @@ SetOwnerAttribute(
if (pwPtr == NULL) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set owner for file \"",
- TclGetString(fileName), "\": user \"", string,
- "\" does not exist", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set owner for file \"%s\":"
+ " user \"%s\" does not exist",
+ TclGetString(fileName), string));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETOWN",
+ "NO_USER", NULL);
}
return TCL_ERROR;
}
@@ -1558,9 +1572,9 @@ SetOwnerAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set owner for file \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set owner for file \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1628,9 +1642,9 @@ SetPermissionsAttribute(
result = TclpObjStat(fileName, &buf);
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1638,8 +1652,10 @@ SetPermissionsAttribute(
if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "unknown permission string format \"",
- modeStringPtr, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown permission string format \"%s\"",
+ modeStringPtr));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", NULL);
}
return TCL_ERROR;
}
@@ -1649,9 +1665,9 @@ SetPermissionsAttribute(
result = chmod(native, newMode); /* INTL: Native. */
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set permissions for file \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set permissions for file \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2087,7 +2103,7 @@ TclpObjNormalizePath(
/*
*----------------------------------------------------------------------
*
- * TclpOpenTemporaryFile --
+ * TclpOpenTemporaryFile, TclUnixOpenTemporaryFile --
*
* Creates a temporary file, possibly based on the supplied bits and
* pieces of template supplied in the first three arguments. If the
@@ -2097,7 +2113,12 @@ TclpObjNormalizePath(
* file to go away once it is no longer needed.
*
* Results:
- * A read-write Tcl Channel open on the file.
+ * A read-write Tcl Channel open on the file for TclpOpenTemporaryFile,
+ * or a file descriptor (or -1 on failure) for TclUnixOpenTemporaryFile.
+ *
+ * Side effects:
+ * Accesses the filesystem. Will set the contents of the Tcl_Obj fourth
+ * argument (if that is non-NULL).
*
*----------------------------------------------------------------------
*/
@@ -2109,11 +2130,30 @@ TclpOpenTemporaryFile(
Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj)
{
- Tcl_Channel chan;
+ int fd = TclUnixOpenTemporaryFile(dirObj, basenameObj, extensionObj,
+ resultingNameObj);
+
+ if (fd == -1) {
+ return NULL;
+ }
+ return Tcl_MakeFileChannel(INT2PTR(fd), TCL_READABLE|TCL_WRITABLE);
+}
+
+int
+TclUnixOpenTemporaryFile(
+ Tcl_Obj *dirObj,
+ Tcl_Obj *basenameObj,
+ Tcl_Obj *extensionObj,
+ Tcl_Obj *resultingNameObj)
+{
Tcl_DString template, tmp;
const char *string;
int len, fd;
+ /*
+ * We should also check against making more then TMP_MAX of these.
+ */
+
if (dirObj) {
string = Tcl_GetStringFromObj(dirObj, &len);
Tcl_UtfToExternalDString(NULL, string, len, &template);
@@ -2122,24 +2162,24 @@ TclpOpenTemporaryFile(
Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */
}
- Tcl_DStringAppend(&template, "/", -1);
+ TclDStringAppendLiteral(&template, "/");
if (basenameObj) {
string = Tcl_GetStringFromObj(basenameObj, &len);
Tcl_UtfToExternalDString(NULL, string, len, &tmp);
- Tcl_DStringAppend(&template, Tcl_DStringValue(&tmp), -1);
+ TclDStringAppendDString(&template, &tmp);
Tcl_DStringFree(&tmp);
} else {
- Tcl_DStringAppend(&template, "tcl", -1);
+ TclDStringAppendLiteral(&template, "tcl");
}
- Tcl_DStringAppend(&template, "_XXXXXX", -1);
+ TclDStringAppendLiteral(&template, "_XXXXXX");
#ifdef HAVE_MKSTEMPS
if (extensionObj) {
string = Tcl_GetStringFromObj(extensionObj, &len);
Tcl_UtfToExternalDString(NULL, string, len, &tmp);
- Tcl_DStringAppend(&template, Tcl_DStringValue(&tmp), -1);
+ TclDStringAppendDString(&template, &tmp);
fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp));
Tcl_DStringFree(&tmp);
} else
@@ -2149,9 +2189,10 @@ TclpOpenTemporaryFile(
}
if (fd == -1) {
- return NULL;
+ Tcl_DStringFree(&template);
+ return -1;
}
- chan = Tcl_MakeFileChannel(INT2PTR(fd), TCL_READABLE|TCL_WRITABLE);
+
if (resultingNameObj) {
Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&template),
Tcl_DStringLength(&template), &tmp);
@@ -2170,7 +2211,7 @@ TclpOpenTemporaryFile(
}
Tcl_DStringFree(&template);
- return chan;
+ return fd;
}
/*
@@ -2197,11 +2238,12 @@ DefaultTempDir(void)
#endif
/*
- * Assume that "/tmp" is always an existing writable directory; we've no
- * recovery mechanism if it isn't.
+ * Assume that the default location ("/tmp" if not overridden) is always
+ * an existing writable directory; we've no recovery mechanism if it
+ * isn't.
*/
- return "/tmp";
+ return TCL_TEMPORARY_FILE_DIRECTORY;
}
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
@@ -2236,14 +2278,14 @@ GetReadOnlyAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
- *attributePtrPtr = Tcl_NewBooleanObj((statBuf.st_flags&UF_IMMUTABLE) != 0);
+ *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags&UF_IMMUTABLE);
return TCL_OK;
}
@@ -2283,9 +2325,9 @@ SetReadOnlyAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2300,9 +2342,9 @@ SetReadOnlyAttribute(
result = chflags(native, statBuf.st_flags); /* INTL: Native. */
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set flags for file \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set flags for file \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 1ab92f3..38504d9 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUnixFile.c,v 1.58 2010/06/21 11:23:23 nijtmans Exp $
*/
#include "tclInt.h"
@@ -24,7 +22,8 @@ static int NativeMatchType(Tcl_Interp *interp, const char* nativeEntry,
* TclpFindExecutable --
*
* This function computes the absolute path name of the current
- * application, given its argv[0] value.
+ * application, given its argv[0] value. For Cygwin, argv[0] is
+ * ignored and the path is determined the same as under win32.
*
* Results:
* None.
@@ -40,10 +39,25 @@ TclpFindExecutable(
const char *argv0) /* The value of the application's argv[0]
* (native). */
{
+ Tcl_Encoding encoding;
+#ifdef __CYGWIN__
+ int length;
+ char buf[PATH_MAX * 2];
+ char name[PATH_MAX * TCL_UTF_MAX + 1];
+ GetModuleFileNameW(NULL, buf, PATH_MAX);
+ cygwin_conv_path(3, buf, name, PATH_MAX);
+ length = strlen(name);
+ if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
+ /* Strip '.exe' part. */
+ length -= 4;
+ }
+ encoding = Tcl_GetEncoding(NULL, NULL);
+ TclSetObjNameOfExecutable(
+ Tcl_NewStringObj(name, length), encoding);
+#else
const char *name, *p;
Tcl_StatBuf statBuf;
Tcl_DString buffer, nameString, cwd, utfName;
- Tcl_Encoding encoding;
if (argv0 == NULL) {
return;
@@ -84,18 +98,18 @@ TclpFindExecutable(
*/
while (1) {
- while (isspace(UCHAR(*p))) { /* INTL: BUG */
+ while (TclIsSpaceProc(*p)) {
p++;
}
name = p;
while ((*p != ':') && (*p != 0)) {
p++;
}
- Tcl_DStringSetLength(&buffer, 0);
+ TclDStringClear(&buffer);
if (p != name) {
Tcl_DStringAppend(&buffer, name, p - name);
if (p[-1] != '/') {
- Tcl_DStringAppend(&buffer, "/", 1);
+ TclDStringAppendLiteral(&buffer, "/");
}
}
name = Tcl_DStringAppend(&buffer, argv0, -1);
@@ -160,11 +174,10 @@ TclpFindExecutable(
Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd),
Tcl_DStringLength(&cwd), &buffer);
if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') {
- Tcl_DStringAppend(&buffer, "/", 1);
+ TclDStringAppendLiteral(&buffer, "/");
}
Tcl_DStringFree(&cwd);
- Tcl_DStringAppend(&buffer, Tcl_DStringValue(&nameString),
- Tcl_DStringLength(&nameString));
+ TclDStringAppendDString(&buffer, &nameString);
Tcl_DStringFree(&nameString);
encoding = Tcl_GetEncoding(NULL, NULL);
@@ -176,6 +189,7 @@ TclpFindExecutable(
done:
Tcl_DStringFree(&buffer);
+#endif
}
/*
@@ -273,7 +287,7 @@ TclpMatchInDirectory(
*/
if (dirName[dirLength-1] != '/') {
- dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
+ dirName = TclDStringAppendLiteral(&dsOrig, "/");
dirLength++;
}
}
@@ -296,10 +310,9 @@ TclpMatchInDirectory(
if (d == NULL) {
Tcl_DStringFree(&ds);
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read directory \"",
- Tcl_DStringValue(&dsOrig), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read directory \"%s\": %s",
+ Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
}
Tcl_DStringFree(&dsOrig);
Tcl_DecrRefCount(fileNamePtr);
@@ -457,7 +470,7 @@ NativeMatchType(
#ifndef MAC_OSX_TCL
|| ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
(*nativeName != '.'))
-#endif
+#endif /* MAC_OSX_TCL */
) {
return 0;
}
@@ -475,12 +488,10 @@ NativeMatchType(
* check that here:
*/
- if (types->type & TCL_GLOB_TYPE_LINK) {
- if (TclOSlstat(nativeEntry, &buf) == 0) {
- if (S_ISLNK(buf.st_mode)) {
- return 1;
- }
- }
+ if ((types->type & TCL_GLOB_TYPE_LINK)
+ && (TclOSlstat(nativeEntry, &buf) == 0)
+ && S_ISLNK(buf.st_mode)) {
+ return 1;
}
return 0;
}
@@ -503,12 +514,10 @@ NativeMatchType(
*/
} else {
#ifdef S_ISLNK
- if (types->type & TCL_GLOB_TYPE_LINK) {
- if (TclOSlstat(nativeEntry, &buf) == 0) {
- if (S_ISLNK(buf.st_mode)) {
- goto filetypeOK;
- }
- }
+ if ((types->type & TCL_GLOB_TYPE_LINK)
+ && (TclOSlstat(nativeEntry, &buf) == 0)
+ && S_ISLNK(buf.st_mode)) {
+ goto filetypeOK;
}
#endif /* S_ISLNK */
return 0;
@@ -704,10 +713,10 @@ TclpGetNativeCwd(
if (getcwd(buffer, MAXPATHLEN+1) == NULL) { /* INTL: Native. */
return NULL;
}
-#endif
+#endif /* USEGETWD */
- if ((clientData == NULL) || strcmp(buffer, (const char*)clientData)) {
- char *newCd = ckalloc((unsigned) strlen(buffer) + 1);
+ if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) {
+ char *newCd = ckalloc(strlen(buffer) + 1);
strcpy(newCd, buffer);
return newCd;
@@ -754,12 +763,12 @@ TclpGetCwd(
if (getwd(buffer) == NULL) /* INTL: Native. */
#else
if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */
-#endif
+#endif /* USEGETWD */
{
if (interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error getting working directory name: %s",
+ Tcl_PosixError(interp)));
}
return NULL;
}
@@ -810,7 +819,7 @@ TclpReadlink(
return Tcl_DStringValue(linkPtr);
#else
return NULL;
-#endif
+#endif /* !DJGPP */
}
/*
@@ -844,7 +853,7 @@ TclpObjStat(
#ifdef S_IFLNK
-Tcl_Obj*
+Tcl_Obj *
TclpObjLink(
Tcl_Obj *pathPtr,
Tcl_Obj *toPtr,
@@ -976,12 +985,8 @@ TclpObjLink(
}
Tcl_ExternalToUtfDString(NULL, link, length, &ds);
- linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
- if (linkPtr != NULL) {
- Tcl_IncrRefCount(linkPtr);
- }
+ linkPtr = TclDStringToObj(&ds);
+ Tcl_IncrRefCount(linkPtr);
return linkPtr;
}
}
@@ -1043,19 +1048,9 @@ TclpNativeToNormalized(
ClientData clientData)
{
Tcl_DString ds;
- Tcl_Obj *objPtr;
- int len;
-
- const char *copy;
- Tcl_ExternalToUtfDString(NULL, (const char*)clientData, -1, &ds);
- copy = Tcl_DStringValue(&ds);
- len = Tcl_DStringLength(&ds);
-
- objPtr = Tcl_NewStringObj(copy,len);
- Tcl_DStringFree(&ds);
-
- return objPtr;
+ Tcl_ExternalToUtfDString(NULL, (const char *) clientData, -1, &ds);
+ return TclDStringToObj(&ds);
}
/*
@@ -1111,7 +1106,7 @@ TclNativeCreateNativeRep(
Tcl_UtfToExternalDString(NULL, str, len, &ds);
len = Tcl_DStringLength(&ds) + sizeof(char);
Tcl_DecrRefCount(validPathPtr);
- nativePathPtr = ckalloc((unsigned) len);
+ nativePathPtr = ckalloc(len);
memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
Tcl_DStringFree(&ds);
@@ -1181,6 +1176,53 @@ TclpUtime(
return utime(Tcl_FSGetNativePath(pathPtr), tval);
}
+#ifdef __CYGWIN__
+
+int
+TclOSstat(
+ const char *name,
+ Tcl_StatBuf *statBuf)
+{
+ struct stat buf;
+ int result = stat(name, &buf);
+
+ statBuf->st_mode = buf.st_mode;
+ statBuf->st_ino = buf.st_ino;
+ statBuf->st_dev = buf.st_dev;
+ statBuf->st_rdev = buf.st_rdev;
+ statBuf->st_nlink = buf.st_nlink;
+ statBuf->st_uid = buf.st_uid;
+ statBuf->st_gid = buf.st_gid;
+ statBuf->st_size = buf.st_size;
+ statBuf->st_atime = buf.st_atime;
+ statBuf->st_mtime = buf.st_mtime;
+ statBuf->st_ctime = buf.st_ctime;
+ return result;
+}
+
+int
+TclOSlstat(
+ const char *name,
+ Tcl_StatBuf *statBuf)
+{
+ struct stat buf;
+ int result = lstat(name, &buf);
+
+ statBuf->st_mode = buf.st_mode;
+ statBuf->st_ino = buf.st_ino;
+ statBuf->st_dev = buf.st_dev;
+ statBuf->st_rdev = buf.st_rdev;
+ statBuf->st_nlink = buf.st_nlink;
+ statBuf->st_uid = buf.st_uid;
+ statBuf->st_gid = buf.st_gid;
+ statBuf->st_size = buf.st_size;
+ statBuf->st_atime = buf.st_atime;
+ statBuf->st_mtime = buf.st_mtime;
+ statBuf->st_ctime = buf.st_ctime;
+ return result;
+}
+#endif /* CYGWIN */
+
/*
* Local Variables:
* mode: c
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index db7bbfe..f07b123 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -6,8 +6,6 @@
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
* Copyright (c) 1999 by Scriptics Corporation.
* All rights reserved.
- *
- * RCS: @(#) $Id: tclUnixInit.c,v 1.87 2009/10/05 02:41:07 das Exp $
*/
#include "tclInt.h"
@@ -33,6 +31,51 @@
# include <dlfcn.h>
# endif
#endif
+
+#ifdef __CYGWIN__
+DLLIMPORT extern __stdcall unsigned char GetVersionExA(void *);
+DLLIMPORT extern __stdcall void GetSystemInfo(void *);
+
+#define NUMPLATFORMS 4
+static const char *const platforms[NUMPLATFORMS] = {
+ "Win32s", "Windows 95", "Windows NT", "Windows CE"
+};
+
+#define NUMPROCESSORS 11
+static const char *const processors[NUMPROCESSORS] = {
+ "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
+ "amd64", "ia32_on_win64"
+};
+
+typedef struct _SYSTEM_INFO {
+ union {
+ DWORD dwOemId;
+ struct {
+ int wProcessorArchitecture;
+ int wReserved;
+ };
+ };
+ DWORD dwPageSize;
+ void *lpMinimumApplicationAddress;
+ void *lpMaximumApplicationAddress;
+ void *dwActiveProcessorMask;
+ DWORD dwNumberOfProcessors;
+ DWORD dwProcessorType;
+ DWORD dwAllocationGranularity;
+ int wProcessorLevel;
+ int wProcessorRevision;
+} SYSTEM_INFO;
+
+typedef struct _OSVERSIONINFOA {
+ DWORD dwOSVersionInfoSize;
+ DWORD dwMajorVersion;
+ DWORD dwMinorVersion;
+ DWORD dwBuildNumber;
+ DWORD dwPlatformId;
+ char szCSDVersion[128];
+} OSVERSIONINFOA;
+#endif
+
#ifdef HAVE_COREFOUNDATION
#include <CoreFoundation/CoreFoundation.h>
#endif
@@ -456,8 +499,7 @@ TclpInitLibraryPath(
* If TCL_LIBRARY is set, search there.
*/
- objPtr = Tcl_NewStringObj(str, -1);
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(str, -1));
Tcl_SplitPath(str, &pathc, &pathv);
if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
@@ -471,11 +513,9 @@ TclpInitLibraryPath(
pathv[pathc - 1] = installLib + 4;
str = Tcl_JoinPath(pathc, pathv, &ds);
- objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- Tcl_DStringFree(&ds);
+ Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds));
}
- ckfree((char *) pathv);
+ ckfree(pathv);
}
/*
@@ -508,7 +548,7 @@ TclpInitLibraryPath(
*encodingPtr = Tcl_GetEncoding(NULL, NULL);
str = Tcl_GetStringFromObj(pathPtr, lengthPtr);
- *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
+ *valuePtr = ckalloc((*lengthPtr) + 1);
memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1);
Tcl_DecrRefCount(pathPtr);
}
@@ -705,7 +745,11 @@ void
TclpSetVariables(
Tcl_Interp *interp)
{
-#ifndef NO_UNAME
+#ifdef __CYGWIN__
+ SYSTEM_INFO sysInfo;
+ OSVERSIONINFOA osInfo;
+ char buffer[TCL_INTEGER_SPACE * 2];
+#elif !defined(NO_UNAME)
struct utsname name;
#endif
int unameOK;
@@ -814,7 +858,25 @@ TclpSetVariables(
#endif
unameOK = 0;
-#ifndef NO_UNAME
+#ifdef __CYGWIN__
+ unameOK = 1;
+ osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
+ GetVersionExA(&osInfo);
+ GetSystemInfo(&sysInfo);
+
+ if (osInfo.dwPlatformId < NUMPLATFORMS) {
+ Tcl_SetVar2(interp, "tcl_platform", "os",
+ platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
+ }
+ sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
+ Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
+ if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) {
+ Tcl_SetVar2(interp, "tcl_platform", "machine",
+ processors[sysInfo.wProcessorArchitecture],
+ TCL_GLOBAL_ONLY);
+ }
+
+#elif !defined NO_UNAME
if (uname(&name) >= 0) {
const char *native;
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index 79bcf9c..b87af1b 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUnixNotfy.c,v 1.42 2010/06/21 11:23:23 nijtmans Exp $
*/
#include "tclInt.h"
@@ -53,13 +51,13 @@ typedef struct FileHandlerEvent {
/*
* The following structure contains a set of select() masks to track readable,
- * writable, and exceptional conditions.
+ * writable, and exception conditions.
*/
typedef struct SelectMasks {
fd_set readable;
fd_set writable;
- fd_set exceptional;
+ fd_set exception;
} SelectMasks;
/*
@@ -93,13 +91,20 @@ typedef struct ThreadSpecificData {
* from these pointers. You must hold the
* notifierMutex lock before accessing these
* fields. */
+#ifdef __CYGWIN__
+ void *event; /* Any other thread alerts a notifier
+ * that an event is ready to be processed
+ * by sending this event. */
+ void *hwnd; /* Messaging window. */
+#else
Tcl_Condition waitCV; /* Any other thread alerts a notifier that an
* event is ready to be processed by signaling
* this condition variable. */
+#endif /* __CYGWIN__ */
int eventReady; /* True if an event is ready to be processed.
* Used as condition flag together with waitCV
* above. */
-#endif
+#endif /* TCL_THREADS */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
@@ -172,16 +177,71 @@ static Tcl_Condition notifierCV;
static Tcl_ThreadId notifierThread;
-#endif
+#endif /* TCL_THREADS */
/*
* Static routines defined in this file.
*/
#ifdef TCL_THREADS
-static void NotifierThreadProc(ClientData clientData);
+static void NotifierThreadProc(ClientData clientData);
#endif
-static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
+static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
+
+/*
+ * Import of Windows API when building threaded with Cygwin.
+ */
+
+#if defined(TCL_THREADS) && defined(__CYGWIN__)
+typedef struct {
+ void *hwnd;
+ unsigned int *message;
+ int wParam;
+ int lParam;
+ int time;
+ int x;
+ int y;
+} MSG;
+
+typedef struct {
+ unsigned int style;
+ void *lpfnWndProc;
+ int cbClsExtra;
+ int cbWndExtra;
+ void *hInstance;
+ void *hIcon;
+ void *hCursor;
+ void *hbrBackground;
+ void *lpszMenuName;
+ void *lpszClassName;
+} WNDCLASS;
+
+extern void __stdcall CloseHandle(void *);
+extern void *__stdcall CreateEventW(void *, unsigned char, unsigned char,
+ void *);
+extern void * __stdcall CreateWindowExW(void *, void *, void *, DWORD, int,
+ int, int, int, void *, void *, void *, void *);
+extern DWORD __stdcall DefWindowProcW(void *, int, void *, void *);
+extern unsigned char __stdcall DestroyWindow(void *);
+extern int __stdcall DispatchMessageW(const MSG *);
+extern unsigned char __stdcall GetMessageW(MSG *, void *, int, int);
+extern void __stdcall MsgWaitForMultipleObjects(DWORD, void *,
+ unsigned char, DWORD, DWORD);
+extern unsigned char __stdcall PeekMessageW(MSG *, void *, int, int, int);
+extern unsigned char __stdcall PostMessageW(void *, unsigned int, void *,
+ void *);
+extern void __stdcall PostQuitMessage(int);
+extern void *__stdcall RegisterClassW(const WNDCLASS *);
+extern unsigned char __stdcall ResetEvent(void *);
+extern unsigned char __stdcall TranslateMessage(const MSG *);
+
+/*
+ * Threaded-cygwin specific functions in this file:
+ */
+
+static DWORD __stdcall NotifierProc(void *hwnd, unsigned int message,
+ void *wParam, void *lParam);
+#endif /* TCL_THREADS && __CYGWIN__ */
/*
*----------------------------------------------------------------------
@@ -206,6 +266,7 @@ Tcl_InitNotifier(void)
return tclNotifierHooks.initNotifierProc();
} else {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
#ifdef TCL_THREADS
tsdPtr->eventReady = 0;
@@ -231,7 +292,7 @@ Tcl_InitNotifier(void)
}
Tcl_MutexUnlock(&notifierMutex);
-#endif
+#endif /* TCL_THREADS */
return tsdPtr;
}
}
@@ -277,7 +338,8 @@ Tcl_FinalizeNotifier(
int result;
if (triggerPipe < 0) {
- Tcl_Panic("Tcl_FinalizeNotifier: notifier pipe not initialized");
+ Tcl_Panic("Tcl_FinalizeNotifier: %s",
+ "notifier pipe not initialized");
}
/*
@@ -292,7 +354,8 @@ Tcl_FinalizeNotifier(
*/
if (write(triggerPipe, "q", 1) != 1) {
- Tcl_Panic("Tcl_FinalizeNotifier: unable to write q to triggerPipe");
+ Tcl_Panic("Tcl_FinalizeNotifier: %s",
+ "unable to write q to triggerPipe");
}
close(triggerPipe);
while(triggerPipe >= 0) {
@@ -301,7 +364,8 @@ Tcl_FinalizeNotifier(
result = Tcl_JoinThread(notifierThread, NULL);
if (result) {
- Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier thread");
+ Tcl_Panic("Tcl_FinalizeNotifier: %s",
+ "unable to join notifier thread");
}
}
@@ -309,10 +373,14 @@ Tcl_FinalizeNotifier(
* Clean up any synchronization objects in the thread local storage.
*/
+#ifdef __CYGWIN__
+ CloseHandle(tsdPtr->event);
+#else /* __CYGWIN__ */
Tcl_ConditionFinalize(&(tsdPtr->waitCV));
+#endif /* __CYGWIN__ */
Tcl_MutexUnlock(&notifierMutex);
-#endif
+#endif /* TCL_THREADS */
}
}
@@ -348,9 +416,13 @@ Tcl_AlertNotifier(
Tcl_MutexLock(&notifierMutex);
tsdPtr->eventReady = 1;
+# ifdef __CYGWIN__
+ PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
+# else
Tcl_ConditionNotify(&tsdPtr->waitCV);
+# endif /* __CYGWIN__ */
Tcl_MutexUnlock(&notifierMutex);
-#endif
+#endif /* TCL_THREADS */
}
}
@@ -458,7 +530,7 @@ Tcl_CreateFileHandler(
}
}
if (filePtr == NULL) {
- filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
+ filePtr = ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->readyMask = 0;
filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
@@ -473,19 +545,19 @@ Tcl_CreateFileHandler(
*/
if (mask & TCL_READABLE) {
- FD_SET(fd, &(tsdPtr->checkMasks.readable));
+ FD_SET(fd, &tsdPtr->checkMasks.readable);
} else {
- FD_CLR(fd, &(tsdPtr->checkMasks.readable));
+ FD_CLR(fd, &tsdPtr->checkMasks.readable);
}
if (mask & TCL_WRITABLE) {
- FD_SET(fd, &(tsdPtr->checkMasks.writable));
+ FD_SET(fd, &tsdPtr->checkMasks.writable);
} else {
- FD_CLR(fd, &(tsdPtr->checkMasks.writable));
+ FD_CLR(fd, &tsdPtr->checkMasks.writable);
}
if (mask & TCL_EXCEPTION) {
- FD_SET(fd, &(tsdPtr->checkMasks.exceptional));
+ FD_SET(fd, &tsdPtr->checkMasks.exception);
} else {
- FD_CLR(fd, &(tsdPtr->checkMasks.exceptional));
+ FD_CLR(fd, &tsdPtr->checkMasks.exception);
}
if (tsdPtr->numFdBits <= fd) {
tsdPtr->numFdBits = fd+1;
@@ -527,7 +599,7 @@ Tcl_DeleteFileHandler(
*/
for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
- prevPtr = filePtr, filePtr = filePtr->nextPtr) {
+ prevPtr = filePtr, filePtr = filePtr->nextPtr) {
if (filePtr == NULL) {
return;
}
@@ -541,13 +613,13 @@ Tcl_DeleteFileHandler(
*/
if (filePtr->mask & TCL_READABLE) {
- FD_CLR(fd, &(tsdPtr->checkMasks.readable));
+ FD_CLR(fd, &tsdPtr->checkMasks.readable);
}
if (filePtr->mask & TCL_WRITABLE) {
- FD_CLR(fd, &(tsdPtr->checkMasks.writable));
+ FD_CLR(fd, &tsdPtr->checkMasks.writable);
}
if (filePtr->mask & TCL_EXCEPTION) {
- FD_CLR(fd, &(tsdPtr->checkMasks.exceptional));
+ FD_CLR(fd, &tsdPtr->checkMasks.exception);
}
/*
@@ -558,9 +630,9 @@ Tcl_DeleteFileHandler(
int numFdBits = 0;
for (i = fd-1; i >= 0; i--) {
- if (FD_ISSET(i, &(tsdPtr->checkMasks.readable))
- || FD_ISSET(i, &(tsdPtr->checkMasks.writable))
- || FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))) {
+ if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
+ || FD_ISSET(i, &tsdPtr->checkMasks.writable)
+ || FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
numFdBits = i+1;
break;
}
@@ -577,7 +649,7 @@ Tcl_DeleteFileHandler(
} else {
prevPtr->nextPtr = filePtr->nextPtr;
}
- ckfree((char *) filePtr);
+ ckfree(filePtr);
}
}
@@ -654,6 +726,31 @@ FileHandlerEventProc(
return 1;
}
+#if defined(TCL_THREADS) && defined(__CYGWIN__)
+
+static DWORD __stdcall
+NotifierProc(
+ void *hwnd,
+ unsigned int message,
+ void *wParam,
+ void *lParam)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (message != 1024) {
+ return DefWindowProcW(hwnd, message, wParam, lParam);
+ }
+
+ /*
+ * Process all of the runnable events.
+ */
+
+ tsdPtr->eventReady = 1;
+ Tcl_ServiceAll();
+ return 0;
+}
+#endif /* TCL_THREADS && __CYGWIN__ */
+
/*
*----------------------------------------------------------------------
*
@@ -680,11 +777,13 @@ Tcl_WaitForEvent(
return tclNotifierHooks.waitForEventProc(timePtr);
} else {
FileHandler *filePtr;
- FileHandlerEvent *fileEvPtr;
int mask;
Tcl_Time vTime;
#ifdef TCL_THREADS
int waitForFiles;
+# ifdef __CYGWIN__
+ MSG msg;
+# endif /* __CYGWIN__ */
#else
/*
* Impl. notes: timeout & timeoutPtr are used if, and only if threads
@@ -706,8 +805,8 @@ Tcl_WaitForEvent(
if (timePtr != NULL) {
/*
* TIP #233 (Virtualized Time). Is virtual time in effect? And do
- * we actually have something to scale? If yes to both then we call
- * the handler to do this scaling.
+ * we actually have something to scale? If yes to both then we
+ * call the handler to do this scaling.
*/
if (timePtr->sec != 0 || timePtr->usec != 0) {
@@ -721,17 +820,17 @@ Tcl_WaitForEvent(
timeoutPtr = &timeout;
} else if (tsdPtr->numFdBits == 0) {
/*
- * If there are no threads, no timeout, and no fds registered, then
- * there are no events possible and we must avoid deadlock. Note
- * that this is not entirely correct because there might be a
- * signal that could interrupt the select call, but we don't handle
- * that case if we aren't using threads.
+ * If there are no threads, no timeout, and no fds registered,
+ * then there are no events possible and we must avoid deadlock.
+ * Note that this is not entirely correct because there might be a
+ * signal that could interrupt the select call, but we don't
+ * handle that case if we aren't using threads.
*/
return -1;
} else {
timeoutPtr = NULL;
-#endif /* TCL_THREADS */
+#endif /* !TCL_THREADS */
}
#ifdef TCL_THREADS
@@ -740,19 +839,43 @@ Tcl_WaitForEvent(
* notifier thread, and wait for a response or a timeout.
*/
+#ifdef __CYGWIN__
+ if (!tsdPtr->hwnd) {
+ WNDCLASS class;
+
+ class.style = 0;
+ class.cbClsExtra = 0;
+ class.cbWndExtra = 0;
+ class.hInstance = TclWinGetTclInstance();
+ class.hbrBackground = NULL;
+ class.lpszMenuName = NULL;
+ class.lpszClassName = L"TclNotifier";
+ class.lpfnWndProc = NotifierProc;
+ class.hIcon = NULL;
+ class.hCursor = NULL;
+
+ RegisterClassW(&class);
+ tsdPtr->hwnd = CreateWindowExW(NULL, class.lpszClassName,
+ class.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL,
+ TclWinGetTclInstance(), NULL);
+ tsdPtr->event = CreateEventW(NULL, 1 /* manual */,
+ 0 /* !signaled */, NULL);
+ }
+#endif /* __CYGWIN */
+
Tcl_MutexLock(&notifierMutex);
if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0
#if defined(__APPLE__) && defined(__LP64__)
/*
- * On 64-bit Darwin, pthread_cond_timedwait() appears to have a
- * bug that causes it to wait forever when passed an absolute
- * time which has already been exceeded by the system time; as
- * a workaround, when given a very brief timeout, just do a
- * poll. [Bug 1457797]
+ * On 64-bit Darwin, pthread_cond_timedwait() appears to have
+ * a bug that causes it to wait forever when passed an
+ * absolute time which has already been exceeded by the system
+ * time; as a workaround, when given a very brief timeout,
+ * just do a poll. [Bug 1457797]
*/
|| timePtr->usec < 10
-#endif
+#endif /* __APPLE__ && __LP64__ */
)) {
/*
* Cannot emulate a polling select with a polling condition
@@ -773,8 +896,8 @@ Tcl_WaitForEvent(
if (waitForFiles) {
/*
* Add the ThreadSpecificData structure of this thread to the list
- * of ThreadSpecificData structures of all threads that are waiting
- * on file events.
+ * of ThreadSpecificData structures of all threads that are
+ * waiting on file events.
*/
tsdPtr->nextPtr = waitingListPtr;
@@ -785,20 +908,55 @@ Tcl_WaitForEvent(
waitingListPtr = tsdPtr;
tsdPtr->onList = 1;
- if (write(triggerPipe, "", 1) != 1) {
- Tcl_Panic("Tcl_WaitForEvent: unable to write to triggerPipe");
+ if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
+ Tcl_Panic("Tcl_WaitForEvent: %s",
+ "unable to write to triggerPipe");
}
}
- FD_ZERO(&(tsdPtr->readyMasks.readable));
- FD_ZERO(&(tsdPtr->readyMasks.writable));
- FD_ZERO(&(tsdPtr->readyMasks.exceptional));
+ FD_ZERO(&tsdPtr->readyMasks.readable);
+ FD_ZERO(&tsdPtr->readyMasks.writable);
+ FD_ZERO(&tsdPtr->readyMasks.exception);
if (!tsdPtr->eventReady) {
+#ifdef __CYGWIN__
+ if (!PeekMessageW(&msg, NULL, 0, 0, 0)) {
+ DWORD timeout;
+
+ if (timePtr) {
+ timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+ } else {
+ timeout = 0xFFFFFFFF;
+ }
+ Tcl_MutexUnlock(&notifierMutex);
+ MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279);
+ Tcl_MutexLock(&notifierMutex);
+ }
+#else
Tcl_ConditionWait(&tsdPtr->waitCV, &notifierMutex, timePtr);
+#endif /* __CYGWIN__ */
}
tsdPtr->eventReady = 0;
+#ifdef __CYGWIN__
+ while (PeekMessageW(&msg, NULL, 0, 0, 0)) {
+ /*
+ * Retrieve and dispatch the message.
+ */
+
+ DWORD result = GetMessageW(&msg, NULL, 0, 0);
+
+ if (result == 0) {
+ PostQuitMessage(msg.wParam);
+ /* What to do here? */
+ } else if (result != (DWORD) -1) {
+ TranslateMessage(&msg);
+ DispatchMessageW(&msg);
+ }
+ }
+ ResetEvent(tsdPtr->event);
+#endif /* __CYGWIN__ */
+
if (waitForFiles && tsdPtr->onList) {
/*
* Remove the ThreadSpecificData structure of this thread from the
@@ -817,16 +975,17 @@ Tcl_WaitForEvent(
}
tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
tsdPtr->onList = 0;
- if (write(triggerPipe, "", 1) != 1) {
- Tcl_Panic("Tcl_WaitForEvent: unable to write to triggerPipe");
+ if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
+ Tcl_Panic("Tcl_WaitForEvent: %s",
+ "unable to write to triggerPipe");
}
}
#else
tsdPtr->readyMasks = tsdPtr->checkMasks;
- numFound = select(tsdPtr->numFdBits, &(tsdPtr->readyMasks.readable),
- &(tsdPtr->readyMasks.writable),
- &(tsdPtr->readyMasks.exceptional), timeoutPtr);
+ numFound = select(tsdPtr->numFdBits, &tsdPtr->readyMasks.readable,
+ &tsdPtr->readyMasks.writable, &tsdPtr->readyMasks.exception,
+ timeoutPtr);
/*
* Some systems don't clear the masks after an error, so we have to do
@@ -834,9 +993,9 @@ Tcl_WaitForEvent(
*/
if (numFound == -1) {
- FD_ZERO(&(tsdPtr->readyMasks.readable));
- FD_ZERO(&(tsdPtr->readyMasks.writable));
- FD_ZERO(&(tsdPtr->readyMasks.exceptional));
+ FD_ZERO(&tsdPtr->readyMasks.readable);
+ FD_ZERO(&tsdPtr->readyMasks.writable);
+ FD_ZERO(&tsdPtr->readyMasks.exception);
}
#endif /* TCL_THREADS */
@@ -846,15 +1005,14 @@ Tcl_WaitForEvent(
for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
filePtr = filePtr->nextPtr) {
-
mask = 0;
- if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.readable))) {
+ if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.readable)) {
mask |= TCL_READABLE;
}
- if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.writable))) {
+ if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.writable)) {
mask |= TCL_WRITABLE;
}
- if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.exceptional))) {
+ if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.exception)) {
mask |= TCL_EXCEPTION;
}
@@ -868,8 +1026,9 @@ Tcl_WaitForEvent(
*/
if (filePtr->readyMask == 0) {
- fileEvPtr = (FileHandlerEvent *)
+ FileHandlerEvent *fileEvPtr =
ckalloc(sizeof(FileHandlerEvent));
+
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
@@ -915,7 +1074,7 @@ NotifierThreadProc(
ThreadSpecificData *tsdPtr;
fd_set readableMask;
fd_set writableMask;
- fd_set exceptionalMask;
+ fd_set exceptionMask;
int fds[2];
int i, numFdBits = 0, receivePipe;
long found;
@@ -923,22 +1082,26 @@ NotifierThreadProc(
char buf[2];
if (pipe(fds) != 0) {
- Tcl_Panic("NotifierThreadProc: could not create trigger pipe");
+ Tcl_Panic("NotifierThreadProc: %s", "could not create trigger pipe");
}
receivePipe = fds[0];
if (TclUnixSetBlockingMode(receivePipe, TCL_MODE_NONBLOCKING) < 0) {
- Tcl_Panic("NotifierThreadProc: could not make receive pipe non blocking");
+ Tcl_Panic("NotifierThreadProc: %s",
+ "could not make receive pipe non blocking");
}
if (TclUnixSetBlockingMode(fds[1], TCL_MODE_NONBLOCKING) < 0) {
- Tcl_Panic("NotifierThreadProc: could not make trigger pipe non blocking");
+ Tcl_Panic("NotifierThreadProc: %s",
+ "could not make trigger pipe non blocking");
}
if (fcntl(receivePipe, F_SETFD, FD_CLOEXEC) < 0) {
- Tcl_Panic("NotifierThreadProc: could not make receive pipe close-on-exec");
+ Tcl_Panic("NotifierThreadProc: %s",
+ "could not make receive pipe close-on-exec");
}
if (fcntl(fds[1], F_SETFD, FD_CLOEXEC) < 0) {
- Tcl_Panic("NotifierThreadProc: could not make trigger pipe close-on-exec");
+ Tcl_Panic("NotifierThreadProc: %s",
+ "could not make trigger pipe close-on-exec");
}
/*
@@ -962,7 +1125,7 @@ NotifierThreadProc(
while (1) {
FD_ZERO(&readableMask);
FD_ZERO(&writableMask);
- FD_ZERO(&exceptionalMask);
+ FD_ZERO(&exceptionMask);
/*
* Compute the logical OR of the select masks from all the waiting
@@ -973,14 +1136,14 @@ NotifierThreadProc(
timePtr = NULL;
for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
- if (FD_ISSET(i, &(tsdPtr->checkMasks.readable))) {
+ if (FD_ISSET(i, &tsdPtr->checkMasks.readable)) {
FD_SET(i, &readableMask);
}
- if (FD_ISSET(i, &(tsdPtr->checkMasks.writable))) {
+ if (FD_ISSET(i, &tsdPtr->checkMasks.writable)) {
FD_SET(i, &writableMask);
}
- if (FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))) {
- FD_SET(i, &exceptionalMask);
+ if (FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
+ FD_SET(i, &exceptionMask);
}
}
if (tsdPtr->numFdBits > numFdBits) {
@@ -1007,7 +1170,7 @@ NotifierThreadProc(
}
FD_SET(receivePipe, &readableMask);
- if (select(numFdBits, &readableMask, &writableMask, &exceptionalMask,
+ if (select(numFdBits, &readableMask, &writableMask, &exceptionMask,
timePtr) == -1) {
/*
* Try again immediately on an error.
@@ -1025,19 +1188,19 @@ NotifierThreadProc(
found = 0;
for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
- if (FD_ISSET(i, &(tsdPtr->checkMasks.readable))
+ if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
&& FD_ISSET(i, &readableMask)) {
- FD_SET(i, &(tsdPtr->readyMasks.readable));
+ FD_SET(i, &tsdPtr->readyMasks.readable);
found = 1;
}
- if (FD_ISSET(i, &(tsdPtr->checkMasks.writable))
+ if (FD_ISSET(i, &tsdPtr->checkMasks.writable)
&& FD_ISSET(i, &writableMask)) {
- FD_SET(i, &(tsdPtr->readyMasks.writable));
+ FD_SET(i, &tsdPtr->readyMasks.writable);
found = 1;
}
- if (FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))
- && FD_ISSET(i, &exceptionalMask)) {
- FD_SET(i, &(tsdPtr->readyMasks.exceptional));
+ if (FD_ISSET(i, &tsdPtr->checkMasks.exception)
+ && FD_ISSET(i, &exceptionMask)) {
+ FD_SET(i, &tsdPtr->readyMasks.exception);
found = 1;
}
}
@@ -1064,7 +1227,11 @@ NotifierThreadProc(
tsdPtr->onList = 0;
tsdPtr->pollState = 0;
}
+#ifdef __CYGWIN__
+ PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
+#else
Tcl_ConditionNotify(&tsdPtr->waitCV);
+#endif /* __CYGWIN__ */
}
}
Tcl_MutexUnlock(&notifierMutex);
@@ -1101,11 +1268,11 @@ NotifierThreadProc(
Tcl_ConditionNotify(&notifierCV);
Tcl_MutexUnlock(&notifierMutex);
- TclpThreadExit (0);
+ TclpThreadExit(0);
}
#endif /* TCL_THREADS */
-#endif /* HAVE_COREFOUNDATION */
+#endif /* !HAVE_COREFOUNDATION */
/*
* Local Variables:
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index 391c7a1..9c21b28 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUnixPipe.c,v 1.53 2010/04/22 11:40:32 nijtmans Exp $
*/
#include "tclInt.h"
@@ -190,30 +188,18 @@ TclFile
TclpCreateTempFile(
const char *contents) /* String to write into temp file, or NULL. */
{
- char fileName[L_tmpnam + 9];
- const char *native;
- Tcl_DString dstring;
- int fd;
-
- /*
- * We should also check against making more then TMP_MAX of these.
- */
+ int fd = TclUnixOpenTemporaryFile(NULL, NULL, NULL, NULL);
- strcpy(fileName, P_tmpdir); /* INTL: Native. */
- if (fileName[strlen(fileName) - 1] != '/') {
- strcat(fileName, "/"); /* INTL: Native. */
- }
- strcat(fileName, "tclXXXXXX");
- fd = mkstemp(fileName); /* INTL: Native. */
if (fd == -1) {
return NULL;
}
fcntl(fd, F_SETFD, FD_CLOEXEC);
- unlink(fileName); /* INTL: Native. */
-
if (contents != NULL) {
+ Tcl_DString dstring;
+ char *native;
+
native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
- if (write(fd, native, strlen(native)) == -1) {
+ if (write(fd, native, Tcl_DStringLength(&dstring)) == -1) {
close(fd);
Tcl_DStringFree(&dstring);
return NULL;
@@ -243,61 +229,51 @@ TclpCreateTempFile(
Tcl_Obj *
TclpTempFileName(void)
{
- char fileName[L_tmpnam + 9];
- Tcl_Obj *result = NULL;
+ Tcl_Obj *nameObj = Tcl_NewObj();
int fd;
- /*
- * We should also check against making more then TMP_MAX of these.
- */
-
- strcpy(fileName, P_tmpdir); /* INTL: Native. */
- if (fileName[strlen(fileName) - 1] != '/') {
- strcat(fileName, "/"); /* INTL: Native. */
- }
- strcat(fileName, "tclXXXXXX");
- fd = mkstemp(fileName); /* INTL: Native. */
+ Tcl_IncrRefCount(nameObj);
+ fd = TclUnixOpenTemporaryFile(NULL, NULL, NULL, nameObj);
if (fd == -1) {
+ Tcl_DecrRefCount(nameObj);
return NULL;
}
- fcntl(fd, F_SETFD, FD_CLOEXEC);
- unlink(fileName); /* INTL: Native. */
- result = TclpNativeToNormalized(fileName);
+ fcntl(fd, F_SETFD, FD_CLOEXEC);
+ TclpObjDeleteFile(nameObj);
close(fd);
- return result;
+ return nameObj;
}
/*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------------
*
* TclpTempFileNameForLibrary --
*
- * Constructs a file name in the native file system where a
- * dynamically loaded library may be placed.
+ * Constructs a file name in the native file system where a dynamically
+ * loaded library may be placed.
*
* Results:
- * Returns the constructed file name. If an error occurs,
- * returns NULL and leaves an error message in the interpreter
- * result.
+ * Returns the constructed file name. If an error occurs, returns NULL
+ * and leaves an error message in the interpreter result.
*
- * On Unix, it works to load a shared object from a file of any
- * name, so this function is merely a thin wrapper around
- * TclpTempFileName().
+ * On Unix, it works to load a shared object from a file of any name, so this
+ * function is merely a thin wrapper around TclpTempFileName().
*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------------
*/
-Tcl_Obj*
-TclpTempFileNameForLibrary(Tcl_Interp* interp, /* Tcl interpreter */
- Tcl_Obj* path) /* Path name of the library
- * in the VFS */
+Tcl_Obj *
+TclpTempFileNameForLibrary(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *path) /* Path name of the library in the VFS. */
{
- Tcl_Obj* retval;
- retval = TclpTempFileName();
+ Tcl_Obj *retval = TclpTempFileName();
+
if (retval == NULL) {
- Tcl_AppendResult(interp, "couldn't create temporary file: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create temporary file: %s",
+ Tcl_PosixError(interp)));
}
return retval;
}
@@ -444,8 +420,8 @@ TclpCreateProcess(
*/
if (TclpCreatePipe(&errPipeIn, &errPipeOut) == 0) {
- Tcl_AppendResult(interp, "couldn't create pipe: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create pipe: %s", Tcl_PosixError(interp)));
goto error;
}
@@ -465,8 +441,9 @@ TclpCreateProcess(
/*
* After vfork(), do not call code in the child that changes global state,
* because it is using the parent's memory space at that point and writes
- * might corrupt the parent: so ensure standard channels are initialized in
- * the parent, otherwise SetupStdFile() might initialize them in the child.
+ * might corrupt the parent: so ensure standard channels are initialized
+ * in the parent, otherwise SetupStdFile() might initialize them in the
+ * child.
*/
if (!inputFile) {
@@ -497,7 +474,7 @@ TclpCreateProcess(
|| (joinThisError &&
((dup2(1,2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) {
sprintf(errSpace,
- "%dforked process couldn't set up input/output: ", errno);
+ "%dforked process couldn't set up input/output", errno);
len = strlen(errSpace);
if (len != (size_t) write(fd, errSpace, len)) {
Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
@@ -511,11 +488,11 @@ TclpCreateProcess(
RestoreSignals();
execvp(newArgv[0], newArgv); /* INTL: Native. */
- sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno, argv[0]);
+ sprintf(errSpace, "%dcouldn't execute \"%.150s\"", errno, argv[0]);
len = strlen(errSpace);
- if (len != (size_t) write(fd, errSpace, len)) {
+ if (len != (size_t) write(fd, errSpace, len)) {
Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
- }
+ }
_exit(1);
}
@@ -530,8 +507,8 @@ TclpCreateProcess(
TclStackFree(interp, dsArray);
if (pid == -1) {
- Tcl_AppendResult(interp, "couldn't fork child process: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't fork child process: %s", Tcl_PosixError(interp)));
goto error;
}
@@ -548,9 +525,11 @@ TclpCreateProcess(
count = read(fd, errSpace, (size_t) (sizeof(errSpace) - 1));
if (count > 0) {
char *end;
+
errSpace[count] = 0;
errno = strtol(errSpace, &end, 10);
- Tcl_AppendResult(interp, end, Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s: %s",
+ end, Tcl_PosixError(interp)));
goto error;
}
@@ -763,7 +742,7 @@ TclpCreateCommandChannel(
{
char channelName[16 + TCL_INTEGER_SPACE];
int channelId;
- PipeState *statePtr = (PipeState *) ckalloc((unsigned) sizeof(PipeState));
+ PipeState *statePtr = ckalloc(sizeof(PipeState));
int mode;
statePtr->inFile = readFile;
@@ -834,8 +813,8 @@ Tcl_CreatePipe(
int fileNums[2];
if (pipe(fileNums) < 0) {
- Tcl_AppendResult(interp, "pipe creation failed: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("pipe creation failed: %s",
+ Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -876,8 +855,8 @@ TclGetAndDetachPids(
{
PipeState *pipePtr;
const Tcl_ChannelType *chanTypePtr;
+ Tcl_Obj *pidsObj;
int i;
- char buf[TCL_INTEGER_SPACE];
/*
* Punt if the channel is not a command channel.
@@ -888,14 +867,16 @@ TclGetAndDetachPids(
return;
}
- pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
+ pipePtr = Tcl_GetChannelInstanceData(chan);
+ TclNewObj(pidsObj);
for (i = 0; i < pipePtr->numPids; i++) {
- TclFormatInt(buf, (long) TclpGetPid(pipePtr->pidPtr[i]));
- Tcl_AppendElement(interp, buf);
- Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
+ Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewIntObj(
+ PTR2INT(pipePtr->pidPtr[i])));
+ Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
}
+ Tcl_SetObjResult(interp, pidsObj);
if (pipePtr->numPids > 0) {
- ckfree((char *) pipePtr->pidPtr);
+ ckfree(pipePtr->pidPtr);
pipePtr->numPids = 0;
}
}
@@ -1026,9 +1007,9 @@ PipeClose2Proc(
}
if (pipePtr->numPids != 0) {
- ckfree((char *) pipePtr->pidPtr);
+ ckfree(pipePtr->pidPtr);
}
- ckfree((char *) pipePtr);
+ ckfree(pipePtr);
if (errorCode == 0) {
return result;
}
@@ -1277,7 +1258,7 @@ Tcl_PidObjCmd(
Tcl_Channel chan;
PipeState *pipePtr;
int i;
- Tcl_Obj *resultPtr, *longObjPtr;
+ Tcl_Obj *resultPtr;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
@@ -1303,11 +1284,11 @@ Tcl_PidObjCmd(
* Extract the process IDs from the pipe structure.
*/
- pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
+ pipePtr = Tcl_GetChannelInstanceData(chan);
resultPtr = Tcl_NewObj();
for (i = 0; i < pipePtr->numPids; i++) {
- longObjPtr = Tcl_NewLongObj((long) TclpGetPid(pipePtr->pidPtr[i]));
- Tcl_ListObjAppendElement(NULL, resultPtr, longObjPtr);
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i]))));
}
Tcl_SetObjResult(interp, resultPtr);
}
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 6ed41a1..63c500d 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -1,34 +1,31 @@
/*
* tclUnixPort.h --
*
- * This header file handles porting issues that occur because
- * of differences between systems. It reads in UNIX-related
- * header files and sets up UNIX-related macros for Tcl's UNIX
- * core. It should be the only file that contains #ifdefs to
- * handle different flavors of UNIX. This file sets up the
- * union of all UNIX-related things needed by any of the Tcl
- * core files. This file depends on configuration #defines such
- * as NO_DIRENT_H that are set up by the "configure" script.
+ * This header file handles porting issues that occur because of
+ * differences between systems. It reads in UNIX-related header files and
+ * sets up UNIX-related macros for Tcl's UNIX core. It should be the only
+ * file that contains #ifdefs to handle different flavors of UNIX. This
+ * file sets up the union of all UNIX-related things needed by any of the
+ * Tcl core files. This file depends on configuration #defines such as
+ * NO_DIRENT_H that are set up by the "configure" script.
*
- * Much of the material in this file was originally contributed
- * by Karl Lehenbauer, Mark Diekhans and Peter da Silva.
+ * Much of the material in this file was originally contributed by Karl
+ * Lehenbauer, Mark Diekhans and Peter da Silva.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUnixPort.h,v 1.72 2010/04/23 15:45:15 nijtmans Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _TCLUNIXPORT
#define _TCLUNIXPORT
#ifndef MODULE_SCOPE
-#define MODULE_SCOPE extern
+#define MODULE_SCOPE extern
#endif
-
+
/*
*---------------------------------------------------------------------------
* The following sets of #includes and #ifdefs are required to get Tcl to
@@ -56,6 +53,12 @@
# include <dirent.h>
#endif
#endif
+
+/*
+ *---------------------------------------------------------------------------
+ * Parameterize for 64-bit filesystem support.
+ *---------------------------------------------------------------------------
+ */
#ifdef HAVE_STRUCT_DIRENT64
typedef struct dirent64 Tcl_DirEntry;
@@ -75,19 +78,57 @@ typedef off_t Tcl_SeekOffset;
# define TclOSopen open
#endif
-#ifdef HAVE_STRUCT_STAT64
+#ifdef __CYGWIN__
+
+ /* Make some symbols available without including <windows.h> */
+# define DWORD unsigned int
+# define CP_UTF8 65001
+# define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004
+# define HANDLE void *
+# define HINSTANCE void *
+# define SOCKET unsigned int
+# define WSAEWOULDBLOCK 10035
+ typedef unsigned short WCHAR;
+ DLLIMPORT extern __stdcall int GetModuleHandleExW(unsigned int, const char *, void *);
+ DLLIMPORT extern __stdcall int GetModuleFileNameW(void *, const char *, int);
+ DLLIMPORT extern __stdcall int WideCharToMultiByte(int, int, const char *, int,
+ const char *, int, const char *, const char *);
+ DLLIMPORT extern __stdcall int MultiByteToWideChar(int, int, const char *, int,
+ WCHAR *, int);
+ DLLIMPORT extern __stdcall void OutputDebugStringW(const WCHAR *);
+ DLLIMPORT extern __stdcall int IsDebuggerPresent();
+
+ DLLIMPORT extern int cygwin_conv_path(int, const void *, void *, int);
+ DLLIMPORT extern int cygwin_conv_path_list(int, const void *, void *, int);
+# define USE_PUTENV 1
+# define USE_PUTENV_FOR_UNSET 1
+/* On Cygwin, the environment is imported from the Cygwin DLL. */
+# define environ __cygwin_environ
+# define timezone _timezone
+ DLLIMPORT extern char **__cygwin_environ;
+ MODULE_SCOPE int TclOSstat(const char *name, Tcl_StatBuf *statBuf);
+ MODULE_SCOPE int TclOSlstat(const char *name, Tcl_StatBuf *statBuf);
+#elif defined(HAVE_STRUCT_STAT64)
# define TclOSstat stat64
# define TclOSlstat lstat64
#else
# define TclOSstat stat
# define TclOSlstat lstat
#endif
+
+/*
+ *---------------------------------------------------------------------------
+ * Miscellaneous includes that might be missing.
+ *---------------------------------------------------------------------------
+ */
#include <sys/file.h>
#ifdef HAVE_SYS_SELECT_H
# include <sys/select.h>
#endif
-#include <sys/stat.h>
+#ifdef HAVE_SYS_STAT_H
+# include <sys/stat.h>
+#endif
#if TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
@@ -118,26 +159,34 @@ typedef off_t Tcl_SeekOffset;
# include "../compat/unistd.h"
#endif
-MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
+MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
#include <utime.h>
-
+
/*
- * Socket support stuff: This likely needs more work to parameterize for
- * each system.
+ *---------------------------------------------------------------------------
+ * Socket support stuff: This likely needs more work to parameterize for each
+ * system.
+ *---------------------------------------------------------------------------
*/
+
#include <sys/socket.h> /* struct sockaddr, SOCK_STREAM, ... */
#ifndef NO_UNAME
# include <sys/utsname.h> /* uname system call. */
#endif
#include <netinet/in.h> /* struct in_addr, struct sockaddr_in */
#include <arpa/inet.h> /* inet_ntoa() */
-#include <netdb.h> /* gethostbyname() */
-
+#include <netdb.h> /* getaddrinfo() */
+#ifdef NEED_FAKE_RFC2553
+# include "../compat/fake-rfc2553.h"
+#endif
+
/*
- * Some platforms (e.g. SunOS) don't define FLT_MAX and FLT_MIN, so we
- * look for an alternative definition. If no other alternative is available
- * we use a reasonable guess.
+ *---------------------------------------------------------------------------
+ * Some platforms (e.g. SunOS) don't define FLT_MAX and FLT_MIN, so we look
+ * for an alternative definition. If no other alternative is available we use
+ * a reasonable guess.
+ *---------------------------------------------------------------------------
*/
#ifndef NO_FLOAT_H
@@ -150,74 +199,84 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
#ifndef FLT_MAX
# ifdef MAXFLOAT
-# define FLT_MAX MAXFLOAT
+# define FLT_MAX MAXFLOAT
# else
-# define FLT_MAX 3.402823466E+38F
+# define FLT_MAX 3.402823466E+38F
# endif
#endif
#ifndef FLT_MIN
# ifdef MINFLOAT
-# define FLT_MIN MINFLOAT
+# define FLT_MIN MINFLOAT
# else
-# define FLT_MIN 1.175494351E-38F
+# define FLT_MIN 1.175494351E-38F
# endif
#endif
-
+
/*
+ *---------------------------------------------------------------------------
* NeXT doesn't define O_NONBLOCK, so #define it here if necessary.
+ *---------------------------------------------------------------------------
*/
#ifndef O_NONBLOCK
# define O_NONBLOCK 0x80
#endif
-
+
/*
- * The type of the status returned by wait varies from UNIX system
- * to UNIX system. The macro below defines it:
+ *---------------------------------------------------------------------------
+ * The type of the status returned by wait varies from UNIX system to UNIX
+ * system. The macro below defines it:
+ *---------------------------------------------------------------------------
*/
#ifdef _AIX
-# define WAIT_STATUS_TYPE pid_t
+# define WAIT_STATUS_TYPE pid_t
#else
#ifndef NO_UNION_WAIT
-# define WAIT_STATUS_TYPE union wait
+# define WAIT_STATUS_TYPE union wait
#else
-# define WAIT_STATUS_TYPE int
+# define WAIT_STATUS_TYPE int
#endif
#endif
-
+
/*
- * Supply definitions for macros to query wait status, if not already
- * defined in header files above.
+ *---------------------------------------------------------------------------
+ * Supply definitions for macros to query wait status, if not already defined
+ * in header files above.
+ *---------------------------------------------------------------------------
*/
#ifndef WIFEXITED
-# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0)
+# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0)
#endif
#ifndef WEXITSTATUS
-# define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
+# define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
#endif
#ifndef WIFSIGNALED
-# define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))
+# define WIFSIGNALED(stat) \
+ (((*((int *) &(stat)))) && ((*((int *) &(stat))) \
+ == ((*((int *) &(stat))) & 0x00ff)))
#endif
#ifndef WTERMSIG
-# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f)
+# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f)
#endif
#ifndef WIFSTOPPED
-# define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xff) == 0177)
+# define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xff) == 0177)
#endif
#ifndef WSTOPSIG
-# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff)
+# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff)
#endif
-
+
/*
- * Define constants for waitpid() system call if they aren't defined
- * by a system header file.
+ *---------------------------------------------------------------------------
+ * Define constants for waitpid() system call if they aren't defined by a
+ * system header file.
+ *---------------------------------------------------------------------------
*/
#ifndef WNOHANG
@@ -226,10 +285,12 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
#ifndef WUNTRACED
# define WUNTRACED 2
#endif
-
+
/*
- * Supply macros for seek offsets, if they're not already provided by
- * an include file.
+ *---------------------------------------------------------------------------
+ * Supply macros for seek offsets, if they're not already provided by an
+ * include file.
+ *---------------------------------------------------------------------------
*/
#ifndef SEEK_SET
@@ -241,10 +302,12 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
#ifndef SEEK_END
# define SEEK_END 2
#endif
-
+
/*
- * The stuff below is needed by the "time" command. If this system has no
+ *---------------------------------------------------------------------------
+ * The stuff below is needed by the "time" command. If this system has no
* gettimeofday call, then must use times() instead.
+ *---------------------------------------------------------------------------
*/
#ifdef NO_GETTOD
@@ -256,38 +319,45 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
#endif
#ifdef GETTOD_NOT_DECLARED
-MODULE_SCOPE int gettimeofday(struct timeval *tp, struct timezone *tzp);
+MODULE_SCOPE int gettimeofday(struct timeval *tp,
+ struct timezone *tzp);
#endif
-
+
/*
+ *---------------------------------------------------------------------------
* Define access mode constants if they aren't already defined.
+ *---------------------------------------------------------------------------
*/
#ifndef F_OK
-# define F_OK 00
+# define F_OK 00
#endif
#ifndef X_OK
-# define X_OK 01
+# define X_OK 01
#endif
#ifndef W_OK
-# define W_OK 02
+# define W_OK 02
#endif
#ifndef R_OK
-# define R_OK 04
+# define R_OK 04
#endif
-
+
/*
- * Define FD_CLOEEXEC (the close-on-exec flag bit) if it isn't
- * already defined.
+ *---------------------------------------------------------------------------
+ * Define FD_CLOEEXEC (the close-on-exec flag bit) if it isn't already
+ * defined.
+ *---------------------------------------------------------------------------
*/
#ifndef FD_CLOEXEC
-# define FD_CLOEXEC 1
+# define FD_CLOEXEC 1
#endif
-
+
/*
- * On systems without symbolic links (i.e. S_IFLNK isn't defined)
- * define "lstat" to use "stat" instead.
+ *---------------------------------------------------------------------------
+ * On systems without symbolic links (i.e. S_IFLNK isn't defined) define
+ * "lstat" to use "stat" instead.
+ *---------------------------------------------------------------------------
*/
#ifndef S_IFLNK
@@ -296,264 +366,313 @@ MODULE_SCOPE int gettimeofday(struct timeval *tp, struct timezone *tzp);
# define lstat64 stat64
# define TclOSlstat TclOSstat
#endif
-
+
/*
- * Define macros to query file type bits, if they're not already
- * defined.
+ *---------------------------------------------------------------------------
+ * Define macros to query file type bits, if they're not already defined.
+ *---------------------------------------------------------------------------
*/
#ifndef S_ISREG
# ifdef S_IFREG
-# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
+# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
# else
-# define S_ISREG(m) 0
+# define S_ISREG(m) 0
# endif
#endif /* !S_ISREG */
#ifndef S_ISDIR
# ifdef S_IFDIR
-# define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
+# define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
# else
-# define S_ISDIR(m) 0
+# define S_ISDIR(m) 0
# endif
#endif /* !S_ISDIR */
#ifndef S_ISCHR
# ifdef S_IFCHR
-# define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR)
+# define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR)
# else
-# define S_ISCHR(m) 0
+# define S_ISCHR(m) 0
# endif
#endif /* !S_ISCHR */
+
#ifndef S_ISBLK
# ifdef S_IFBLK
-# define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
+# define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
# else
-# define S_ISBLK(m) 0
+# define S_ISBLK(m) 0
# endif
#endif /* !S_ISBLK */
+
#ifndef S_ISFIFO
# ifdef S_IFIFO
-# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
+# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
# else
-# define S_ISFIFO(m) 0
+# define S_ISFIFO(m) 0
# endif
#endif /* !S_ISFIFO */
+
#ifndef S_ISLNK
# ifdef S_IFLNK
-# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
+# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
# else
-# define S_ISLNK(m) 0
+# define S_ISLNK(m) 0
# endif
#endif /* !S_ISLNK */
+
#ifndef S_ISSOCK
# ifdef S_IFSOCK
-# define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK)
+# define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK)
# else
-# define S_ISSOCK(m) 0
+# define S_ISSOCK(m) 0
# endif
#endif /* !S_ISSOCK */
-
+
/*
+ *---------------------------------------------------------------------------
* Make sure that MAXPATHLEN and MAXNAMLEN are defined.
+ *---------------------------------------------------------------------------
*/
#ifndef MAXPATHLEN
# ifdef PATH_MAX
-# define MAXPATHLEN PATH_MAX
+# define MAXPATHLEN PATH_MAX
# else
-# define MAXPATHLEN 2048
+# define MAXPATHLEN 2048
# endif
#endif
#ifndef MAXNAMLEN
# ifdef NAME_MAX
-# define MAXNAMLEN NAME_MAX
+# define MAXNAMLEN NAME_MAX
# else
-# define MAXNAMLEN 255
+# define MAXNAMLEN 255
# endif
#endif
-
+
/*
+ *---------------------------------------------------------------------------
* Make sure that L_tmpnam is defined.
+ *---------------------------------------------------------------------------
*/
#ifndef L_tmpnam
-# define L_tmpnam 100
+# define L_tmpnam 100
#endif
-
+
/*
- * The following macro defines the type of the mask arguments to
- * select:
+ *---------------------------------------------------------------------------
+ * The following macro defines the type of the mask arguments to select:
+ *---------------------------------------------------------------------------
*/
#ifndef NO_FD_SET
-# define SELECT_MASK fd_set
+# define SELECT_MASK fd_set
#else /* NO_FD_SET */
# ifndef _AIX
- typedef long fd_mask;
+ typedef long fd_mask;
# endif /* !AIX */
# if defined(_IBMR2)
-# define SELECT_MASK void
+# define SELECT_MASK void
# else /* !defined(_IBMR2) */
-# define SELECT_MASK int
+# define SELECT_MASK int
# endif /* defined(_IBMR2) */
#endif /* !NO_FD_SET */
-
+
/*
+ *---------------------------------------------------------------------------
* Define "NBBY" (number of bits per byte) if it's not already defined.
+ *---------------------------------------------------------------------------
*/
#ifndef NBBY
-# define NBBY 8
+# define NBBY 8
#endif
-
+
/*
+ *---------------------------------------------------------------------------
* The following macro defines the number of fd_masks in an fd_set:
+ *---------------------------------------------------------------------------
*/
#ifndef FD_SETSIZE
# ifdef OPEN_MAX
-# define FD_SETSIZE OPEN_MAX
+# define FD_SETSIZE OPEN_MAX
# else
-# define FD_SETSIZE 256
+# define FD_SETSIZE 256
# endif
#endif /* FD_SETSIZE */
-#if !defined(howmany)
-# define howmany(x, y) (((x)+((y)-1))/(y))
+
+#ifndef howmany
+# define howmany(x, y) (((x)+((y)-1))/(y))
#endif /* !defined(howmany) */
+
#ifndef NFDBITS
-# define NFDBITS NBBY*sizeof(fd_mask)
+# define NFDBITS NBBY*sizeof(fd_mask)
#endif /* NFDBITS */
-#define MASK_SIZE howmany(FD_SETSIZE, NFDBITS)
+#define MASK_SIZE howmany(FD_SETSIZE, NFDBITS)
+
/*
- * Not all systems declare the errno variable in errno.h. so this
- * file does it explicitly. The list of system error messages also
- * isn't generally declared in a header file anywhere.
+ *---------------------------------------------------------------------------
+ * Not all systems declare the errno variable in errno.h. so this file does it
+ * explicitly. The list of system error messages also isn't generally declared
+ * in a header file anywhere.
+ *---------------------------------------------------------------------------
*/
#ifdef NO_ERRNO
extern int errno;
#endif /* NO_ERRNO */
-
+
/*
- * Not all systems declare all the errors that Tcl uses! Provide some
+ *---------------------------------------------------------------------------
+ * Not all systems declare all the errors that Tcl uses! Provide some
* work-arounds...
+ *---------------------------------------------------------------------------
*/
#ifndef EOVERFLOW
# ifdef EFBIG
-# define EOVERFLOW EFBIG
+# define EOVERFLOW EFBIG
# else /* !EFBIG */
-# define EOVERFLOW EINVAL
+# define EOVERFLOW EINVAL
# endif /* EFBIG */
#endif /* EOVERFLOW */
-
+
/*
+ *---------------------------------------------------------------------------
* Variables provided by the C library:
+ *---------------------------------------------------------------------------
*/
#if defined(__APPLE__) && defined(__DYNAMIC__)
# include <crt_externs.h>
-# define environ (*_NSGetEnviron())
-# define USE_PUTENV 1
+# define environ (*_NSGetEnviron())
+# define USE_PUTENV 1
#else
# if defined(_sgi) || defined(__sgi)
-# define environ _environ
+# define environ _environ
# endif
-extern char **environ;
+extern char ** environ;
#endif
-
+
/*
+ *---------------------------------------------------------------------------
* Darwin specifc configure overrides.
+ *---------------------------------------------------------------------------
*/
#ifdef __APPLE__
+
/*
+ *---------------------------------------------------------------------------
* Support for fat compiles: configure runs only once for multiple architectures
+ *---------------------------------------------------------------------------
*/
+
# if defined(__LP64__) && defined (NO_COREFOUNDATION_64)
-# undef HAVE_COREFOUNDATION
-# endif /* __LP64__ && NO_COREFOUNDATION_64 */
+# undef HAVE_COREFOUNDATION
+# endif /* __LP64__ && NO_COREFOUNDATION_64 */
# include <sys/cdefs.h>
# ifdef __DARWIN_UNIX03
-# if __DARWIN_UNIX03
-# undef HAVE_PUTENV_THAT_COPIES
-# else
-# define HAVE_PUTENV_THAT_COPIES 1
-# endif
+# if __DARWIN_UNIX03
+# undef HAVE_PUTENV_THAT_COPIES
+# else
+# define HAVE_PUTENV_THAT_COPIES 1
+# endif
# endif /* __DARWIN_UNIX03 */
+
/*
+ *---------------------------------------------------------------------------
* The termios configure test program relies on the configure script being run
- * from a terminal, which is not the case e.g. when configuring from Xcode.
+ * from a terminal, which is not the case e.g., when configuring from Xcode.
* Since termios is known to be present on all Mac OS X releases since 10.0,
* override the configure defines for serial API here. [Bug 497147]
+ *---------------------------------------------------------------------------
*/
+
# define USE_TERMIOS 1
-# undef USE_TERMIO
-# undef USE_SGTTY
+# undef USE_TERMIO
+# undef USE_SGTTY
+
/*
+ *---------------------------------------------------------------------------
* Include AvailabilityMacros.h here (when available) to ensure any symbolic
* MAC_OS_X_VERSION_* constants passed on the command line are translated.
+ *---------------------------------------------------------------------------
*/
+
# ifdef HAVE_AVAILABILITYMACROS_H
-# include <AvailabilityMacros.h>
+# include <AvailabilityMacros.h>
# endif
+
/*
+ *---------------------------------------------------------------------------
* Support for weak import.
+ *---------------------------------------------------------------------------
*/
+
# ifdef HAVE_WEAK_IMPORT
-# if !defined(HAVE_AVAILABILITYMACROS_H) || !defined(MAC_OS_X_VERSION_MIN_REQUIRED)
-# undef HAVE_WEAK_IMPORT
-# else
-# ifndef WEAK_IMPORT_ATTRIBUTE
-# define WEAK_IMPORT_ATTRIBUTE __attribute__((weak_import))
-# endif
-# endif
+# if !defined(HAVE_AVAILABILITYMACROS_H) || !defined(MAC_OS_X_VERSION_MIN_REQUIRED)
+# undef HAVE_WEAK_IMPORT
+# else
+# ifndef WEAK_IMPORT_ATTRIBUTE
+# define WEAK_IMPORT_ATTRIBUTE __attribute__((weak_import))
+# endif
+# endif
# endif /* HAVE_WEAK_IMPORT */
+
/*
+ *---------------------------------------------------------------------------
* Support for MAC_OS_X_VERSION_MAX_ALLOWED define from AvailabilityMacros.h:
* only use API available in the indicated OS version or earlier.
+ *---------------------------------------------------------------------------
*/
+
# ifdef MAC_OS_X_VERSION_MAX_ALLOWED
-# if MAC_OS_X_VERSION_MAX_ALLOWED < 1050 && defined(__LP64__)
-# undef HAVE_COREFOUNDATION
-# endif
-# if MAC_OS_X_VERSION_MAX_ALLOWED < 1040
-# undef HAVE_OSSPINLOCKLOCK
-# undef HAVE_PTHREAD_ATFORK
-# undef HAVE_COPYFILE
-# endif
-# if MAC_OS_X_VERSION_MAX_ALLOWED < 1030
-# ifdef TCL_THREADS
+# if MAC_OS_X_VERSION_MAX_ALLOWED < 1050 && defined(__LP64__)
+# undef HAVE_COREFOUNDATION
+# endif
+# if MAC_OS_X_VERSION_MAX_ALLOWED < 1040
+# undef HAVE_OSSPINLOCKLOCK
+# undef HAVE_PTHREAD_ATFORK
+# undef HAVE_COPYFILE
+# endif
+# if MAC_OS_X_VERSION_MAX_ALLOWED < 1030
+# ifdef TCL_THREADS
/* prior to 10.3, realpath is not threadsafe, c.f. bug 711232 */
-# define NO_REALPATH 1
-# endif
-# undef HAVE_LANGINFO
-# endif
+# define NO_REALPATH 1
+# endif
+# undef HAVE_LANGINFO
+# endif
# endif /* MAC_OS_X_VERSION_MAX_ALLOWED */
# if defined(HAVE_COREFOUNDATION) && defined(__LP64__) && \
defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050
-# warning "Weak import of 64-bit CoreFoundation is not supported, will not run on Mac OS X < 10.5."
+# warning "Weak import of 64-bit CoreFoundation is not supported, will not run on Mac OS X < 10.5."
# endif
+
/*
+ *---------------------------------------------------------------------------
* At present, using vfork() instead of fork() causes execve() to fail
* intermittently on Darwin x86_64. rdar://4685553
+ *---------------------------------------------------------------------------
*/
+
# if defined(__x86_64__) && !defined(FIXED_RDAR_4685553)
-# undef USE_VFORK
+# undef USE_VFORK
# endif /* __x86_64__ */
/* Workaround problems with vfork() when building with llvm-gcc-4.2 */
# if defined (__llvm__) && \
(__GNUC__ > 4 || (__GNUC__ == 4 && (__GNUC_MINOR__ > 2 || \
(__GNUC_MINOR__ == 2 && __GNUC_PATCHLEVEL__ > 0))))
-# undef USE_VFORK
+# undef USE_VFORK
# endif /* __llvm__ */
#endif /* __APPLE__ */
-
+
/*
*---------------------------------------------------------------------------
* The following macros and declarations represent the interface between
- * generic and unix-specific parts of Tcl. Some of the macros may override
+ * generic and unix-specific parts of Tcl. Some of the macros may override
* functions declared in tclInt.h.
*---------------------------------------------------------------------------
*/
@@ -568,53 +687,72 @@ typedef int socklen_t;
#else
#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_LF
#endif
-
+
/*
+ *---------------------------------------------------------------------------
* The following macros have trivial definitions, allowing generic code to
* address platform-specific issues.
+ *---------------------------------------------------------------------------
*/
-#define TclpGetPid(pid) ((unsigned long) (pid))
#define TclpReleaseFile(file) /* Nothing. */
-
+
/*
+ *---------------------------------------------------------------------------
* The following defines wrap the system memory allocation routines.
+ *---------------------------------------------------------------------------
*/
-#define TclpSysAlloc(size, isBin) malloc((size_t)size)
-#define TclpSysFree(ptr) free((char*)ptr)
-#define TclpSysRealloc(ptr, size) realloc((char*)ptr, (size_t)size)
-
+#define TclpSysAlloc(size, isBin) malloc((size_t)(size))
+#define TclpSysFree(ptr) free((char *)(ptr))
+#define TclpSysRealloc(ptr, size) realloc((char *)(ptr), (size_t)(size))
+
/*
- * The following macros and declaration wrap the C runtime library
- * functions.
+ *---------------------------------------------------------------------------
+ * The following macros and declaration wrap the C runtime library functions.
+ *---------------------------------------------------------------------------
*/
-#define TclpExit exit
+#define TclpExit exit
#ifdef TCL_THREADS
+# include <pthread.h>
# undef inet_ntoa
# define inet_ntoa(x) TclpInetNtoa(x)
#endif /* TCL_THREADS */
+/* FIXME - Hyper-enormous platform assumption! */
+#ifndef AF_INET6
+# define AF_INET6 10
+#endif
+
/*
- * Set of MT-safe implementations of some
- * known-to-be-MT-unsafe library calls.
- * Instead of returning pointers to the
- * static storage, those return pointers
+ *---------------------------------------------------------------------------
+ * Set of MT-safe implementations of some known-to-be-MT-unsafe library calls.
+ * Instead of returning pointers to the static storage, those return pointers
* to the TSD data.
+ *---------------------------------------------------------------------------
*/
#include <pwd.h>
#include <grp.h>
-MODULE_SCOPE struct passwd* TclpGetPwNam(const char *name);
-MODULE_SCOPE struct group* TclpGetGrNam(const char *name);
-MODULE_SCOPE struct passwd* TclpGetPwUid(uid_t uid);
-MODULE_SCOPE struct group* TclpGetGrGid(gid_t gid);
-MODULE_SCOPE struct hostent* TclpGetHostByName(const char *name);
-MODULE_SCOPE struct hostent* TclpGetHostByAddr(const char *addr, int length, int type);
-MODULE_SCOPE Tcl_Channel TclpMakeTcpClientChannelMode(ClientData tcpSocket, int mode);
-
+MODULE_SCOPE struct passwd * TclpGetPwNam(const char *name);
+MODULE_SCOPE struct group * TclpGetGrNam(const char *name);
+MODULE_SCOPE struct passwd * TclpGetPwUid(uid_t uid);
+MODULE_SCOPE struct group * TclpGetGrGid(gid_t gid);
+MODULE_SCOPE struct hostent * TclpGetHostByName(const char *name);
+MODULE_SCOPE struct hostent * TclpGetHostByAddr(const char *addr,
+ int length, int type);
+MODULE_SCOPE Tcl_Channel TclpMakeTcpClientChannelMode(
+ ClientData tcpSocket, int mode);
#endif /* _TCLUNIXPORT */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index f5b9be4..31daa62 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -5,10 +5,8 @@
*
* Copyright (c) 1995 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUnixSock.c,v 1.26 2010/06/21 11:23:23 nijtmans Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
@@ -22,19 +20,62 @@
#define SET_BITS(var, bits) ((var) |= (bits))
#define CLEAR_BITS(var, bits) ((var) &= ~(bits))
+/* "sock" + a pointer in hex + \0 */
+#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1)
+#define SOCK_TEMPLATE "sock%lx"
+
+#undef SOCKET /* Possible conflict with win32 SOCKET */
+
+/*
+ * This is needed to comply with the strict aliasing rules of GCC, but it also
+ * simplifies casting between the different sockaddr types.
+ */
+
+typedef union {
+ struct sockaddr sa;
+ struct sockaddr_in sa4;
+ struct sockaddr_in6 sa6;
+ struct sockaddr_storage sas;
+} address;
+
/*
* This structure describes per-instance state of a tcp based channel.
*/
-typedef struct TcpState {
+typedef struct TcpState TcpState;
+
+typedef struct TcpFdList {
+ TcpState *statePtr;
+ int fd;
+ struct TcpFdList *next;
+} TcpFdList;
+
+struct TcpState {
Tcl_Channel channel; /* Channel associated with this file. */
- int fd; /* The socket itself. */
+ TcpFdList fds; /* The file descriptors of the sockets. */
int flags; /* ORed combination of the bitfields defined
* below. */
+ /*
+ * Only needed for server sockets
+ */
+
Tcl_TcpAcceptProc *acceptProc;
- /* Proc to call on accept. */
- ClientData acceptProcData; /* The data for the accept proc. */
-} TcpState;
+ /* Proc to call on accept. */
+ ClientData acceptProcData; /* The data for the accept proc. */
+
+ /*
+ * Only needed for client sockets
+ */
+
+ struct addrinfo *addrlist; /* Addresses to connect to. */
+ struct addrinfo *addr; /* Iterator over addrlist. */
+ struct addrinfo *myaddrlist;/* Local address. */
+ struct addrinfo *myaddr; /* Iterator over myaddrlist. */
+ int filehandlers; /* Caches FileHandlers that get set up while
+ * an async socket is not yet connected. */
+ int status; /* Cache status of async socket. */
+ int cachedBlocking; /* Cache blocking mode of async socket. */
+};
/*
* These bits may be ORed together into the "flags" field of a TcpState
@@ -53,9 +94,7 @@ typedef struct TcpState {
#ifndef SOMAXCONN
# define SOMAXCONN 100
-#endif /* SOMAXCONN */
-
-#if (SOMAXCONN < 100)
+#elif (SOMAXCONN < 100)
# undef SOMAXCONN
# define SOMAXCONN 100
#endif /* SOMAXCONN < 100 */
@@ -71,19 +110,14 @@ typedef struct TcpState {
* Static routines for this file:
*/
-static TcpState * CreateSocket(Tcl_Interp *interp, int port,
- const char *host, int server, const char *myaddr,
- int myport, int async);
-static int CreateSocketAddress(struct sockaddr_in *sockaddrPtr,
- const char *host, int port, int willBind,
- const char **errorMsgPtr);
+static int CreateClientSocket(Tcl_Interp *interp,
+ TcpState *state);
static void TcpAccept(ClientData data, int mask);
static int TcpBlockModeProc(ClientData data, int mode);
static int TcpCloseProc(ClientData instanceData,
Tcl_Interp *interp);
static int TcpClose2Proc(ClientData instanceData,
- Tcl_Interp *interp,
- int flags);
+ Tcl_Interp *interp, int flags);
static int TcpGetHandleProc(ClientData instanceData,
int direction, ClientData *handlePtr);
static int TcpGetOptionProc(ClientData instanceData,
@@ -95,6 +129,7 @@ static int TcpOutputProc(ClientData instanceData,
const char *buf, int toWrite, int *errorCode);
static void TcpWatchProc(ClientData instanceData, int mask);
static int WaitForConnect(TcpState *statePtr, int *errorCodePtr);
+
/*
* This structure describes the channel type structure for TCP socket
* based IO:
@@ -120,7 +155,6 @@ static const Tcl_ChannelType tcpChannelType = {
NULL /* truncate proc. */
};
-
/*
* The following variable holds the network name of this host.
*/
@@ -128,7 +162,6 @@ static const Tcl_ChannelType tcpChannelType = {
static TclInitProcessGlobalValueProc InitializeHostName;
static ProcessGlobalValue hostName =
{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
-
/*
*----------------------------------------------------------------------
@@ -169,7 +202,7 @@ InitializeHostName(
char *dot = strchr(u.nodename, '.');
if (dot != NULL) {
- char *node = ckalloc((unsigned) (dot - u.nodename + 1));
+ char *node = ckalloc(dot - u.nodename + 1);
memcpy(node, u.nodename, (size_t) (dot - u.nodename));
node[dot - u.nodename] = '\0';
@@ -186,7 +219,7 @@ InitializeHostName(
if (native == NULL) {
native = tclEmptyStringRep;
}
-#else
+#else /* !NO_UNAME */
/*
* Uname doesn't exist; try gethostname instead.
*
@@ -211,11 +244,11 @@ InitializeHostName(
if (gethostname(buffer, sizeof(buffer)) > -1) { /* INTL: Native. */
native = buffer;
}
-#endif
+#endif /* NO_UNAME */
*encodingPtr = Tcl_GetEncoding(NULL, NULL);
*lengthPtr = strlen(native);
- *valuePtr = ckalloc((unsigned) (*lengthPtr) + 1);
+ *valuePtr = ckalloc((*lengthPtr) + 1);
memcpy(*valuePtr, native, (size_t)(*lengthPtr)+1);
}
@@ -313,14 +346,18 @@ TcpBlockModeProc(
* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
if (mode == TCL_MODE_BLOCKING) {
CLEAR_BITS(statePtr->flags, TCP_ASYNC_SOCKET);
} else {
SET_BITS(statePtr->flags, TCP_ASYNC_SOCKET);
}
- if (TclUnixSetBlockingMode(statePtr->fd, mode) < 0) {
+ if (statePtr->flags & TCP_ASYNC_CONNECT) {
+ statePtr->cachedBlocking = mode;
+ return 0;
+ }
+ if (TclUnixSetBlockingMode(statePtr->fds.fd, mode) < 0) {
return errno;
}
return 0;
@@ -362,7 +399,7 @@ WaitForConnect(
timeOut = -1;
}
errno = 0;
- state = TclUnixWaitForFile(statePtr->fd,
+ state = TclUnixWaitForFile(statePtr->fds.fd,
TCL_WRITABLE | TCL_EXCEPTION, timeOut);
if (state & TCL_EXCEPTION) {
return -1;
@@ -408,14 +445,14 @@ TcpInputProc(
* buffer? */
int *errorCodePtr) /* Where to store error code. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
int bytesRead;
*errorCodePtr = 0;
if (WaitForConnect(statePtr, errorCodePtr) != 0) {
return -1;
}
- bytesRead = recv(statePtr->fd, buf, (size_t) bufSize, 0);
+ bytesRead = recv(statePtr->fds.fd, buf, (size_t) bufSize, 0);
if (bytesRead > -1) {
return bytesRead;
}
@@ -458,14 +495,14 @@ TcpOutputProc(
int toWrite, /* How many bytes to write? */
int *errorCodePtr) /* Where to store error code. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
int written;
*errorCodePtr = 0;
if (WaitForConnect(statePtr, errorCodePtr) != 0) {
return -1;
}
- written = send(statePtr->fd, buf, (size_t) toWrite, 0);
+ written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0);
if (written > -1) {
return written;
}
@@ -497,8 +534,9 @@ TcpCloseProc(
ClientData instanceData, /* The socket to close. */
Tcl_Interp *interp) /* For error reporting - unused. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
int errorCode = 0;
+ TcpFdList *fds;
/*
* Delete a file handler that may be active for this socket if this is a
@@ -507,14 +545,30 @@ TcpCloseProc(
* handlers are already deleted in the generic IO channel closing code
* that called this function, so we do not have to delete them here.
*/
-
- Tcl_DeleteFileHandler(statePtr->fd);
-
- if (close(statePtr->fd) < 0) {
- errorCode = errno;
+
+ for (fds = &statePtr->fds; fds != NULL; fds = fds->next) {
+ if (fds->fd < 0) {
+ continue;
+ }
+ Tcl_DeleteFileHandler(fds->fd);
+ if (close(fds->fd) < 0) {
+ errorCode = errno;
+ }
+
}
- ckfree((char *) statePtr);
-
+ fds = statePtr->fds.next;
+ while (fds != NULL) {
+ TcpFdList *next = fds->next;
+ ckfree(fds);
+ fds = next;
+ }
+ if (statePtr->addrlist != NULL) {
+ freeaddrinfo(statePtr->addrlist);
+ }
+ if (statePtr->myaddrlist != NULL) {
+ freeaddrinfo(statePtr->myaddrlist);
+ }
+ ckfree(statePtr);
return errorCode;
}
@@ -541,28 +595,29 @@ TcpClose2Proc(
Tcl_Interp *interp, /* For error reporting. */
int flags) /* Flags that indicate which side to close. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
int errorCode = 0;
int sd;
/*
* Shutdown the OS socket handle.
*/
- switch(flags)
- {
- case TCL_CLOSE_READ:
- sd=SHUT_RD;
- break;
- case TCL_CLOSE_WRITE:
- sd=SHUT_WR;
- break;
- default:
- if (interp) {
- Tcl_AppendResult(interp, "Socket close2proc called bidirectionally", NULL);
- }
- return TCL_ERROR;
- }
- if (shutdown(statePtr->fd,sd)<0) {
+
+ switch(flags) {
+ case TCL_CLOSE_READ:
+ sd = SHUT_RD;
+ break;
+ case TCL_CLOSE_WRITE:
+ sd = SHUT_WR;
+ break;
+ default:
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "socket close2proc called bidirectionally", -1));
+ }
+ return TCL_ERROR;
+ }
+ if (shutdown(statePtr->fds.fd,sd) < 0) {
errorCode = errno;
}
@@ -572,6 +627,74 @@ TcpClose2Proc(
/*
*----------------------------------------------------------------------
*
+ * TcpHostPortList --
+ *
+ * This function is called by the -gethostname and -getpeername
+ * switches of TcpGetOptionProc() to add three list elements
+ * with the textual representation of the given address to the
+ * given DString.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adds three elements do dsPtr
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TcpHostPortList(
+ Tcl_Interp *interp,
+ Tcl_DString *dsPtr,
+ address addr,
+ socklen_t salen)
+{
+#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
+ char host[NI_MAXHOST], nhost[NI_MAXHOST], nport[NI_MAXSERV];
+ int flags = 0;
+
+ getnameinfo(&addr.sa, salen,
+ nhost, sizeof(nhost), nport, sizeof(nport),
+ NI_NUMERICHOST | NI_NUMERICSERV);
+ Tcl_DStringAppendElement(dsPtr, nhost);
+ /*
+ * We don't want to resolve INADDR_ANY and sin6addr_any; they
+ * can sometimes cause problems (and never have a name).
+ */
+ if (addr.sa.sa_family == AF_INET) {
+ if (addr.sa4.sin_addr.s_addr == INADDR_ANY) {
+ flags |= NI_NUMERICHOST;
+ }
+#ifndef NEED_FAKE_RFC2553
+ } else if (addr.sa.sa_family == AF_INET6) {
+ if ((IN6_ARE_ADDR_EQUAL(&addr.sa6.sin6_addr,
+ &in6addr_any))
+ || (IN6_IS_ADDR_V4MAPPED(&addr.sa6.sin6_addr) &&
+ addr.sa6.sin6_addr.s6_addr[12] == 0 &&
+ addr.sa6.sin6_addr.s6_addr[13] == 0 &&
+ addr.sa6.sin6_addr.s6_addr[14] == 0 &&
+ addr.sa6.sin6_addr.s6_addr[15] == 0)) {
+ flags |= NI_NUMERICHOST;
+ }
+#endif /* NEED_FAKE_RFC2553 */
+ }
+ /* Check if reverse DNS has been switched off globally */
+ if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
+ flags |= NI_NUMERICHOST;
+ }
+ if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0, flags) == 0) {
+ /* Reverse mapping worked */
+ Tcl_DStringAppendElement(dsPtr, host);
+ } else {
+ /* Reverse mappong failed - use the numeric rep once more */
+ Tcl_DStringAppendElement(dsPtr, nhost);
+ }
+ Tcl_DStringAppendElement(dsPtr, nport);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TcpGetOptionProc --
*
* Computes an option value for a TCP socket based channel, or a list of
@@ -600,13 +723,8 @@ TcpGetOptionProc(
Tcl_DString *dsPtr) /* Where to store the computed value;
* initialized by caller. */
{
- TcpState *statePtr = (TcpState *) instanceData;
- struct sockaddr_in sockname;
- struct sockaddr_in peername;
- struct hostent *hostEntPtr;
- socklen_t size = sizeof(struct sockaddr_in);
+ TcpState *statePtr = instanceData;
size_t len = 0;
- char buf[TCL_INTEGER_SPACE];
if (optionName != NULL) {
len = strlen(optionName);
@@ -617,46 +735,37 @@ TcpGetOptionProc(
socklen_t optlen = sizeof(int);
int err, ret;
- ret = getsockopt(statePtr->fd, SOL_SOCKET, SO_ERROR,
- (char *)&err, &optlen);
- if (ret < 0) {
- err = errno;
- }
+ if (statePtr->status == 0) {
+ ret = getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR,
+ (char *) &err, &optlen);
+ if (ret < 0) {
+ err = errno;
+ }
+ } else {
+ err = statePtr->status;
+ statePtr->status = 0;
+ }
if (err != 0) {
Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(err), -1);
}
return TCL_OK;
}
- if ((len == 0) ||
- ((len > 1) && (optionName[1] == 'p') &&
- (strncmp(optionName, "-peername", len) == 0))) {
- if (getpeername(statePtr->fd, (struct sockaddr *) &peername,
- &size) >= 0) {
+ if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
+ (strncmp(optionName, "-peername", len) == 0))) {
+ address peername;
+ socklen_t size = sizeof(peername);
+
+ if (getpeername(statePtr->fds.fd, &peername.sa, &size) >= 0) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-peername");
Tcl_DStringStartSublist(dsPtr);
}
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
- hostEntPtr = TclpGetHostByAddr( /* INTL: Native. */
- (char *) &peername.sin_addr,
- sizeof(peername.sin_addr), AF_INET);
- if (hostEntPtr != NULL) {
- Tcl_DString ds;
-
- Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
- Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
- Tcl_DStringFree(&ds);
- } else {
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
- }
- TclFormatInt(buf, ntohs(peername.sin_port));
- Tcl_DStringAppendElement(dsPtr, buf);
- if (len == 0) {
- Tcl_DStringEndSublist(dsPtr);
- } else {
- return TCL_OK;
- }
+ TcpHostPortList(interp, dsPtr, peername, size);
+ if (len) {
+ return TCL_OK;
+ }
+ Tcl_DStringEndSublist(dsPtr);
} else {
/*
* getpeername failed - but if we were asked for all the options
@@ -667,57 +776,43 @@ TcpGetOptionProc(
if (len) {
if (interp) {
- Tcl_AppendResult(interp, "can't get peername: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get peername: %s",
+ Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
}
}
- if ((len == 0) ||
- ((len > 1) && (optionName[1] == 's') &&
+ if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
(strncmp(optionName, "-sockname", len) == 0))) {
- if (getsockname(statePtr->fd, (struct sockaddr *) &sockname,
- &size) >= 0) {
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-sockname");
- Tcl_DStringStartSublist(dsPtr);
+ TcpFdList *fds;
+ address sockname;
+ socklen_t size;
+ int found = 0;
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-sockname");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ for (fds = &statePtr->fds; fds != NULL; fds = fds->next) {
+ size = sizeof(sockname);
+ if (getsockname(fds->fd, &(sockname.sa), &size) >= 0) {
+ found = 1;
+ TcpHostPortList(interp, dsPtr, sockname, size);
}
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
- if (sockname.sin_addr.s_addr == INADDR_ANY) {
- /*
- * We don't want to resolve INADDR_ANY; it can sometimes cause
- * problems (and never has a name).
- */
-
- hostEntPtr = NULL;
- } else {
- hostEntPtr = TclpGetHostByAddr( /* INTL: Native. */
- (char *) &sockname.sin_addr,
- sizeof(sockname.sin_addr), AF_INET);
+ }
+ if (found) {
+ if (len) {
+ return TCL_OK;
+ }
+ Tcl_DStringEndSublist(dsPtr);
+ } else {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get sockname: %s", Tcl_PosixError(interp)));
}
- if (hostEntPtr != NULL) {
- Tcl_DString ds;
-
- Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
- Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
- Tcl_DStringFree(&ds);
- } else {
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
- }
- TclFormatInt(buf, ntohs(sockname.sin_port));
- Tcl_DStringAppendElement(dsPtr, buf);
- if (len == 0) {
- Tcl_DStringEndSublist(dsPtr);
- } else {
- return TCL_OK;
- }
- } else {
- if (interp) {
- Tcl_AppendResult(interp, "can't get sockname: ",
- Tcl_PosixError(interp), NULL);
- }
return TCL_ERROR;
}
}
@@ -753,22 +848,26 @@ TcpWatchProc(
* TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION. */
{
- TcpState *statePtr = (TcpState *) instanceData;
-
- /*
- * Make sure we don't mess with server sockets since they will never be
- * readable or writable at the Tcl level. This keeps Tcl scripts from
- * interfering with the -accept behavior.
- */
-
- if (!statePtr->acceptProc) {
- if (mask) {
- Tcl_CreateFileHandler(statePtr->fd, mask,
- (Tcl_FileProc *) Tcl_NotifyChannel,
- (ClientData) statePtr->channel);
- } else {
- Tcl_DeleteFileHandler(statePtr->fd);
- }
+ TcpState *statePtr = instanceData;
+
+ if (statePtr->acceptProc != NULL) {
+ /*
+ * Make sure we don't mess with server sockets since they will never
+ * be readable or writable at the Tcl level. This keeps Tcl scripts
+ * from interfering with the -accept behavior (bug #3394732).
+ */
+ return;
+ }
+
+ if (statePtr->flags & TCP_ASYNC_CONNECT) {
+ /* Async sockets use a FileHandler internally while connecting, so we
+ * need to cache this request until the connection has succeeded. */
+ statePtr->filehandlers = mask;
+ } else if (mask) {
+ Tcl_CreateFileHandler(statePtr->fds.fd, mask,
+ (Tcl_FileProc *) Tcl_NotifyChannel, statePtr->channel);
+ } else {
+ Tcl_DeleteFileHandler(statePtr->fds.fd);
}
}
@@ -797,304 +896,209 @@ TcpGetHandleProc(
int direction, /* Not used. */
ClientData *handlePtr) /* Where to store the handle. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
- *handlePtr = INT2PTR(statePtr->fd);
+ *handlePtr = INT2PTR(statePtr->fds.fd);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * CreateSocket --
- *
- * This function opens a new socket in client or server mode and
- * initializes the TcpState structure.
+ * TcpAsyncCallback --
*
- * Results:
- * Returns a new TcpState, or NULL with an error in the interp's result,
- * if interp is not NULL.
- *
- * Side effects:
- * Opens a socket.
+ * Called by the event handler that CreateClientSocket sets up
+ * internally for [socket -async] to get notified when the
+ * asyncronous connection attempt has succeeded or failed.
*
*----------------------------------------------------------------------
*/
-
-static TcpState *
-CreateSocket(
- Tcl_Interp *interp, /* For error reporting; can be NULL. */
- int port, /* Port number to open. */
- const char *host, /* Name of host on which to open port. NULL
- * implies INADDR_ANY */
- int server, /* 1 if socket should be a server socket, else
- * 0 for a client socket. */
- const char *myaddr, /* Optional client-side address */
- int myport, /* Optional client-side port */
- int async) /* If nonzero and creating a client socket,
- * attempt to do an async connect. Otherwise
- * do a synchronous connect or bind. */
+static void
+TcpAsyncCallback(
+ ClientData clientData, /* The socket state. */
+ int mask) /* Events of interest; an OR-ed combination of
+ * TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION. */
{
- int status = 0, sock = -1;
- struct sockaddr_in sockaddr; /* socket address */
- struct sockaddr_in mysockaddr; /* Socket address for client */
- TcpState *statePtr;
- const char *errorMsg = NULL;
-
- if (!CreateSocketAddress(&sockaddr, host, port, 0, &errorMsg)) {
- goto error;
- }
- if ((myaddr != NULL || myport != 0) &&
- !CreateSocketAddress(&mysockaddr, myaddr, myport, 1, &errorMsg)) {
- goto error;
- }
-
- sock = socket(AF_INET, SOCK_STREAM, 0);
- if (sock < 0) {
- goto error;
- }
-
- /*
- * Set the close-on-exec flag so that the socket will not get inherited by
- * child processes.
- */
-
- fcntl(sock, F_SETFD, FD_CLOEXEC);
-
- /*
- * Set kernel space buffering
- */
-
- TclSockMinimumBuffers(sock, SOCKET_BUFSIZE);
-
- status = 0;
- if (server) {
- /*
- * Set up to reuse server addresses automatically and bind to the
- * specified port.
- */
-
- int reuseaddr = 1;
- (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
- (char *) &reuseaddr, sizeof(reuseaddr));
- status = bind(sock, (struct sockaddr *) &sockaddr,
- sizeof(struct sockaddr));
- if (status != -1) {
- status = listen(sock, SOMAXCONN);
- }
- } else {
- if (myaddr != NULL || myport != 0) {
- int reuseaddr = 1;
- (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
- (char *) &reuseaddr, sizeof(reuseaddr));
- status = bind(sock, (struct sockaddr *) &mysockaddr,
- sizeof(struct sockaddr));
- if (status < 0) {
- goto error;
- }
- }
-
- /*
- * Attempt to connect. The connect may fail at present with an
- * EINPROGRESS but at a later time it will complete. The caller will
- * set up a file handler on the socket if she is interested in being
- * informed when the connect completes.
- */
-
- if (async) {
- status = TclUnixSetBlockingMode(sock, TCL_MODE_NONBLOCKING);
- if (status < 0) {
- goto error;
- }
- }
-
- status = connect(sock, (struct sockaddr *) &sockaddr,
- sizeof(sockaddr));
- if (status < 0) {
- if (errno == EINPROGRESS) {
- status = 0;
- } else {
- goto error;
- }
- }
- if (async) {
- /*
- * Restore blocking mode.
- */
- status = TclUnixSetBlockingMode(sock, TCL_MODE_BLOCKING);
- }
- }
-
- if (status < 0) {
-error:
- if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), NULL);
- if (errorMsg != NULL) {
- Tcl_AppendResult(interp, " (", errorMsg, ")", NULL);
- }
- }
- if (sock != -1) {
- close(sock);
- }
- return NULL;
- }
-
- /*
- * Allocate a new TcpState for this socket.
- */
-
- statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
- statePtr->flags = async ? TCP_ASYNC_CONNECT : 0;
- statePtr->fd = sock;
-
- return statePtr;
+ CreateClientSocket(NULL, clientData);
}
/*
*----------------------------------------------------------------------
*
- * CreateSocketAddress --
+ * CreateClientSocket --
*
- * This function initializes a sockaddr structure for a host and port.
+ * This function opens a new socket in client mode.
*
* Results:
- * 1 if the host was valid, 0 if the host could not be converted to an IP
- * address.
+ * TCL_OK, if the socket was successfully connected or an asynchronous
+ * connection is in progress. If an error occurs, TCL_ERROR is returned
+ * and an error message is left in interp.
*
* Side effects:
- * Fills in the *sockaddrPtr structure.
+ * Opens a socket.
+ *
+ * Remarks:
+ * A single host name may resolve to more than one IP address, e.g. for
+ * an IPv4/IPv6 dual stack host. For handling asyncronously connecting
+ * sockets in the background for such hosts, this function can act as a
+ * coroutine. On the first call, it sets up the control variables for the
+ * two nested loops over the local and remote addresses. Once the first
+ * connection attempt is in progress, it sets up itself as a writable
+ * event handler for that socket, and returns. When the callback occurs,
+ * control is transferred to the "reenter" label, right after the initial
+ * return and the loops resume as if they had never been interrupted.
+ * For syncronously connecting sockets, the loops work the usual way.
*
*----------------------------------------------------------------------
*/
static int
-CreateSocketAddress(
- struct sockaddr_in *sockaddrPtr, /* Socket address */
- const char *host, /* Host. NULL implies INADDR_ANY */
- int port, /* Port number */
- int willBind, /* Is this an address to bind() to or
- * to connect() to? */
- const char **errorMsgPtr) /* Place to store the error message
- * detail, if available. */
+CreateClientSocket(
+ Tcl_Interp *interp, /* For error reporting; can be NULL. */
+ TcpState *state)
{
-#ifdef HAVE_GETADDRINFO
- struct addrinfo hints, *resPtr = NULL;
- char *native;
- Tcl_DString ds;
- int result;
-
- if (host == NULL) {
- sockaddrPtr->sin_family = AF_INET;
- sockaddrPtr->sin_addr.s_addr = INADDR_ANY;
- addPort:
- sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
- return 1;
- }
+ socklen_t optlen;
+ int async_callback = (state->addr != NULL);
+ int status;
+ int async = state->flags & TCP_ASYNC_CONNECT;
- (void) memset(&hints, 0, sizeof(struct addrinfo));
- hints.ai_family = AF_INET;
- hints.ai_socktype = SOCK_STREAM;
- if (willBind) {
- hints.ai_flags |= AI_PASSIVE;
+ if (async_callback) {
+ goto reenter;
}
- /*
- * Note that getaddrinfo() *is* thread-safe. If a platform doesn't get
- * that right, it shouldn't use this part of the code.
- */
+ for (state->addr = state->addrlist; state->addr != NULL;
+ state->addr = state->addr->ai_next) {
+ status = -1;
- native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
- result = getaddrinfo(native, NULL, &hints, &resPtr);
- Tcl_DStringFree(&ds);
- if (result == 0) {
- memcpy(sockaddrPtr, resPtr->ai_addr, sizeof(struct sockaddr_in));
- freeaddrinfo(resPtr);
- goto addPort;
- }
+ for (state->myaddr = state->myaddrlist; state->myaddr != NULL;
+ state->myaddr = state->myaddr->ai_next) {
+ int reuseaddr;
+
+ /*
+ * No need to try combinations of local and remote addresses of
+ * different families.
+ */
- /*
- * Ought to use gai_strerror() here...
- */
+ if (state->myaddr->ai_family != state->addr->ai_family) {
+ continue;
+ }
- switch (result) {
- case EAI_NONAME:
- case EAI_SERVICE:
-#if defined(EAI_ADDRFAMILY) && EAI_ADDRFAMILY != EAI_NONAME
- case EAI_ADDRFAMILY:
-#endif
-#if defined(EAI_NODATA) && EAI_NODATA != EAI_NONAME
- case EAI_NODATA:
-#endif
- *errorMsgPtr = gai_strerror(result);
- errno = EHOSTUNREACH;
- return 0;
- case EAI_SYSTEM:
- return 0;
- default:
- *errorMsgPtr = gai_strerror(result);
- errno = ENXIO;
- return 0;
- }
-#else /* !HAVE_GETADDRINFO */
- struct in_addr addr; /* For 64/32 bit madness */
-
- (void) memset(sockaddrPtr, '\0', sizeof(struct sockaddr_in));
- sockaddrPtr->sin_family = AF_INET;
- sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
- if (host == NULL) {
- addr.s_addr = INADDR_ANY;
- } else {
- struct hostent *hostent; /* Host database entry */
- Tcl_DString ds;
- const char *native;
+ /*
+ * Close the socket if it is still open from the last unsuccessful
+ * iteration.
+ */
- if (host == NULL) {
- native = NULL;
- } else {
- native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
- }
- addr.s_addr = inet_addr(native); /* INTL: Native. */
+ if (state->fds.fd >= 0) {
+ close(state->fds.fd);
+ state->fds.fd = -1;
+ }
- /*
- * This is 0xFFFFFFFF to ensure that it compares as a 32bit -1 on
- * either 32 or 64 bits systems.
- */
+ state->fds.fd = socket(state->addr->ai_family, SOCK_STREAM, 0);
+ if (state->fds.fd < 0) {
+ continue;
+ }
- if (addr.s_addr == 0xFFFFFFFF) {
- hostent = TclpGetHostByName(native); /* INTL: Native. */
- if (hostent != NULL) {
- memcpy(&addr, hostent->h_addr_list[0],
- (size_t) hostent->h_length);
- } else {
-#ifdef EHOSTUNREACH
- errno = EHOSTUNREACH;
-#else /* !EHOSTUNREACH */
-#ifdef ENXIO
- errno = ENXIO;
-#endif /* ENXIO */
-#endif /* EHOSTUNREACH */
- if (native != NULL) {
- Tcl_DStringFree(&ds);
+ /*
+ * Set the close-on-exec flag so that the socket will not get
+ * inherited by child processes.
+ */
+
+ fcntl(state->fds.fd, F_SETFD, FD_CLOEXEC);
+
+ /*
+ * Set kernel space buffering
+ */
+
+ TclSockMinimumBuffers(INT2PTR(state->fds.fd), SOCKET_BUFSIZE);
+
+ if (async) {
+ status = TclUnixSetBlockingMode(state->fds.fd,
+ TCL_MODE_NONBLOCKING);
+ if (status < 0) {
+ continue;
}
- return 0; /* Error. */
}
- }
- if (native != NULL) {
- Tcl_DStringFree(&ds);
+
+ reuseaddr = 1;
+ (void) setsockopt(state->fds.fd, SOL_SOCKET, SO_REUSEADDR,
+ (char *) &reuseaddr, sizeof(reuseaddr));
+ status = bind(state->fds.fd, state->myaddr->ai_addr,
+ state->myaddr->ai_addrlen);
+ if (status < 0) {
+ continue;
+ }
+
+ /*
+ * Attempt to connect. The connect may fail at present with an
+ * EINPROGRESS but at a later time it will complete. The caller
+ * will set up a file handler on the socket if she is interested
+ * in being informed when the connect completes.
+ */
+
+ status = connect(state->fds.fd, state->addr->ai_addr,
+ state->addr->ai_addrlen);
+ if (status < 0 && errno == EINPROGRESS) {
+ Tcl_CreateFileHandler(state->fds.fd,
+ TCL_WRITABLE|TCL_EXCEPTION, TcpAsyncCallback, state);
+ return TCL_OK;
+
+ reenter:
+ Tcl_DeleteFileHandler(state->fds.fd);
+
+ /*
+ * Read the error state from the socket to see if the async
+ * connection has succeeded or failed. As this clears the
+ * error condition, we cache the status in the socket state
+ * struct for later retrieval by [fconfigure -error].
+ */
+
+ optlen = sizeof(int);
+ getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR,
+ (char *) &status, &optlen);
+ state->status = status;
+ }
+ if (status == 0) {
+ CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT);
+ goto out;
+ }
}
}
- /*
- * NOTE: On 64 bit machines the assignment below is rumored to not do the
- * right thing. Please report errors related to this if you observe
- * incorrect behavior on 64 bit machines such as DEC Alphas. Should we
- * modify this code to do an explicit memcpy?
- */
-
- sockaddrPtr->sin_addr.s_addr = addr.s_addr;
- return 1; /* Success. */
-#endif /* HAVE_GETADDRINFO */
+out:
+
+ if (async_callback) {
+ /*
+ * An asynchonous connection has finally succeeded or failed.
+ */
+
+ TcpWatchProc(state, state->filehandlers);
+ TclUnixSetBlockingMode(state->fds.fd, state->cachedBlocking);
+
+ /*
+ * We need to forward the writable event that brought us here, bcasue
+ * upon reading of getsockopt(SO_ERROR), at least some OSes clear the
+ * writable state from the socket, and so a subsequent select() on
+ * behalf of a script level [fileevent] would not fire. It doesn't
+ * hurt that this is also called in the successful case and will save
+ * the event mechanism one roundtrip through select().
+ */
+
+ Tcl_NotifyChannel(state->channel, TCL_WRITABLE);
+ } else if (status != 0) {
+ /*
+ * Failure for either a synchronous connection, or an async one that
+ * failed before it could enter background mode, e.g. because an
+ * invalid -myaddr was given.
+ */
+
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open socket: %s", Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
}
/*
@@ -1125,31 +1129,57 @@ Tcl_OpenTcpClient(
* connect. Otherwise we do a blocking
* connect. */
{
- TcpState *statePtr;
- char channelName[16 + TCL_INTEGER_SPACE];
+ TcpState *state;
+ const char *errorMsg = NULL;
+ struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
+ char channelName[SOCK_CHAN_LENGTH];
/*
- * Create a new client socket and wrap it in a channel.
+ * Do the name lookups for the local and remote addresses.
*/
- statePtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
- if (statePtr == NULL) {
- return NULL;
+ if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
+ || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
+ &errorMsg)) {
+ if (addrlist != NULL) {
+ freeaddrinfo(addrlist);
+ }
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open socket: %s", errorMsg));
+ }
+ return NULL;
}
- statePtr->acceptProc = NULL;
- statePtr->acceptProcData = NULL;
+ /*
+ * Allocate a new TcpState for this socket.
+ */
+ state = ckalloc(sizeof(TcpState));
+ memset(state, 0, sizeof(TcpState));
+ state->flags = async ? TCP_ASYNC_CONNECT : 0;
+ state->cachedBlocking = TCL_MODE_BLOCKING;
+ state->addrlist = addrlist;
+ state->myaddrlist = myaddrlist;
+ state->fds.fd = -1;
- sprintf(channelName, "sock%d", statePtr->fd);
+ /*
+ * Create a new client socket and wrap it in a channel.
+ */
+ if (CreateClientSocket(interp, state) != TCL_OK) {
+ TcpCloseProc(state, NULL);
+ return NULL;
+ }
- statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- statePtr, (TCL_READABLE | TCL_WRITABLE));
- if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
+ sprintf(channelName, SOCK_TEMPLATE, (long) state);
+
+ state->channel = Tcl_CreateChannel(&tcpChannelType, channelName, state,
+ (TCL_READABLE | TCL_WRITABLE));
+ if (Tcl_SetChannelOption(interp, state->channel, "-translation",
"auto crlf") == TCL_ERROR) {
- Tcl_Close(NULL, statePtr->channel);
+ Tcl_Close(NULL, state->channel);
return NULL;
}
- return statePtr->channel;
+ return state->channel;
}
/*
@@ -1199,15 +1229,14 @@ TclpMakeTcpClientChannelMode(
* TCL_WRITABLE to indicate file mode. */
{
TcpState *statePtr;
- char channelName[16 + TCL_INTEGER_SPACE];
+ char channelName[SOCK_CHAN_LENGTH];
- statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
- statePtr->fd = PTR2INT(sock);
+ statePtr = ckalloc(sizeof(TcpState));
+ memset(statePtr, 0, sizeof(TcpState));
+ statePtr->fds.fd = PTR2INT(sock);
statePtr->flags = 0;
- statePtr->acceptProc = NULL;
- statePtr->acceptProcData = NULL;
- sprintf(channelName, "sock%d", statePtr->fd);
+ sprintf(channelName, SOCK_TEMPLATE, (long)statePtr);
statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
statePtr, mode);
@@ -1246,32 +1275,164 @@ Tcl_OpenTcpServer(
* clients. */
ClientData acceptProcData) /* Data for the callback. */
{
- TcpState *statePtr;
- char channelName[16 + TCL_INTEGER_SPACE];
+ int status = 0, sock = -1, reuseaddr = 1, chosenport = 0;
+ struct addrinfo *addrlist = NULL, *addrPtr; /* socket address */
+ TcpState *statePtr = NULL;
+ char channelName[SOCK_CHAN_LENGTH];
+ const char *errorMsg = NULL;
+ TcpFdList *fds = NULL, *newfds;
/*
- * Create a new client socket and wrap it in a channel.
+ * Try to record and return the most meaningful error message, i.e. the
+ * one from the first socket that went the farthest before it failed.
*/
- statePtr = CreateSocket(interp, port, myHost, 1, NULL, 0, 0);
- if (statePtr == NULL) {
- return NULL;
+ enum { LOOKUP, SOCKET, BIND, LISTEN } howfar = LOOKUP;
+ int my_errno = 0;
+
+ if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
+ my_errno = errno;
+ goto error;
}
- statePtr->acceptProc = acceptProc;
- statePtr->acceptProcData = acceptProcData;
+ for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
+ sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
+ addrPtr->ai_protocol);
+ if (sock == -1) {
+ if (howfar < SOCKET) {
+ howfar = SOCKET;
+ my_errno = errno;
+ }
+ continue;
+ }
+
+ /*
+ * Set the close-on-exec flag so that the socket will not get
+ * inherited by child processes.
+ */
+
+ fcntl(sock, F_SETFD, FD_CLOEXEC);
+
+ /*
+ * Set kernel space buffering
+ */
+
+ TclSockMinimumBuffers(INT2PTR(sock), SOCKET_BUFSIZE);
+
+ /*
+ * Set up to reuse server addresses automatically and bind to the
+ * specified port.
+ */
+
+ (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
+ (char *) &reuseaddr, sizeof(reuseaddr));
+
+ /*
+ * Make sure we use the same port number when opening two server
+ * sockets for IPv4 and IPv6 on a random port.
+ *
+ * As sockaddr_in6 uses the same offset and size for the port member
+ * as sockaddr_in, we can handle both through the IPv4 API.
+ */
+
+ if (port == 0 && chosenport != 0) {
+ ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
+ htons(chosenport);
+ }
- /*
- * Set up the callback mechanism for accepting connections from new
- * clients.
- */
+#ifdef IPV6_V6ONLY
+ /* Missing on: Solaris 2.8 */
+ if (addrPtr->ai_family == AF_INET6) {
+ int v6only = 1;
- Tcl_CreateFileHandler(statePtr->fd, TCL_READABLE, TcpAccept,
- statePtr);
- sprintf(channelName, "sock%d", statePtr->fd);
- statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- statePtr, 0);
- return statePtr->channel;
+ (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY,
+ &v6only, sizeof(v6only));
+ }
+#endif /* IPV6_V6ONLY */
+
+ status = bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen);
+ if (status == -1) {
+ if (howfar < BIND) {
+ howfar = BIND;
+ my_errno = errno;
+ }
+ close(sock);
+ continue;
+ }
+ if (port == 0 && chosenport == 0) {
+ address sockname;
+ socklen_t namelen = sizeof(sockname);
+
+ /*
+ * Synchronize port numbers when binding to port 0 of multiple
+ * addresses.
+ */
+
+ if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
+ chosenport = ntohs(sockname.sa4.sin_port);
+ }
+ }
+ status = listen(sock, SOMAXCONN);
+ if (status < 0) {
+ if (howfar < LISTEN) {
+ howfar = LISTEN;
+ my_errno = errno;
+ }
+ close(sock);
+ continue;
+ }
+ if (statePtr == NULL) {
+ /*
+ * Allocate a new TcpState for this socket.
+ */
+
+ statePtr = ckalloc(sizeof(TcpState));
+ memset(statePtr, 0, sizeof(TcpState));
+ statePtr->acceptProc = acceptProc;
+ statePtr->acceptProcData = acceptProcData;
+ sprintf(channelName, SOCK_TEMPLATE, (long) statePtr);
+ newfds = &statePtr->fds;
+ } else {
+ newfds = ckalloc(sizeof(TcpFdList));
+ memset(newfds, (int) 0, sizeof(TcpFdList));
+ fds->next = newfds;
+ }
+ newfds->fd = sock;
+ newfds->statePtr = statePtr;
+ fds = newfds;
+
+ /*
+ * Set up the callback mechanism for accepting connections from new
+ * clients.
+ */
+
+ Tcl_CreateFileHandler(sock, TCL_READABLE, TcpAccept, fds);
+ }
+
+ error:
+ if (addrlist != NULL) {
+ freeaddrinfo(addrlist);
+ }
+ if (statePtr != NULL) {
+ statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+ statePtr, 0);
+ return statePtr->channel;
+ }
+ if (interp != NULL) {
+ Tcl_Obj *errorObj = Tcl_NewStringObj("couldn't open socket: ", -1);
+
+ if (errorMsg == NULL) {
+ errno = my_errno;
+ Tcl_AppendToObj(errorObj, Tcl_PosixError(interp), -1);
+ } else {
+ Tcl_AppendToObj(errorObj, errorMsg, -1);
+ }
+ Tcl_SetObjResult(interp, errorObj);
+ }
+ if (sock != -1) {
+ close(sock);
+ }
+ return NULL;
}
/*
@@ -1296,17 +1457,16 @@ TcpAccept(
ClientData data, /* Callback token. */
int mask) /* Not used. */
{
- TcpState *sockState; /* Client data of server socket. */
+ TcpFdList *fds = data; /* Client data of server socket. */
int newsock; /* The new client socket */
TcpState *newSockState; /* State for new socket. */
- struct sockaddr_in addr; /* The remote address */
+ address addr; /* The remote address */
socklen_t len; /* For accept interface */
- char channelName[16 + TCL_INTEGER_SPACE];
-
- sockState = (TcpState *) data;
-
- len = sizeof(struct sockaddr_in);
- newsock = accept(sockState->fd, (struct sockaddr *) &addr, &len);
+ char channelName[SOCK_CHAN_LENGTH];
+ char host[NI_MAXHOST], port[NI_MAXSERV];
+
+ len = sizeof(addr);
+ newsock = accept(fds->fd, &addr.sa, &len);
if (newsock < 0) {
return;
}
@@ -1318,24 +1478,23 @@ TcpAccept(
(void) fcntl(newsock, F_SETFD, FD_CLOEXEC);
- newSockState = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
-
+ newSockState = ckalloc(sizeof(TcpState));
+ memset(newSockState, 0, sizeof(TcpState));
newSockState->flags = 0;
- newSockState->fd = newsock;
- newSockState->acceptProc = NULL;
- newSockState->acceptProcData = NULL;
+ newSockState->fds.fd = newsock;
- sprintf(channelName, "sock%d", newsock);
+ sprintf(channelName, SOCK_TEMPLATE, (long) newSockState);
newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
newSockState, (TCL_READABLE | TCL_WRITABLE));
Tcl_SetChannelOption(NULL, newSockState->channel, "-translation",
"auto crlf");
- if (sockState->acceptProc != NULL) {
- sockState->acceptProc(sockState->acceptProcData,
- newSockState->channel, inet_ntoa(addr.sin_addr),
- ntohs(addr.sin_port));
+ if (fds->statePtr->acceptProc != NULL) {
+ getnameinfo(&addr.sa, len, host, sizeof(host), port, sizeof(port),
+ NI_NUMERICHOST|NI_NUMERICSERV);
+ fds->statePtr->acceptProc(fds->statePtr->acceptProcData,
+ newSockState->channel, host, atoi(port));
}
}
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index f51cf2e..46fc972 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -6,10 +6,8 @@
* Copyright (c) 1996-1997 Sun Microsystems, Inc.
* Copyright (c) 1998 by Scriptics Corporation.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUnixTest.c,v 1.34 2010/06/21 11:23:23 nijtmans Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef USE_TCL_STUBS
@@ -40,8 +38,8 @@
*/
typedef struct Pipe {
- TclFile readFile; /* File handle for reading from the pipe.
- * NULL means pipe doesn't exist yet. */
+ TclFile readFile; /* File handle for reading from the pipe. NULL
+ * means pipe doesn't exist yet. */
TclFile writeFile; /* File handle for writing from the pipe. */
int readCount; /* Number of times the file handler for this
* file has triggered and the file was
@@ -701,7 +699,7 @@ TestchmodCmd(
char *rest;
if (argc < 2) {
- usage:
+ usage:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" mode file ?file ...?", NULL);
return TCL_ERROR;
@@ -729,3 +727,12 @@ TestchmodCmd(
}
return TCL_OK;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index e1ffb9e..789dbb6 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -9,16 +9,12 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUnixThrd.c,v 1.63 2010/06/16 14:49:51 nijtmans Exp $
*/
#include "tclInt.h"
#ifdef TCL_THREADS
-#include <pthread.h>
-
typedef struct ThreadSpecificData {
char nabuf[16];
} ThreadSpecificData;
@@ -432,7 +428,7 @@ Tcl_MutexLock(
* Double inside master lock check to avoid a race condition.
*/
- pmutexPtr = (pthread_mutex_t *) ckalloc(sizeof(pthread_mutex_t));
+ pmutexPtr = ckalloc(sizeof(pthread_mutex_t));
pthread_mutex_init(pmutexPtr, NULL);
*mutexPtr = (Tcl_Mutex)pmutexPtr;
TclRememberMutex(mutexPtr);
@@ -496,7 +492,7 @@ TclpFinalizeMutex(
if (pmutexPtr != NULL) {
pthread_mutex_destroy(pmutexPtr);
- ckfree((char *) pmutexPtr);
+ ckfree(pmutexPtr);
*mutexPtr = NULL;
}
}
@@ -542,9 +538,9 @@ Tcl_ConditionWait(
*/
if (*condPtr == NULL) {
- pcondPtr = (pthread_cond_t *) ckalloc(sizeof(pthread_cond_t));
+ pcondPtr = ckalloc(sizeof(pthread_cond_t));
pthread_cond_init(pcondPtr, NULL);
- *condPtr = (Tcl_Condition)pcondPtr;
+ *condPtr = (Tcl_Condition) pcondPtr;
TclRememberCondition(condPtr);
}
MASTER_UNLOCK;
@@ -626,9 +622,10 @@ TclpFinalizeCondition(
Tcl_Condition *condPtr)
{
pthread_cond_t *pcondPtr = *(pthread_cond_t **)condPtr;
+
if (pcondPtr != NULL) {
pthread_cond_destroy(pcondPtr);
- ckfree((char *) pcondPtr);
+ ckfree(pcondPtr);
*condPtr = NULL;
}
}
@@ -637,7 +634,7 @@ TclpFinalizeCondition(
/*
*----------------------------------------------------------------------
*
- * TclpReaddir, TclpLocaltime, TclpGmtime, TclpInetNtoa --
+ * TclpReaddir, TclpInetNtoa --
*
* These procedures replace core C versions to be used in a threaded
* environment.
diff --git a/unix/tclUnixThrd.h b/unix/tclUnixThrd.h
index a4f6fc6..6a73132 100644
--- a/unix/tclUnixThrd.h
+++ b/unix/tclUnixThrd.h
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * SCCS: @(#)
*/
#ifndef _TCLUNIXTHRD
diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c
index 01217b6..c7921fe 100644
--- a/unix/tclUnixTime.c
+++ b/unix/tclUnixTime.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclUnixTime.c,v 1.38 2010/03/14 14:59:25 dkf Exp $
*/
#include "tclInt.h"
@@ -226,122 +224,6 @@ TclpWideClicksToNanoseconds(
/*
*----------------------------------------------------------------------
*
- * TclpGetTimeZone --
- *
- * Determines the current timezone. The method varies wildly between
- * different platform implementations, so its hidden in this function.
- *
- * Results:
- * The return value is the local time zone, measured in minutes away from
- * GMT (-ve for east, +ve for west).
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpGetTimeZone(
- unsigned long currentTime)
-{
- int timeZone;
-
- /*
- * We prefer first to use the time zone in "struct tm" if the structure
- * contains such a member. Following that, we try to locate the external
- * 'timezone' variable and use its value. If both of those methods fail,
- * we attempt to convert a known time to local time and use the difference
- * from UTC as the local time zone. In all cases, we need to undo any
- * Daylight Saving Time adjustment.
- */
-
-#if defined(HAVE_TM_TZADJ)
-#define TCL_GOT_TIMEZONE
- /*
- * Struct tm contains tm_tzadj - that value may be used.
- */
-
- time_t curTime = (time_t) currentTime;
- struct tm *timeDataPtr = TclpLocaltime(&curTime);
-
- timeZone = timeDataPtr->tm_tzadj / 60;
- if (timeDataPtr->tm_isdst) {
- timeZone += 60;
- }
-#endif
-
-#if defined(HAVE_TM_GMTOFF) && !defined (TCL_GOT_TIMEZONE)
-#define TCL_GOT_TIMEZONE
- /*
- * Struct tm contains tm_gmtoff - that value may be used.
- */
-
- time_t curTime = (time_t) currentTime;
- struct tm *timeDataPtr = TclpLocaltime(&curTime);
-
- timeZone = -(timeDataPtr->tm_gmtoff / 60);
- if (timeDataPtr->tm_isdst) {
- timeZone += 60;
- }
-#endif
-
-#if defined(HAVE_TIMEZONE_VAR) && !defined(TCL_GOT_TIMEZONE) && !defined(USE_DELTA_FOR_TZ)
-#define TCL_GOT_TIMEZONE
- /*
- * The 'timezone' external var is present and may be used.
- */
-
- SetTZIfNecessary();
-
- /*
- * Note: this is not a typo in "timezone" below! See tzset documentation
- * for details.
- */
-
- timeZone = timezone / 60;
-#endif
-
-#if !defined(TCL_GOT_TIMEZONE)
-#define TCL_GOT_TIMEZONE
- /*
- * Fallback - determine time zone with a known reference time.
- */
-
- time_t tt;
- struct tm *stm;
-
- tt = 849268800L; /* 1996-11-29 12:00:00 GMT */
- stm = TclpLocaltime(&tt); /* eg 1996-11-29 6:00:00 CST6CDT */
-
- /*
- * The calculation below assumes a max of +12 or -12 hours from GMT.
- */
-
- timeZone = (12 - stm->tm_hour)*60 + (0 - stm->tm_min);
- if (stm->tm_isdst) {
- timeZone += 60;
- }
-
- /*
- * Now have offset for our known reference time, eg +360 for CST6CDT.
- */
-#endif
-
-#ifndef TCL_GOT_TIMEZONE
- /*
- * Cause fatal compile error, we don't know how to get timezone.
- */
-
-#error autoconf did not figure out how to determine the timezone.
-#endif
-
- return timeZone;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_GetTime --
*
* Gets the current system time in seconds and microseconds since the
@@ -433,17 +315,6 @@ TclpGmtime(
return &tsdPtr->gmtime_buf;
}
-
-/*
- * Forwarder for obsolete item in Stubs
- */
-
-struct tm *
-TclpGmtime_unix(
- const time_t *timePtr)
-{
- return TclpGmtime(timePtr);
-}
/*
*----------------------------------------------------------------------
@@ -484,15 +355,6 @@ TclpLocaltime(
return &tsdPtr->localtime_buf;
}
-/*
- * Forwarder for obsolete item in Stubs
- */
-struct tm*
-TclpLocaltime_unix(
- const time_t *timePtr)
-{
- return TclpLocaltime(timePtr);
-}
/*
*----------------------------------------------------------------------
diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c
index ab82c58..e289e8c 100644
--- a/unix/tclXtNotify.c
+++ b/unix/tclXtNotify.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclXtNotify.c,v 1.12 2010/06/14 12:58:12 nijtmans Exp $
*/
#ifndef USE_TCL_STUBS
@@ -18,9 +16,6 @@
#include <X11/Intrinsic.h>
#include "tclInt.h"
-#ifndef CONST86
-# define CONST86
-#endif
/*
* This structure is used to keep track of the notifier info for a a
* registered file.
@@ -87,10 +82,10 @@ static void FileProc(ClientData clientData, int *source,
static void NotifierExitHandler(ClientData clientData);
static void TimerProc(ClientData clientData, XtIntervalId *id);
static void CreateFileHandler(int fd, int mask,
- Tcl_FileProc * proc, ClientData clientData);
+ Tcl_FileProc *proc, ClientData clientData);
static void DeleteFileHandler(int fd);
-static void SetTimer(CONST86 Tcl_Time * timePtr);
-static int WaitForEvent(CONST86 Tcl_Time * timePtr);
+static void SetTimer(const Tcl_Time * timePtr);
+static int WaitForEvent(const Tcl_Time * timePtr);
/*
* Functions defined in this file for use by users of the Xt Notifier:
@@ -267,7 +262,7 @@ NotifierExitHandler(
static void
SetTimer(
- CONST86 Tcl_Time *timePtr) /* Timeout value, may be NULL. */
+ const Tcl_Time *timePtr) /* Timeout value, may be NULL. */
{
long timeout;
@@ -360,7 +355,7 @@ CreateFileHandler(
}
}
if (filePtr == NULL) {
- filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
+ filePtr = ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->read = 0;
filePtr->write = 0;
@@ -471,7 +466,7 @@ DeleteFileHandler(
if (filePtr->mask & TCL_EXCEPTION) {
XtRemoveInput(filePtr->except);
}
- ckfree((char *) filePtr);
+ ckfree(filePtr);
}
/*
@@ -526,7 +521,7 @@ FileProc(
*/
filePtr->readyMask |= mask;
- fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));
+ fileEvPtr = ckalloc(sizeof(FileHandlerEvent));
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
@@ -631,7 +626,7 @@ FileHandlerEventProc(
static int
WaitForEvent(
- CONST86 Tcl_Time *timePtr) /* Maximum block time, or NULL. */
+ const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
int timeout;
diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c
index d921074..fcb0773 100644
--- a/unix/tclXtTest.c
+++ b/unix/tclXtTest.c
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclXtTest.c,v 1.12 2010/06/21 11:23:23 nijtmans Exp $
*/
#ifndef USE_TCL_STUBS
@@ -126,3 +124,12 @@ TesteventloopCmd(
}
return TCL_OK;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */
diff --git a/unix/tclooConfig.sh b/unix/tclooConfig.sh
index 86959ac..721825b 100644
--- a/unix/tclooConfig.sh
+++ b/unix/tclooConfig.sh
@@ -8,8 +8,6 @@
# this all out for themselves.
#
# The information in this file is specific to a single platform.
-#
-# RCS: @(#) $Id: tclooConfig.sh,v 1.2 2009/11/27 07:27:53 dkf Exp $
# These are mostly empty because no special steps are ever needed from Tcl 8.6
# onwards; all libraries and include files are just part of Tcl.
@@ -17,5 +15,5 @@ TCLOO_LIB_SPEC=""
TCLOO_STUB_LIB_SPEC=""
TCLOO_INCLUDE_SPEC=""
TCLOO_PRIVATE_INCLUDE_SPEC=""
-TCLOO_CFLAGS=-DUSE_TCLOO_STUBS
-TCLOO_VERSION=0.6.2
+TCLOO_CFLAGS=""
+TCLOO_VERSION=1.0
diff --git a/win/.cvsignore b/win/.cvsignore
deleted file mode 100644
index c3044c9..0000000
--- a/win/.cvsignore
+++ /dev/null
@@ -1,31 +0,0 @@
-Debug
-Release
-autom4te.cache
-pkgs
-*.a
-*.opt
-*.ncb
-*.plg
-*.00?
-*.o
-*.obj
-*.i
-*.asm
-*.dll
-*.exe
-Makefile
-tcl.hpj
-tclConfig.sh
-config.status
-.#*
-tcl.sln
-tcl.suo
-*.manifest
-*.res
-*.exp
-*.lib
-*.pdb
-*.ilk
-*.pch
-versions.vc
-vercl.x
diff --git a/win/Makefile.in b/win/Makefile.in
index 0c0c0bb..8cfb68c 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -3,8 +3,6 @@
# is a template for a Makefile; to generate the actual Makefile, run
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
-#
-# RCS: @(#) $Id: Makefile.in,v 1.184 2010/08/30 09:19:38 nijtmans Exp $
VERSION = @TCL_VERSION@
@@ -92,7 +90,7 @@ COMPILE_DEBUG_FLAGS =
SRC_DIR = @srcdir@
ROOT_DIR = @srcdir@/..
-TOP_DIR = $(shell cd @srcdir@/..; pwd)
+TOP_DIR = $(shell cd @srcdir@/..; pwd -P)
GENERIC_DIR = $(TOP_DIR)/generic
TOMMATH_DIR = $(TOP_DIR)/libtommath
WIN_DIR = $(TOP_DIR)/win
@@ -114,7 +112,7 @@ ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)' | sed 's!\\!/!g')
# Fully qualify library path so that `make test`
# does not depend on the current directory.
-LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd)
+LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd -P)
LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)' | sed 's!\\!/!g')
DLLSUFFIX = @DLLSUFFIX@
LIBSUFFIX = @LIBSUFFIX@
@@ -139,19 +137,19 @@ TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX}
ZLIB_DLL_FILE = zlib1.dll
SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@
-STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE)
-
-# TCL_EXE is the name of a tclsh executable that is available *BEFORE* running
-# make for the first time. Certain build targets (make genstubs) need it to be
-# available on the PATH. This executable should *NOT* be required just to do a
-# normal build although it can be required to run make dist.
-TCL_EXE = tclsh
+STATIC_LIBRARIES = $(TCL_LIB_FILE)
TCLSH = tclsh$(VER)${EXESUFFIX}
-TCLTEST = tcltest${EXEEXT}
CAT32 = cat32$(EXEEXT)
MAN2TCL = man2tcl$(EXEEXT)
+# For cross-compiled builds, TCL_EXE is the name of a tclsh executable that is
+# available *BEFORE* running make for the first time. Certain build targets
+# (make genstubs, make install) need it to be available on the PATH. This
+# executable should *NOT* be required just to do a normal build although
+# it can be required to run make dist.
+TCL_EXE = @TCL_EXE@
+
@SET_MAKE@
# Setting the VPATH variable to a list of paths will cause the Makefile to
@@ -212,6 +210,7 @@ GENERIC_OBJS = \
regfree.$(OBJEXT) \
regerror.$(OBJEXT) \
tclAlloc.$(OBJEXT) \
+ tclAssembly.$(OBJEXT) \
tclAsync.$(OBJEXT) \
tclBasic.$(OBJEXT) \
tclBinary.$(OBJEXT) \
@@ -251,6 +250,7 @@ GENERIC_OBJS = \
tclListObj.$(OBJEXT) \
tclLoad.$(OBJEXT) \
tclMain.$(OBJEXT) \
+ tclMain2.$(OBJEXT) \
tclNamesp.$(OBJEXT) \
tclNotify.$(OBJEXT) \
tclOO.$(OBJEXT) \
@@ -303,6 +303,7 @@ TOMMATH_OBJS = \
bn_mp_cmp.${OBJEXT} \
bn_mp_cmp_d.${OBJEXT} \
bn_mp_cmp_mag.${OBJEXT} \
+ bn_mp_cnt_lsb.${OBJEXT} \
bn_mp_copy.${OBJEXT} \
bn_mp_count_bits.${OBJEXT} \
bn_mp_div.${OBJEXT} \
@@ -317,6 +318,7 @@ TOMMATH_OBJS = \
bn_mp_init_copy.${OBJEXT} \
bn_mp_init_multi.${OBJEXT} \
bn_mp_init_set.${OBJEXT} \
+ bn_mp_init_set_int.${OBJEXT} \
bn_mp_init_size.${OBJEXT} \
bn_mp_karatsuba_mul.${OBJEXT} \
bn_mp_karatsuba_sqr.$(OBJEXT) \
@@ -334,6 +336,7 @@ TOMMATH_OBJS = \
bn_mp_read_radix.${OBJEXT} \
bn_mp_rshd.${OBJEXT} \
bn_mp_set.${OBJEXT} \
+ bn_mp_set_int.${OBJEXT} \
bn_mp_shrink.${OBJEXT} \
bn_mp_sqr.${OBJEXT} \
bn_mp_sqrt.${OBJEXT} \
@@ -399,7 +402,7 @@ TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]
all: binaries libraries doc packages
-tcltest: $(TCLTEST)
+tcltest: $(TCLSH) $(TEST_DLL_FILE)
binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(TCLSH)
@@ -412,11 +415,6 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
@VC_MANIFEST_EMBED_EXE@
-$(TCLTEST): testMain.$(OBJEXT) ${TEST_DLL_FILE} @LIBRARIES@ $(TCL_STUB_LIB_FILE) $(CAT32) tclsh.$(RES)
- $(CC) $(CFLAGS) testMain.$(OBJEXT) ${TEST_LIB_FILE} $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
- tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
- @VC_MANIFEST_EMBED_EXE@
-
cat32.$(OBJEXT): cat.c
$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
@@ -436,50 +434,28 @@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@
@MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
@VC_MANIFEST_EMBED_DLL@
-${TCL_LIB_FILE}: ${TCL_OBJS}
+${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
@$(RM) ${TCL_LIB_FILE}
- @MAKE_LIB@ ${TCL_OBJS}
+ @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
@POST_MAKE_LIB@
-# assume GNU make
-
-# To enable concurrent parallel make of tcl<x>.dll and tcl<x>.lib, the tcl<x>.dll
-# targets have to depend on tcl<x>.lib, this ensures that linking of tcl<x>.dll
-# does not execute concurrently with the renaming and recompiling of tcl<x>.lib
-
-${DDE_DLL_FILE}: ${DDE_OBJS} ${DDE_LIB_FILE} ${TCL_STUB_LIB_FILE}
- @-$(RM) ${DDE_DLL_FILE} ${DDE_LIB_FILE}.sav
- @-$(COPY) ${DDE_LIB_FILE} ${DDE_LIB_FILE}.sav
+${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE}
@MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
- @-$(RM) ${DDE_LIB_FILE}
- @-$(COPY) ${DDE_LIB_FILE}.sav ${DDE_LIB_FILE}
- @-$(RM) ${DDE_LIB_FILE}.sav
-
-${DDE_LIB_FILE}: ${DDE_OBJS}
- @$(RM) ${DDE_LIB_FILE}
- @MAKE_LIB@ ${DDE_OBJS}
- @POST_MAKE_LIB@
-${REG_DLL_FILE}: ${REG_OBJS} ${REG_LIB_FILE} ${TCL_STUB_LIB_FILE}
- @-$(RM) ${REG_DLL_FILE} ${REG_LIB_FILE}.sav
- @-$(COPY) ${REG_LIB_FILE} ${REG_LIB_FILE}.sav
+${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE}
@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
- @-$(RM) ${REG_LIB_FILE}
- @-$(COPY) ${REG_LIB_FILE}.sav ${REG_LIB_FILE}
- @-$(RM) ${REG_LIB_FILE}.sav
-
-${REG_LIB_FILE}: ${REG_OBJS}
- @$(RM) ${REG_LIB_FILE}
- @MAKE_LIB@ ${REG_OBJS}
- @POST_MAKE_LIB@
${TEST_DLL_FILE}: ${TCLTEST_OBJS} ${TCL_STUB_LIB_FILE}
@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
# use pre-built zlib1.dll
-${ZLIB_DLL_FILE}: $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE}
- @$(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}
+${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE}
+ @if test "@ZLIB_LIBS@set" == "${ZLIB_DIR}/win64/zdll.libset" ; then \
+ $(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
+ else \
+ $(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
+ fi;
# Add the object extension to the implicit rules. By default .obj is not
# automatically added.
@@ -499,6 +475,9 @@ tclWinPipe.${OBJEXT}: tclWinPipe.c
testMain.${OBJEXT}: tclAppInit.c
$(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME)
+tclMain2.${OBJEXT}: tclMain.c
+ $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME)
+
# TIP #59, embedding of configuration information into the binary library.
#
# Part of Tcl's configuration information are the paths where it was installed
@@ -559,9 +538,9 @@ gendate:
# run (and the results checked) after updating to a new release of libtommath.
gentommath_h:
- $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\fix_tommath_h.tcl" \
- "$(TOMMATH_DIR_NATIVE)\tommath.h" \
- > "$(GENERIC_DIR_NATIVE)\tclTomMath.h"
+ $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/fix_tommath_h.tcl" \
+ "$(TOMMATH_DIR_NATIVE)/tommath.h" \
+ > "$(GENERIC_DIR_NATIVE)/tclTomMath.h"
install: all install-binaries install-libraries install-doc install-packages
@@ -599,23 +578,23 @@ install-binaries: binaries
done
@if [ -f $(DDE_DLL_FILE) ]; then \
echo installing $(DDE_DLL_FILE); \
- $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
+ $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
$(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/dde1.3; \
+ $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
fi
@if [ -f $(DDE_LIB_FILE) ]; then \
echo installing $(DDE_LIB_FILE); \
- $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
+ $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
fi
@if [ -f $(REG_DLL_FILE) ]; then \
echo installing $(REG_DLL_FILE); \
- $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.3; \
+ $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
$(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/reg1.3; \
+ $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
fi
@if [ -f $(REG_LIB_FILE) ]; then \
echo installing $(REG_LIB_FILE); \
- $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.3; \
+ $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
fi
install-libraries: libraries install-tzdata install-msgs
@@ -628,7 +607,7 @@ install-libraries: libraries install-tzdata install-msgs
else true; \
fi; \
done;
- @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.2 ../tcl8/8.3 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
+ @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
do \
if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
@@ -641,9 +620,7 @@ install-libraries: libraries install-tzdata install-msgs
"$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \
"$(GENERIC_DIR)/tclPlatDecls.h" \
"$(GENERIC_DIR)/tclTomMath.h" \
- "$(GENERIC_DIR)/tclTomMathDecls.h" \
- "$(TOMMATH_DIR)/tommath_class.h" \
- "$(TOMMATH_DIR)/tommath_superclass.h" ; \
+ "$(GENERIC_DIR)/tclTomMathDecls.h"; \
do \
$(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
done;
@@ -657,19 +634,19 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
done;
- @echo "Installing package http 2.8.2 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.2.tm;
+ @echo "Installing package http 2.8.5 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.5.tm;
@echo "Installing library opt0.4 directory";
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
- @echo "Installing package msgcat 1.4.3 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.3.tm;
- @echo "Installing package tcltest 2.3.2 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.2.tm;
- @echo "Installing package platform 1.0.9 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.9.tm;
+ @echo "Installing package msgcat 1.5.0 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.0.tm;
+ @echo "Installing package tcltest 2.3.5 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.5.tm;
+ @echo "Installing package platform 1.0.10 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.10.tm;
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
@echo "Installing encodings";
@@ -679,14 +656,12 @@ install-libraries: libraries install-tzdata install-msgs
install-tzdata:
@echo "Installing time zone data"
- @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \
- ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \
+ @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
"$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
install-msgs:
@echo "Installing message catalogs"
- @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \
- ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \
+ @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
"$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
install-doc: doc
@@ -716,17 +691,19 @@ install-private-headers: libraries
test: test-tcl test-packages
-test-tcl: binaries $(TCLTEST)
+test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
- -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \
- set ::reglib [file normalize ${REG_DLL_FILE}]" | ./$(CAT32)
+ ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
+ -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
+ package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
+ package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
-# Useful target to launch a built tcltest with the proper path,...
-runtest: binaries $(TCLTEST)
+# Useful target to launch a built tclsh with the proper path,...
+runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLTEST) $(TESTFLAGS) -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \
- set ::reglib [file normalize ${REG_DLL_FILE}]" $(SCRIPT)
+ ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
+ package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
+ package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
# This target can be used to run tclsh from the build directory via
# `make shell SCRIPT=foo.tcl`
@@ -750,7 +727,7 @@ cleanhelp:
clean: cleanhelp clean-packages
$(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
- $(RM) $(TCLSH) $(TCLTEST) $(CAT32)
+ $(RM) $(TCLSH) $(CAT32)
$(RM) *.pch *.ilk *.pdb
distclean: distclean-packages clean
@@ -765,7 +742,7 @@ PKG_CFG_ARGS = @PKG_CFG_ARGS@
PKG_DIR = ./pkgs
packages:
- @builddir=`pwd`; \
+ @builddir=`pwd -P`; \
for i in $(PKGS_DIR)/*; do \
if [ -d $$i ] ; then \
if [ -x $$i/configure ] ; then \
@@ -773,7 +750,7 @@ packages:
mkdir -p $(PKG_DIR)/$$pkg; \
if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
( cd $(PKG_DIR)/$$pkg; \
- echo "Configuring package '$$i' wd = `pwd`"; \
+ echo "Configuring package '$$i' wd = `pwd -P`"; \
$$i/configure --with-tcl=$(PWD) --with-tclinclude=$(GENERIC_DIR) $(PKG_CFG_ARGS) --enable-shared --enable-threads; ) \
fi ; \
echo "Building package '$$pkg'"; \
@@ -784,7 +761,7 @@ packages:
cd $$builddir
install-packages: packages
- @builddir=`pwd`; \
+ @builddir=`pwd -P`; \
for i in $(PKGS_DIR)/*; do \
if [ -d $$i ]; then \
pkg=`basename $$i`; \
@@ -797,20 +774,20 @@ install-packages: packages
cd $$builddir
test-packages: tcltest packages
- @builddir=`pwd`; \
+ @builddir=`pwd -P`; \
for i in $(PKGS_DIR)/*; do \
if [ -d $$i ]; then \
pkg=`basename $$i`; \
if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
echo "Testing package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) "LD_LIBRARY_PATH=$$builddir:${LD_LIBRARY_PATH}" "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" "TCLLIBPATH=$$builddir/pkgs" test "TCLSH_PROG=$$builddir/tcltest"; ) \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE) "LD_LIBRARY_PATH=$$builddir:${LD_LIBRARY_PATH}" "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" "TCLLIBPATH=$$builddir/pkgs" test "TCLSH_PROG=$$builddir/${TCLSH}"; ) \
fi; \
fi; \
done; \
cd $$builddir
clean-packages:
- @builddir=`pwd`; \
+ @builddir=`pwd -P`; \
for i in $(PKGS_DIR)/*; do \
if [ -d $$i ]; then \
pkg=`basename $$i`; \
@@ -822,7 +799,7 @@ clean-packages:
cd $$builddir
distclean-packages:
- @builddir=`pwd`; \
+ @builddir=`pwd -P`; \
for i in $(PKGS_DIR)/*; do \
if [ -d $$i ]; then \
pkg=`basename $$i`; \
@@ -846,14 +823,14 @@ $(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
@echo "This warning can be safely ignored, do not report as a bug!"
genstubs:
- $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \
+ $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \
"$(GENERIC_DIR_NATIVE)" \
- "$(GENERIC_DIR_NATIVE)\tcl.decls" \
- "$(GENERIC_DIR_NATIVE)\tclInt.decls" \
- "$(GENERIC_DIR_NATIVE)\tclTomMath.decls"
- $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \
+ "$(GENERIC_DIR_NATIVE)/tcl.decls" \
+ "$(GENERIC_DIR_NATIVE)/tclInt.decls" \
+ "$(GENERIC_DIR_NATIVE)/tclTomMath.decls"
+ $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \
"$(GENERIC_DIR_NATIVE)" \
- "$(GENERIC_DIR_NATIVE)\tclOO.decls"
+ "$(GENERIC_DIR_NATIVE)/tclOO.decls"
#
# This target creates the HTML folder for Tcl & Tk and places it in
diff --git a/win/README b/win/README
index 024be8a..8b257b1 100644
--- a/win/README
+++ b/win/README
@@ -1,7 +1,5 @@
Tcl 8.6 for Windows
-RCS: @(#) $Id: README,v 1.41 2009/11/09 23:14:57 stwo Exp $
-
1. Introduction
---------------
@@ -13,9 +11,6 @@ The information in this file is maintained on the web at:
http://www.tcl.tk/doc/howto/compile.html#win
-The above URL includes a lengthy discussion of compiler macros necessary
-when compiling Tcl extensions that will be dynamically loaded.
-
2. Compiling Tcl
----------------
@@ -29,11 +24,29 @@ In order to compile Tcl for Windows, you need the following:
or
- Msys + Mingw [http://www.mingw.org/download.shtml]
+ Linux + MinGW-w64 [http://mingw-w64.sourceforge.net/]
+ (win32 or win64)
+
+ or
+
+ Cygwin + MinGW-w64 [http://cygwin.com/install.html]
+ (win32 or win64)
+
+ or
+
+ Darwin + MinGW-w64 [http://mingw-w64.sourceforge.net/]
+ (win32 or win64)
+
+ or
+ Msys + MinGW-w64 [http://mingw-w64.sourceforge.net/]
+ (win32 or win64)
+
+ or
+
+ Msys + MinGW [http://www.mingw.org/download.shtml]
+ (win32 only)
-Please note that building under Cygwin is NOT supported,
-do not file a bug report about building under Cygwin.
In practice, this release is built with Visual C++ 6.0 and the TEA
Makefile.
@@ -48,19 +61,26 @@ using it, are in the comments of "makefile.vc". A quick example would be:
There is also a Developer Studio workspace and project file, too, if you
would like to use them.
-If you are building with Msys, you can use the configure script that lives
-in the win subdirectory. The Msys based configure/build process works just
-like the UNIX one, so you will want to refer to ../unix/README for
-available configure options. An error will be generated by the configure
-script if you try to compile Tcl with the Cygwin version of gcc instead of
-the Mingw version. Check your PATH if you get this error.
+If you are building with Linux, Cygwin or Msys, you can use the configure
+script that lives in the win subdirectory. The Linux/Cygwin/Msys based
+configure/build process works just like the UNIX one, so you will want
+to refer to ../unix/README for available configure options.
+
+If you want 64-bit executables (x86_64), you need to configure using
+the --enable-64bit option. Make sure that the x86_64-w64-mingw32
+compiler is present. For Cygwin this compiler can be found in the
+"mingw64-x86_64-gcc-core" package, which can be installed through
+the normal Cygwin install process. If you only want 32-bit executables,
+the "mingw64-i686-gcc-core" package is what you need. For Linux, Darwin
+and Msys, you can download a suitable win32 or win64 compiler from
+[https://sourceforge.net/projects/mingw-w64/files/]
Use the Makefile "install" target to install Tcl. It will install it
according to the prefix options you provided in the correct directory
structure.
-Note that in order to run tclsh86.exe, you must ensure that tcl86.dll is on
-your path, in the system directory, or in the directory containing
+Note that in order to run tclsh85.exe, you must ensure that tcl85.dll is
+on your path, in the system directory, or in the directory containing
tclsh86.exe.
Note: Tcl no longer provides support for Win32s.
diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat
index 6552ccd..e4f0a30 100755
--- a/win/buildall.vc.bat
+++ b/win/buildall.vc.bat
@@ -1,9 +1,8 @@
@echo off
+
:: This is an example batchfile for building everything. Please
:: edit this (or make your own) for your needs and wants using
:: the instructions for calling makefile.vc found in makefile.vc
-::
-:: RCS: @(#) $Id: buildall.vc.bat,v 1.11 2009/01/19 19:54:19 davygrvy Exp $
set SYMBOLS=
@@ -28,10 +27,11 @@ cd > nul
:: path or have already run vcvars32.bat. Testing these envars proves
:: cl.exe and friends are in your path.
::
-if defined VCINSTALLDIR (goto :startBuilding)
-if defined MSDRVDIR (goto :startBuilding)
-if defined MSVCDIR (goto :startBuilding)
-if defined MSSDK (goto :startBuilding)
+if defined VCINSTALLDIR (goto :startBuilding)
+if defined MSDEVDIR (goto :startBuilding)
+if defined MSVCDIR (goto :startBuilding)
+if defined MSSDK (goto :startBuilding)
+if defined WINDOWSSDKDIR (goto :startBuilding)
:: We need to run the development environment batch script that comes
:: with developer studio (v4,5,6,7,etc...) All have it. This path
@@ -64,42 +64,13 @@ if not %SYMBOLS%.==. set OPTS=symbols
nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1
if errorlevel 1 goto error
-:: Build the static core, dlls and shell.
-::
-set OPTS=static
-if not %SYMBOLS%.==. set OPTS=symbols,static
-nmake -nologo -f makefile.vc release OPTS=%OPTS% %1
-if errorlevel 1 goto error
-
-:: Build the special static libraries that use the dynamic runtime.
+:: Build the static core and shell.
::
set OPTS=static,msvcrt
if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt
-nmake -nologo -f makefile.vc core dlls OPTS=%OPTS% %1
-if errorlevel 1 goto error
-
-:: Build the core and shell for thread support.
-::
-set OPTS=threads
-if not %SYMBOLS%.==. set OPTS=symbols,threads
nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
if errorlevel 1 goto error
-:: Build a static, thread support core library with a shell.
-::
-set OPTS=static,threads
-if not %SYMBOLS%.==. set OPTS=symbols,static,threads
-nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
-if errorlevel 1 goto error
-
-:: Build the special static libraries that use the dynamic runtime,
-:: but now with thread support.
-::
-set OPTS=static,msvcrt,threads
-if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt,threads
-nmake -nologo -f makefile.vc core dlls OPTS=%OPTS% %1
-if errorlevel 1 goto error
-
set OPTS=
set SYMBOLS=
goto end
diff --git a/win/cat.c b/win/cat.c
index c91e0d2..d49e37c 100644
--- a/win/cat.c
+++ b/win/cat.c
@@ -7,20 +7,21 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: cat.c,v 1.5 2010/01/13 06:46:56 nijtmans Exp $
*/
-#include <stdio.h>
-#ifdef __CYGWIN__
-# include <unistd.h>
-#else
-# include <io.h>
+#ifdef TCL_BROKEN_MAINARGS
+/* On mingw32 and cygwin this doesn't work */
+# undef UNICODE
+# undef _UNICODE
#endif
+
+#include <stdio.h>
+#include <io.h>
#include <string.h>
+#include <tchar.h>
int
-main(void)
+_tmain(void)
{
char buf[1024];
int n;
diff --git a/win/coffbase.txt b/win/coffbase.txt
index eda9a5b..bdf5506 100644
--- a/win/coffbase.txt
+++ b/win/coffbase.txt
@@ -11,8 +11,6 @@
; maximum size is too small a linker warning will occur. Modules can overlap when
; they're mutually exclusive. This info is placed in the DLL's PE header by the
; linker with the `-base:@$(TCLDIR)\win\coffbase.txt,<key>` option.
-;
-; RCS: @(#) $Id: coffbase.txt,v 1.14 2008/12/20 11:49:00 patthoyts Exp $
tcl 0x10000000 0x00200000
tcldde 0x10200000 0x00010000
@@ -26,6 +24,7 @@ blt 0x10680000 0x00080000
iocpsock 0x10700000 0x00080000
tls 0x10780000 0x00100000
winico 0x10880000 0x00010000
+sample 0x108B0000 0x00010000
tile 0x10900000 0x00080000
memchan 0x109D0000 0x00010000
tdom 0x109E0000 0x00080000
@@ -34,6 +33,7 @@ tkvideo 0x10B00000 0x00010000
tclsdl 0x10B20000 0x00080000
vqtcl 0x10C00000 0x00010000
tdbc 0x10C40000 0x00010000
+thread 0x10C80000 0x00020000
;
; insert new packages here
;
diff --git a/win/configure b/win/configure
index 771a1cb..03a20b4 100755
--- a/win/configure
+++ b/win/configure
@@ -309,7 +309,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR RANLIB RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_DDE_PATCH_LEVEL TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION TCL_REG_PATCH_LEVEL RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
ac_subst_files=''
# Initialize some variables set by options.
@@ -840,18 +840,18 @@ if test -n "$ac_init_help"; then
Optional Features:
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
- --enable-threads build with threads
- --enable-shared build and link with shared libraries --enable-shared
+ --enable-threads build with threads (default: on)
+ --enable-shared build and link with shared libraries (default: on)
--enable-64bit enable 64bit support (where applicable)
--enable-wince enable Win/CE support (where applicable)
- --enable-symbols build with debugging symbols --disable-symbols
+ --enable-symbols build with debugging symbols (default: off)
--enable-embedded-manifest
embed manifest if possible (default: yes)
Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
- --with-encoding encoding for configuration values
+ --with-encoding encoding for configuration values
--with-celib=DIR use Windows/CE support library from DIR
Some influential environment variables:
@@ -1311,24 +1311,27 @@ SHELL=/bin/sh
TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL="b1.2"
+TCL_PATCH_LEVEL=".0"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-TCL_DDE_VERSION=1.3
+TCL_DDE_VERSION=1.4
TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=3
-TCL_DDE_PATCH_LEVEL="2"
+TCL_DDE_MINOR_VERSION=4
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
TCL_REG_MINOR_VERSION=3
-TCL_REG_PATCH_LEVEL="0"
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
PKG_CFG_ARGS=$@
#------------------------------------------------------------------------
+# Empty slate for bundled packages, to avoid stale configuration
+#------------------------------------------------------------------------
+rm -Rf pkgs
+
+#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
@@ -2770,16 +2773,9 @@ _ACEOF
fi
-# To properly support cross-compilation, one would
-# need to use these tool checks instead of
-# the ones below and reconfigure with
-# autoconf 2.50. You can also just set
-# the CC, AR, RANLIB, and RC environment
-# variables if you want to cross compile.
-
-if test "${GCC}" = "yes" ; then
- # Extract the first word of "ar", so it can be a program name with args.
-set dummy ar; ac_word=$2
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ar; ac_word=$2
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_AR+set}" = set; then
@@ -2795,7 +2791,7 @@ do
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_AR="ar"
+ ac_cv_prog_AR="${ac_tool_prefix}ar"
echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
@@ -2813,8 +2809,52 @@ else
echo "${ECHO_T}no" >&6
fi
- # Extract the first word of "ranlib", so it can be a program name with args.
-set dummy ranlib; ac_word=$2
+fi
+if test -z "$ac_cv_prog_AR"; then
+ ac_ct_AR=$AR
+ # Extract the first word of "ar", so it can be a program name with args.
+set dummy ar; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_AR+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_AR"; then
+ ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_AR="ar"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_AR=$ac_cv_prog_ac_ct_AR
+if test -n "$ac_ct_AR"; then
+ echo "$as_me:$LINENO: result: $ac_ct_AR" >&5
+echo "${ECHO_T}$ac_ct_AR" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ AR=$ac_ct_AR
+else
+ AR="$ac_cv_prog_AR"
+fi
+
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_RANLIB+set}" = set; then
@@ -2830,7 +2870,7 @@ do
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_RANLIB="ranlib"
+ ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
@@ -2848,8 +2888,52 @@ else
echo "${ECHO_T}no" >&6
fi
- # Extract the first word of "windres", so it can be a program name with args.
-set dummy windres; ac_word=$2
+fi
+if test -z "$ac_cv_prog_RANLIB"; then
+ ac_ct_RANLIB=$RANLIB
+ # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_RANLIB"; then
+ ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_RANLIB="ranlib"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
+if test -n "$ac_ct_RANLIB"; then
+ echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5
+echo "${ECHO_T}$ac_ct_RANLIB" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ RANLIB=$ac_ct_RANLIB
+else
+ RANLIB="$ac_cv_prog_RANLIB"
+fi
+
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args.
+set dummy ${ac_tool_prefix}windres; ac_word=$2
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_RC+set}" = set; then
@@ -2865,7 +2949,7 @@ do
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_RC="windres"
+ ac_cv_prog_RC="${ac_tool_prefix}windres"
echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
@@ -2883,24 +2967,50 @@ else
echo "${ECHO_T}no" >&6
fi
+fi
+if test -z "$ac_cv_prog_RC"; then
+ ac_ct_RC=$RC
+ # Extract the first word of "windres", so it can be a program name with args.
+set dummy windres; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_RC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_RC"; then
+ ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_RC="windres"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
- if test "${AR}" = "" ; then
- { { echo "$as_me:$LINENO: error: Required archive tool 'ar' not found on PATH." >&5
-echo "$as_me: error: Required archive tool 'ar' not found on PATH." >&2;}
- { (exit 1); exit 1; }; }
- fi
- if test "${RANLIB}" = "" ; then
- { { echo "$as_me:$LINENO: error: Required archive index tool 'ranlib' not found on PATH." >&5
-echo "$as_me: error: Required archive index tool 'ranlib' not found on PATH." >&2;}
- { (exit 1); exit 1; }; }
- fi
- if test "${RC}" = "" ; then
- { { echo "$as_me:$LINENO: error: Required resource tool 'windres' not found on PATH." >&5
-echo "$as_me: error: Required resource tool 'windres' not found on PATH." >&2;}
- { (exit 1); exit 1; }; }
- fi
+fi
+fi
+ac_ct_RC=$ac_cv_prog_ac_ct_RC
+if test -n "$ac_ct_RC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_RC" >&5
+echo "${ECHO_T}$ac_ct_RC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
fi
+ RC=$ac_ct_RC
+else
+ RC="$ac_cv_prog_RC"
+fi
+
+
#--------------------------------------------------------------------
# Checks to see if the make program sets the $MAKE variable.
#--------------------------------------------------------------------
@@ -2936,592 +3046,6 @@ fi
#--------------------------------------------------------------------
-# Perform additinal compiler tests.
-#--------------------------------------------------------------------
-
-
-echo "$as_me:$LINENO: checking for SEH support in compiler" >&5
-echo $ECHO_N "checking for SEH support in compiler... $ECHO_C" >&6
-if test "${tcl_cv_seh+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if test "$cross_compiling" = yes; then
- tcl_cv_seh=no
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
-int main(int argc, char** argv) {
- int a, b = 0;
- __try {
- a = 666 / b;
- }
- __except (EXCEPTION_EXECUTE_HANDLER) {
- return 0;
- }
- return 1;
-}
-
-_ACEOF
-rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_seh=yes
-else
- echo "$as_me: program exited with status $ac_status" >&5
-echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-( exit $ac_status )
-tcl_cv_seh=no
-fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
-fi
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_seh" >&5
-echo "${ECHO_T}$tcl_cv_seh" >&6
-if test "$tcl_cv_seh" = "no" ; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_NO_SEH 1
-_ACEOF
-
-fi
-
-#
-# Check to see if the excpt.h include file provided contains the
-# definition for EXCEPTION_DISPOSITION; if not, which is the case
-# with Cygwin's version as of 2002-04-10, define it to be int,
-# sufficient for getting the current code to work.
-#
-echo "$as_me:$LINENO: checking for EXCEPTION_DISPOSITION support in include files" >&5
-echo $ECHO_N "checking for EXCEPTION_DISPOSITION support in include files... $ECHO_C" >&6
-if test "${tcl_cv_eh_disposition+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
-int
-main ()
-{
-
- EXCEPTION_DISPOSITION x;
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_eh_disposition=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_eh_disposition=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_eh_disposition" >&5
-echo "${ECHO_T}$tcl_cv_eh_disposition" >&6
-if test "$tcl_cv_eh_disposition" = "no" ; then
-
-cat >>confdefs.h <<\_ACEOF
-#define EXCEPTION_DISPOSITION int
-_ACEOF
-
-fi
-
-
-# Check to see if the winsock2.h include file provided contains
-# typedefs like LPFN_ACCEPT and friends.
-#
-echo "$as_me:$LINENO: checking for LPFN_ACCEPT support in winsock2.h" >&5
-echo $ECHO_N "checking for LPFN_ACCEPT support in winsock2.h... $ECHO_C" >&6
-if test "${tcl_cv_lpfn_decls+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-#include <winsock2.h>
-
-int
-main ()
-{
-
- LPFN_ACCEPT accept;
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_lpfn_decls=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_lpfn_decls=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_lpfn_decls" >&5
-echo "${ECHO_T}$tcl_cv_lpfn_decls" >&6
-if test "$tcl_cv_lpfn_decls" = "no" ; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_NO_LPFN_DECLS 1
-_ACEOF
-
-fi
-
-# Check to see if winnt.h defines CHAR, SHORT, and LONG
-# even if VOID has already been #defined. The win32api
-# used by mingw and cygwin is known to do this.
-
-echo "$as_me:$LINENO: checking for winnt.h that ignores VOID define" >&5
-echo $ECHO_N "checking for winnt.h that ignores VOID define... $ECHO_C" >&6
-if test "${tcl_cv_winnt_ignore_void+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#define VOID void
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
-int
-main ()
-{
-
- CHAR c;
- SHORT s;
- LONG l;
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_winnt_ignore_void=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_winnt_ignore_void=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_winnt_ignore_void" >&5
-echo "${ECHO_T}$tcl_cv_winnt_ignore_void" >&6
-if test "$tcl_cv_winnt_ignore_void" = "yes" ; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_WINNT_IGNORE_VOID 1
-_ACEOF
-
-fi
-
-# Check to see if malloc.h is missing the alloca function
-# declaration. This is known to be a problem with Mingw.
-# If we compiled without the function declaration, it
-# would work but we would get a warning message from gcc.
-# If we add the function declaration ourselves, it
-# would not compile correctly because the _alloca
-# function expects the argument to be passed in a
-# register and not on the stack. Instead, we just
-# call it from inline asm code.
-
-echo "$as_me:$LINENO: checking for alloca declaration in malloc.h" >&5
-echo $ECHO_N "checking for alloca declaration in malloc.h... $ECHO_C" >&6
-if test "${tcl_cv_malloc_decl_alloca+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#include <malloc.h>
-
-int
-main ()
-{
-
- size_t arg = 0;
- void* ptr;
- ptr = alloca;
- ptr = alloca(arg);
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_malloc_decl_alloca=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_malloc_decl_alloca=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_malloc_decl_alloca" >&5
-echo "${ECHO_T}$tcl_cv_malloc_decl_alloca" >&6
-if test "$tcl_cv_malloc_decl_alloca" = "no" &&
- test "${GCC}" = "yes" ; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_ALLOCA_GCC_INLINE 1
-_ACEOF
-
-fi
-
-# See if the compiler supports casting to a union type.
-# This is used to stop gcc from printing a compiler
-# warning when initializing a union member.
-
-echo "$as_me:$LINENO: checking for cast to union support" >&5
-echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6
-if test "${tcl_cv_cast_to_union+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-int
-main ()
-{
-
- union foo { int i; double d; };
- union foo f = (union foo) (int) 0;
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_cast_to_union=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_cast_to_union=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5
-echo "${ECHO_T}$tcl_cv_cast_to_union" >&6
-if test "$tcl_cv_cast_to_union" = "yes"; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_CAST_TO_UNION 1
-_ACEOF
-
-fi
-
-
-# See if declarations like FINDEX_INFO_LEVELS are
-# missing from winbase.h. This is known to be
-# a problem with VC++ 5.2.
-
-echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
-echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6
-if test "${tcl_cv_findex_enums+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
-int
-main ()
-{
-
- FINDEX_INFO_LEVELS i;
- FINDEX_SEARCH_OPS j;
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_findex_enums=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_findex_enums=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5
-echo "${ECHO_T}$tcl_cv_findex_enums" >&6
-if test "$tcl_cv_findex_enums" = "no"; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_NO_FINDEX_ENUMS 1
-_ACEOF
-
-fi
-
-# See if MWMO_ALERTABLE is missing from winuser.h
-# This is known to be a problem with Mingw.
-
-echo "$as_me:$LINENO: checking for MWMO_ALERTABLE in winuser.h" >&5
-echo $ECHO_N "checking for MWMO_ALERTABLE in winuser.h... $ECHO_C" >&6
-if test "${tcl_cv_mwmo_alertable+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
-int
-main ()
-{
-
- int i = MWMO_ALERTABLE;
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_mwmo_alertable=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_mwmo_alertable=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_mwmo_alertable" >&5
-echo "${ECHO_T}$tcl_cv_mwmo_alertable" >&6
-if test "$tcl_cv_mwmo_alertable" = "no"; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_NO_MWMO_ALERTABLE 1
-_ACEOF
-
-fi
-
-#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------
@@ -3544,8 +3068,8 @@ else
fi;
if test "$tcl_ok" = "yes"; then
- echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
+ echo "$as_me:$LINENO: result: yes (default)" >&5
+echo "${ECHO_T}yes (default)" >&6
TCL_THREADS=1
cat >>confdefs.h <<\_ACEOF
#define TCL_THREADS 1
@@ -3753,6 +3277,11 @@ echo "${ECHO_T}$CELIB_DIR" >&6
# Set some defaults (may get changed below)
EXTRA_CFLAGS=""
+cat >>confdefs.h <<\_ACEOF
+#define MODULE_SCOPE extern
+_ACEOF
+
+
# Extract the first word of "cygpath", so it can be a program name with args.
set dummy cygpath; ac_word=$2
echo "$as_me:$LINENO: checking for $ac_word" >&5
@@ -3792,6 +3321,91 @@ fi
SHLIB_SUFFIX=".dll"
+ # MACHINE is IX86 for LINK, but this is used by the manifest,
+ # which requires x86|amd64|ia64.
+ MACHINE="X86"
+
+ if test "$GCC" = "yes"; then
+
+ echo "$as_me:$LINENO: checking for cross-compile version of gcc" >&5
+echo $ECHO_N "checking for cross-compile version of gcc... $ECHO_C" >&6
+if test "${ac_cv_cross+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+ #ifndef __WIN32__
+ #error cross-compiler
+ #endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_cross=no
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_cross=yes
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_cross" >&5
+echo "${ECHO_T}$ac_cv_cross" >&6
+
+ if test "$ac_cv_cross" = "yes"; then
+ case "$do64bit" in
+ amd64|x64|yes)
+ CC="x86_64-w64-mingw32-gcc"
+ LD="x86_64-w64-mingw32-ld"
+ AR="x86_64-w64-mingw32-ar"
+ RANLIB="x86_64-w64-mingw32-ranlib"
+ RC="x86_64-w64-mingw32-windres"
+ ;;
+ *)
+ CC="i686-w64-mingw32-gcc"
+ LD="i686-w64-mingw32-ld"
+ AR="i686-w64-mingw32-ar"
+ RANLIB="i686-w64-mingw32-ranlib"
+ RC="i686-w64-mingw32-windres"
+ ;;
+ esac
+ fi
+ fi
+
# Check for a bug in gcc's windres that causes the
# compile to fail when a Windows native path is
# passed into windres. The mingw toolchain requires
@@ -3825,9 +3439,18 @@ echo "${ECHO_T}yes" >&6
cyg_conftest=
fi
- echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5
-echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6
-if test "${ac_cv_cygwin+set}" = set; then
+ if test "$CYGPATH" = "echo"; then
+ DEPARG='"$<"'
+ else
+ DEPARG='"$(shell $(CYGPATH) $<)"'
+ fi
+
+ # set various compiler flags depending on whether we are using gcc or cl
+
+ if test "${GCC}" = "yes" ; then
+ echo "$as_me:$LINENO: checking for mingw32 version of gcc" >&5
+echo $ECHO_N "checking for mingw32 version of gcc... $ECHO_C" >&6
+if test "${ac_cv_win32+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
@@ -3837,9 +3460,9 @@ cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
- #ifdef __CYGWIN__
- #error cygwin
- #endif
+ #ifdef __WIN32__
+ #error win32
+ #endif
int
main ()
@@ -3871,44 +3494,97 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
- ac_cv_cygwin=no
+ ac_cv_win32=no
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-ac_cv_cygwin=yes
+ac_cv_win32=yes
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5
-echo "${ECHO_T}$ac_cv_cygwin" >&6
- if test "$ac_cv_cygwin" = "yes" ; then
- { echo "$as_me:$LINENO: WARNING: Compiling under Cygwin is not currently supported.
-If you are not sure you want this, see the README
-file for information about building with Mingw." >&5
-echo "$as_me: WARNING: Compiling under Cygwin is not currently supported.
-If you are not sure you want this, see the README
-file for information about building with Mingw." >&2;}
- fi
- if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then
- DEPARG='"$<"'
- else
- DEPARG='"$(shell $(CYGPATH) $<)"'
- fi
+echo "$as_me:$LINENO: result: $ac_cv_win32" >&5
+echo "${ECHO_T}$ac_cv_win32" >&6
+ if test "$ac_cv_win32" != "yes"; then
+ { { echo "$as_me:$LINENO: error: ${CC} cannot produce win32 executables." >&5
+echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;}
+ { (exit 1); exit 1; }; }
+ fi
- # set various compiler flags depending on whether we are using gcc or cl
+ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
+ echo "$as_me:$LINENO: checking for working -municode linker flag" >&5
+echo $ECHO_N "checking for working -municode linker flag... $ECHO_C" >&6
+if test "${ac_cv_municode+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+ #include <windows.h>
+ int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_municode=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_municode=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_municode" >&5
+echo "${ECHO_T}$ac_cv_municode" >&6
+ CFLAGS=$hold_cflags
+ if test "$ac_cv_municode" = "yes" ; then
+ extra_ldflags="$extra_ldflags -municode"
+ else
+ extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
+ fi
+ fi
echo "$as_me:$LINENO: checking compiler flags" >&5
echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
if test "${GCC}" = "yes" ; then
- if test "$do64bit" != "no" ; then
- { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on Windows" >&5
-echo "$as_me: WARNING: 64bit mode not supported with GCC on Windows" >&2;}
- fi
SHLIB_LD=""
SHLIB_LD_LIBS='${LIBS}'
- LIBS="-lkernel32 -luser32 -ladvapi32 -lws2_32"
+ LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -lws2_32"
# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32"
STLIB_LD='${AR} cr'
@@ -3922,23 +3598,8 @@ echo "$as_me: WARNING: 64bit mode not supported with GCC on Windows" >&2;}
MAKE_EXE="\${CC} -o \$@"
LIBPREFIX="lib"
- extra_cflags="-pipe"
- extra_ldflags="-pipe"
-
- if test "$ac_cv_cygwin" = "yes"; then
- touch ac$$.c
- if ${CC} -c -mwin32 ac$$.c >/dev/null 2>&1; then
- case "$extra_cflags" in
- *-mwin32*) ;;
- *) extra_cflags="-mwin32 $extra_cflags" ;;
- esac
- case "$extra_ldflags" in
- *-mwin32*) ;;
- *) extra_ldflags="-mwin32 $extra_ldflags" ;;
- esac
- fi
- rm -f ac$$.o ac$$.c
- fi
+ extra_cflags="$extra_cflags -pipe"
+ extra_ldflags="$extra_ldflags -pipe"
if test "${SHARED_BUILD}" = "0" ; then
# static
@@ -4010,8 +3671,76 @@ echo "$as_me: error: ${CC} does not support the -shared option.
LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}"
LDFLAGS_WINDOW="-mwindows ${extra_ldflags}"
- # gcc under Windows supports only 32bit builds
- MACHINE="X86"
+ case "$do64bit" in
+ amd64|x64|yes)
+ MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
+ echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
+echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
+ ;;
+ ia64)
+ MACHINE="IA64"
+ echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
+echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
+ ;;
+ *)
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+ #ifndef _WIN64
+ #error 32-bit
+ #endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_win_64bit=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_win_64bit=no
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ if test "$tcl_win_64bit" = "yes" ; then
+ do64bit=amd64
+ MACHINE="AMD64"
+ echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
+echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
+ fi
+ ;;
+ esac
else
if test "${SHARED_BUILD}" = "0" ; then
# static
@@ -4036,12 +3765,9 @@ echo "${ECHO_T}using shared flags" >&6
LIBSUFFIX="\${DBGX}.lib"
LIBFLAGSUFFIX="\${DBGX}"
- # This is a 2-stage check to make sure we have the 64-bit SDK
- # We have to know where the SDK is installed.
+ # This is a 2-stage check to make sure we have the 64-bit SDK
+ # We have to know where the SDK is installed.
# This magic is based on MS Platform SDK for Win2003 SP1 - hobbs
- # MACHINE is IX86 for LINK, but this is used by the manifest,
- # which requires x86|amd64|ia64.
- MACHINE="X86"
if test "$do64bit" != "no" ; then
if test "x${MSSDK}x" = "xx" ; then
MSSDK="C:/Progra~1/Microsoft Platform SDK"
@@ -4049,14 +3775,14 @@ echo "${ECHO_T}using shared flags" >&6
MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'`
PATH64=""
case "$do64bit" in
- amd64|x64|yes)
- MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
- PATH64="${MSSDK}/Bin/Win64/x86/AMD64"
- ;;
- ia64)
- MACHINE="IA64"
- PATH64="${MSSDK}/Bin/Win64"
- ;;
+ amd64|x64|yes)
+ MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
+ PATH64="${MSSDK}/Bin/Win64/x86/AMD64"
+ ;;
+ ia64)
+ MACHINE="IA64"
+ PATH64="${MSSDK}/Bin/Win64"
+ ;;
esac
if test ! -d "${PATH64}" ; then
{ echo "$as_me:$LINENO: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&5
@@ -4070,7 +3796,7 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
fi
fi
- LIBS="kernel32.lib user32.lib advapi32.lib ws2_32.lib"
+ LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib"
if test "$do64bit" != "no" ; then
# The space-based-path will work for the Makefile, but will
# not work if AC_TRY_COMPILE is called. TEA has the
@@ -4286,7 +4012,7 @@ _ACEOF
EXTRA_CFLAGS=""
CFLAGS_WARNING="-W3"
- LDFLAGS_DEBUG="-debug:full"
+ LDFLAGS_DEBUG="-debug"
LDFLAGS_OPTIMIZE="-release"
# Specify the CC output file names based on the target name
@@ -4311,6 +4037,291 @@ _ACEOF
fi
+ if test "${GCC}" = "yes" ; then
+ echo "$as_me:$LINENO: checking for SEH support in compiler" >&5
+echo $ECHO_N "checking for SEH support in compiler... $ECHO_C" >&6
+if test "${tcl_cv_seh+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test "$cross_compiling" = yes; then
+ tcl_cv_seh=no
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+ #define WIN32_LEAN_AND_MEAN
+ #include <windows.h>
+ #undef WIN32_LEAN_AND_MEAN
+
+ int main(int argc, char** argv) {
+ int a, b = 0;
+ __try {
+ a = 666 / b;
+ }
+ __except (EXCEPTION_EXECUTE_HANDLER) {
+ return 0;
+ }
+ return 1;
+ }
+
+_ACEOF
+rm -f conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_seh=yes
+else
+ echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+( exit $ac_status )
+tcl_cv_seh=no
+fi
+rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+fi
+
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_seh" >&5
+echo "${ECHO_T}$tcl_cv_seh" >&6
+ if test "$tcl_cv_seh" = "no" ; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_NO_SEH 1
+_ACEOF
+
+ fi
+
+ #
+ # Check to see if the excpt.h include file provided contains the
+ # definition for EXCEPTION_DISPOSITION; if not, which is the case
+ # with Cygwin's version as of 2002-04-10, define it to be int,
+ # sufficient for getting the current code to work.
+ #
+ echo "$as_me:$LINENO: checking for EXCEPTION_DISPOSITION support in include files" >&5
+echo $ECHO_N "checking for EXCEPTION_DISPOSITION support in include files... $ECHO_C" >&6
+if test "${tcl_cv_eh_disposition+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+# undef WIN32_LEAN_AND_MEAN
+
+int
+main ()
+{
+
+ EXCEPTION_DISPOSITION x;
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_eh_disposition=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_eh_disposition=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_eh_disposition" >&5
+echo "${ECHO_T}$tcl_cv_eh_disposition" >&6
+ if test "$tcl_cv_eh_disposition" = "no" ; then
+
+cat >>confdefs.h <<\_ACEOF
+#define EXCEPTION_DISPOSITION int
+_ACEOF
+
+ fi
+
+ # Check to see if winnt.h defines CHAR, SHORT, and LONG
+ # even if VOID has already been #defined. The win32api
+ # used by mingw and cygwin is known to do this.
+
+ echo "$as_me:$LINENO: checking for winnt.h that ignores VOID define" >&5
+echo $ECHO_N "checking for winnt.h that ignores VOID define... $ECHO_C" >&6
+if test "${tcl_cv_winnt_ignore_void+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+ #define VOID void
+ #define WIN32_LEAN_AND_MEAN
+ #include <windows.h>
+ #undef WIN32_LEAN_AND_MEAN
+
+int
+main ()
+{
+
+ CHAR c;
+ SHORT s;
+ LONG l;
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_winnt_ignore_void=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_winnt_ignore_void=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_winnt_ignore_void" >&5
+echo "${ECHO_T}$tcl_cv_winnt_ignore_void" >&6
+ if test "$tcl_cv_winnt_ignore_void" = "yes" ; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_WINNT_IGNORE_VOID 1
+_ACEOF
+
+ fi
+
+ # See if the compiler supports casting to a union type.
+ # This is used to stop gcc from printing a compiler
+ # warning when initializing a union member.
+
+ echo "$as_me:$LINENO: checking for cast to union support" >&5
+echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6
+if test "${tcl_cv_cast_to_union+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ union foo { int i; double d; };
+ union foo f = (union foo) (int) 0;
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_cast_to_union=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_cast_to_union=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5
+echo "${ECHO_T}$tcl_cv_cast_to_union" >&6
+ if test "$tcl_cv_cast_to_union" = "yes"; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_CAST_TO_UNION 1
+_ACEOF
+
+ fi
+ fi
+
# DL_LIBS is empty, but then we match the Unix version
@@ -4318,17 +4329,21 @@ _ACEOF
+# Cross-compiling
+case ${host_alias} in
+*mingw32*)
+ TCL_EXE="tclsh"
+ ;;
+*)
+ TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}"
+ ;;
+esac
+
#------------------------------------------------------------------------
# Add stuff for zlib; note that this is mostly done in the makefile now
# as we just assume that the platform hasn't got a usable z.lib
#------------------------------------------------------------------------
-if test "$do64bit" = "yes"; then
-
- tcl_ok=no
-
-else
-
if test "${enable_shared+set}" = "set"; then
enableval="$enable_shared"
@@ -4340,20 +4355,31 @@ else
fi
-
-fi
-
if test "$tcl_ok" = "yes"; then
ZLIB_DLL_FILE=\${ZLIB_DLL_FILE}
- ZLIB_LIBS=\${ZLIB_DIR}/win32/zdll.lib
+ if test "$do64bit" = "yes"; then
+
+ ZLIB_LIBS=\${ZLIB_DIR}/win64/zdll.lib
+
+
+else
+
+ ZLIB_LIBS=\${ZLIB_DIR}/win32/zdll.lib
+
+
+fi
else
ZLIB_OBJS=\${ZLIB_OBJS}
+ cat >>confdefs.h <<_ACEOF
+#define NO_VIZ 1
+_ACEOF
+
fi
@@ -4363,6 +4389,566 @@ cat >>confdefs.h <<\_ACEOF
_ACEOF
+echo "$as_me:$LINENO: checking for intptr_t" >&5
+echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6
+if test "${ac_cv_type_intptr_t+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+if ((intptr_t *) 0)
+ return 0;
+if (sizeof (intptr_t))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_type_intptr_t=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_type_intptr_t=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5
+echo "${ECHO_T}$ac_cv_type_intptr_t" >&6
+if test $ac_cv_type_intptr_t = yes; then
+
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_INTPTR_T 1
+_ACEOF
+
+else
+
+ echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5
+echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6
+if test "${tcl_cv_intptr_t+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+
+ for tcl_cv_intptr_t in "int" "long" "long long" none; do
+ if test "$tcl_cv_intptr_t" != none; then
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))];
+test_array [0] = 0
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_ok=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_ok=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ test "$tcl_ok" = yes && break; fi
+ done
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5
+echo "${ECHO_T}$tcl_cv_intptr_t" >&6
+ if test "$tcl_cv_intptr_t" != none; then
+
+cat >>confdefs.h <<_ACEOF
+#define intptr_t $tcl_cv_intptr_t
+_ACEOF
+
+ fi
+
+fi
+
+echo "$as_me:$LINENO: checking for uintptr_t" >&5
+echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6
+if test "${ac_cv_type_uintptr_t+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+if ((uintptr_t *) 0)
+ return 0;
+if (sizeof (uintptr_t))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_type_uintptr_t=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_type_uintptr_t=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5
+echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6
+if test $ac_cv_type_uintptr_t = yes; then
+
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_UINTPTR_T 1
+_ACEOF
+
+else
+
+ echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5
+echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6
+if test "${tcl_cv_uintptr_t+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+
+ for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
+ none; do
+ if test "$tcl_cv_uintptr_t" != none; then
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))];
+test_array [0] = 0
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_ok=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_ok=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ test "$tcl_ok" = yes && break; fi
+ done
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5
+echo "${ECHO_T}$tcl_cv_uintptr_t" >&6
+ if test "$tcl_cv_uintptr_t" != none; then
+
+cat >>confdefs.h <<_ACEOF
+#define uintptr_t $tcl_cv_uintptr_t
+_ACEOF
+
+ fi
+
+fi
+
+
+#--------------------------------------------------------------------
+# Perform additinal compiler tests.
+#--------------------------------------------------------------------
+
+# See if declarations like FINDEX_INFO_LEVELS are
+# missing from winbase.h. This is known to be
+# a problem with VC++ 5.2.
+
+echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
+echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6
+if test "${tcl_cv_findex_enums+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+
+int
+main ()
+{
+
+ FINDEX_INFO_LEVELS i;
+ FINDEX_SEARCH_OPS j;
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_findex_enums=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_findex_enums=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5
+echo "${ECHO_T}$tcl_cv_findex_enums" >&6
+if test "$tcl_cv_findex_enums" = "no"; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_NO_FINDEX_ENUMS 1
+_ACEOF
+
+fi
+
+# See if the compiler supports intrinsics.
+
+echo "$as_me:$LINENO: checking for intrinsics support in compiler" >&5
+echo $ECHO_N "checking for intrinsics support in compiler... $ECHO_C" >&6
+if test "${tcl_cv_intrinsics+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+#include <intrin.h>
+
+int
+main ()
+{
+
+ __cpuidex(0,0,0);
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_intrinsics=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_intrinsics=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_intrinsics" >&5
+echo "${ECHO_T}$tcl_cv_intrinsics" >&6
+if test "$tcl_cv_intrinsics" = "yes"; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_INTRIN_H 1
+_ACEOF
+
+fi
+
+# See if the <wspiapi.h> header file is present
+
+echo "$as_me:$LINENO: checking for wspiapi.h" >&5
+echo $ECHO_N "checking for wspiapi.h... $ECHO_C" >&6
+if test "${tcl_cv_wspiapi_h+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+#include <wspiapi.h>
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_wspiapi_h=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_wspiapi_h=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_wspiapi_h" >&5
+echo "${ECHO_T}$tcl_cv_wspiapi_h" >&6
+if test "$tcl_cv_wspiapi_h" = "yes"; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_WSPIAPI_H 1
+_ACEOF
+
+fi
+
+# See if declarations like FINDEX_INFO_LEVELS are
+# missing from winbase.h. This is known to be
+# a problem with VC++ 5.2.
+
+echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
+echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6
+if test "${tcl_cv_findex_enums+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+
+int
+main ()
+{
+
+ FINDEX_INFO_LEVELS i;
+ FINDEX_SEARCH_OPS j;
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_findex_enums=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_findex_enums=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5
+echo "${ECHO_T}$tcl_cv_findex_enums" >&6
+if test "$tcl_cv_findex_enums" = "no"; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_NO_FINDEX_ENUMS 1
+_ACEOF
+
+fi
+
#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
# option. This macro depends on C flags, and should be called
@@ -4384,6 +4970,11 @@ fi;
CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
DBGX=""
+
+cat >>confdefs.h <<\_ACEOF
+#define NDEBUG 1
+_ACEOF
+
echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
@@ -4402,24 +4993,23 @@ echo "${ECHO_T}yes (standard debugging)" >&6
fi
- cat >>confdefs.h <<\_ACEOF
-#define TCL_CFG_DEBUG 1
-_ACEOF
-
if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then
- cat >>confdefs.h <<\_ACEOF
+
+cat >>confdefs.h <<\_ACEOF
#define TCL_MEM_DEBUG 1
_ACEOF
fi
if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then
- cat >>confdefs.h <<\_ACEOF
+
+cat >>confdefs.h <<\_ACEOF
#define TCL_COMPILE_DEBUG 1
_ACEOF
- cat >>confdefs.h <<\_ACEOF
+
+cat >>confdefs.h <<\_ACEOF
#define TCL_COMPILE_STATS 1
_ACEOF
@@ -4583,6 +5173,7 @@ fi
+
# empty on win
@@ -4663,8 +5254,6 @@ fi
-
-
ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
@@ -5312,8 +5901,11 @@ s,@OBJEXT@,$OBJEXT,;t t
s,@CPP@,$CPP,;t t
s,@EGREP@,$EGREP,;t t
s,@AR@,$AR,;t t
+s,@ac_ct_AR@,$ac_ct_AR,;t t
s,@RANLIB@,$RANLIB,;t t
+s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t
s,@RC@,$RC,;t t
+s,@ac_ct_RC@,$ac_ct_RC,;t t
s,@SET_MAKE@,$SET_MAKE,;t t
s,@TCL_THREADS@,$TCL_THREADS,;t t
s,@CYGPATH@,$CYGPATH,;t t
@@ -5334,6 +5926,7 @@ s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t
s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t
s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t
s,@PKG_CFG_ARGS@,$PKG_CFG_ARGS,;t t
+s,@TCL_EXE@,$TCL_EXE,;t t
s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t
s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t
s,@TCL_STATIC_LIB_FILE@,$TCL_STATIC_LIB_FILE,;t t
@@ -5389,11 +5982,9 @@ s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t
s,@TCL_DDE_VERSION@,$TCL_DDE_VERSION,;t t
s,@TCL_DDE_MAJOR_VERSION@,$TCL_DDE_MAJOR_VERSION,;t t
s,@TCL_DDE_MINOR_VERSION@,$TCL_DDE_MINOR_VERSION,;t t
-s,@TCL_DDE_PATCH_LEVEL@,$TCL_DDE_PATCH_LEVEL,;t t
s,@TCL_REG_VERSION@,$TCL_REG_VERSION,;t t
s,@TCL_REG_MAJOR_VERSION@,$TCL_REG_MAJOR_VERSION,;t t
s,@TCL_REG_MINOR_VERSION@,$TCL_REG_MINOR_VERSION,;t t
-s,@TCL_REG_PATCH_LEVEL@,$TCL_REG_PATCH_LEVEL,;t t
s,@RC_OUT@,$RC_OUT,;t t
s,@RC_TYPE@,$RC_TYPE,;t t
s,@RC_INCLUDE@,$RC_INCLUDE,;t t
diff --git a/win/configure.in b/win/configure.in
index 77420a2..b0c007a 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -2,8 +2,6 @@
# This file is an input file used by the GNU "autoconf" program to
# generate the file "configure", which is run during Tcl installation
# to configure the system for the local environment.
-#
-# RCS: @(#) $Id: configure.in,v 1.123 2010/08/27 00:50:51 hobbs Exp $
AC_INIT(../generic/tcl.h)
AC_PREREQ(2.59)
@@ -16,24 +14,27 @@ SHELL=/bin/sh
TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL="b1.2"
+TCL_PATCH_LEVEL=".0"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-TCL_DDE_VERSION=1.3
+TCL_DDE_VERSION=1.4
TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=3
-TCL_DDE_PATCH_LEVEL="2"
+TCL_DDE_MINOR_VERSION=4
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
TCL_REG_MINOR_VERSION=3
-TCL_REG_PATCH_LEVEL="0"
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
PKG_CFG_ARGS=$@
#------------------------------------------------------------------------
+# Empty slate for bundled packages, to avoid stale configuration
+#------------------------------------------------------------------------
+rm -Rf pkgs
+
+#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
@@ -60,31 +61,9 @@ AC_PROG_CC
AC_C_INLINE
AC_HEADER_STDC
-# To properly support cross-compilation, one would
-# need to use these tool checks instead of
-# the ones below and reconfigure with
-# autoconf 2.50. You can also just set
-# the CC, AR, RANLIB, and RC environment
-# variables if you want to cross compile.
-dnl AC_CHECK_TOOL(AR, ar)
-dnl AC_CHECK_TOOL(RANLIB, ranlib)
-dnl AC_CHECK_TOOL(RC, windres)
-
-if test "${GCC}" = "yes" ; then
- AC_CHECK_PROG(AR, ar, ar)
- AC_CHECK_PROG(RANLIB, ranlib, ranlib)
- AC_CHECK_PROG(RC, windres, windres)
-
- if test "${AR}" = "" ; then
- AC_MSG_ERROR([Required archive tool 'ar' not found on PATH.])
- fi
- if test "${RANLIB}" = "" ; then
- AC_MSG_ERROR([Required archive index tool 'ranlib' not found on PATH.])
- fi
- if test "${RC}" = "" ; then
- AC_MSG_ERROR([Required resource tool 'windres' not found on PATH.])
- fi
-fi
+AC_CHECK_TOOL(AR, ar)
+AC_CHECK_TOOL(RANLIB, ranlib)
+AC_CHECK_TOOL(RC, windres)
#--------------------------------------------------------------------
# Checks to see if the make program sets the $MAKE variable.
@@ -93,163 +72,168 @@ fi
AC_PROG_MAKE_SET
#--------------------------------------------------------------------
-# Perform additinal compiler tests.
+# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------
-dnl Currently AC_CYGWIN is disabled since it invokes AC_CANONICAL_HOST
-dnl under autoconf 2.5X.
-dnl
-dnl AC_CYGWIN
+AC_OBJEXT
+AC_EXEEXT
-AC_CACHE_CHECK(for SEH support in compiler,
- tcl_cv_seh,
-AC_TRY_RUN([
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
+#--------------------------------------------------------------------
+# Check whether --enable-threads or --disable-threads was given.
+#--------------------------------------------------------------------
-int main(int argc, char** argv) {
- int a, b = 0;
- __try {
- a = 666 / b;
- }
- __except (EXCEPTION_EXECUTE_HANDLER) {
- return 0;
- }
- return 1;
-}
-],
- tcl_cv_seh=yes,
- tcl_cv_seh=no,
- tcl_cv_seh=no)
-)
-if test "$tcl_cv_seh" = "no" ; then
- AC_DEFINE(HAVE_NO_SEH, 1,
- [Defined when mingw does not support SEH])
-fi
+SC_ENABLE_THREADS
-#
-# Check to see if the excpt.h include file provided contains the
-# definition for EXCEPTION_DISPOSITION; if not, which is the case
-# with Cygwin's version as of 2002-04-10, define it to be int,
-# sufficient for getting the current code to work.
-#
-AC_CACHE_CHECK(for EXCEPTION_DISPOSITION support in include files,
- tcl_cv_eh_disposition,
-AC_TRY_COMPILE([
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-],
-[
- EXCEPTION_DISPOSITION x;
-],
- tcl_cv_eh_disposition=yes,
- tcl_cv_eh_disposition=no)
-)
-if test "$tcl_cv_eh_disposition" = "no" ; then
- AC_DEFINE(EXCEPTION_DISPOSITION, int,
- [Defined when cygwin/mingw does not support EXCEPTION DISPOSITION])
-fi
+#------------------------------------------------------------------------
+# Embedded configuration information, encoding to use for the values, TIP #59
+#------------------------------------------------------------------------
+
+SC_TCL_CFG_ENCODING
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libtcl as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+SC_ENABLE_SHARED
+#--------------------------------------------------------------------
+# The statements below define a collection of compile flags. This
+# macro depends on the value of SHARED_BUILD, and should be called
+# after SC_ENABLE_SHARED checks the configure switches.
+#--------------------------------------------------------------------
+
+SC_CONFIG_CFLAGS
+
+# Cross-compiling
+case ${host_alias} in
+*mingw32*)
+ TCL_EXE="tclsh"
+ ;;
+*)
+ TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}"
+ ;;
+esac
+
+#------------------------------------------------------------------------
+# Add stuff for zlib; note that this is mostly done in the makefile now
+# as we just assume that the platform hasn't got a usable z.lib
+#------------------------------------------------------------------------
+
+AS_IF([test "${enable_shared+set}" = "set"], [
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+], [
+ tcl_ok=yes
+])
+AS_IF([test "$tcl_ok" = "yes"], [
+ AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}])
+ AS_IF([test "$do64bit" = "yes"], [
+ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win64/zdll.lib])
+ ], [
+ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win32/zdll.lib])
+ ])
+], [
+ AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
+ AC_DEFINE_UNQUOTED(NO_VIZ, 1)
+])
+AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?])
-# Check to see if the winsock2.h include file provided contains
-# typedefs like LPFN_ACCEPT and friends.
-#
-AC_CACHE_CHECK(for LPFN_ACCEPT support in winsock2.h,
- tcl_cv_lpfn_decls,
+AC_CHECK_TYPE([intptr_t], [
+ AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
+ AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
+ for tcl_cv_intptr_t in "int" "long" "long long" none; do
+ if test "$tcl_cv_intptr_t" != none; then
+ AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
+ [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])],
+ [tcl_ok=yes], [tcl_ok=no])
+ test "$tcl_ok" = yes && break; fi
+ done])
+ if test "$tcl_cv_intptr_t" != none; then
+ AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer
+ type wide enough to hold a pointer.])
+ fi
+])
+AC_CHECK_TYPE([uintptr_t], [
+ AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [
+ AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [
+ for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
+ none; do
+ if test "$tcl_cv_uintptr_t" != none; then
+ AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
+ [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])],
+ [tcl_ok=yes], [tcl_ok=no])
+ test "$tcl_ok" = yes && break; fi
+ done])
+ if test "$tcl_cv_uintptr_t" != none; then
+ AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer
+ type wide enough to hold a pointer.])
+ fi
+])
+
+#--------------------------------------------------------------------
+# Perform additinal compiler tests.
+#--------------------------------------------------------------------
+
+# See if declarations like FINDEX_INFO_LEVELS are
+# missing from winbase.h. This is known to be
+# a problem with VC++ 5.2.
+
+AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h,
+ tcl_cv_findex_enums,
AC_TRY_COMPILE([
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
-#include <winsock2.h>
],
[
- LPFN_ACCEPT accept;
+ FINDEX_INFO_LEVELS i;
+ FINDEX_SEARCH_OPS j;
],
- tcl_cv_lpfn_decls=yes,
- tcl_cv_lpfn_decls=no)
+ tcl_cv_findex_enums=yes,
+ tcl_cv_findex_enums=no)
)
-if test "$tcl_cv_lpfn_decls" = "no" ; then
- AC_DEFINE(HAVE_NO_LPFN_DECLS, 1,
- [Defined when cygwin/mingw does not support LPFN_ACCEPT and friends.])
+if test "$tcl_cv_findex_enums" = "no"; then
+ AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1,
+ [Defined when enums are missing from winbase.h])
fi
-# Check to see if winnt.h defines CHAR, SHORT, and LONG
-# even if VOID has already been #defined. The win32api
-# used by mingw and cygwin is known to do this.
+# See if the compiler supports intrinsics.
-AC_CACHE_CHECK(for winnt.h that ignores VOID define,
- tcl_cv_winnt_ignore_void,
-AC_TRY_COMPILE([
-#define VOID void
+AC_CACHE_CHECK(for intrinsics support in compiler,
+ tcl_cv_intrinsics,
+AC_TRY_LINK([
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
+#include <intrin.h>
],
[
- CHAR c;
- SHORT s;
- LONG l;
+ __cpuidex(0,0,0);
],
- tcl_cv_winnt_ignore_void=yes,
- tcl_cv_winnt_ignore_void=no)
+ tcl_cv_intrinsics=yes,
+ tcl_cv_intrinsics=no)
)
-if test "$tcl_cv_winnt_ignore_void" = "yes" ; then
- AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1,
- [Defined when cygwin/mingw ignores VOID define in winnt.h])
+if test "$tcl_cv_intrinsics" = "yes"; then
+ AC_DEFINE(HAVE_INTRIN_H, 1,
+ [Defined when the compilers supports intrinsics])
fi
-# Check to see if malloc.h is missing the alloca function
-# declaration. This is known to be a problem with Mingw.
-# If we compiled without the function declaration, it
-# would work but we would get a warning message from gcc.
-# If we add the function declaration ourselves, it
-# would not compile correctly because the _alloca
-# function expects the argument to be passed in a
-# register and not on the stack. Instead, we just
-# call it from inline asm code.
-
-AC_CACHE_CHECK(for alloca declaration in malloc.h,
- tcl_cv_malloc_decl_alloca,
-AC_TRY_COMPILE([
-#include <malloc.h>
-],
-[
- size_t arg = 0;
- void* ptr;
- ptr = alloca;
- ptr = alloca(arg);
-],
- tcl_cv_malloc_decl_alloca=yes,
- tcl_cv_malloc_decl_alloca=no)
-)
-if test "$tcl_cv_malloc_decl_alloca" = "no" &&
- test "${GCC}" = "yes" ; then
- AC_DEFINE(HAVE_ALLOCA_GCC_INLINE, 1,
- [Defined when gcc should use inline ASM to call alloca.])
-fi
-
-# See if the compiler supports casting to a union type.
-# This is used to stop gcc from printing a compiler
-# warning when initializing a union member.
+# See if the <wspiapi.h> header file is present
-AC_CACHE_CHECK(for cast to union support,
- tcl_cv_cast_to_union,
-AC_TRY_COMPILE([],
-[
- union foo { int i; double d; };
- union foo f = (union foo) (int) 0;
-],
- tcl_cv_cast_to_union=yes,
- tcl_cv_cast_to_union=no)
+AC_CACHE_CHECK(for wspiapi.h,
+ tcl_cv_wspiapi_h,
+AC_TRY_COMPILE([
+#include <wspiapi.h>
+], [],
+ tcl_cv_wspiapi_h=yes,
+ tcl_cv_wspiapi_h=no)
)
-if test "$tcl_cv_cast_to_union" = "yes"; then
- AC_DEFINE(HAVE_CAST_TO_UNION, 1,
- [Defined when compiler supports casting to union type.])
+if test "$tcl_cv_wspiapi_h" = "yes"; then
+ AC_DEFINE(HAVE_WSPIAPI_H, 1,
+ [Defined when wspiapi.h exists])
fi
-
# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.
@@ -273,84 +257,6 @@ if test "$tcl_cv_findex_enums" = "no"; then
[Defined when enums are missing from winbase.h])
fi
-# See if MWMO_ALERTABLE is missing from winuser.h
-# This is known to be a problem with Mingw.
-
-AC_CACHE_CHECK(for MWMO_ALERTABLE in winuser.h,
- tcl_cv_mwmo_alertable,
-AC_TRY_COMPILE([
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-],
-[
- int i = MWMO_ALERTABLE;
-],
- tcl_cv_mwmo_alertable=yes,
- tcl_cv_mwmo_alertable=no)
-)
-if test "$tcl_cv_mwmo_alertable" = "no"; then
- AC_DEFINE(HAVE_NO_MWMO_ALERTABLE, 1,
- [Defined when MWMO_ALERTABLE is missing from winuser.h])
-fi
-
-#--------------------------------------------------------------------
-# Determines the correct binary file extension (.o, .obj, .exe etc.)
-#--------------------------------------------------------------------
-
-AC_OBJEXT
-AC_EXEEXT
-
-#--------------------------------------------------------------------
-# Check whether --enable-threads or --disable-threads was given.
-#--------------------------------------------------------------------
-
-SC_ENABLE_THREADS
-
-#------------------------------------------------------------------------
-# Embedded configuration information, encoding to use for the values, TIP #59
-#------------------------------------------------------------------------
-
-SC_TCL_CFG_ENCODING
-
-#--------------------------------------------------------------------
-# The statements below define a collection of symbols related to
-# building libtcl as a shared library instead of a static library.
-#--------------------------------------------------------------------
-
-SC_ENABLE_SHARED
-
-#--------------------------------------------------------------------
-# The statements below define a collection of compile flags. This
-# macro depends on the value of SHARED_BUILD, and should be called
-# after SC_ENABLE_SHARED checks the configure switches.
-#--------------------------------------------------------------------
-
-SC_CONFIG_CFLAGS
-
-#------------------------------------------------------------------------
-# Add stuff for zlib; note that this is mostly done in the makefile now
-# as we just assume that the platform hasn't got a usable z.lib
-#------------------------------------------------------------------------
-
-AS_IF([test "$do64bit" = "yes"], [
- tcl_ok=no
-], [
-AS_IF([test "${enable_shared+set}" = "set"], [
- enableval="$enable_shared"
- tcl_ok=$enableval
-], [
- tcl_ok=yes
-])
-])
-AS_IF([test "$tcl_ok" = "yes"], [
- AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}])
- AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win32/zdll.lib])
-], [
- AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
-])
-AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?])
-
#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
# option. This macro depends on C flags, and should be called
@@ -446,6 +352,7 @@ AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(PKG_CFG_ARGS)
+AC_SUBST(TCL_EXE)
AC_SUBST(TCL_LIB_FILE)
AC_SUBST(TCL_LIB_FLAG)
@@ -521,11 +428,9 @@ AC_SUBST(TCL_PACKAGE_PATH)
AC_SUBST(TCL_DDE_VERSION)
AC_SUBST(TCL_DDE_MAJOR_VERSION)
AC_SUBST(TCL_DDE_MINOR_VERSION)
-AC_SUBST(TCL_DDE_PATCH_LEVEL)
AC_SUBST(TCL_REG_VERSION)
AC_SUBST(TCL_REG_MAJOR_VERSION)
AC_SUBST(TCL_REG_MINOR_VERSION)
-AC_SUBST(TCL_REG_PATCH_LEVEL)
AC_SUBST(RC)
AC_SUBST(RC_OUT)
diff --git a/win/makefile.bc b/win/makefile.bc
index 12ba603..18bfa28 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -126,8 +126,8 @@ STUBPREFIX = $(NAMEPREFIX)stub
DOTVERSION = 8.6
VERSION = 86
-DDEVERSION = 13
-DDEDOTVERSION = 1.3
+DDEVERSION = 14
+DDEDOTVERSION = 1.4
REGVERSION = 13
REGDOTVERSION = 1.3
@@ -136,7 +136,7 @@ BINROOT = ..
!IF "$(NODEBUG)" == "1"
TMPDIRNAME = Release
DBGX =
-SYMDEFINES =
+SYMDEFINES = -DNDEBUG
!ELSE
TMPDIRNAME = Debug
#DBGX = d
@@ -433,10 +433,10 @@ install-libraries:
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
-@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
-@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
- @echo installing msgcat1.4
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.4"
- -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.4"
- -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.4"
+ @echo installing msgcat1.5
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
+ -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
+ -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
@echo installing tcltest2.3
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
-@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
diff --git a/win/makefile.vc b/win/makefile.vc
index 8e0ea11..2784140 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -11,15 +11,11 @@
# Copyright (c) 2001-2005 ActiveState Corporation.
# Copyright (c) 2001-2004 David Gravereaux.
# Copyright (c) 2003-2008 Pat Thoyts.
-#
-#------------------------------------------------------------------------------
-# RCS: @(#) $Id: makefile.vc,v 1.214 2010/09/09 14:30:20 nijtmans Exp $
#------------------------------------------------------------------------------
-# Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR)
-# or with the MS Platform SDK (MSSDK). Visual Studio .NET 2003 and 2005 define
-# VCINSTALLDIR instead.
-!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(MSSDK) && !defined(VCINSTALLDIR)
+# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
+# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)
+!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
MSG = ^
You need to run vcvars32.bat from Developer Studio or setenv.bat from the^
Platform SDK first to setup the environment. Jump to this line to read^
@@ -75,57 +71,62 @@ the build instructions.
# Sets where to install Tcl from the built binaries.
# C:\Progra~1\Tcl is assumed when not specified.
#
-# OPTS=static,msvcrt,staticpkg,nothreads,symbols,profile,loimpact,unchecked,pdbs,none
+# OPTS=loimpact,msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,tclalloc,unchecked,none
# Sets special options for the core. The default is for none.
# Any combination of the above may be used (comma separated).
# 'none' will over-ride everything to nothing.
#
-# static = Builds a static library of the core instead of a
-# dll. The shell will be static (and large), as well.
-# msvcrt = Affects the static option only to switch it from
+# loimpact = Adds a flag for how NT treats the heap to keep memory
+# in use, low. This is said to impact alloc performance.
+# msvcrt = Affects the static option only to switch it from
# using libcmt(d) as the C runtime [by default] to
# msvcrt(d). This is useful for static embedding
# support.
+# nothreads= Turns off full multithreading support.
+# pdbs = Build detached symbols for release builds.
+# profile = Adds profiling hooks. Map file is assumed.
+# static = Builds a static library of the core instead of a
+# dll. The static library will contain the dde and reg
+# extensions. External applications who want to use
+# this, need to link with the stub library as well as
+# the static Tcl library.The shell will be static (and
+# large), as well.
# staticpkg = Affects the static option only to switch
# tclshXX.exe to have the dde and reg extension linked
# inside it.
-# nothreads = Turns off full multithreading support.
+# symbols = Debug build. Links to the debug C runtime, disables
+# optimizations and creates pdb symbols files.
# thrdalloc = Use the thread allocator (shared global free pool)
# This is the default on threaded builds.
# tclalloc = Use the old non-thread allocator
-# symbols = Debug build. Links to the debug C runtime, disables
-# optimizations and creates pdb symbols files.
-# pdbs = Build detached symbols for release builds.
-# profile = Adds profiling hooks. Map file is assumed.
-# loimpact = Adds a flag for how NT treats the heap to keep memory
-# in use, low. This is said to impact alloc performance.
-# unchecked = Allows a symbols build to not use the debug
+# unchecked= Allows a symbols build to not use the debug
# enabled runtime (msvcrt.dll not msvcrtd.dll
# or libcmt.lib not libcmtd.lib).
#
-# STATS=memdbg,compdbg,none
+# STATS=compdbg,memdbg,none
# Sets optional memory and bytecode compiler debugging code added
# to the core. The default is for none. Any combination of the
# above may be used (comma separated). 'none' will over-ride
# everything to nothing.
#
-# memdbg = Enables the debugging memory allocator.
# compdbg = Enables byte compilation logging.
+# memdbg = Enables the debugging memory allocator.
#
-# CHECKS=nodep,fullwarn,64bit,none
+# CHECKS=64bit,fullwarn,nodep,none
# Sets special macros for checking compatability.
#
-# nodep = Turns off compatability macros to ensure the core
-# isn't being built with deprecated functions.
+# 64bit = Enable 64bit portability warnings (if available)
# fullwarn = Builds with full compiler and link warnings enabled.
# Very verbose.
-# 64bit = Enable 64bit portability warnings (if available)
+# nodep = Turns off compatability macros to ensure the core
+# isn't being built with deprecated functions.
#
-# MACHINE=(IX86|IA64|AMD64|ALPHA)
+# MACHINE=(ALPHA|AMD64|IA64|IX86)
# Set the machine type used for the compiler, linker, and
# resource compiler. This hook is needed to tell the tools
# when alternate platforms are requested. IX86 is the default
-# when not specified.
+# when not specified. If the CPU environment variable has been
+# set (ie: recent Platform SDK) then MACHINE is set from CPU.
#
# TMP_DIR=<path>
# OUT_DIR=<path>
@@ -182,14 +183,14 @@ Please `cd` to its location first.
!error $(MSG)
!endif
-PROJECT = tcl
+PROJECT = tcl
!include "rules.vc"
STUBPREFIX = $(PROJECT)stub
DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
-DDEDOTVERSION = 1.3
+DDEDOTVERSION = 1.4
DDEVERSION = $(DDEDOTVERSION:.=)
REGDOTVERSION = 1.3
@@ -217,6 +218,15 @@ TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
CAT32 = $(OUT_DIR)\cat32.exe
+# Can we run what we build? IX86 runs on all architectures.
+!ifndef TCLSH_NATIVE
+!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
+TCLSH_NATIVE = $(TCLSH)
+!else
+!error You must explicitly set TCLSH_NATIVE for cross-compilation
+!endif
+!endif
+
### Make sure we use backslash only.
LIB_INSTALL_DIR = $(_INSTALLDIR)\lib
BIN_INSTALL_DIR = $(_INSTALLDIR)\bin
@@ -226,10 +236,12 @@ INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
TCLSHOBJS = \
$(TMP_DIR)\tclAppInit.obj \
+!if !$(STATIC_BUILD)
!if $(TCL_USE_STATIC_PACKAGES)
$(TMP_DIR)\tclWinReg.obj \
$(TMP_DIR)\tclWinDde.obj \
!endif
+!endif
$(TMP_DIR)\tclsh.res
TCLTESTOBJS = \
@@ -238,10 +250,12 @@ TCLTESTOBJS = \
$(TMP_DIR)\tclTestProcBodyObj.obj \
$(TMP_DIR)\tclThreadTest.obj \
$(TMP_DIR)\tclWinTest.obj \
+!if !$(STATIC_BUILD)
!if $(TCL_USE_STATIC_PACKAGES)
$(TMP_DIR)\tclWinReg.obj \
$(TMP_DIR)\tclWinDde.obj \
!endif
+!endif
$(TMP_DIR)\testMain.obj
COREOBJS = \
@@ -250,6 +264,7 @@ COREOBJS = \
$(TMP_DIR)\regexec.obj \
$(TMP_DIR)\regfree.obj \
$(TMP_DIR)\tclAlloc.obj \
+ $(TMP_DIR)\tclAssembly.obj \
$(TMP_DIR)\tclAsync.obj \
$(TMP_DIR)\tclBasic.obj \
$(TMP_DIR)\tclBinary.obj \
@@ -289,6 +304,7 @@ COREOBJS = \
$(TMP_DIR)\tclLiteral.obj \
$(TMP_DIR)\tclLoad.obj \
$(TMP_DIR)\tclMain.obj \
+ $(TMP_DIR)\tclMain2.obj \
$(TMP_DIR)\tclNamesp.obj \
$(TMP_DIR)\tclNotify.obj \
$(TMP_DIR)\tclOO.obj \
@@ -354,6 +370,7 @@ TOMMATHOBJS = \
$(TMP_DIR)\bn_mp_cmp.obj \
$(TMP_DIR)\bn_mp_cmp_d.obj \
$(TMP_DIR)\bn_mp_cmp_mag.obj \
+ $(TMP_DIR)\bn_mp_cnt_lsb.obj \
$(TMP_DIR)\bn_mp_copy.obj \
$(TMP_DIR)\bn_mp_count_bits.obj \
$(TMP_DIR)\bn_mp_div.obj \
@@ -368,6 +385,7 @@ TOMMATHOBJS = \
$(TMP_DIR)\bn_mp_init_copy.obj \
$(TMP_DIR)\bn_mp_init_multi.obj \
$(TMP_DIR)\bn_mp_init_set.obj \
+ $(TMP_DIR)\bn_mp_init_set_int.obj \
$(TMP_DIR)\bn_mp_init_size.obj \
$(TMP_DIR)\bn_mp_karatsuba_mul.obj \
$(TMP_DIR)\bn_mp_karatsuba_sqr.obj \
@@ -385,6 +403,7 @@ TOMMATHOBJS = \
$(TMP_DIR)\bn_mp_read_radix.obj \
$(TMP_DIR)\bn_mp_rshd.obj \
$(TMP_DIR)\bn_mp_set.obj \
+ $(TMP_DIR)\bn_mp_set_int.obj \
$(TMP_DIR)\bn_mp_shrink.obj \
$(TMP_DIR)\bn_mp_sqr.obj \
$(TMP_DIR)\bn_mp_sqrt.obj \
@@ -418,11 +437,13 @@ PLATFORMOBJS = \
$(TMP_DIR)\tclWinSock.obj \
$(TMP_DIR)\tclWinThrd.obj \
$(TMP_DIR)\tclWinTime.obj \
-!if !$(STATIC_BUILD)
+!if $(STATIC_BUILD)
+ $(TMP_DIR)\tclWinReg.obj \
+ $(TMP_DIR)\tclWinDde.obj \
+!else
$(TMP_DIR)\tcl.res
!endif
-
TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
TCLSTUBOBJS = \
@@ -491,11 +512,11 @@ STUB_CFLAGS = $(cflags) $(cdebug) $(OPTDEFINES)
#---------------------------------------------------------------------
!if $(DEBUG)
-ldebug = -debug:full -debugtype:cv
+ldebug = -debug -debugtype:cv
!else
ldebug = -release -opt:ref -opt:icf,3
!if $(SYMBOLS)
-ldebug = $(ldebug) -debug:full -debugtype:cv
+ldebug = $(ldebug) -debug -debugtype:cv
!endif
!endif
@@ -522,7 +543,7 @@ dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
-baselibs = kernel32.lib user32.lib advapi32.lib ws2_32.lib
+baselibs = netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
@@ -554,27 +575,27 @@ install: install-binaries install-libraries install-docs install-pkgs
test: test-core test-pkgs
test-core: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT:\=/)/../library
+ set TCL_LIBRARY=$(ROOT:\=/)/library
!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
- $(DEBUGGER) $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
- set ::ddelib [file normalize $(TCLDDELIB:\=/)]
- set ::reglib [file normalize $(TCLREGLIB:\=/)]
+ $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
+ package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
+ package ifneeded registry 1.3.0 [list load "$(TCLREGLIB:\=/)" registry]
<<
!else
@echo Please wait while the tests are collected...
- $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
- set ::ddelib [file normalize $(TCLDDELIB:\=/)]
- set ::reglib [file normalize $(TCLREGLIB:\=/)]
+ $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
+ package ifneeded dde 1.4.0 "$(TCLDDELIB:\=/)" dde]
+ package ifneeded registry 1.3.0 "$(TCLREGLIB:\=/)" registry]
<<
type tests.log | more
!endif
runtest: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT)/library
+ set TCL_LIBRARY=$(ROOT:\=/)/library
$(DEBUGGER) $(TCLTEST) $(SCRIPT)
runshell: setup $(TCLSH) dlls
- set TCL_LIBRARY=$(ROOT)/library
+ set TCL_LIBRARY=$(ROOT:\=/)/library
$(DEBUGGER) $(TCLSH) $(SCRIPT)
setup:
@@ -809,7 +830,6 @@ install-docs:
@$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
!endif
-#"
#---------------------------------------------------------------------
# Build tclConfig.sh for the TEA build system.
#---------------------------------------------------------------------
@@ -828,7 +848,7 @@ $(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
@DEFS@ $(TCL_CFLAGS)
@CFLAGS_DEBUG@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd
@CFLAGS_OPTIMIZE@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD
-@LDFLAGS_DEBUG@ -nologo -machine:$(MACHINE) -debug:full -debugtype:cv
+@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
@@ -896,6 +916,10 @@ $(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c
-DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
-Fo$@ $?
+$(TMP_DIR)\tclMain2.obj: $(GENERICDIR)\tclMain.c
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -DTCL_ASCII_MAIN \
+ -Fo$@ $?
+
$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
$(cc32) $(TCL_CFLAGS) -Fo$@ $?
@@ -1144,15 +1168,15 @@ install-libraries: tclConfig install-msgs install-tzdata
install-tzdata:
@echo Installing time zone data
- @set TCL_LIBRARY=$(ROOT)/library
- @$(TCLSH) "$(ROOT)/tools/installData.tcl" \
- "$(ROOT)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
+ @set TCL_LIBRARY=$(ROOT:\=/)/library
+ @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
+ "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
install-msgs:
@echo Installing message catalogs
- @set TCL_LIBRARY=$(ROOT)/library
- @$(TCLSH) "$(ROOT)/tools/installData.tcl" \
- "$(ROOT)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
+ @set TCL_LIBRARY=$(ROOT:\=/)/library
+ @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
+ "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
#---------------------------------------------------------------------
# Clean up
diff --git a/win/nmakehlp.c b/win/nmakehlp.c
index e75f92c..b1a1517 100644
--- a/win/nmakehlp.c
+++ b/win/nmakehlp.c
@@ -9,16 +9,18 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * ----------------------------------------------------------------------------
- * RCS: @(#) $Id: nmakehlp.c,v 1.23 2009/01/19 19:54:19 davygrvy Exp $
* ----------------------------------------------------------------------------
*/
#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
+#define NO_SHLWAPI_GDI
+#define NO_SHLWAPI_STREAM
+#define NO_SHLWAPI_REG
+#include <shlwapi.h>
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
+#pragma comment (lib, "shlwapi.lib")
#include <stdio.h>
#include <math.h>
@@ -40,12 +42,13 @@
/* protos */
-int CheckForCompilerFeature(const char *option);
-int CheckForLinkerFeature(const char *option);
-int IsIn(const char *string, const char *substring);
-int SubstituteFile(const char *substs, const char *filename);
-const char * GetVersionFromFile(const char *filename, const char *match);
-DWORD WINAPI ReadFromPipe(LPVOID args);
+static int CheckForCompilerFeature(const char *option);
+static int CheckForLinkerFeature(const char *option);
+static int IsIn(const char *string, const char *substring);
+static int SubstituteFile(const char *substs, const char *filename);
+static int QualifyPath(const char *path);
+static const char *GetVersionFromFile(const char *filename, const char *match, int numdots);
+static DWORD WINAPI ReadFromPipe(LPVOID args);
/* globals */
@@ -150,12 +153,23 @@ main(
&dwWritten, NULL);
return 0;
}
- printf("%s\n", GetVersionFromFile(argv[2], argv[3]));
+ printf("%s\n", GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0'));
return 0;
+ case 'Q':
+ if (argc != 3) {
+ chars = snprintf(msg, sizeof(msg) - 1,
+ "usage: %s -Q path\n"
+ "Emit the fully qualified path\n"
+ "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+ &dwWritten, NULL);
+ return 2;
+ }
+ return QualifyPath(argv[2]);
}
}
chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -c|-l|-f|-g|-V ...\n"
+ "usage: %s -c|-f|-l|-Q|-s|-V ...\n"
"This is a little helper app to equalize shell differences between WinNT and\n"
"Win9x and get nmake.exe to accomplish its job.\n",
argv[0]);
@@ -163,7 +177,7 @@ main(
return 2;
}
-int
+static int
CheckForCompilerFeature(
const char *option)
{
@@ -248,7 +262,7 @@ CheckForCompilerFeature(
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
(300-chars), 0);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg,lstrlen(msg), &err,NULL);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
return 2;
}
@@ -297,7 +311,7 @@ CheckForCompilerFeature(
|| strstr(Err.buffer, "D2021") != NULL);
}
-int
+static int
CheckForLinkerFeature(
const char *option)
{
@@ -376,7 +390,7 @@ CheckForLinkerFeature(
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
(300-chars), 0);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg,lstrlen(msg), &err,NULL);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
return 2;
}
@@ -422,7 +436,7 @@ CheckForLinkerFeature(
strstr(Err.buffer, "LNK4044") != NULL);
}
-DWORD WINAPI
+static DWORD WINAPI
ReadFromPipe(
LPVOID args)
{
@@ -447,7 +461,7 @@ ReadFromPipe(
return 0; /* makes the compiler happy */
}
-int
+static int
IsIn(
const char *string,
const char *substring)
@@ -462,10 +476,11 @@ IsIn(
* package provide or package ifneeded.
*/
-const char *
+static const char *
GetVersionFromFile(
const char *filename,
- const char *match)
+ const char *match,
+ int numdots)
{
size_t cbBuffer = 100;
static char szBuffer[100];
@@ -483,9 +498,10 @@ GetVersionFromFile(
p = strstr(szBuffer, match);
if (p != NULL) {
/*
- * Skip to first digit.
+ * Skip to first digit after the match.
*/
+ p += strlen(match);
while (*p && !isdigit(*p)) {
++p;
}
@@ -495,7 +511,8 @@ GetVersionFromFile(
*/
q = p;
- while (*q && (isalnum(*q) || *q == '.')) {
+ while (*q && (strchr("0123456789.ab", *q)) && ((!strchr(".ab", *q)
+ && (!strchr("ab", q[-1])) || --numdots))) {
++q;
}
@@ -568,7 +585,7 @@ list_free(list_item_t **listPtrPtr)
* <<
*/
-int
+static int
SubstituteFile(
const char *substitutions,
const char *filename)
@@ -614,11 +631,11 @@ SubstituteFile(
}
}
#endif
-
+
/*
* Run the substitutions over each line of the input
*/
-
+
while (fgets(szBuffer, cbBuffer, fp) != NULL) {
list_item_t *p = NULL;
for (p = substPtr; p != NULL; p = p->nextPtr) {
@@ -638,12 +655,36 @@ SubstituteFile(
}
printf(szBuffer);
}
-
+
list_free(&substPtr);
}
fclose(fp);
return 0;
}
+
+/*
+ * QualifyPath --
+ *
+ * This composes the current working directory with a provided path
+ * and returns the fully qualified and normalized path.
+ * Mostly needed to setup paths for testing.
+ */
+
+static int
+QualifyPath(
+ const char *szPath)
+{
+ char szCwd[MAX_PATH + 1];
+ char szTmp[MAX_PATH + 1];
+ char *p;
+ GetCurrentDirectory(MAX_PATH, szCwd);
+ while ((p = strchr(szPath, '/')) && *p)
+ *p = '\\';
+ PathCombine(szTmp, szCwd, szPath);
+ PathCanonicalize(szCwd, szTmp);
+ printf("%s\n", szCwd);
+ return 0;
+}
/*
* Local variables:
diff --git a/win/rules.vc b/win/rules.vc
index f35a51f..1513198 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -8,10 +8,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 2001-2003 David Gravereaux.
-# Copyright (c) 2003-2007 Patrick Thoyts
-#
-#------------------------------------------------------------------------------
-# RCS: @(#) $Id: rules.vc,v 1.44 2010/08/31 20:48:17 nijtmans Exp $
+# Copyright (c) 2003-2008 Patrick Thoyts
#------------------------------------------------------------------------------
!ifndef _RULES_VC
@@ -30,18 +27,6 @@ _INSTALLDIR = C:\Program Files\Tcl
_INSTALLDIR = $(INSTALLDIR:/=\)
!endif
-!ifndef MACHINE
-!if "$(CPU)" == "" || "$(CPU)" == "i386"
-MACHINE = IX86
-!else
-MACHINE = $(CPU)
-!endif
-!endif
-
-!ifndef CFG_ENCODING
-CFG_ENCODING = \"cp1252\"
-!endif
-
#----------------------------------------------------------
# Set the proper copy method to avoid overwrite questions
# to the user when copying files and selecting the right
@@ -67,6 +52,50 @@ ERRNULL = >NUL # Win9x shell cannot redirect stderr
!endif
MKDIR = mkdir
+#------------------------------------------------------------------------------
+# Determine the host and target architectures and compiler version.
+#------------------------------------------------------------------------------
+
+_HASH=^#
+_VC_MANIFEST_EMBED_EXE=
+_VC_MANIFEST_EMBED_DLL=
+VCVER=0
+!if ![echo VCVERSION=_MSC_VER > vercl.x] \
+ && ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \
+ && ![echo ARCH=IX86 >> vercl.x] \
+ && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \
+ && ![echo ARCH=AMD64 >> vercl.x] \
+ && ![echo $(_HASH)endif >> vercl.x] \
+ && ![cl -nologo -TC -P vercl.x $(ERRNULL)]
+!include vercl.i
+!if ![echo VCVER= ^\> vercl.vc] \
+ && ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc]
+!include vercl.vc
+!endif
+!endif
+!if ![del $(ERRNUL) /q/f vercl.x vercl.i vercl.vc]
+!endif
+
+!if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86]
+NATIVE_ARCH=IX86
+!else
+NATIVE_ARCH=AMD64
+!endif
+
+# Since MSVC8 we must deal with manifest resources.
+!if $(VCVERSION) >= 1400
+_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1
+_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
+!endif
+
+!ifndef MACHINE
+MACHINE=$(ARCH)
+!endif
+
+!ifndef CFG_ENCODING
+CFG_ENCODING = \"cp1252\"
+!endif
+
!message ===============================================================================
#----------------------------------------------------------
@@ -179,34 +208,6 @@ LINKERFLAGS =-ltcg
!endif
#----------------------------------------------------------
-# MSVC8 (ships with Visual Studio 2005) generates a manifest
-# file that we should link into the binaries. This is how.
-#----------------------------------------------------------
-
-_VC_MANIFEST_EMBED_EXE=
-_VC_MANIFEST_EMBED_DLL=
-VCVER=0
-!if ![echo VCVERSION=_MSC_VER > vercl.x] \
- && ![cl -nologo -TC -P vercl.x $(ERRNULL)]
-!include vercl.i
-!if $(VCVERSION) >= 1500
-VCVER=9
-!elseif $(VCVERSION) >= 1400
-VCVER=8
-!elseif $(VCVERSION) >= 1300
-VCVER=7
-!elseif $(VCVERSION) >= 1200
-VCVER=6
-!endif
-!endif
-
-# Since MSVC8 we must deal with manifest resources.
-!if $(VCVERSION) >= 1400
-_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1
-_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
-!endif
-
-#----------------------------------------------------------
# Decode the options requested.
#----------------------------------------------------------
@@ -217,7 +218,7 @@ DEBUG = 0
SYMBOLS = 0
PROFILE = 0
PGO = 0
-MSVCRT = 0
+MSVCRT = 1
LOIMPACT = 0
TCL_USE_STATIC_PACKAGES = 0
USE_THREAD_ALLOC = 1
@@ -233,18 +234,23 @@ STATIC_BUILD = 0
!message *** Doing msvcrt
MSVCRT = 1
!else
+!if !$(STATIC_BUILD)
+MSVCRT = 1
+!else
MSVCRT = 0
!endif
-!if [nmakehlp -f $(OPTS) "staticpkg"]
+!endif
+!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
-!message *** Doing threads
TCL_THREADS = 1
USE_THREAD_ALLOC= 1
!endif
@@ -286,7 +292,7 @@ LOIMPACT = 0
USE_THREAD_ALLOC = 1
!endif
!if [nmakehlp -f $(OPTS) "tclalloc"]
-!message *** Doing thrdalloc
+!message *** Doing tclalloc
USE_THREAD_ALLOC = 0
!endif
!if [nmakehlp -f $(OPTS) "unchecked"]
@@ -297,15 +303,6 @@ UNCHECKED = 0
!endif
!endif
-
-!if !$(STATIC_BUILD)
-# Make sure we don't build overly fat DLLs.
-MSVCRT = 1
-# We shouldn't statically put the extensions inside the shell when dynamic.
-TCL_USE_STATIC_PACKAGES = 0
-!endif
-
-
#----------------------------------------------------------
# Figure-out how to name our intermediate and output directories.
# We wouldn't want different builds to use the same .obj files
@@ -347,10 +344,8 @@ TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX
TMP_DIRFULL = $(TMP_DIRFULL:Static=)
SUFX = $(SUFX:s=)
EXT = dll
-!if $(MSVCRT)
TMP_DIRFULL = $(TMP_DIRFULL:X=)
SUFX = $(SUFX:x=)
-!endif
!else
TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=)
EXT = lib
@@ -472,18 +467,21 @@ OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD
OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED
!endif
-!if $(DEBUG)
-OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DEBUG
-!elseif $(OPTIMIZING)
+!if !$(DEBUG)
+OPTDEFINES = $(OPTDEFINES) -DNDEBUG
+!if $(OPTIMIZING)
OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_OPTIMIZED
!endif
+!endif
!if $(PROFILE)
OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_PROFILED
!endif
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT
!endif
-
+!if $(VCVERSION) < 1300
+OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64
+!endif
#----------------------------------------------------------
# Locate the Tcl headers to build against
@@ -579,12 +577,6 @@ Failed to find tcl.h. The TCLDIR macro does not appear correct.
TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
-!if $(TCL_VERSION) < 81
-TCL_DOES_STUBS = 0
-!else
-TCL_DOES_STUBS = 1
-!endif
-
!if $(TCLINSTALL)
TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
!if !exist($(TCLSH)) && $(TCL_THREADS)
@@ -594,7 +586,7 @@ TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib"
TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
TCL_LIBRARY = $(_TCLDIR)\lib
TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib"
COFFBASE = \must\have\tcl\sources\to\build\this\target
TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES = -I"$(_TCLDIR)\include"
@@ -607,7 +599,7 @@ TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
TCL_LIBRARY = $(_TCLDIR)\library
TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib"
COFFBASE = "$(_TCLDIR)\win\coffbase.txt"
TCLTOOLSDIR = $(_TCLDIR)\tools
TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
@@ -699,6 +691,7 @@ TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
!message *** Suffix for binaries will be '$(SUFX)'
!message *** Optional defines are '$(OPTDEFINES)'
!message *** Compiler version $(VCVER). Target machine is $(MACHINE)
+!message *** Host architecture is $(NATIVE_ARCH)
!message *** Compiler options '$(COMPILERFLAGS) $(OPTIMIZATIONS) $(DEBUGFLAGS) $(WARNINGS)'
!message *** Link options '$(LINKERFLAGS)'
diff --git a/win/tcl.dsp b/win/tcl.dsp
index 27b4220..57ec6bf 100644
--- a/win/tcl.dsp
+++ b/win/tcl.dsp
@@ -1560,10 +1560,6 @@ SOURCE=.\tclWinThrd.c
# End Source File
# Begin Source File
-SOURCE=.\tclWinThrd.h
-# End Source File
-# Begin Source File
-
SOURCE=.\tclWinTime.c
# End Source File
# End Group
diff --git a/win/tcl.m4 b/win/tcl.m4
index 20845c0..5e8e135 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -34,7 +34,10 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [
AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
fi
if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
- AC_MSG_ERROR(There is no tclConfig.sh in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
+ if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then
+ AC_MSG_ERROR(There is no tclConfig.sh in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
+ fi
+ TCL_BIN_DIR=`cd ${TCL_BIN_DIR}/../unix; pwd`
fi
AC_MSG_RESULT($TCL_BIN_DIR/tclConfig.sh)
])
@@ -208,7 +211,7 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [
AC_DEFUN([SC_ENABLE_SHARED], [
AC_MSG_CHECKING([how to build libraries])
AC_ARG_ENABLE(shared,
- [ --enable-shared build and link with shared libraries [--enable-shared]],
+ [ --enable-shared build and link with shared libraries (default: on)],
[tcl_ok=$enableval], [tcl_ok=yes])
if test "${enable_shared+set}" = set; then
@@ -247,11 +250,11 @@ AC_DEFUN([SC_ENABLE_SHARED], [
AC_DEFUN([SC_ENABLE_THREADS], [
AC_MSG_CHECKING(for building with threads)
- AC_ARG_ENABLE(threads, [ --enable-threads build with threads],
+ AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: on)],
[tcl_ok=$enableval], [tcl_ok=yes])
if test "$tcl_ok" = "yes"; then
- AC_MSG_RESULT(yes)
+ AC_MSG_RESULT([yes (default)])
TCL_THREADS=1
AC_DEFINE(TCL_THREADS)
# USE_THREAD_ALLOC tells us to try the special thread-based
@@ -294,12 +297,13 @@ AC_DEFUN([SC_ENABLE_THREADS], [
AC_DEFUN([SC_ENABLE_SYMBOLS], [
AC_MSG_CHECKING([for build with symbols])
- AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no])
+ AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols (default: off)], [tcl_ok=$enableval], [tcl_ok=no])
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
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])
AC_DEFINE(TCL_CFG_OPTIMIZED)
@@ -313,15 +317,14 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [
fi
AC_SUBST(CFLAGS_DEFAULT)
AC_SUBST(LDFLAGS_DEFAULT)
- AC_DEFINE(TCL_CFG_DEBUG)
if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then
- AC_DEFINE(TCL_MEM_DEBUG)
+ AC_DEFINE(TCL_MEM_DEBUG, 1, [Is memory debugging enabled?])
fi
if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then
- AC_DEFINE(TCL_COMPILE_DEBUG)
- AC_DEFINE(TCL_COMPILE_STATS)
+ AC_DEFINE(TCL_COMPILE_DEBUG, 1, [Is bytecode debugging enabled?])
+ AC_DEFINE(TCL_COMPILE_STATS, 1, [Are bytecode statistics enabled?])
fi
if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
@@ -402,11 +405,49 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
# Set some defaults (may get changed below)
EXTRA_CFLAGS=""
+ AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])
AC_CHECK_PROG(CYGPATH, cygpath, cygpath -w, echo)
SHLIB_SUFFIX=".dll"
+ # MACHINE is IX86 for LINK, but this is used by the manifest,
+ # which requires x86|amd64|ia64.
+ MACHINE="X86"
+
+ if test "$GCC" = "yes"; then
+
+ AC_CACHE_CHECK(for cross-compile version of gcc,
+ ac_cv_cross,
+ AC_TRY_COMPILE([
+ #ifndef __WIN32__
+ #error cross-compiler
+ #endif
+ ], [],
+ ac_cv_cross=no,
+ ac_cv_cross=yes)
+ )
+
+ if test "$ac_cv_cross" = "yes"; then
+ case "$do64bit" in
+ amd64|x64|yes)
+ CC="x86_64-w64-mingw32-gcc"
+ LD="x86_64-w64-mingw32-ld"
+ AR="x86_64-w64-mingw32-ar"
+ RANLIB="x86_64-w64-mingw32-ranlib"
+ RC="x86_64-w64-mingw32-windres"
+ ;;
+ *)
+ CC="i686-w64-mingw32-gcc"
+ LD="i686-w64-mingw32-ld"
+ AR="i686-w64-mingw32-ar"
+ RANLIB="i686-w64-mingw32-ranlib"
+ RC="i686-w64-mingw32-windres"
+ ;;
+ esac
+ fi
+ fi
+
# Check for a bug in gcc's windres that causes the
# compile to fail when a Windows native path is
# passed into windres. The mingw toolchain requires
@@ -432,23 +473,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
cyg_conftest=
fi
- AC_CACHE_CHECK(for Cygwin version of gcc,
- ac_cv_cygwin,
- AC_TRY_COMPILE([
- #ifdef __CYGWIN__
- #error cygwin
- #endif
- ],
- [],
- ac_cv_cygwin=no,
- ac_cv_cygwin=yes)
- )
- if test "$ac_cv_cygwin" = "yes" ; then
- AC_MSG_WARN([Compiling under Cygwin is not currently supported.
-If you are not sure you want this, see the README
-file for information about building with Mingw.])
- fi
- if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then
+ if test "$CYGPATH" = "echo"; then
DEPARG='"$<"'
else
DEPARG='"$(shell $(CYGPATH) $<)"'
@@ -456,14 +481,45 @@ file for information about building with Mingw.])
# set various compiler flags depending on whether we are using gcc or cl
- AC_MSG_CHECKING([compiler flags])
if test "${GCC}" = "yes" ; then
- if test "$do64bit" != "no" ; then
- AC_MSG_WARN([64bit mode not supported with GCC on Windows])
+ AC_CACHE_CHECK(for mingw32 version of gcc,
+ ac_cv_win32,
+ AC_TRY_COMPILE([
+ #ifdef __WIN32__
+ #error win32
+ #endif
+ ], [],
+ ac_cv_win32=no,
+ ac_cv_win32=yes)
+ )
+ if test "$ac_cv_win32" != "yes"; then
+ AC_MSG_ERROR([${CC} cannot produce win32 executables.])
fi
+
+ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
+ AC_CACHE_CHECK(for working -municode linker flag,
+ ac_cv_municode,
+ AC_TRY_LINK([
+ #include <windows.h>
+ int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}
+ ],
+ [],
+ ac_cv_municode=yes,
+ ac_cv_municode=no)
+ )
+ CFLAGS=$hold_cflags
+ if test "$ac_cv_municode" = "yes" ; then
+ extra_ldflags="$extra_ldflags -municode"
+ else
+ extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
+ fi
+ fi
+
+ AC_MSG_CHECKING([compiler flags])
+ if test "${GCC}" = "yes" ; then
SHLIB_LD=""
SHLIB_LD_LIBS='${LIBS}'
- LIBS="-lkernel32 -luser32 -ladvapi32 -lws2_32"
+ LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -lws2_32"
# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32"
STLIB_LD='${AR} cr'
@@ -477,23 +533,8 @@ file for information about building with Mingw.])
MAKE_EXE="\${CC} -o \[$]@"
LIBPREFIX="lib"
- extra_cflags="-pipe"
- extra_ldflags="-pipe"
-
- if test "$ac_cv_cygwin" = "yes"; then
- touch ac$$.c
- if ${CC} -c -mwin32 ac$$.c >/dev/null 2>&1; then
- case "$extra_cflags" in
- *-mwin32*) ;;
- *) extra_cflags="-mwin32 $extra_cflags" ;;
- esac
- case "$extra_ldflags" in
- *-mwin32*) ;;
- *) extra_ldflags="-mwin32 $extra_ldflags" ;;
- esac
- fi
- rm -f ac$$.o ac$$.c
- fi
+ extra_cflags="$extra_cflags -pipe"
+ extra_ldflags="$extra_ldflags -pipe"
if test "${SHARED_BUILD}" = "0" ; then
# static
@@ -560,8 +601,31 @@ file for information about building with Mingw.])
LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}"
LDFLAGS_WINDOW="-mwindows ${extra_ldflags}"
- # gcc under Windows supports only 32bit builds
- MACHINE="X86"
+ case "$do64bit" in
+ amd64|x64|yes)
+ MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
+ AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
+ ;;
+ ia64)
+ MACHINE="IA64"
+ AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
+ ;;
+ *)
+ AC_TRY_COMPILE([
+ #ifndef _WIN64
+ #error 32-bit
+ #endif
+ ], [],
+ tcl_win_64bit=yes,
+ tcl_win_64bit=no
+ )
+ if test "$tcl_win_64bit" = "yes" ; then
+ do64bit=amd64
+ MACHINE="AMD64"
+ AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
+ fi
+ ;;
+ esac
else
if test "${SHARED_BUILD}" = "0" ; then
# static
@@ -584,12 +648,9 @@ file for information about building with Mingw.])
LIBSUFFIX="\${DBGX}.lib"
LIBFLAGSUFFIX="\${DBGX}"
- # This is a 2-stage check to make sure we have the 64-bit SDK
- # We have to know where the SDK is installed.
+ # This is a 2-stage check to make sure we have the 64-bit SDK
+ # We have to know where the SDK is installed.
# This magic is based on MS Platform SDK for Win2003 SP1 - hobbs
- # MACHINE is IX86 for LINK, but this is used by the manifest,
- # which requires x86|amd64|ia64.
- MACHINE="X86"
if test "$do64bit" != "no" ; then
if test "x${MSSDK}x" = "xx" ; then
MSSDK="C:/Progra~1/Microsoft Platform SDK"
@@ -597,14 +658,14 @@ file for information about building with Mingw.])
MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'`
PATH64=""
case "$do64bit" in
- amd64|x64|yes)
- MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
- PATH64="${MSSDK}/Bin/Win64/x86/AMD64"
- ;;
- ia64)
- MACHINE="IA64"
- PATH64="${MSSDK}/Bin/Win64"
- ;;
+ amd64|x64|yes)
+ MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
+ PATH64="${MSSDK}/Bin/Win64/x86/AMD64"
+ ;;
+ ia64)
+ MACHINE="IA64"
+ PATH64="${MSSDK}/Bin/Win64"
+ ;;
esac
if test ! -d "${PATH64}" ; then
AC_MSG_WARN([Could not find 64-bit $MACHINE SDK to enable 64bit mode])
@@ -615,7 +676,7 @@ file for information about building with Mingw.])
fi
fi
- LIBS="kernel32.lib user32.lib advapi32.lib ws2_32.lib"
+ LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib"
if test "$do64bit" != "no" ; then
# The space-based-path will work for the Makefile, but will
# not work if AC_TRY_COMPILE is called. TEA has the
@@ -758,7 +819,7 @@ file for information about building with Mingw.])
EXTRA_CFLAGS=""
CFLAGS_WARNING="-W3"
- LDFLAGS_DEBUG="-debug:full"
+ LDFLAGS_DEBUG="-debug"
LDFLAGS_OPTIMIZE="-release"
# Specify the CC output file names based on the target name
@@ -780,6 +841,101 @@ file for information about building with Mingw.])
AC_DEFINE(TCL_CFG_DO64BIT)
fi
+ if test "${GCC}" = "yes" ; then
+ AC_CACHE_CHECK(for SEH support in compiler,
+ tcl_cv_seh,
+ AC_TRY_RUN([
+ #define WIN32_LEAN_AND_MEAN
+ #include <windows.h>
+ #undef WIN32_LEAN_AND_MEAN
+
+ int main(int argc, char** argv) {
+ int a, b = 0;
+ __try {
+ a = 666 / b;
+ }
+ __except (EXCEPTION_EXECUTE_HANDLER) {
+ return 0;
+ }
+ return 1;
+ }
+ ],
+ tcl_cv_seh=yes,
+ tcl_cv_seh=no,
+ tcl_cv_seh=no)
+ )
+ if test "$tcl_cv_seh" = "no" ; then
+ AC_DEFINE(HAVE_NO_SEH, 1,
+ [Defined when mingw does not support SEH])
+ fi
+
+ #
+ # Check to see if the excpt.h include file provided contains the
+ # definition for EXCEPTION_DISPOSITION; if not, which is the case
+ # with Cygwin's version as of 2002-04-10, define it to be int,
+ # sufficient for getting the current code to work.
+ #
+ AC_CACHE_CHECK(for EXCEPTION_DISPOSITION support in include files,
+ tcl_cv_eh_disposition,
+ AC_TRY_COMPILE([
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+# undef WIN32_LEAN_AND_MEAN
+ ],[
+ EXCEPTION_DISPOSITION x;
+ ],
+ tcl_cv_eh_disposition=yes,
+ tcl_cv_eh_disposition=no)
+ )
+ if test "$tcl_cv_eh_disposition" = "no" ; then
+ AC_DEFINE(EXCEPTION_DISPOSITION, int,
+ [Defined when cygwin/mingw does not support EXCEPTION DISPOSITION])
+ fi
+
+ # Check to see if winnt.h defines CHAR, SHORT, and LONG
+ # even if VOID has already been #defined. The win32api
+ # used by mingw and cygwin is known to do this.
+
+ AC_CACHE_CHECK(for winnt.h that ignores VOID define,
+ tcl_cv_winnt_ignore_void,
+ AC_TRY_COMPILE([
+ #define VOID void
+ #define WIN32_LEAN_AND_MEAN
+ #include <windows.h>
+ #undef WIN32_LEAN_AND_MEAN
+ ], [
+ CHAR c;
+ SHORT s;
+ LONG l;
+ ],
+ tcl_cv_winnt_ignore_void=yes,
+ tcl_cv_winnt_ignore_void=no)
+ )
+ if test "$tcl_cv_winnt_ignore_void" = "yes" ; then
+ AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1,
+ [Defined when cygwin/mingw ignores VOID define in winnt.h])
+ fi
+
+ # See if the compiler supports casting to a union type.
+ # This is used to stop gcc from printing a compiler
+ # warning when initializing a union member.
+
+ AC_CACHE_CHECK(for cast to union support,
+ tcl_cv_cast_to_union,
+ AC_TRY_COMPILE([],
+ [
+ union foo { int i; double d; };
+ union foo f = (union foo) (int) 0;
+ ],
+ tcl_cv_cast_to_union=yes,
+ tcl_cv_cast_to_union=no)
+ )
+ if test "$tcl_cv_cast_to_union" = "yes"; then
+ AC_DEFINE(HAVE_CAST_TO_UNION, 1,
+ [Defined when compiler supports casting to union type.])
+ fi
+ fi
+
# DL_LIBS is empty, but then we match the Unix version
AC_SUBST(DL_LIBS)
AC_SUBST(CFLAGS_DEBUG)
@@ -915,7 +1071,7 @@ AC_DEFUN([SC_BUILD_TCLSH], [
#--------------------------------------------------------------------
AC_DEFUN([SC_TCL_CFG_ENCODING], [
- AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval})
+ AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval})
if test x"${with_tcencoding}" != x ; then
AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}")
diff --git a/win/tcl.rc b/win/tcl.rc
index d3cf684..d88ca0a 100644
--- a/win/tcl.rc
+++ b/win/tcl.rc
@@ -1,5 +1,3 @@
-// RCS: @(#) $Id: tcl.rc,v 1.11 2004/02/07 21:47:19 davygrvy Exp $
-//
// Version Resource Script
//
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index 48962c0..56f45a0 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -11,15 +11,7 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclAppInit.c,v 1.33 2010/09/23 21:40:45 nijtmans Exp $
- */
-
-/* TODO: This file does not compile in UNICODE mode.
- * See [Freq 2965056]: Windows build with -DUNICODE
*/
-#undef UNICODE
-#undef _UNICODE
#include "tcl.h"
#define WIN32_LEAN_AND_MEAN
@@ -34,9 +26,15 @@ extern Tcl_PackageInitProc Tcltest_Init;
extern Tcl_PackageInitProc Tcltest_SafeInit;
#endif /* TCL_TEST */
-#if defined(__GNUC__)
+#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
+extern Tcl_PackageInitProc Registry_Init;
+extern Tcl_PackageInitProc Dde_Init;
+extern Tcl_PackageInitProc Dde_SafeInit;
+#endif
+
+#ifdef TCL_BROKEN_MAINARGS
static void setargv(int *argcPtr, TCHAR ***argvPtr);
-#endif /* __GNUC__ */
+#endif
/*
* The following #if block allows you to change the AppInit function by using
@@ -76,11 +74,20 @@ extern int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
*----------------------------------------------------------------------
*/
+#ifdef TCL_BROKEN_MAINARGS
+int
+main(
+ int argc,
+ char *dummy[])
+{
+ TCHAR **argv;
+#else
int
_tmain(
int argc,
TCHAR *argv[])
{
+#endif
TCHAR *p;
/*
@@ -90,11 +97,11 @@ _tmain(
setlocale(LC_ALL, "C");
+#ifdef TCL_BROKEN_MAINARGS
/*
* Get our args from the c-runtime. Ignore lpszCmdLine.
*/
-#if defined(__GNUC__)
setargv(&argc, &argv);
#endif
@@ -102,9 +109,9 @@ _tmain(
* Forward slashes substituted for backslashes.
*/
- for (p = argv[0]; *p != TEXT('\0'); p++) {
- if (*p == TEXT('\\')) {
- *p = TEXT('/');
+ for (p = argv[0]; *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
}
}
@@ -144,21 +151,15 @@ Tcl_AppInit(
}
#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
- {
- extern Tcl_PackageInitProc Registry_Init;
- extern Tcl_PackageInitProc Dde_Init;
- extern Tcl_PackageInitProc Dde_SafeInit;
-
- if (Registry_Init(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
- Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
+ if (Registry_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
- if (Dde_Init(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
- Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
- }
+ if (Dde_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
#endif
#ifdef TCL_TEST
@@ -223,7 +224,7 @@ Tcl_AppInit(
*--------------------------------------------------------------------------
*/
-#if defined(__GNUC__)
+#ifdef TCL_BROKEN_MAINARGS
static void
setargv(
int *argcPtr, /* Filled with number of argument strings. */
@@ -241,30 +242,35 @@ setargv(
*/
size = 2;
- for (p = cmdLine; *p != TEXT('\0'); p++) {
- if ((*p == TEXT(' ')) || (*p == TEXT('\t'))) { /* INTL: ISO space. */
+ for (p = cmdLine; *p != '\0'; p++) {
+ if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
size++;
- while ((*p == TEXT(' ')) || (*p == TEXT('\t'))) { /* INTL: ISO space. */
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
p++;
}
- if (*p == TEXT('\0')) {
+ if (*p == '\0') {
break;
}
}
}
- argSpace = (TCHAR *) ckalloc(
- (unsigned) (size * sizeof(TCHAR *) + (_tcslen(cmdLine) * sizeof(TCHAR)) + 1));
+
+ /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
+ #undef Tcl_Alloc
+ #undef Tcl_DbCkalloc
+
+ argSpace = ckalloc(size * sizeof(char *)
+ + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
argv = (TCHAR **) argSpace;
- argSpace += size * sizeof(TCHAR *);
+ argSpace += size * (sizeof(char *)/sizeof(TCHAR));
size--;
p = cmdLine;
for (argc = 0; argc < size; argc++) {
argv[argc] = arg = argSpace;
- while ((*p == TEXT(' ')) || (*p == TEXT('\t'))) { /* INTL: ISO space. */
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
p++;
}
- if (*p == TEXT('\0')) {
+ if (*p == '\0') {
break;
}
@@ -272,14 +278,14 @@ setargv(
slashes = 0;
while (1) {
copy = 1;
- while (*p == TEXT('\\')) {
+ while (*p == '\\') {
slashes++;
p++;
}
- if (*p == TEXT('"')) {
+ if (*p == '"') {
if ((slashes & 1) == 0) {
copy = 0;
- if ((inquote) && (p[1] == TEXT('"'))) {
+ if ((inquote) && (p[1] == '"')) {
p++;
copy = 1;
} else {
@@ -290,13 +296,13 @@ setargv(
}
while (slashes) {
- *arg = TEXT('\\');
+ *arg = '\\';
arg++;
slashes--;
}
- if ((*p == TEXT('\0')) || (!inquote &&
- ((*p == TEXT(' ')) || (*p == TEXT('\t'))))) { /* INTL: ISO space. */
+ if ((*p == '\0') || (!inquote &&
+ ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
break;
}
if (copy != 0) {
@@ -305,7 +311,7 @@ setargv(
}
p++;
}
- *arg = TEXT('\0');
+ *arg = '\0';
argSpace = arg + 1;
}
argv[argc] = NULL;
@@ -313,7 +319,7 @@ setargv(
*argcPtr = argc;
*argvPtr = argv;
}
-#endif /* __GNUC__ */
+#endif /* TCL_BROKEN_MAINARGS */
/*
* Local Variables:
diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in
index 991fc09..65bc5c5 100644
--- a/win/tclConfig.sh.in
+++ b/win/tclConfig.sh.in
@@ -8,8 +8,6 @@
# out for themselves.
#
# The information in this file is specific to a single platform.
-#
-# RCS: @(#) $Id: tclConfig.sh.in,v 1.8 2001/11/08 03:07:22 mdejong Exp $
TCL_DLL_FILE="@TCL_DLL_FILE@"
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index c3fb6f8..019d76f 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -9,25 +9,12 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWin32Dll.c,v 1.68 2010/09/14 08:53:49 nijtmans Exp $
*/
#include "tclWinInt.h"
-
-/*
- * The following data structures are used when loading the thunking library
- * for execing child processes under Win32s.
- */
-
-typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
- LPVOID *lpTranslationList);
-
-typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
- LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk,
- FARPROC UT32Callback, LPVOID Buff);
-
-typedef void (WINAPI UTUNREGISTER)(HANDLE hModule);
+#if defined(HAVE_INTRIN_H)
+# include <intrin.h>
+#endif
/*
* The following variables keep track of information about this DLL on a
@@ -66,72 +53,6 @@ typedef struct EXCEPTION_REGISTRATION {
static Tcl_Encoding winTCharEncoding = NULL;
/*
- * The following function table is used to dispatch to wide-character
- * versions of the operating system calls.
- */
-
-static const TclWinProcs winProcs = {
- 1,
- (BOOL (WINAPI *)(const TCHAR *, LPDCB)) BuildCommDCB,
- (TCHAR *(WINAPI *)(TCHAR *)) CharLower,
- (BOOL (WINAPI *)(const TCHAR *, const TCHAR *, BOOL)) CopyFile,
- (BOOL (WINAPI *)(const TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectory,
- (HANDLE (WINAPI *)(const TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
- DWORD, DWORD, HANDLE)) CreateFile,
- (BOOL (WINAPI *)(const TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
- LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, const TCHAR *,
- LPSTARTUPINFO, LPPROCESS_INFORMATION)) CreateProcess,
- (BOOL (WINAPI *)(const TCHAR *)) DeleteFile,
- (HANDLE (WINAPI *)(const TCHAR *, WIN32_FIND_DATAT *)) FindFirstFile,
- (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFile,
- (BOOL (WINAPI *)(TCHAR *, LPDWORD)) GetComputerName,
- (DWORD (WINAPI *)(DWORD, TCHAR *)) GetCurrentDirectory,
- (DWORD (WINAPI *)(const TCHAR *)) GetFileAttributes,
- (DWORD (WINAPI *)(const TCHAR *, DWORD nBufferLength, TCHAR *,
- TCHAR **)) GetFullPathName,
- (DWORD (WINAPI *)(const TCHAR *, TCHAR *, DWORD)) GetShortPathName,
- (UINT (WINAPI *)(const TCHAR *, const TCHAR *, UINT uUnique,
- TCHAR *)) GetTempFileName,
- (DWORD (WINAPI *)(DWORD, TCHAR *)) GetTempPath,
- (BOOL (WINAPI *)(const TCHAR *, TCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
- TCHAR *, DWORD)) GetVolumeInformation,
- (HINSTANCE (WINAPI *)(const TCHAR *, HANDLE, DWORD)) LoadLibraryEx,
- (BOOL (WINAPI *)(const TCHAR *, const TCHAR *)) MoveFile,
- (BOOL (WINAPI *)(const TCHAR *)) RemoveDirectory,
- (DWORD (WINAPI *)(const TCHAR *, const TCHAR *, const TCHAR *, DWORD,
- TCHAR *, TCHAR **)) SearchPath,
- (BOOL (WINAPI *)(const TCHAR *)) SetCurrentDirectory,
- (BOOL (WINAPI *)(const TCHAR *, DWORD)) SetFileAttributes,
- (BOOL (WINAPI *)(const TCHAR *, GET_FILEEX_INFO_LEVELS,
- LPVOID)) GetFileAttributesEx,
- (BOOL (WINAPI *)(const TCHAR *, const TCHAR*,
- LPSECURITY_ATTRIBUTES)) CreateHardLink,
- (HANDLE (WINAPI *)(const TCHAR*, UINT, LPVOID, UINT,
- LPVOID, DWORD)) FindFirstFileEx,
- (BOOL (WINAPI *)(const TCHAR*, TCHAR*,
- DWORD)) GetVolumeNameForVolumeMountPoint,
- (DWORD (WINAPI *)(const TCHAR*, TCHAR*,
- DWORD)) GetLongPathName,
- /* Security SDK */
- (BOOL (WINAPI *)(LPCTSTR, SECURITY_INFORMATION,
- PSECURITY_DESCRIPTOR, DWORD, LPDWORD)) GetFileSecurity,
- (BOOL (WINAPI *) (SECURITY_IMPERSONATION_LEVEL)) ImpersonateSelf,
- (BOOL (WINAPI *) (HANDLE, DWORD, BOOL, PHANDLE)) OpenThreadToken,
- (BOOL (WINAPI *) (void)) RevertToSelf,
- (void (WINAPI *) (PDWORD, PGENERIC_MAPPING)) MapGenericMask,
- (BOOL (WINAPI *)(PSECURITY_DESCRIPTOR, HANDLE, DWORD,
- PGENERIC_MAPPING, PPRIVILEGE_SET, LPDWORD, LPDWORD, LPBOOL)) AccessCheck,
- /* ReadConsole and WriteConsole */
- (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsole,
- (BOOL (WINAPI *)(HANDLE, const void*, DWORD, LPDWORD, LPVOID)) WriteConsole,
- (BOOL (WINAPI *)(LPTSTR, LPDWORD)) GetUserName,
- (const TCHAR *(*)(const char *, int, Tcl_DString *)) Tcl_WinUtfToTChar,
- (const char *(*)(const TCHAR *, int, Tcl_DString *)) Tcl_WinTCharToUtf
-};
-
-const TclWinProcs *const tclWinProcs = &winProcs;
-
-/*
* The following declaration is for the VC++ DLL entry point.
*/
@@ -146,7 +67,7 @@ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
typedef struct MountPointMap {
const TCHAR *volumeName; /* Native wide string volume name. */
- char driveLetter; /* Drive letter corresponding to the volume
+ TCHAR driveLetter; /* Drive letter corresponding to the volume
* name. */
struct MountPointMap *nextPtr;
/* Pointer to next structure in list, or
@@ -429,8 +350,8 @@ TclWinEncodingsCleanup(void)
dlIter = driveLetterLookup;
while (dlIter != NULL) {
dlIter2 = dlIter->nextPtr;
- ckfree((char *) dlIter->volumeName);
- ckfree((char *) dlIter);
+ ckfree(dlIter->volumeName);
+ ckfree(dlIter);
dlIter = dlIter2;
}
Tcl_MutexUnlock(&mountPointMap);
@@ -486,11 +407,11 @@ TclWinResetInterfaces(void)
char
TclWinDriveLetterForVolMountPoint(
- const WCHAR *mountPoint)
+ const TCHAR *mountPoint)
{
MountPointMap *dlIter, *dlPtr2;
- WCHAR Target[55]; /* Target of mount at mount point */
- WCHAR drive[4] = { L'A', L':', L'\\', L'\0' };
+ TCHAR Target[55]; /* Target of mount at mount point */
+ TCHAR drive[4] = TEXT("A:\\");
/*
* Detect the volume mounted there. Unfortunately, there is no simple way
@@ -501,14 +422,14 @@ TclWinDriveLetterForVolMountPoint(
Tcl_MutexLock(&mountPointMap);
dlIter = driveLetterLookup;
while (dlIter != NULL) {
- if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
+ if (_tcscmp(dlIter->volumeName, mountPoint) == 0) {
/*
* We need to check whether this information is still valid, since
* either the user or various programs could have adjusted the
* mount points on the fly.
*/
- drive[0] = L'A' + (dlIter->driveLetter - 'A');
+ drive[0] = (TCHAR) dlIter->driveLetter;
/*
* Try to read the volume mount point and see where it points.
@@ -516,13 +437,13 @@ TclWinDriveLetterForVolMountPoint(
if (GetVolumeNameForVolumeMountPoint(drive,
Target, 55) != 0) {
- if (wcscmp(dlIter->volumeName, Target) == 0) {
+ if (_tcscmp(dlIter->volumeName, Target) == 0) {
/*
* Nothing has changed.
*/
Tcl_MutexUnlock(&mountPointMap);
- return dlIter->driveLetter;
+ return (char) dlIter->driveLetter;
}
}
@@ -549,8 +470,8 @@ TclWinDriveLetterForVolMountPoint(
* Now dlPtr2 points to the structure to free.
*/
- ckfree((char *) dlPtr2->volumeName);
- ckfree((char *) dlPtr2);
+ ckfree(dlPtr2->volumeName);
+ ckfree(dlPtr2);
/*
* Restart the loop - we could try to be clever and continue half
@@ -579,15 +500,15 @@ TclWinDriveLetterForVolMountPoint(
for (dlIter = driveLetterLookup; dlIter != NULL;
dlIter = dlIter->nextPtr) {
- if (wcscmp(dlIter->volumeName, Target) == 0) {
+ if (_tcscmp(dlIter->volumeName, Target) == 0) {
alreadyStored = 1;
break;
}
}
if (!alreadyStored) {
- dlPtr2 = (MountPointMap *) ckalloc(sizeof(MountPointMap));
+ dlPtr2 = ckalloc(sizeof(MountPointMap));
dlPtr2->volumeName = TclNativeDupInternalRep(Target);
- dlPtr2->driveLetter = 'A' + (drive[0] - L'A');
+ dlPtr2->driveLetter = (char) drive[0];
dlPtr2->nextPtr = driveLetterLookup;
driveLetterLookup = dlPtr2;
}
@@ -600,9 +521,9 @@ TclWinDriveLetterForVolMountPoint(
for (dlIter = driveLetterLookup; dlIter != NULL;
dlIter = dlIter->nextPtr) {
- if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
+ if (_tcscmp(dlIter->volumeName, mountPoint) == 0) {
Tcl_MutexUnlock(&mountPointMap);
- return dlIter->driveLetter;
+ return (char) dlIter->driveLetter;
}
}
@@ -611,7 +532,7 @@ TclWinDriveLetterForVolMountPoint(
* that fact and store '-1' so we don't have to look it up each time.
*/
- dlPtr2 = (MountPointMap *) ckalloc(sizeof(MountPointMap));
+ dlPtr2 = ckalloc(sizeof(MountPointMap));
dlPtr2->volumeName = TclNativeDupInternalRep((ClientData) mountPoint);
dlPtr2->driveLetter = -1;
dlPtr2->nextPtr = driveLetterLookup;
@@ -718,12 +639,47 @@ TclWinCPUID(
unsigned int index, /* Which CPUID value to retrieve. */
unsigned int *regsPtr) /* Registers after the CPUID. */
{
-#ifdef HAVE_NO_SEH
- EXCEPTION_REGISTRATION registration;
-#endif
int status = TCL_ERROR;
-#if defined(__GNUC__) && !defined(_WIN64)
+#if defined(HAVE_INTRIN_H) && defined(_WIN64)
+
+ __cpuid(regsPtr, index);
+ status = TCL_OK;
+
+#elif defined(__GNUC__)
+# if defined(_WIN64)
+ /*
+ * Execute the CPUID instruction with the given index, and store results
+ * off 'regPtr'.
+ */
+
+ __asm__ __volatile__(
+ /*
+ * Do the CPUID instruction, and save the results in the 'regsPtr'
+ * area.
+ */
+
+ "movl %[rptr], %%edi" "\n\t"
+ "movl %[index], %%eax" "\n\t"
+ "cpuid" "\n\t"
+ "movl %%eax, 0x0(%%edi)" "\n\t"
+ "movl %%ebx, 0x4(%%edi)" "\n\t"
+ "movl %%ecx, 0x8(%%edi)" "\n\t"
+ "movl %%edx, 0xc(%%edi)" "\n\t"
+
+ :
+ /* No outputs */
+ :
+ [index] "m" (index),
+ [rptr] "m" (regsPtr)
+ :
+ "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory");
+ status = TCL_OK;
+
+# else
+
+ EXCEPTION_REGISTRATION registration;
+
/*
* Execute the CPUID instruction with the given index, and store results
* off 'regPtr'.
@@ -805,7 +761,14 @@ TclWinCPUID(
"%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory");
status = registration.status;
-#elif defined(_MSC_VER) && !defined(_WIN64)
+# endif /* !_WIN64 */
+#elif defined(_MSC_VER)
+# if defined(_WIN64)
+
+ __cpuid(regsPtr, index);
+ status = TCL_OK;
+
+# else
/*
* Define a structure in the stack frame to hold the registers.
*/
@@ -852,6 +815,7 @@ TclWinCPUID(
/* do nothing */
}
+# endif
#else
/*
* Don't know how to do assembly code for this compiler and/or
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 37e9011..52b9e32 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinChan.c,v 1.59 2010/09/13 14:20:39 nijtmans Exp $
*/
#include "tclWinInt.h"
@@ -276,7 +274,7 @@ FileCheckProc(
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
infoPtr->flags |= FILE_PENDING;
- evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
+ evPtr = ckalloc(sizeof(FileEvent));
evPtr->header.proc = FileEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -443,7 +441,7 @@ FileCloseProc(
break;
}
}
- ckfree((char *)fileInfoPtr);
+ ckfree(fileInfoPtr);
return errorCode;
}
@@ -942,8 +940,9 @@ TclpOpenFileChannel(
}
TclWinConvertError(err);
if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open \"%s\": %s",
+ TclGetString(pathPtr), Tcl_PosixError(interp)));
}
return NULL;
}
@@ -961,9 +960,9 @@ TclpOpenFileChannel(
if (handle == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't reopen serial \"",
- TclGetString(pathPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't reopen serial \"%s\": %s",
+ TclGetString(pathPtr), Tcl_PosixError(interp)));
}
return NULL;
}
@@ -997,8 +996,11 @@ TclpOpenFileChannel(
*/
channel = NULL;
- Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
- "\": bad file type", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open \"%s\": bad file type",
+ TclGetString(pathPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE",
+ NULL);
break;
}
@@ -1027,7 +1029,7 @@ Tcl_MakeFileChannel(
int mode) /* ORed combination of TCL_READABLE and
* TCL_WRITABLE to indicate file mode. */
{
-#ifdef HAVE_NO_SEH
+#if defined(HAVE_NO_SEH) && !defined(_WIN64)
EXCEPTION_REGISTRATION registration;
#endif
char channelName[16 + TCL_INTEGER_SPACE];
@@ -1225,7 +1227,7 @@ TclpGetDefaultStdChannel(
HANDLE handle;
int mode = -1;
const char *bufMode = NULL;
- DWORD handleId = (DWORD)INVALID_HANDLE_VALUE;
+ DWORD handleId = (DWORD) -1;
/* Standard handle to retrieve. */
switch (type) {
@@ -1324,7 +1326,7 @@ TclWinOpenFileChannel(
}
}
- infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
+ infoPtr = ckalloc(sizeof(FileInfo));
/*
* TIP #218. Removed the code inserting the new structure into the global
@@ -1338,7 +1340,7 @@ TclWinOpenFileChannel(
infoPtr->flags = appendMode;
infoPtr->handle = handle;
infoPtr->dirty = 0;
- wsprintfA(channelName, "file%lx", (int) infoPtr);
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
infoPtr, permissions);
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index 6ad92f1..5aab255 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -8,12 +8,9 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinConsole.c,v 1.25 2010/09/13 14:20:39 nijtmans Exp $
*/
#include "tclWinInt.h"
-
#include <sys/stat.h>
/*
@@ -49,6 +46,23 @@ TCL_DECLARE_MUTEX(consoleMutex)
#define CONSOLE_BUFFER_SIZE (8*1024)
/*
+ * Structure containing handles associated with one of the special console
+ * threads.
+ */
+
+typedef struct ConsoleThreadInfo {
+ HANDLE thread; /* Handle to reader or writer thread. */
+ HANDLE readyEvent; /* Manual-reset event to signal _to_ the main
+ * thread when the worker thread has finished
+ * waiting for its normal work to happen. */
+ HANDLE startEvent; /* Auto-reset event used by the main thread to
+ * signal when the thread should attempt to do
+ * its normal work. */
+ HANDLE stopEvent; /* Auto-reset event used by the main thread to
+ * signal when the thread should exit. */
+} ConsoleThreadInfo;
+
+/*
* This structure describes per-instance data for a console based channel.
*/
@@ -67,24 +81,18 @@ typedef struct ConsoleInfo {
Tcl_ThreadId threadId; /* Thread to which events should be reported.
* This value is used by the reader/writer
* threads. */
- HANDLE writeThread; /* Handle to writer thread. */
- HANDLE readThread; /* Handle to reader thread. */
- HANDLE writable; /* Manual-reset event to signal when the
- * writer thread has finished waiting for the
- * current buffer to be written. */
- HANDLE readable; /* Manual-reset event to signal when the
- * reader thread has finished waiting for
- * input. */
- HANDLE startWriter; /* Auto-reset event used by the main thread to
- * signal when the writer thread should
- * attempt to write to the console. */
- HANDLE stopWriter; /* Auto-reset event used by the main thread to
- * signal when the writer thread should exit */
- HANDLE startReader; /* Auto-reset event used by the main thread to
- * signal when the reader thread should
- * attempt to read from the console. */
- HANDLE stopReader; /* Auto-reset event used by the main thread to
- * signal when the reader thread should exit */
+ ConsoleThreadInfo writer; /* A specialized thread for handling
+ * asynchronous writes to the console; the
+ * waiting starts when a start event is sent,
+ * and a reset event is sent back to the main
+ * thread when the write is done. A stop event
+ * is used to terminate the thread. */
+ ConsoleThreadInfo reader; /* A specialized thread for handling
+ * asynchronous reads from the console; the
+ * waiting starts when a start event is sent,
+ * and a reset event is sent back to the main
+ * thread when input is available. A stop
+ * event is used to terminate the thread. */
DWORD writeError; /* An error caused by the last background
* write. Set to 0 if no error has been
* detected. This word is shared with the
@@ -99,8 +107,8 @@ typedef struct ConsoleInfo {
int readFlags; /* Flags that are shared with the reader
* thread. Access is synchronized with the
* readable object. */
- int bytesRead; /* number of bytes in the buffer */
- int offset; /* number of bytes read out of the buffer */
+ int bytesRead; /* Number of bytes in the buffer. */
+ int offset; /* Number of bytes read out of the buffer. */
char buffer[CONSOLE_BUFFER_SIZE];
/* Data consumed by reader thread. */
} ConsoleInfo;
@@ -134,7 +142,8 @@ typedef struct ConsoleEvent {
* Declarations for functions used only in this file.
*/
-static int ConsoleBlockModeProc(ClientData instanceData,int mode);
+static int ConsoleBlockModeProc(ClientData instanceData,
+ int mode);
static void ConsoleCheckProc(ClientData clientData, int flags);
static int ConsoleCloseProc(ClientData instanceData,
Tcl_Interp *interp);
@@ -155,6 +164,15 @@ static void ProcExitHandler(ClientData clientData);
static int WaitForRead(ConsoleInfo *infoPtr, int blocking);
static void ConsoleThreadActionProc(ClientData instanceData,
int action);
+static BOOL ReadConsoleBytes(HANDLE hConsole, LPVOID lpBuffer,
+ DWORD nbytes, LPDWORD nbytesread);
+static BOOL WriteConsoleBytes(HANDLE hConsole,
+ const void *lpBuffer, DWORD nbytes,
+ LPDWORD nbyteswritten);
+static void StartChannelThread(ConsoleInfo *infoPtr,
+ ConsoleThreadInfo *threadInfoPtr,
+ LPTHREAD_START_ROUTINE threadProc);
+static void StopChannelThread(ConsoleThreadInfo *threadInfoPtr);
/*
* This structure describes the channel type structure for command console
@@ -173,23 +191,27 @@ static const Tcl_ChannelType consoleChannelType = {
ConsoleWatchProc, /* Set up notifier to watch the channel. */
ConsoleGetHandleProc, /* Get an OS handle from channel. */
NULL, /* close2proc. */
- ConsoleBlockModeProc, /* Set blocking or non-blocking mode.*/
- NULL, /* flush proc. */
- NULL, /* handler proc. */
- NULL, /* wide seek proc */
- ConsoleThreadActionProc, /* thread action proc */
- NULL /* truncation */
+ ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */
+ NULL, /* Flush proc. */
+ NULL, /* Handler proc. */
+ NULL, /* Wide seek proc. */
+ ConsoleThreadActionProc, /* Thread action proc. */
+ NULL /* Truncation proc. */
};
/*
*----------------------------------------------------------------------
*
- * readConsoleBytes, writeConsoleBytes --
- * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes
- * instead of number of TCHARS
+ * ReadConsoleBytes, WriteConsoleBytes --
+ *
+ * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes
+ * instead of number of TCHARS.
+ *
+ *----------------------------------------------------------------------
*/
+
static BOOL
-readConsoleBytes(
+ReadConsoleBytes(
HANDLE hConsole,
LPVOID lpBuffer,
DWORD nbytes,
@@ -198,15 +220,17 @@ readConsoleBytes(
DWORD ntchars;
BOOL result;
int tcharsize = sizeof(TCHAR);
- result = ReadConsole(
- hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL);
- if (nbytesread)
- *nbytesread = (ntchars*tcharsize);
+
+ result = ReadConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars,
+ NULL);
+ if (nbytesread != NULL) {
+ *nbytesread = ntchars * tcharsize;
+ }
return result;
}
static BOOL
-writeConsoleBytes(
+WriteConsoleBytes(
HANDLE hConsole,
const void *lpBuffer,
DWORD nbytes,
@@ -215,10 +239,12 @@ writeConsoleBytes(
DWORD ntchars;
BOOL result;
int tcharsize = sizeof(TCHAR);
- result = WriteConsole(
- hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL);
- if (nbyteswritten)
- *nbyteswritten = (ntchars*tcharsize);
+
+ result = WriteConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars,
+ NULL);
+ if (nbyteswritten != NULL) {
+ *nbyteswritten = ntchars * tcharsize;
+ }
return result;
}
@@ -241,8 +267,6 @@ writeConsoleBytes(
static void
ConsoleInit(void)
{
- ThreadSpecificData *tsdPtr;
-
/*
* Check the initialized flag first, then check again in the mutex. This
* is a speed enhancement.
@@ -257,9 +281,9 @@ ConsoleInit(void)
Tcl_MutexUnlock(&consoleMutex);
}
- tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
- if (tsdPtr == NULL) {
- tsdPtr = TCL_TSD_INIT(&dataKey);
+ if (TclThreadDataKeyGet(&dataKey) == NULL) {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
tsdPtr->firstConsolePtr = NULL;
Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL);
@@ -285,7 +309,7 @@ ConsoleInit(void)
static void
ConsoleExitHandler(
- ClientData clientData) /* Old window proc */
+ ClientData clientData) /* Old window proc. */
{
Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
}
@@ -309,7 +333,7 @@ ConsoleExitHandler(
static void
ProcExitHandler(
- ClientData clientData) /* Old window proc */
+ ClientData clientData) /* Old window proc. */
{
Tcl_MutexLock(&consoleMutex);
initialized = 0;
@@ -354,7 +378,8 @@ ConsoleSetupProc(
for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ if (WaitForSingleObject(infoPtr->writer.readyEvent,
+ 0) != WAIT_TIMEOUT) {
block = 0;
}
}
@@ -392,7 +417,6 @@ ConsoleCheckProc(
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
ConsoleInfo *infoPtr;
- ConsoleEvent *evPtr;
int needEvent;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -417,7 +441,8 @@ ConsoleCheckProc(
needEvent = 0;
if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ if (WaitForSingleObject(infoPtr->writer.readyEvent,
+ 0) != WAIT_TIMEOUT) {
needEvent = 1;
}
}
@@ -429,8 +454,9 @@ ConsoleCheckProc(
}
if (needEvent) {
+ ConsoleEvent *evPtr = ckalloc(sizeof(ConsoleEvent));
+
infoPtr->flags |= CONSOLE_PENDING;
- evPtr = (ConsoleEvent *) ckalloc(sizeof(ConsoleEvent));
evPtr->header.proc = ConsoleEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -438,7 +464,6 @@ ConsoleCheckProc(
}
}
-
/*
*----------------------------------------------------------------------
*
@@ -461,7 +486,7 @@ ConsoleBlockModeProc(
int mode) /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
- ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ ConsoleInfo *infoPtr = instanceData;
/*
* Consoles on Windows can not be switched between blocking and
@@ -474,7 +499,7 @@ ConsoleBlockModeProc(
if (mode == TCL_MODE_NONBLOCKING) {
infoPtr->flags |= CONSOLE_ASYNC;
} else {
- infoPtr->flags &= ~(CONSOLE_ASYNC);
+ infoPtr->flags &= ~CONSOLE_ASYNC;
}
return 0;
}
@@ -482,6 +507,84 @@ ConsoleBlockModeProc(
/*
*----------------------------------------------------------------------
*
+ * StartChannelThread, StopChannelThread --
+ *
+ * Helpers that codify how to ask one of the console service threads to
+ * start and stop.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+StartChannelThread(
+ ConsoleInfo *infoPtr,
+ ConsoleThreadInfo *threadInfoPtr,
+ LPTHREAD_START_ROUTINE threadProc)
+{
+ DWORD id;
+
+ threadInfoPtr->readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL);
+ threadInfoPtr->startEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
+ threadInfoPtr->stopEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
+ threadInfoPtr->thread = CreateThread(NULL, 256, threadProc, infoPtr, 0,
+ &id);
+ SetThreadPriority(threadInfoPtr->thread, THREAD_PRIORITY_HIGHEST);
+}
+
+static void
+StopChannelThread(
+ ConsoleThreadInfo *threadInfoPtr)
+{
+ DWORD exitCode = 0;
+
+ /*
+ * The thread may already have closed on it's own. Check it's exit
+ * code.
+ */
+
+ GetExitCodeThread(threadInfoPtr->thread, &exitCode);
+ if (exitCode == STILL_ACTIVE) {
+ /*
+ * Set the stop event so that if the reader thread is blocked in
+ * ConsoleReaderThread on WaitForMultipleEvents, it will exit cleanly.
+ */
+
+ SetEvent(threadInfoPtr->stopEvent);
+
+ /*
+ * Wait at most 20 milliseconds for the reader thread to close.
+ */
+
+ if (WaitForSingleObject(threadInfoPtr->thread, 20) == WAIT_TIMEOUT) {
+ /*
+ * Forcibly terminate the background thread as a last resort.
+ * Note that we need to guard against terminating the thread while
+ * it is in the middle of Tcl_ThreadAlert because it won't be able
+ * to release the notifier lock.
+ */
+
+ Tcl_MutexLock(&consoleMutex);
+ /* BUG: this leaks memory. */
+ TerminateThread(threadInfoPtr->thread, 0);
+ Tcl_MutexUnlock(&consoleMutex);
+ }
+ }
+
+ /*
+ * Close all the handles associated with the thread, and set the thread
+ * handle field to NULL to mark that the thread has been cleaned up.
+ */
+
+ CloseHandle(threadInfoPtr->thread);
+ CloseHandle(threadInfoPtr->readyEvent);
+ CloseHandle(threadInfoPtr->startEvent);
+ CloseHandle(threadInfoPtr->stopEvent);
+ threadInfoPtr->thread = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ConsoleCloseProc --
*
* Closes a console based IO channel.
@@ -500,13 +603,10 @@ ConsoleCloseProc(
ClientData instanceData, /* Pointer to ConsoleInfo structure. */
Tcl_Interp *interp) /* For error reporting. */
{
- ConsoleInfo *consolePtr = (ConsoleInfo *) instanceData;
- int errorCode;
+ ConsoleInfo *consolePtr = instanceData;
+ int errorCode = 0;
ConsoleInfo *infoPtr, **nextPtrPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- DWORD exitCode;
-
- errorCode = 0;
/*
* Clean up the background thread if necessary. Note that this must be
@@ -514,49 +614,8 @@ ConsoleCloseProc(
* trying to read from the console.
*/
- if (consolePtr->readThread) {
- /*
- * The thread may already have closed on it's own. Check it's exit
- * code.
- */
-
- GetExitCodeThread(consolePtr->readThread, &exitCode);
-
- if (exitCode == STILL_ACTIVE) {
- /*
- * Set the stop event so that if the reader thread is blocked in
- * ConsoleReaderThread on WaitForMultipleEvents, it will exit
- * cleanly.
- */
-
- SetEvent(consolePtr->stopReader);
-
- /*
- * Wait at most 20 milliseconds for the reader thread to close.
- */
-
- if (WaitForSingleObject(consolePtr->readThread, 20)
- == WAIT_TIMEOUT) {
- /*
- * Forcibly terminate the background thread as a last resort.
- * Note that we need to guard against terminating the thread
- * while it is in the middle of Tcl_ThreadAlert because it
- * won't be able to release the notifier lock.
- */
-
- Tcl_MutexLock(&consoleMutex);
-
- /* BUG: this leaks memory. */
- TerminateThread(consolePtr->readThread, 0);
- Tcl_MutexUnlock(&consoleMutex);
- }
- }
-
- CloseHandle(consolePtr->readThread);
- CloseHandle(consolePtr->readable);
- CloseHandle(consolePtr->startReader);
- CloseHandle(consolePtr->stopReader);
- consolePtr->readThread = NULL;
+ if (consolePtr->reader.thread) {
+ StopChannelThread(&consolePtr->reader);
}
consolePtr->validMask &= ~TCL_READABLE;
@@ -566,62 +625,20 @@ ConsoleCloseProc(
* should be no pending write operations.
*/
- if (consolePtr->writeThread) {
+ if (consolePtr->writer.thread) {
if (consolePtr->toWrite) {
/*
* We only need to wait if there is something to write. This may
- * prevent infinite wait on exit. [python bug 216289]
- */
-
- WaitForSingleObject(consolePtr->writable, INFINITE);
- }
-
- /*
- * The thread may already have closed on it's own. Check it's exit
- * code.
- */
-
- GetExitCodeThread(consolePtr->writeThread, &exitCode);
-
- if (exitCode == STILL_ACTIVE) {
- /*
- * Set the stop event so that if the reader thread is blocked in
- * ConsoleWriterThread on WaitForMultipleEvents, it will exit
- * cleanly.
+ * prevent infinite wait on exit. [Python Bug 216289]
*/
- SetEvent(consolePtr->stopWriter);
-
- /*
- * Wait at most 20 milliseconds for the writer thread to close.
- */
-
- if (WaitForSingleObject(consolePtr->writeThread, 20)
- == WAIT_TIMEOUT) {
- /*
- * Forcibly terminate the background thread as a last resort.
- * Note that we need to guard against terminating the thread
- * while it is in the middle of Tcl_ThreadAlert because it
- * won't be able to release the notifier lock.
- */
-
- Tcl_MutexLock(&consoleMutex);
-
- /* BUG: this leaks memory. */
- TerminateThread(consolePtr->writeThread, 0);
- Tcl_MutexUnlock(&consoleMutex);
- }
+ WaitForSingleObject(consolePtr->writer.readyEvent, INFINITE);
}
- CloseHandle(consolePtr->writeThread);
- CloseHandle(consolePtr->writable);
- CloseHandle(consolePtr->startWriter);
- CloseHandle(consolePtr->stopWriter);
- consolePtr->writeThread = NULL;
+ StopChannelThread(&consolePtr->writer);
}
consolePtr->validMask &= ~TCL_WRITABLE;
-
/*
* Don't close the Win32 handle if the handle is a standard channel during
* the thread exit process. Otherwise, one thread may kill the stdio of
@@ -647,7 +664,7 @@ ConsoleCloseProc(
for (nextPtrPtr = &(tsdPtr->firstConsolePtr), infoPtr = *nextPtrPtr;
infoPtr != NULL;
nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
- if (infoPtr == (ConsoleInfo *)consolePtr) {
+ if (infoPtr == (ConsoleInfo *) consolePtr) {
*nextPtrPtr = infoPtr->nextPtr;
break;
}
@@ -656,7 +673,7 @@ ConsoleCloseProc(
ckfree(consolePtr->writeBuf);
consolePtr->writeBuf = 0;
}
- ckfree((char*) consolePtr);
+ ckfree(consolePtr);
return errorCode;
}
@@ -687,7 +704,7 @@ ConsoleInputProc(
* buffer? */
int *errorCode) /* Where to store error code. */
{
- ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ ConsoleInfo *infoPtr = instanceData;
DWORD count, bytesRead = 0;
int result;
@@ -722,7 +739,7 @@ ConsoleInputProc(
bytesRead = infoPtr->bytesRead - infoPtr->offset;
/*
- * Reset the buffer
+ * Reset the buffer.
*/
infoPtr->readFlags &= ~CONSOLE_BUFFERED;
@@ -738,8 +755,8 @@ ConsoleInputProc(
* byte is available or an EOF occurs.
*/
- if (readConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count)
- == TRUE) {
+ if (ReadConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize,
+ &count) == TRUE) {
buf[count] = '\0';
return count;
}
@@ -772,12 +789,13 @@ ConsoleOutputProc(
int toWrite, /* How many bytes to write? */
int *errorCode) /* Where to store error code. */
{
- ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ ConsoleInfo *infoPtr = instanceData;
+ ConsoleThreadInfo *threadInfo = &infoPtr->reader;
DWORD bytesWritten, timeout;
*errorCode = 0;
timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 0 : INFINITE;
- if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
+ if (WaitForSingleObject(threadInfo->readyEvent,timeout) == WAIT_TIMEOUT) {
/*
* The writer thread is blocked waiting for a write to complete and
* the channel is in non-blocking mode.
@@ -812,12 +830,12 @@ ConsoleOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc((size_t)toWrite);
+ infoPtr->writeBuf = ckalloc(toWrite);
}
- memcpy(infoPtr->writeBuf, buf, (size_t)toWrite);
+ memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
infoPtr->toWrite = toWrite;
- ResetEvent(infoPtr->writable);
- SetEvent(infoPtr->startWriter);
+ ResetEvent(threadInfo->readyEvent);
+ SetEvent(threadInfo->startEvent);
bytesWritten = toWrite;
} else {
/*
@@ -825,9 +843,8 @@ ConsoleOutputProc(
* avoids an unnecessary copy.
*/
- if (writeConsoleBytes(infoPtr->handle, buf, (DWORD)toWrite,
- &bytesWritten)
- == FALSE) {
+ if (WriteConsoleBytes(infoPtr->handle, buf, (DWORD) toWrite,
+ &bytesWritten) == FALSE) {
TclWinConvertError(GetLastError());
goto error;
}
@@ -866,7 +883,7 @@ ConsoleEventProc(
int flags) /* Flags that indicate what events to handle,
* such as TCL_FILE_EVENTS. */
{
- ConsoleEvent *consoleEvPtr = (ConsoleEvent *)evPtr;
+ ConsoleEvent *consoleEvPtr = (ConsoleEvent *) evPtr;
ConsoleInfo *infoPtr;
int mask;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -885,7 +902,7 @@ ConsoleEventProc(
for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (consoleEvPtr->infoPtr == infoPtr) {
- infoPtr->flags &= ~(CONSOLE_PENDING);
+ infoPtr->flags &= ~CONSOLE_PENDING;
break;
}
}
@@ -906,7 +923,8 @@ ConsoleEventProc(
mask = 0;
if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ if (WaitForSingleObject(infoPtr->writer.readyEvent,
+ 0) != WAIT_TIMEOUT) {
mask = TCL_WRITABLE;
}
}
@@ -953,7 +971,7 @@ ConsoleWatchProc(
* TCL_EXCEPTION. */
{
ConsoleInfo **nextPtrPtr, *ptr;
- ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ ConsoleInfo *infoPtr = instanceData;
int oldMask = infoPtr->watchMask;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -965,6 +983,7 @@ ConsoleWatchProc(
infoPtr->watchMask = mask & infoPtr->validMask;
if (infoPtr->watchMask) {
Tcl_Time blockTime = { 0, 0 };
+
if (!oldMask) {
infoPtr->nextPtr = tsdPtr->firstConsolePtr;
tsdPtr->firstConsolePtr = infoPtr;
@@ -1007,12 +1026,12 @@ ConsoleWatchProc(
static int
ConsoleGetHandleProc(
ClientData instanceData, /* The console state. */
- int direction, /* TCL_READABLE or TCL_WRITABLE */
+ int direction, /* TCL_READABLE or TCL_WRITABLE. */
ClientData *handlePtr) /* Where to store the handle. */
{
- ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ ConsoleInfo *infoPtr = instanceData;
- *handlePtr = (ClientData) infoPtr->handle;
+ *handlePtr = infoPtr->handle;
return TCL_OK;
}
@@ -1045,6 +1064,7 @@ WaitForRead(
{
DWORD timeout, count;
HANDLE *handle = infoPtr->handle;
+ ConsoleThreadInfo *threadInfo = &infoPtr->reader;
INPUT_RECORD input;
while (1) {
@@ -1053,7 +1073,8 @@ WaitForRead(
*/
timeout = blocking ? INFINITE : 0;
- if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
+ if (WaitForSingleObject(threadInfo->readyEvent,
+ timeout) == WAIT_TIMEOUT) {
/*
* The reader thread is blocked waiting for data and the channel
* is in non-blocking mode.
@@ -1112,8 +1133,8 @@ WaitForRead(
* There wasn't any data available, so reset the thread and try again.
*/
- ResetEvent(infoPtr->readable);
- SetEvent(infoPtr->startReader);
+ ResetEvent(threadInfo->readyEvent);
+ SetEvent(threadInfo->startEvent);
}
}
@@ -1140,14 +1161,18 @@ static DWORD WINAPI
ConsoleReaderThread(
LPVOID arg)
{
- ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
+ ConsoleInfo *infoPtr = arg;
HANDLE *handle = infoPtr->handle;
- DWORD count, waitResult;
+ ConsoleThreadInfo *threadInfo = &infoPtr->reader;
+ DWORD waitResult;
HANDLE wEvents[2];
- /* The first event takes precedence. */
- wEvents[0] = infoPtr->stopReader;
- wEvents[1] = infoPtr->startReader;
+ /*
+ * The first event takes precedence.
+ */
+
+ wEvents[0] = threadInfo->stopEvent;
+ wEvents[1] = threadInfo->startEvent;
for (;;) {
/*
@@ -1165,14 +1190,12 @@ ConsoleReaderThread(
break;
}
- count = 0;
-
/*
* Look for data on the console, but first ignore any events that are
* not KEY_EVENTs.
*/
- if (readConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE,
+ if (ReadConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE,
(LPDWORD) &infoPtr->bytesRead) != FALSE) {
/*
* Data was stored in the buffer.
@@ -1180,10 +1203,9 @@ ConsoleReaderThread(
infoPtr->readFlags |= CONSOLE_BUFFERED;
} else {
- DWORD err;
- err = GetLastError();
+ DWORD err = GetLastError();
- if (err == (DWORD)EOF) {
+ if (err == (DWORD) EOF) {
infoPtr->readFlags = CONSOLE_EOF;
}
}
@@ -1193,7 +1215,7 @@ ConsoleReaderThread(
* waking up the notifier thread.
*/
- SetEvent(infoPtr->readable);
+ SetEvent(threadInfo->readyEvent);
/*
* Alert the foreground thread. Note that we need to treat this like a
@@ -1207,6 +1229,7 @@ ConsoleReaderThread(
* TIP #218. When in flight ignore the event, no one will receive
* it anyway.
*/
+
Tcl_ThreadAlert(infoPtr->threadId);
}
Tcl_MutexUnlock(&consoleMutex);
@@ -1238,16 +1261,19 @@ static DWORD WINAPI
ConsoleWriterThread(
LPVOID arg)
{
-
- ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
+ ConsoleInfo *infoPtr = arg;
HANDLE *handle = infoPtr->handle;
+ ConsoleThreadInfo *threadInfo = &infoPtr->writer;
DWORD count, toWrite, waitResult;
char *buf;
HANDLE wEvents[2];
- /* The first event takes precedence. */
- wEvents[0] = infoPtr->stopWriter;
- wEvents[1] = infoPtr->startWriter;
+ /*
+ * The first event takes precedence.
+ */
+
+ wEvents[0] = threadInfo->stopEvent;
+ wEvents[1] = threadInfo->startEvent;
for (;;) {
/*
@@ -1273,14 +1299,13 @@ ConsoleWriterThread(
*/
while (toWrite > 0) {
- if (writeConsoleBytes(handle, buf, (DWORD)toWrite,
- &count) == FALSE) {
+ if (WriteConsoleBytes(handle, buf, (DWORD) toWrite,
+ &count) == FALSE) {
infoPtr->writeError = GetLastError();
break;
- } else {
- toWrite -= count;
- buf += count;
}
+ toWrite -= count;
+ buf += count;
}
/*
@@ -1288,7 +1313,7 @@ ConsoleWriterThread(
* waking up the notifier thread.
*/
- SetEvent(infoPtr->writable);
+ SetEvent(threadInfo->readyEvent);
/*
* Alert the foreground thread. Note that we need to treat this like a
@@ -1324,7 +1349,7 @@ ConsoleWriterThread(
* Returns the new channel, or NULL.
*
* Side effects:
- * May open the channel
+ * May open the channel.
*
*----------------------------------------------------------------------
*/
@@ -1337,7 +1362,7 @@ TclWinOpenConsoleChannel(
{
char encoding[4 + TCL_INTEGER_SPACE];
ConsoleInfo *infoPtr;
- DWORD id, modes;
+ DWORD modes;
ConsoleInit();
@@ -1345,7 +1370,7 @@ TclWinOpenConsoleChannel(
* See if a channel with this handle already exists.
*/
- infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo));
+ infoPtr = ckalloc(sizeof(ConsoleInfo));
memset(infoPtr, 0, sizeof(ConsoleInfo));
infoPtr->validMask = permissions;
@@ -1362,7 +1387,7 @@ TclWinOpenConsoleChannel(
* for instance).
*/
- wsprintfA(channelName, "file%lx", (int) infoPtr);
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
infoPtr, permissions);
@@ -1378,22 +1403,11 @@ TclWinOpenConsoleChannel(
modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT);
modes |= ENABLE_LINE_INPUT;
SetConsoleMode(infoPtr->handle, modes);
-
- infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
- infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
- infoPtr->stopReader = CreateEvent(NULL, FALSE, FALSE, NULL);
- infoPtr->readThread = CreateThread(NULL, 256, ConsoleReaderThread,
- infoPtr, 0, &id);
- SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
+ StartChannelThread(infoPtr, &infoPtr->reader, ConsoleReaderThread);
}
if (permissions & TCL_WRITABLE) {
- infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
- infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
- infoPtr->stopWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
- infoPtr->writeThread = CreateThread(NULL, 256, ConsoleWriterThread,
- infoPtr, 0, &id);
- SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST);
+ StartChannelThread(infoPtr, &infoPtr->writer, ConsoleWriterThread);
}
/*
@@ -1432,9 +1446,10 @@ ConsoleThreadActionProc(
ClientData instanceData,
int action)
{
- ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ ConsoleInfo *infoPtr = instanceData;
- /* We do not access firstConsolePtr in the thread structures. This is not
+ /*
+ * We do not access firstConsolePtr in the thread structures. This is not
* for all serials managed by the thread, but only those we are watching.
* Removal of the filevent handlers before transfer thus takes care of
* this structure.
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 9909d3a..d0600e6 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -8,24 +8,30 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinDde.c,v 1.44 2010/08/30 09:19:38 nijtmans Exp $
- */
-
-/* TODO: This file does not compile in UNICODE mode.
- * See [Freq 2965056]: Windows build with -DUNICODE
*/
-#undef UNICODE
-#undef _UNICODE
#undef STATIC_BUILD
-#ifndef USE_TCL_STUBS
-# define USE_TCL_STUBS
-#endif
+#undef USE_TCL_STUBS
+#define USE_TCL_STUBS
#include "tclInt.h"
#include <dde.h>
#include <ddeml.h>
+#ifndef UNICODE
+# undef CP_WINUNICODE
+# define CP_WINUNICODE CP_WINANSI
+# undef Tcl_WinTCharToUtf
+# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
+# undef Tcl_WinUtfToTChar
+# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
+#endif
+
+#if !defined(NDEBUG)
+ /* test POKE server Implemented for debug mode only */
+# undef CBF_FAIL_POKES
+# define CBF_FAIL_POKES 0
+#endif
+
/*
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init
* declaration is in the source file itself, which is only accessed when we
@@ -45,7 +51,7 @@ typedef struct RegisteredInterp {
struct RegisteredInterp *nextPtr;
/* The next interp this application knows
* about. */
- char *name; /* Interpreter's name (malloc-ed). */
+ TCHAR *name; /* Interpreter's name (malloc-ed). */
Tcl_Obj *handlerPtr; /* The server handler command */
Tcl_Interp *interp; /* The interpreter attached to this name. */
} RegisteredInterp;
@@ -59,7 +65,7 @@ typedef struct Conversation {
/* The next conversation in the list. */
RegisteredInterp *riPtr; /* The info we know about the conversation. */
HCONV hConv; /* The DDE handle for this conversation. */
- Tcl_Obj *returnPackagePtr; /* The result package for this conversation */
+ Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
} Conversation;
typedef struct DdeEnumServices {
@@ -90,10 +96,14 @@ static DWORD ddeInstance; /* The application instance handle given to us
* by DdeInitialize. */
static int ddeIsServer = 0;
-#define TCL_DDE_VERSION "1.3.2"
+#define TCL_DDE_VERSION "1.4.0"
#define TCL_DDE_PACKAGE_NAME "dde"
-#define TCL_DDE_SERVICE_NAME "TclEval"
-#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT"
+#define TCL_DDE_SERVICE_NAME TEXT("TclEval")
+#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT")
+
+#define DDE_FLAG_ASYNC 1
+#define DDE_FLAG_BINARY 2
+#define DDE_FLAG_FORCE 4
TCL_DECLARE_MUTEX(ddeMutex)
@@ -108,7 +118,7 @@ static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget,
LPARAM lParam);
static void DdeExitProc(ClientData clientData);
static int DdeGetServicesList(Tcl_Interp *interp,
- const char *serviceName, const char *topicName);
+ const TCHAR *serviceName, const TCHAR *topicName);
static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv,
HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData,
DWORD dwData1, DWORD dwData2);
@@ -118,7 +128,7 @@ static void DeleteProc(ClientData clientData);
static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr,
Tcl_Obj *ddeObjectPtr);
static int MakeDdeConnection(Tcl_Interp *interp,
- const char *name, HCONV *ddeConvPtr);
+ const TCHAR *name, HCONV *ddeConvPtr);
static void SetDdeError(Tcl_Interp *interp);
static int DdeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -147,14 +157,18 @@ int
Dde_Init(
Tcl_Interp *interp)
{
- ThreadSpecificData *tsdPtr;
-
if (!Tcl_InitStubs(interp, "8.1", 0)) {
return TCL_ERROR;
}
+#ifdef UNICODE
+ if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Win32s and Windows 9x are not supported platforms", -1));
+ return TCL_ERROR;
+ }
+#endif
Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
- tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_CreateExitHandler(DdeExitProc, NULL);
return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
}
@@ -226,7 +240,7 @@ Initialize(void)
if (ddeInstance == 0) {
Tcl_MutexLock(&ddeMutex);
if (ddeInstance == 0) {
- if (DdeInitialize(&ddeInstance, DdeServerProc,
+ if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc,
CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS
| CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) {
ddeInstance = 0;
@@ -240,7 +254,7 @@ Initialize(void)
ddeIsServer = 1;
Tcl_CreateExitHandler(DdeExitProc, NULL);
ddeServiceGlobal = DdeCreateStringHandle(ddeInstance,
- TCL_DDE_SERVICE_NAME, 0);
+ TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
} else {
ddeIsServer = 0;
@@ -274,20 +288,20 @@ Initialize(void)
*----------------------------------------------------------------------
*/
-static const char *
+static const TCHAR *
DdeSetServerName(
Tcl_Interp *interp,
- const char *name, /* The name that will be used to refer to the
+ const TCHAR *name, /* The name that will be used to refer to the
* interpreter in later "send" commands. Must
* be globally unique. */
- int exactName, /* Should we make a unique name? 0 = unique */
+ int flags, /* DDE_FLAG_FORCE or 0 */
Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle
* incoming Dde eval's */
{
int suffix, offset;
RegisteredInterp *riPtr, *prevPtr;
Tcl_DString dString;
- const char *actualName;
+ const TCHAR *actualName;
Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL;
int n, srvCount = 0, lastSuffix, r = TCL_OK;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -325,7 +339,7 @@ DdeSetServerName(
* current interp, but it doesn't have a name.
*/
- return "";
+ return TEXT("");
}
/*
@@ -336,7 +350,7 @@ DdeSetServerName(
Tcl_DStringInit(&dString);
actualName = name;
- if (!exactName) {
+ if (!(flags & DDE_FLAG_FORCE)) {
r = DdeGetServicesList(interp, TCL_DDE_SERVICE_NAME, NULL);
if (r == TCL_OK) {
srvListPtr = Tcl_GetObjResult(interp);
@@ -346,7 +360,9 @@ DdeSetServerName(
&srvPtrPtr);
}
if (r != TCL_OK) {
- OutputDebugString(Tcl_GetStringResult(interp));
+ Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), -1, &dString);
+ OutputDebugString((TCHAR *) Tcl_DStringValue(&dString));
+ Tcl_DStringFree(&dString);
return NULL;
}
@@ -363,13 +379,13 @@ DdeSetServerName(
lastSuffix = suffix;
if (suffix > 1) {
if (suffix == 2) {
- Tcl_DStringAppend(&dString, name, -1);
- Tcl_DStringAppend(&dString, " #", 2);
+ Tcl_DStringAppend(&dString, (char *)name, _tcslen(name) * sizeof(TCHAR));
+ Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(TCHAR));
offset = Tcl_DStringLength(&dString);
- Tcl_DStringSetLength(&dString, offset+TCL_INTEGER_SPACE);
- actualName = Tcl_DStringValue(&dString);
+ Tcl_DStringSetLength(&dString, offset + sizeof(TCHAR) * TCL_INTEGER_SPACE);
+ actualName = (TCHAR *) Tcl_DStringValue(&dString);
}
- sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix);
+ _stprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), TEXT("%d"), suffix);
}
/*
@@ -378,32 +394,34 @@ DdeSetServerName(
for (n = 0; n < srvCount; ++n) {
Tcl_Obj* namePtr;
+ Tcl_DString ds;
Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
- if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) {
+ Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds);
+ if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) {
suffix++;
+ Tcl_DStringFree(&ds);
break;
}
+ Tcl_DStringFree(&ds);
}
}
- Tcl_DStringSetLength(&dString,
- offset + (int)strlen(Tcl_DStringValue(&dString)+offset));
}
/*
* We have found a unique name. Now add it to the registry.
*/
- riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
+ riPtr = ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
- riPtr->name = ckalloc((unsigned int) strlen(actualName) + 1);
+ riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
riPtr->nextPtr = tsdPtr->interpListPtr;
riPtr->handlerPtr = handlerPtr;
if (riPtr->handlerPtr != NULL) {
Tcl_IncrRefCount(riPtr->handlerPtr);
}
tsdPtr->interpListPtr = riPtr;
- strcpy(riPtr->name, actualName);
+ _tcscpy(riPtr->name, actualName);
if (Tcl_IsSafe(interp)) {
Tcl_ExposeCommand(interp, "dde", "dde");
@@ -483,7 +501,7 @@ DeleteProc(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;
- searchPtr != NULL && searchPtr != riPtr;
+ (searchPtr != NULL) && (searchPtr != riPtr);
prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
/*
* Empty loop body.
@@ -539,6 +557,7 @@ ExecuteRemoteObject(
Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
"a handler procedure must be defined for use in a safe "
"interp", -1));
+ Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL);
result = TCL_ERROR;
}
@@ -562,7 +581,8 @@ ExecuteRemoteObject(
returnPackagePtr = Tcl_NewListObj(0, NULL);
- Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_NewIntObj(result));
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr,
+ Tcl_NewIntObj(result));
Tcl_ListObjAppendElement(NULL, returnPackagePtr,
Tcl_GetObjResult(riPtr->interp));
@@ -617,7 +637,7 @@ DdeServerProc(
Tcl_DString dString;
int len;
DWORD dlen;
- char *utilString;
+ TCHAR *utilString;
Tcl_Obj *ddeObjectPtr;
HDDEDATA ddeReturn = NULL;
RegisteredInterp *riPtr;
@@ -631,16 +651,16 @@ DdeServerProc(
* sure we have a valid topic.
*/
- len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINANSI);
+ CP_WINUNICODE);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (strcasecmp(utilString, riPtr->name) == 0) {
+ if (_tcsicmp(utilString, riPtr->name) == 0) {
Tcl_DStringFree(&dString);
return (HDDEDATA) TRUE;
}
@@ -656,16 +676,16 @@ DdeServerProc(
* result to return in an XTYP_REQUEST.
*/
- len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINANSI);
+ CP_WINUNICODE);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (strcasecmp(riPtr->name, utilString) == 0) {
- convPtr = (Conversation *) ckalloc(sizeof(Conversation));
+ if (_tcsicmp(riPtr->name, utilString) == 0) {
+ convPtr = ckalloc(sizeof(Conversation));
convPtr->nextPtr = tsdPtr->currentConversations;
convPtr->returnPackagePtr = NULL;
convPtr->hConv = hConv;
@@ -695,7 +715,7 @@ DdeServerProc(
if (convPtr->returnPackagePtr != NULL) {
Tcl_DecrRefCount(convPtr->returnPackagePtr);
}
- ckfree((char *) convPtr);
+ ckfree(convPtr);
break;
}
}
@@ -708,7 +728,7 @@ DdeServerProc(
* execute.
*/
- if (uFmt != CF_TEXT) {
+ if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) {
return (HDDEDATA) FALSE;
}
@@ -721,41 +741,104 @@ DdeServerProc(
}
if (convPtr != NULL) {
- BYTE *returnString;
+ char *returnString;
- len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI);
+ len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
- CP_WINANSI);
- if (strcasecmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
- returnString = (BYTE *)
- Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
- ddeReturn = DdeCreateDataHandle(ddeInstance, returnString,
- (DWORD) len+1, 0, ddeItem, CF_TEXT, 0);
+ CP_WINUNICODE);
+ if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
+ if (uFmt == CF_TEXT) {
+ returnString =
+ Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
+ } else {
+ returnString = (char *)
+ Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len);
+ len = sizeof(TCHAR) * len + 1;
+ }
+ ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
+ (DWORD) len+1, 0, ddeItem, uFmt, 0);
} else {
if (Tcl_IsSafe(convPtr->riPtr->interp)) {
ddeReturn = NULL;
} else {
- Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
- convPtr->riPtr->interp, utilString, NULL,
+ Tcl_DString ds;
+ Tcl_Obj *variableObjPtr;
+ Tcl_WinTCharToUtf(utilString, -1, &ds);
+ variableObjPtr = Tcl_GetVar2Ex(
+ convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
TCL_GLOBAL_ONLY);
if (variableObjPtr != NULL) {
- returnString = (BYTE *) Tcl_GetStringFromObj(
- variableObjPtr, &len);
+ if (uFmt == CF_TEXT) {
+ returnString = Tcl_GetStringFromObj(
+ variableObjPtr, &len);
+ } else {
+ returnString = (char *) Tcl_GetUnicodeFromObj(
+ variableObjPtr, &len);
+ len = sizeof(TCHAR) * len + 1;
+ }
ddeReturn = DdeCreateDataHandle(ddeInstance,
- returnString, (DWORD) len+1, 0, ddeItem,
- CF_TEXT, 0);
+ (BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
+ uFmt, 0);
} else {
ddeReturn = NULL;
}
+ Tcl_DStringFree(&ds);
}
}
Tcl_DStringFree(&dString);
}
return ddeReturn;
+#if !CBF_FAIL_POKES
+ case XTYP_POKE:
+ /*
+ * This is a poke for a Tcl variable, only implemented in
+ * debug/UNICODE mode.
+ */
+ ddeReturn = DDE_FNOTPROCESSED;
+
+ if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) {
+ return ddeReturn;
+ }
+
+ for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
+ && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+ }
+
+ if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) {
+ Tcl_DString ds;
+ Tcl_Obj *variableObjPtr;
+
+ len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
+ Tcl_DStringInit(&dString);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
+ CP_WINUNICODE);
+ Tcl_WinTCharToUtf(utilString, -1, &ds);
+ utilString = (TCHAR *) DdeAccessData(hData, &dlen);
+ if (uFmt == CF_TEXT) {
+ variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
+ } else {
+ variableObjPtr = Tcl_NewUnicodeObj(utilString, -1);
+ }
+
+ Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
+ variableObjPtr, TCL_GLOBAL_ONLY);
+
+ Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&dString);
+ ddeReturn = (HDDEDATA) DDE_FACK;
+ }
+ return ddeReturn;
+
+#endif
case XTYP_EXECUTE: {
/*
* Execute this script. The results will be saved into a list object
@@ -763,6 +846,7 @@ DdeServerProc(
*/
Tcl_Obj *returnPackagePtr;
+ char *string;
for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
@@ -775,9 +859,22 @@ DdeServerProc(
return (HDDEDATA) DDE_FNOTPROCESSED;
}
- utilString = (char *) DdeAccessData(hData, &dlen);
- len = dlen;
- ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
+ utilString = (TCHAR *) DdeAccessData(hData, &dlen);
+ string = (char *) utilString;
+ if (!dlen) {
+ /* Empty binary array. */
+ ddeObjectPtr = Tcl_NewObj();
+ } else if ((dlen & 1) || utilString[(dlen>>1)-1]) {
+ /* Cannot be unicode, so assume utf-8 */
+ if (!string[dlen-1]) {
+ dlen--;
+ }
+ ddeObjectPtr = Tcl_NewStringObj(string, dlen);
+ } else {
+ /* unicode */
+ dlen >>= 1;
+ ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *)utilString, dlen - 1);
+ }
Tcl_IncrRefCount(ddeObjectPtr);
DdeUnaccessData(hData);
if (convPtr->returnPackagePtr != NULL) {
@@ -829,9 +926,9 @@ DdeServerProc(
for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
i++, riPtr = riPtr->nextPtr) {
returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance,
- TCL_DDE_SERVICE_NAME, CP_WINANSI);
+ TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance,
- riPtr->name, CP_WINANSI);
+ riPtr->name, CP_WINUNICODE);
}
returnPtr[i].hszSvc = NULL;
returnPtr[i].hszTopic = NULL;
@@ -889,14 +986,14 @@ DdeExitProc(
static int
MakeDdeConnection(
Tcl_Interp *interp, /* Used to report errors. */
- const char *name, /* The connection to use. */
+ const TCHAR *name, /* The connection to use. */
HCONV *ddeConvPtr)
{
HSZ ddeTopic, ddeService;
HCONV ddeConv;
- ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0);
- ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) name, 0);
+ ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
+ ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE);
ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
@@ -904,8 +1001,13 @@ MakeDdeConnection(
if (ddeConv == (HCONV) NULL) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "no registered server named \"",
- name, "\"", NULL);
+ Tcl_DString dString;
+
+ Tcl_WinTCharToUtf(name, -1, &dString);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no registered server named \"%s\"", Tcl_DStringValue(&dString)));
+ Tcl_DStringFree(&dString);
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
}
return TCL_ERROR;
}
@@ -939,8 +1041,8 @@ DdeCreateClient(
struct DdeEnumServices *es)
{
WNDCLASSEX wc;
- static const char *szDdeClientClassName = "TclEval client class";
- static const char *szDdeClientWindowName = "TclEval client window";
+ static const TCHAR *szDdeClientClassName = TEXT("TclEval client class");
+ static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window");
memset(&wc, 0, sizeof(wc));
wc.cbSize = sizeof(wc);
@@ -965,7 +1067,6 @@ DdeClientWindowProc(
WPARAM wParam,
LPARAM lParam) /* (Potentially) our local handle */
{
-
switch (uMsg) {
case WM_CREATE: {
LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
@@ -973,15 +1074,14 @@ DdeClientWindowProc(
(struct DdeEnumServices *) lpcs->lpCreateParams;
#ifdef _WIN64
- SetWindowLongPtr(hwnd, GWLP_USERDATA, (long)es);
+ SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es);
#else
- SetWindowLong(hwnd, GWL_USERDATA, (long)es);
+ SetWindowLong(hwnd, GWL_USERDATA, (LONG) es);
#endif
return (LRESULT) 0L;
}
case WM_DDE_ACK:
return DdeServicesOnAck(hwnd, wParam, lParam);
- break;
default:
return DefWindowProc(hwnd, uMsg, wParam, lParam);
}
@@ -997,7 +1097,8 @@ DdeServicesOnAck(
ATOM service = (ATOM)LOWORD(lParam);
ATOM topic = (ATOM)HIWORD(lParam);
struct DdeEnumServices *es;
- char sz[255];
+ TCHAR sz[255];
+ Tcl_DString dString;
#ifdef _WIN64
es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
@@ -1010,10 +1111,14 @@ DdeServicesOnAck(
Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);
- GlobalGetAtomNameA(service, sz, 255);
- Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
- GlobalGetAtomNameA(topic, sz, 255);
- Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
+ GlobalGetAtomName(service, sz, 255);
+ Tcl_WinTCharToUtf(sz, -1, &dString);
+ Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
+ Tcl_DStringFree(&dString);
+ GlobalGetAtomName(topic, sz, 255);
+ Tcl_WinTCharToUtf(sz, -1, &dString);
+ Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
+ Tcl_DStringFree(&dString);
/*
* Adding the hwnd as a third list element provides a unique
@@ -1048,7 +1153,7 @@ DdeEnumWindowsCallback(
HWND hwndTarget,
LPARAM lParam)
{
- DWORD dwResult = 0;
+ DWORD_PTR dwResult = 0;
struct DdeEnumServices *es = (struct DdeEnumServices *) lParam;
SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
@@ -1060,8 +1165,8 @@ DdeEnumWindowsCallback(
static int
DdeGetServicesList(
Tcl_Interp *interp,
- const char *serviceName,
- const char *topicName)
+ const TCHAR *serviceName,
+ const TCHAR *topicName)
{
struct DdeEnumServices es;
@@ -1108,25 +1213,30 @@ static void
SetDdeError(
Tcl_Interp *interp) /* The interp to put the message in. */
{
- const char *errorMessage;
+ const char *errorMessage, *errorCode;
switch (DdeGetLastError(ddeInstance)) {
case DMLERR_DATAACKTIMEOUT:
case DMLERR_EXECACKTIMEOUT:
case DMLERR_POKEACKTIMEOUT:
errorMessage = "remote interpreter did not respond";
+ errorCode = "TIMEOUT";
break;
case DMLERR_BUSY:
errorMessage = "remote server is busy";
+ errorCode = "BUSY";
break;
case DMLERR_NOTPROCESSED:
errorMessage = "remote server cannot handle this command";
+ errorCode = "NOCANDO";
break;
default:
errorMessage = "dde command failed";
+ errorCode = "FAILED";
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL);
}
/*
@@ -1151,12 +1261,11 @@ DdeObjCmd(
ClientData clientData, /* Used only for deletion */
Tcl_Interp *interp, /* The interp we are sending from */
int objc, /* Number of arguments */
- Tcl_Obj *const * objv) /* The arguments */
+ Tcl_Obj *const *objv) /* The arguments */
{
static const char *const ddeCommands[] = {
"servername", "execute", "poke", "request", "services", "eval",
- (char *) NULL
- };
+ (char *) NULL};
enum DdeSubcommands {
DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES,
DDE_EVAL
@@ -1168,20 +1277,25 @@ DdeObjCmd(
DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST,
};
static const char *const ddeExecOptions[] = {
+ "-async", "-binary", NULL
+ };
+ enum DdeExecOptions {
+ DDE_EXEC_ASYNC, DDE_EXEC_BINARY
+ };
+ static const char *const ddeEvalOptions[] = {
"-async", NULL
};
static const char *const ddeReqOptions[] = {
"-binary", NULL
};
- int index, i, length;
- int async = 0, binary = 0, exact = 0;
- int result = TCL_OK, firstArg = 0;
+ int index, i, length, argIndex;
+ int flags = 0, result = TCL_OK, firstArg = 0;
HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
HCONV hConv = NULL;
- const char *serviceName = NULL, *topicName = NULL;
- char *string;
+ const TCHAR *serviceName = NULL, *topicName = NULL;
+ const char *string;
DWORD ddeResult;
Tcl_Obj *objPtr, *handlerPtr = NULL;
@@ -1202,7 +1316,6 @@ DdeObjCmd(
switch ((enum DdeSubcommands) index) {
case DDE_SERVERNAME:
for (i = 2; i < objc; i++) {
- int argIndex;
if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions,
"option", 0, &argIndex) != TCL_OK) {
/*
@@ -1217,7 +1330,7 @@ DdeObjCmd(
break;
}
if (argIndex == DDE_SERVERNAME_EXACT) {
- exact = 1;
+ flags |= DDE_FLAG_FORCE;
} else if (argIndex == DDE_SERVERNAME_HANDLER) {
if ((objc - i) == 1) { /* return current handler */
RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp);
@@ -1249,39 +1362,53 @@ DdeObjCmd(
if (objc == 5) {
firstArg = 2;
break;
- } else if (objc == 6) {
- int dummy;
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0,
- &dummy) == TCL_OK) {
- async = 1;
- firstArg = 3;
- break;
+ } else if (objc >= 6 && objc <= 7) {
+ firstArg = objc - 3;
+ for (i = 2; i < firstArg; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions,
+ "option", 0, &argIndex) != TCL_OK) {
+ goto wrongDdeExecuteArgs;
+ }
+ if (argIndex == DDE_EXEC_ASYNC) {
+ flags |= DDE_FLAG_ASYNC;
+ } else {
+ flags |= DDE_FLAG_BINARY;
+ }
}
+ break;
}
/* otherwise... */
+ wrongDdeExecuteArgs:
Tcl_WrongNumArgs(interp, 2, objv,
- "?-async? serviceName topicName value");
+ "?-async? ?-binary? serviceName topicName value");
return TCL_ERROR;
case DDE_POKE:
- if (objc != 6) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "serviceName topicName item value");
- return TCL_ERROR;
+ if (objc == 6) {
+ firstArg = 2;
+ break;
+ } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2],
+ ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
+ flags |= DDE_FLAG_BINARY;
+ firstArg = 3;
+ break;
}
- firstArg = 2;
- break;
+
+ /*
+ * Otherwise...
+ */
+
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-binary? serviceName topicName item value");
+ return TCL_ERROR;
case DDE_REQUEST:
if (objc == 5) {
firstArg = 2;
break;
- } else if (objc == 6) {
- int dummy;
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
- &dummy) == TCL_OK) {
- binary = 1;
- firstArg = 3;
- break;
- }
+ } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2],
+ ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
+ flags |= DDE_FLAG_BINARY;
+ firstArg = 3;
+ break;
}
/*
@@ -1304,15 +1431,13 @@ DdeObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args");
return TCL_ERROR;
} else {
- int dummy;
-
firstArg = 2;
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option",
- 0, &dummy) == TCL_OK) {
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option",
+ 0, &argIndex) == TCL_OK) {
if (objc < 5) {
goto wrongDdeEvalArgs;
}
- async = 1;
+ flags |= DDE_FLAG_ASYNC;
firstArg++;
}
break;
@@ -1322,7 +1447,11 @@ DdeObjCmd(
Initialize();
if (firstArg != 1) {
+#ifdef UNICODE
+ serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length);
+#else
serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
+#endif
} else {
length = 0;
}
@@ -1331,25 +1460,33 @@ DdeObjCmd(
serviceName = NULL;
} else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName,
- CP_WINANSI);
+ CP_WINUNICODE);
}
if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
+#ifdef UNICODE
+ topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length);
+#else
topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
+#endif
if (length == 0) {
topicName = NULL;
} else {
ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName,
- CP_WINANSI);
+ CP_WINUNICODE);
}
}
switch ((enum DdeSubcommands) index) {
case DDE_SERVERNAME:
- serviceName = DdeSetServerName(interp, serviceName, exact,
+ serviceName = DdeSetServerName(interp, serviceName, flags,
handlerPtr);
if (serviceName != NULL) {
+#ifdef UNICODE
+ Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1));
+#else
Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1));
+#endif
} else {
Tcl_ResetResult(interp);
}
@@ -1357,12 +1494,21 @@ DdeObjCmd(
case DDE_EXECUTE: {
int dataLength;
- BYTE *dataString = (BYTE *) Tcl_GetStringFromObj(
- objv[firstArg + 2], &dataLength);
+ const Tcl_UniChar *dataString;
+
+ if (flags & DDE_FLAG_BINARY) {
+ dataString = (const Tcl_UniChar *)
+ Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
+ } else {
+ dataString =
+ Tcl_GetUnicodeFromObj(objv[firstArg + 2], &dataLength);
+ dataLength = (dataLength + 1) * sizeof(Tcl_UniChar);
+ }
- if (dataLength == 0) {
+ if (dataLength <= 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot execute null data", -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
result = TCL_ERROR;
break;
}
@@ -1376,16 +1522,16 @@ DdeObjCmd(
break;
}
- ddeData = DdeCreateDataHandle(ddeInstance, dataString,
- (DWORD) dataLength+1, 0, 0, CF_TEXT, 0);
+ ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString,
+ (DWORD) dataLength, 0, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, 0);
if (ddeData != NULL) {
- if (async) {
+ if (flags & DDE_FLAG_ASYNC) {
DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
- CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
+ (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
} else {
ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
- hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
+ hConv, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL);
if (ddeReturn == 0) {
SetDdeError(interp);
result = TCL_ERROR;
@@ -1399,12 +1545,18 @@ DdeObjCmd(
break;
}
case DDE_REQUEST: {
- const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
+#ifdef UNICODE
+ const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
&length);
+#else
+ const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
+ &length);
+#endif
if (length == 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot request value of null data", -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
result = TCL_ERROR;
goto cleanup;
}
@@ -1418,22 +1570,27 @@ DdeObjCmd(
} else {
Tcl_Obj *returnObjPtr;
ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
- CP_WINANSI);
+ CP_WINUNICODE);
if (ddeItem != NULL) {
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
- CF_TEXT, XTYP_REQUEST, 5000, NULL);
+ (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL);
if (ddeData == NULL) {
SetDdeError(interp);
result = TCL_ERROR;
} else {
DWORD tmp;
- const BYTE *dataString = DdeAccessData(ddeData, &tmp);
+ const Tcl_UniChar *dataString = (const Tcl_UniChar *) DdeAccessData(ddeData, &tmp);
- if (binary) {
- returnObjPtr = Tcl_NewByteArrayObj(dataString,
- (int) tmp);
+ if (flags & DDE_FLAG_BINARY) {
+ returnObjPtr =
+ Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp);
} else {
- returnObjPtr = Tcl_NewStringObj((char*)dataString,-1);
+ tmp >>= 1;
+ if (tmp && !dataString[(tmp-1)]) {
+ --tmp;
+ }
+ returnObjPtr = Tcl_NewUnicodeObj(dataString,
+ (int) tmp);
}
DdeUnaccessData(ddeData);
DdeFreeDataHandle(ddeData);
@@ -1448,18 +1605,30 @@ DdeObjCmd(
break;
}
case DDE_POKE: {
- const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
+#ifdef UNICODE
+ const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
+ &length);
+#else
+ const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
&length);
+#endif
BYTE *dataString;
if (length == 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot have a null item", -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
result = TCL_ERROR;
goto cleanup;
}
- dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3],
- &length);
+ if (flags & DDE_FLAG_BINARY) {
+ dataString = (BYTE *)
+ Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
+ } else {
+ dataString = (BYTE *)
+ Tcl_GetUnicodeFromObj(objv[firstArg + 3], &length);
+ length = 2 * length + 1;
+ }
hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
@@ -1470,10 +1639,10 @@ DdeObjCmd(
result = TCL_ERROR;
} else {
ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
- CP_WINANSI);
+ CP_WINUNICODE);
if (ddeItem != NULL) {
- ddeData = DdeClientTransaction(dataString, (DWORD) length+1,
- hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
+ ddeData = DdeClientTransaction(dataString, (DWORD) length,
+ hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_POKE, 5000, NULL);
if (ddeData == NULL) {
SetDdeError(interp);
result = TCL_ERROR;
@@ -1497,12 +1666,13 @@ DdeObjCmd(
if (serviceName == NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("invalid service name \"\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
result = TCL_ERROR;
goto cleanup;
}
- objc -= (async + 3);
- objv += (async + 3);
+ objc -= firstArg + 1;
+ objv += firstArg + 1;
/*
* See if the target interpreter is local. If so, execute the command
@@ -1515,7 +1685,7 @@ DdeObjCmd(
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (strcasecmp(serviceName, riPtr->name) == 0) {
+ if (_tcsicmp(serviceName, riPtr->name) == 0) {
break;
}
}
@@ -1541,9 +1711,11 @@ DdeObjCmd(
*/
if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) {
- Tcl_SetResult(riPtr->interp, "permission denied: "
- "a handler procedure must be defined for use in "
- "a safe interp", TCL_STATIC);
+ Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj(
+ "permission denied: a handler procedure must be"
+ " defined for use in a safe interp", -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK",
+ NULL);
result = TCL_ERROR;
}
@@ -1606,31 +1778,31 @@ DdeObjCmd(
if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
invalidServerResponse:
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("invalid data returned from server",
- -1));
+ Tcl_NewStringObj("invalid data returned from server", -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
result = TCL_ERROR;
goto cleanup;
}
objPtr = Tcl_ConcatObj(objc, objv);
- string = Tcl_GetStringFromObj(objPtr, &length);
+ string = (const char *) Tcl_GetUnicodeFromObj(objPtr, &length);
ddeItemData = DdeCreateDataHandle(ddeInstance,
- (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
+ (BYTE *) string, (DWORD) 2*length+2, 0, 0, CF_UNICODETEXT, 0);
- if (async) {
+ if (flags & DDE_FLAG_ASYNC) {
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
0xFFFFFFFF, hConv, 0,
- CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
+ CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
} else {
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
0xFFFFFFFF, hConv, 0,
- CF_TEXT, XTYP_EXECUTE, 30000, NULL);
+ CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL);
if (ddeData != 0) {
ddeCookie = DdeCreateStringHandle(ddeInstance,
- TCL_DDE_EXECUTE_RESULT, CP_WINANSI);
+ TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE);
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
- CF_TEXT, XTYP_REQUEST, 30000, NULL);
+ CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL);
}
}
@@ -1639,10 +1811,12 @@ DdeObjCmd(
if (ddeData == 0) {
SetDdeError(interp);
result = TCL_ERROR;
+ goto cleanup;
}
- if (async == 0) {
+ if (!(flags & DDE_FLAG_ASYNC)) {
Tcl_Obj *resultPtr;
+ Tcl_UniChar *ddeDataString;
/*
* The return handle has a two or four element list in it. The
@@ -1655,10 +1829,11 @@ DdeObjCmd(
resultPtr = Tcl_NewObj();
length = DdeGetData(ddeData, NULL, 0, 0);
- Tcl_SetObjLength(resultPtr, length);
- string = Tcl_GetString(resultPtr);
- DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0);
- Tcl_SetObjLength(resultPtr, (int) strlen(string));
+ ddeDataString = ckalloc(length);
+ DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
+ length = (length >> 1) - 1;
+ resultPtr = Tcl_NewUnicodeObj(ddeDataString, length);
+ ckfree(ddeDataString);
if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
Tcl_DecrRefCount(resultPtr);
diff --git a/win/tclWinError.c b/win/tclWinError.c
index c71f535..49eeed3 100644
--- a/win/tclWinError.c
+++ b/win/tclWinError.c
@@ -8,17 +8,14 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinError.c,v 1.8 2010/01/22 13:02:50 nijtmans Exp $
*/
#include "tclInt.h"
-
/*
* The following table contains the mapping from Win32 errors to errno errors.
*/
-static char errorTable[] = {
+static const unsigned char errorTable[] = {
0,
EINVAL, /* ERROR_INVALID_FUNCTION 1 */
ENOENT, /* ERROR_FILE_NOT_FOUND 2 */
@@ -286,18 +283,16 @@ static char errorTable[] = {
EINVAL, /* 264 */
EINVAL, /* 265 */
EINVAL, /* 266 */
- ENOTDIR, /* ERROR_DIRECTORY 267 */
+ ENOTDIR /* ERROR_DIRECTORY 267 */
};
-static const unsigned int tableLen = sizeof(errorTable);
-
/*
* The following table contains the mapping from WinSock errors to
* errno errors.
*/
-static int wsaErrorTable[] = {
- EWOULDBLOCK, /* WSAEWOULDBLOCK */
+static const unsigned char wsaErrorTable[] = {
+ EAGAIN, /* WSAEWOULDBLOCK */
EINPROGRESS, /* WSAEINPROGRESS */
EALREADY, /* WSAEALREADY */
ENOTSOCK, /* WSAENOTSOCK */
@@ -333,7 +328,7 @@ static int wsaErrorTable[] = {
EUSERS, /* WSAEUSERS */
EDQUOT, /* WSAEDQUOT */
ESTALE, /* WSAESTALE */
- EREMOTE, /* WSAEREMOTE */
+ EREMOTE /* WSAEREMOTE */
};
/*
@@ -354,38 +349,80 @@ static int wsaErrorTable[] = {
void
TclWinConvertError(
- unsigned long errCode) /* Win32 error code. */
+ DWORD errCode) /* Win32 error code. */
{
- if (errCode >= tableLen) {
- Tcl_SetErrno(EINVAL);
+ if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
+ errCode -= WSAEWOULDBLOCK;
+ if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
+ Tcl_SetErrno(errorTable[1]);
+ } else {
+ Tcl_SetErrno(wsaErrorTable[errCode]);
+ }
} else {
Tcl_SetErrno(errorTable[errCode]);
}
}
-
+
+#ifdef __CYGWIN__
/*
*----------------------------------------------------------------------
*
- * TclWinConvertWSAError --
+ * tclWinDebugPanic --
*
- * This routine converts a WinSock error into an errno value.
+ * Display a message. If a debugger is present, present it directly to
+ * the debugger, otherwise send it to stderr.
*
* Results:
* None.
*
* Side effects:
- * Sets the errno global variable.
+ * None.
*
*----------------------------------------------------------------------
*/
void
-TclWinConvertWSAError(
- unsigned long errCode) /* Win32 error code. */
+tclWinDebugPanic(
+ const char *format, ...)
{
- if ((errCode >= WSAEWOULDBLOCK) && (errCode <= WSAEREMOTE)) {
- Tcl_SetErrno(wsaErrorTable[errCode - WSAEWOULDBLOCK]);
+#define TCL_MAX_WARN_LEN 1024
+ va_list argList;
+ va_start(argList, format);
+
+ if (IsDebuggerPresent()) {
+ WCHAR msgString[TCL_MAX_WARN_LEN];
+ char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
+
+ vsnprintf(buf, sizeof(buf), format, argList);
+ msgString[TCL_MAX_WARN_LEN-1] = L'\0';
+ MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN);
+
+ /*
+ * Truncate MessageBox string if it is too long to not overflow the buffer.
+ */
+
+ if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
+ memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
+ }
+ OutputDebugStringW(msgString);
} else {
- Tcl_SetErrno(EINVAL);
+ vfprintf(stderr, format, argList);
+ fprintf(stderr, "\n");
+ fflush(stderr);
}
+# if defined(__GNUC__)
+ __builtin_trap();
+# else
+ DebugBreak();
+# endif
+ abort();
}
+#endif
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 47c1b09..ac88861 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinFCmd.c,v 1.68 2010/09/21 21:50:35 nijtmans Exp $
*/
#include "tclWinInt.h"
@@ -52,7 +50,7 @@ enum {
WIN_SYSTEM_ATTRIBUTE
};
-static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
+static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
@@ -177,7 +175,7 @@ DoRenameFile(
const TCHAR *nativeDst) /* New pathname for file or directory
* (native). */
{
-#ifdef HAVE_NO_SEH
+#if defined(HAVE_NO_SEH) && !defined(_WIN64)
EXCEPTION_REGISTRATION registration;
#endif
DWORD srcAttr, dstAttr;
@@ -277,7 +275,7 @@ DoRenameFile(
[registration] "m" (registration),
[nativeDst] "m" (nativeDst),
[nativeSrc] "m" (nativeSrc),
- [moveFile] "r" (tclWinProcs->moveFileProc)
+ [moveFile] "r" (MoveFile)
:
"%eax", "%ebx", "%ecx", "%edx", "memory"
);
@@ -288,7 +286,7 @@ DoRenameFile(
#ifndef HAVE_NO_SEH
__try {
#endif
- if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
+ if ((*MoveFile)(nativeSrc, nativeDst) != FALSE) {
retval = TCL_OK;
}
#ifndef HAVE_NO_SEH
@@ -302,10 +300,10 @@ DoRenameFile(
TclWinConvertError(GetLastError());
- srcAttr = tclWinProcs->getFileAttributesProc(nativeSrc);
- dstAttr = tclWinProcs->getFileAttributesProc(nativeDst);
+ srcAttr = GetFileAttributes(nativeSrc);
+ dstAttr = GetFileAttributes(nativeDst);
if (srcAttr == 0xffffffff) {
- if (tclWinProcs->getFullPathNameProc(nativeSrc, 0, NULL,
+ if (GetFullPathName(nativeSrc, 0, NULL,
NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
@@ -313,7 +311,7 @@ DoRenameFile(
srcAttr = 0;
}
if (dstAttr == 0xffffffff) {
- if (tclWinProcs->getFullPathNameProc(nativeDst, 0, NULL,
+ if (GetFullPathName(nativeDst, 0, NULL,
NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
@@ -336,21 +334,21 @@ DoRenameFile(
Tcl_DString srcString, dstString;
const char *src, *dst;
- size = tclWinProcs->getFullPathNameProc(nativeSrc, MAX_PATH,
+ size = GetFullPathName(nativeSrc, MAX_PATH,
nativeSrcPath, &nativeSrcRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
- size = tclWinProcs->getFullPathNameProc(nativeDst, MAX_PATH,
+ size = GetFullPathName(nativeDst, MAX_PATH,
nativeDstPath, &nativeDstRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
- tclWinProcs->charLowerProc(nativeSrcPath);
- tclWinProcs->charLowerProc(nativeDstPath);
+ CharLower(nativeSrcPath);
+ CharLower(nativeDstPath);
- src = tclWinProcs->tchar2utf(nativeSrcPath, -1, &srcString);
- dst = tclWinProcs->tchar2utf(nativeDstPath, -1, &dstString);
+ src = Tcl_WinTCharToUtf(nativeSrcPath, -1, &srcString);
+ dst = Tcl_WinTCharToUtf(nativeDstPath, -1, &dstString);
/*
* Check whether the destination path is actually inside the
@@ -397,8 +395,8 @@ DoRenameFile(
Tcl_SetErrno(EXDEV);
}
- ckfree((char *) srcArgv);
- ckfree((char *) dstArgv);
+ ckfree(srcArgv);
+ ckfree(dstArgv);
}
/*
@@ -429,7 +427,7 @@ DoRenameFile(
* directory back, for completeness.
*/
- if (tclWinProcs->moveFileProc(nativeSrc,
+ if (MoveFile(nativeSrc,
nativeDst) != FALSE) {
return TCL_OK;
}
@@ -440,8 +438,8 @@ DoRenameFile(
*/
TclWinConvertError(GetLastError());
- tclWinProcs->createDirectoryProc(nativeDst, NULL);
- tclWinProcs->setFileAttributesProc(nativeDst, dstAttr);
+ CreateDirectory(nativeDst, NULL);
+ SetFileAttributes(nativeDst, dstAttr);
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
@@ -470,7 +468,7 @@ DoRenameFile(
int result, size;
TCHAR tempBuf[MAX_PATH];
- size = tclWinProcs->getFullPathNameProc(nativeDst, MAX_PATH,
+ size = GetFullPathName(nativeDst, MAX_PATH,
tempBuf, &nativeRest);
if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
return TCL_ERROR;
@@ -480,7 +478,7 @@ DoRenameFile(
result = TCL_ERROR;
nativePrefix = (TCHAR *) L"tclr";
- if (tclWinProcs->getTempFileNameProc(nativeTmp, nativePrefix,
+ if (GetTempFileName(nativeTmp, nativePrefix,
0, tempBuf) != 0) {
/*
* Strictly speaking, need the following DeleteFile and
@@ -489,19 +487,16 @@ DoRenameFile(
* same temp file.
*/
- nativeTmp = (TCHAR *) tempBuf;
- tclWinProcs->deleteFileProc(nativeTmp);
- if (tclWinProcs->moveFileProc(nativeDst,
- nativeTmp) != FALSE) {
- if (tclWinProcs->moveFileProc(nativeSrc,
- nativeDst) != FALSE) {
- tclWinProcs->setFileAttributesProc(nativeTmp,
- FILE_ATTRIBUTE_NORMAL);
- tclWinProcs->deleteFileProc(nativeTmp);
+ nativeTmp = tempBuf;
+ DeleteFile(nativeTmp);
+ if (MoveFile(nativeDst, nativeTmp) != FALSE) {
+ if (MoveFile(nativeSrc, nativeDst) != FALSE) {
+ SetFileAttributes(nativeTmp, FILE_ATTRIBUTE_NORMAL);
+ DeleteFile(nativeTmp);
return TCL_OK;
} else {
- tclWinProcs->deleteFileProc(nativeDst);
- tclWinProcs->moveFileProc(nativeTmp, nativeDst);
+ DeleteFile(nativeDst);
+ MoveFile(nativeTmp, nativeDst);
}
}
@@ -567,7 +562,7 @@ DoCopyFile(
const TCHAR *nativeSrc, /* Pathname of file to be copied (native). */
const TCHAR *nativeDst) /* Pathname of file to copy to (native). */
{
-#ifdef HAVE_NO_SEH
+#if defined(HAVE_NO_SEH) && !defined(_WIN64)
EXCEPTION_REGISTRATION registration;
#endif
int retval = -1;
@@ -668,7 +663,7 @@ DoCopyFile(
[registration] "m" (registration),
[nativeDst] "m" (nativeDst),
[nativeSrc] "m" (nativeSrc),
- [copyFile] "r" (tclWinProcs->copyFileProc)
+ [copyFile] "r" (CopyFile)
:
"%eax", "%ebx", "%ecx", "%edx", "memory"
);
@@ -679,7 +674,7 @@ DoCopyFile(
#ifndef HAVE_NO_SEH
__try {
#endif
- if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
+ if (CopyFile(nativeSrc, nativeDst, 0) != FALSE) {
retval = TCL_OK;
}
#ifndef HAVE_NO_SEH
@@ -699,8 +694,8 @@ DoCopyFile(
if (Tcl_GetErrno() == EACCES) {
DWORD srcAttr, dstAttr;
- srcAttr = tclWinProcs->getFileAttributesProc(nativeSrc);
- dstAttr = tclWinProcs->getFileAttributesProc(nativeDst);
+ srcAttr = GetFileAttributes(nativeSrc);
+ dstAttr = GetFileAttributes(nativeDst);
if (srcAttr != 0xffffffff) {
if (dstAttr == 0xffffffff) {
dstAttr = 0;
@@ -716,9 +711,9 @@ DoCopyFile(
Tcl_SetErrno(EISDIR);
}
if (dstAttr & FILE_ATTRIBUTE_READONLY) {
- tclWinProcs->setFileAttributesProc(nativeDst,
+ SetFileAttributes(nativeDst,
dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
- if (tclWinProcs->copyFileProc(nativeSrc, nativeDst,
+ if (CopyFile(nativeSrc, nativeDst,
0) != FALSE) {
return TCL_OK;
}
@@ -729,7 +724,7 @@ DoCopyFile(
*/
TclWinConvertError(GetLastError());
- tclWinProcs->setFileAttributesProc(nativeDst, dstAttr);
+ SetFileAttributes(nativeDst, dstAttr);
}
}
}
@@ -785,13 +780,13 @@ TclpDeleteFile(
return TCL_ERROR;
}
- if (tclWinProcs->deleteFileProc(path) != FALSE) {
+ if (DeleteFile(path) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
- attr = tclWinProcs->getFileAttributesProc(path);
+ attr = GetFileAttributes(path);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
@@ -812,21 +807,21 @@ TclpDeleteFile(
Tcl_SetErrno(EISDIR);
} else if (attr & FILE_ATTRIBUTE_READONLY) {
- int res = tclWinProcs->setFileAttributesProc(path,
+ int res = SetFileAttributes(path,
attr & ~((DWORD) FILE_ATTRIBUTE_READONLY));
if ((res != 0) &&
- (tclWinProcs->deleteFileProc(path) != FALSE)) {
+ (DeleteFile(path) != FALSE)) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
if (res != 0) {
- tclWinProcs->setFileAttributesProc(path, attr);
+ SetFileAttributes(path, attr);
}
}
}
} else if (Tcl_GetErrno() == ENOENT) {
- attr = tclWinProcs->getFileAttributesProc(path);
+ attr = GetFileAttributes(path);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
/*
@@ -885,7 +880,7 @@ static int
DoCreateDirectory(
const TCHAR *nativePath) /* Pathname of directory to create (native). */
{
- if (tclWinProcs->createDirectoryProc(nativePath, NULL) == 0) {
+ if (CreateDirectory(nativePath, NULL) == 0) {
DWORD error = GetLastError();
TclWinConvertError(error);
@@ -935,8 +930,8 @@ TclpObjCopyDirectory(
return TCL_ERROR;
}
- tclWinProcs->utf2tchar(Tcl_GetString(normSrcPtr), -1, &srcString);
- tclWinProcs->utf2tchar(Tcl_GetString(normDestPtr), -1, &dstString);
+ Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString);
+ Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString);
ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);
@@ -1008,7 +1003,7 @@ TclpObjRemoveDirectory(
if (normPtr == NULL) {
return TCL_ERROR;
}
- tclWinProcs->utf2tchar(Tcl_GetString(normPtr), -1, &native);
+ Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native);
ret = DoRemoveDirectory(&native, recursive, &ds);
Tcl_DStringFree(&native);
} else {
@@ -1016,13 +1011,12 @@ TclpObjRemoveDirectory(
}
if (ret != TCL_OK) {
- int len = Tcl_DStringLength(&ds);
- if (len > 0) {
+ if (Tcl_DStringLength(&ds) > 0) {
if (normPtr != NULL &&
!strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
*errorPtr = pathPtr;
} else {
- *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ *errorPtr = TclDStringToObj(&ds);
}
Tcl_IncrRefCount(*errorPtr);
}
@@ -1054,7 +1048,7 @@ DoRemoveJustDirectory(
goto end;
}
- attr = tclWinProcs->getFileAttributesProc(nativePath);
+ attr = GetFileAttributes(nativePath);
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
/*
@@ -1068,7 +1062,7 @@ DoRemoveJustDirectory(
* Ordinary directory.
*/
- if (tclWinProcs->removeDirectoryProc(nativePath) != FALSE) {
+ if (RemoveDirectory(nativePath) != FALSE) {
return TCL_OK;
}
}
@@ -1076,7 +1070,7 @@ DoRemoveJustDirectory(
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
- attr = tclWinProcs->getFileAttributesProc(nativePath);
+ attr = GetFileAttributes(nativePath);
if (attr != 0xffffffff) {
if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
@@ -1100,15 +1094,15 @@ DoRemoveJustDirectory(
if (attr & FILE_ATTRIBUTE_READONLY) {
attr &= ~FILE_ATTRIBUTE_READONLY;
- if (tclWinProcs->setFileAttributesProc(nativePath,
+ if (SetFileAttributes(nativePath,
attr) == FALSE) {
goto end;
}
- if (tclWinProcs->removeDirectoryProc(nativePath) != FALSE) {
+ if (RemoveDirectory(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
- tclWinProcs->setFileAttributesProc(nativePath,
+ SetFileAttributes(nativePath,
attr | FILE_ATTRIBUTE_READONLY);
}
@@ -1131,9 +1125,9 @@ DoRemoveJustDirectory(
len = strlen(path);
find = Tcl_DStringAppend(&buffer, path, len);
if ((len > 0) && (find[len - 1] != '\\')) {
- Tcl_DStringAppend(&buffer, "\\", 1);
+ TclDStringAppendLiteral(&buffer, "\\");
}
- find = Tcl_DStringAppend(&buffer, "*.*", 3);
+ find = TclDStringAppendLiteral(&buffer, "*.*");
handle = FindFirstFileA(find, &data);
if (handle != INVALID_HANDLE_VALUE) {
while (1) {
@@ -1176,7 +1170,7 @@ DoRemoveJustDirectory(
end:
if (errorPtr != NULL) {
- tclWinProcs->tchar2utf(nativePath, -1, errorPtr);
+ Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
}
return TCL_ERROR;
@@ -1247,7 +1241,7 @@ TraverseWinTree(
TCHAR *nativeSource, *nativeTarget, *nativeErrfile;
int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen;
HANDLE handle;
- WIN32_FIND_DATAT data;
+ WIN32_FIND_DATA data;
nativeErrfile = NULL;
result = TCL_OK;
@@ -1258,7 +1252,7 @@ TraverseWinTree(
(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr));
oldSourceLen = Tcl_DStringLength(sourcePtr);
- sourceAttr = tclWinProcs->getFileAttributesProc(nativeSource);
+ sourceAttr = GetFileAttributes(nativeSource);
if (sourceAttr == 0xffffffff) {
nativeErrfile = nativeSource;
goto end;
@@ -1281,11 +1275,11 @@ TraverseWinTree(
return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr);
}
- Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1);
+ Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\*.*"), 4 * sizeof(TCHAR) + 1);
Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
- handle = tclWinProcs->findFirstFileProc(nativeSource, &data);
+ handle = FindFirstFile(nativeSource, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* Can't read directory.
@@ -1305,24 +1299,24 @@ TraverseWinTree(
return result;
}
- sourceLen = oldSourceLen + sizeof(WCHAR);
- Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1);
+ sourceLen = oldSourceLen + sizeof(TCHAR);
+ Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1);
Tcl_DStringSetLength(sourcePtr, sourceLen);
if (targetPtr != NULL) {
oldTargetLen = Tcl_DStringLength(targetPtr);
targetLen = oldTargetLen;
- targetLen += sizeof(WCHAR);
- Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1);
+ targetLen += sizeof(TCHAR);
+ Tcl_DStringAppend(targetPtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1);
Tcl_DStringSetLength(targetPtr, targetLen);
}
found = 1;
- for (; found; found = tclWinProcs->findNextFileProc(handle, &data)) {
+ for (; found; found = FindNextFile(handle, &data)) {
TCHAR *nativeName;
int len;
- WCHAR *wp = data.w.cFileName;
+ TCHAR *wp = data.cFileName;
if (*wp == '.') {
wp++;
if (*wp == '.') {
@@ -1332,8 +1326,8 @@ TraverseWinTree(
continue;
}
}
- nativeName = (TCHAR *) data.w.cFileName;
- len = wcslen(data.w.cFileName) * sizeof(WCHAR);
+ nativeName = (TCHAR *) data.cFileName;
+ len = _tcslen(data.cFileName) * sizeof(TCHAR);
/*
* Append name after slash, and recurse on the file.
@@ -1387,7 +1381,7 @@ TraverseWinTree(
if (nativeErrfile != NULL) {
TclWinConvertError(GetLastError());
if (errorPtr != NULL) {
- tclWinProcs->tchar2utf(nativeErrfile, -1, errorPtr);
+ Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr);
}
result = TCL_ERROR;
}
@@ -1433,9 +1427,9 @@ TraversalCopy(
break;
case DOTREE_PRED:
if (DoCreateDirectory(nativeDst) == TCL_OK) {
- DWORD attr = tclWinProcs->getFileAttributesProc(nativeSrc);
+ DWORD attr = GetFileAttributes(nativeSrc);
- if (tclWinProcs->setFileAttributesProc(nativeDst,
+ if (SetFileAttributes(nativeDst,
attr) != FALSE) {
return TCL_OK;
}
@@ -1452,7 +1446,7 @@ TraversalCopy(
*/
if (errorPtr != NULL) {
- tclWinProcs->tchar2utf(nativeDst, -1, errorPtr);
+ Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);
}
return TCL_ERROR;
}
@@ -1507,7 +1501,7 @@ TraversalDelete(
}
if (errorPtr != NULL) {
- tclWinProcs->tchar2utf(nativeSrc, -1, errorPtr);
+ Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
}
return TCL_ERROR;
}
@@ -1536,8 +1530,8 @@ StatError(
* error. */
{
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName),
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
/*
@@ -1571,7 +1565,7 @@ GetWinFileAttributes(
int attr;
nativeName = Tcl_FSGetNativePath(fileName);
- result = tclWinProcs->getFileAttributesProc(nativeName);
+ result = GetFileAttributes(nativeName);
if (result == 0xffffffff) {
StatError(interp, fileName);
@@ -1655,9 +1649,11 @@ ConvertFileNameFormat(
if (splitPath == NULL || pathc == 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- Tcl_GetString(fileName), "\": no such file or directory",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": no such file or directory",
+ Tcl_GetString(fileName)));
+ errno = ENOENT;
+ Tcl_PosixError(interp);
}
goto cleanup;
}
@@ -1701,7 +1697,7 @@ ConvertFileNameFormat(
const TCHAR *nativeName;
const char *tempString;
int tempLen;
- WIN32_FIND_DATAT data;
+ WIN32_FIND_DATA data;
HANDLE handle;
DWORD attr;
@@ -1715,9 +1711,9 @@ ConvertFileNameFormat(
Tcl_DStringInit(&ds);
tempString = Tcl_GetStringFromObj(tempPath,&tempLen);
- nativeName = tclWinProcs->utf2tchar(tempString, tempLen, &ds);
+ nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds);
Tcl_DecrRefCount(tempPath);
- handle = tclWinProcs->findFirstFileProc(nativeName, &data);
+ handle = FindFirstFile(nativeName, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* FindFirstFile() doesn't like root directories. We would
@@ -1726,7 +1722,7 @@ ConvertFileNameFormat(
* root directory
*/
- attr = tclWinProcs->getFileAttributesProc(nativeName);
+ attr = GetFileAttributes(nativeName);
if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_DStringFree(&ds);
goto simple;
@@ -1740,14 +1736,14 @@ ConvertFileNameFormat(
}
goto cleanup;
}
- nativeName = (TCHAR *) data.w.cAlternateFileName;
+ nativeName = data.cAlternateFileName;
if (longShort) {
- if (data.w.cFileName[0] != '\0') {
- nativeName = (TCHAR *) data.w.cFileName;
+ if (data.cFileName[0] != '\0') {
+ nativeName = data.cFileName;
}
} else {
- if (data.w.cAlternateFileName[0] == '\0') {
- nativeName = (TCHAR *) data.w.cFileName;
+ if (data.cAlternateFileName[0] == '\0') {
+ nativeName = (TCHAR *) data.cFileName;
}
}
@@ -1764,7 +1760,8 @@ ConvertFileNameFormat(
*/
Tcl_DStringInit(&dsTemp);
- tclWinProcs->tchar2utf(nativeName, -1, &dsTemp);
+ Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
+ Tcl_DStringFree(&ds);
/*
* Deal with issues of tildes being absolute.
@@ -1774,13 +1771,11 @@ ConvertFileNameFormat(
TclNewLiteralStringObj(tempPath, "./");
Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
Tcl_DStringLength(&dsTemp));
+ Tcl_DStringFree(&dsTemp);
} else {
- tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
- Tcl_DStringLength(&dsTemp));
+ tempPath = TclDStringToObj(&dsTemp);
}
Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
- Tcl_DStringFree(&ds);
- Tcl_DStringFree(&dsTemp);
FindClose(handle);
}
}
@@ -1897,7 +1892,7 @@ SetWinFileAttributes(
const TCHAR *nativeName;
nativeName = Tcl_FSGetNativePath(fileName);
- fileAttributes = tclWinProcs->getFileAttributesProc(nativeName);
+ fileAttributes = GetFileAttributes(nativeName);
if (fileAttributes == 0xffffffff) {
StatError(interp, fileName);
@@ -1915,7 +1910,7 @@ SetWinFileAttributes(
fileAttributes &= ~(attributeArray[objIndex]);
}
- if (!tclWinProcs->setFileAttributesProc(nativeName, fileAttributes)) {
+ if (!SetFileAttributes(nativeName, fileAttributes)) {
StatError(interp, fileName);
return TCL_ERROR;
}
@@ -1946,12 +1941,13 @@ CannotSetAttribute(
Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
- Tcl_AppendResult(interp, "cannot set attribute \"",
- tclpFileAttrStrings[objIndex], "\" for file \"",
- Tcl_GetString(fileName), "\": attribute is readonly", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot set attribute \"%s\" for file \"%s\": attribute is readonly",
+ tclpFileAttrStrings[objIndex], Tcl_GetString(fileName)));
+ errno = EINVAL;
+ Tcl_PosixError(interp);
return TCL_ERROR;
}
-
/*
*---------------------------------------------------------------------------
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 0bdcbd8..a1189f5 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -10,8 +10,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinFile.c,v 1.113 2010/09/21 20:22:51 nijtmans Exp $
*/
#include "tclWinInt.h"
@@ -19,7 +17,7 @@
#include <winioctl.h>
#include <sys/stat.h>
#include <shlobj.h>
-#include <lmaccess.h> /* For TclpGetUserHome(). */
+#include <lm.h> /* For TclpGetUserHome(). */
/*
* The number of 100-ns intervals between the Windows system epoch (1601-01-01
@@ -150,14 +148,6 @@ typedef struct {
static time_t ToCTime(FILETIME fileTime);
static void FromCTime(time_t posixTime, FILETIME *fileTime);
-typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC(
- LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr);
-
-typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC(LPVOID Buffer);
-
-typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC(
- LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr);
-
/*
* Declarations for local functions defined in this file:
*/
@@ -183,6 +173,7 @@ static int WinLink(const TCHAR *LinkSource,
const TCHAR *LinkTarget, int linkAction);
static int WinSymLinkDirectory(const TCHAR *LinkDirectory,
const TCHAR *LinkTarget);
+MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
/*
*--------------------------------------------------------------------
@@ -208,8 +199,8 @@ WinLink(
* Get the full path referenced by the target.
*/
- if (!tclWinProcs->getFullPathNameProc(linkTargetPath, MAX_PATH,
- tempFileName, &tempFilePart)) {
+ if (!GetFullPathName(linkTargetPath, MAX_PATH, tempFileName,
+ &tempFilePart)) {
/*
* Invalid file.
*/
@@ -222,7 +213,7 @@ WinLink(
* Make sure source file doesn't exist.
*/
- attr = tclWinProcs->getFileAttributesProc(linkSourcePath);
+ attr = GetFileAttributes(linkSourcePath);
if (attr != INVALID_FILE_ATTRIBUTES) {
Tcl_SetErrno(EEXIST);
return -1;
@@ -232,8 +223,8 @@ WinLink(
* Get the full path referenced by the source file/directory.
*/
- if (!tclWinProcs->getFullPathNameProc(linkSourcePath, MAX_PATH,
- tempFileName, &tempFilePart)) {
+ if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName,
+ &tempFilePart)) {
/*
* Invalid file.
*/
@@ -246,43 +237,36 @@ WinLink(
* Check the target.
*/
- attr = tclWinProcs->getFileAttributesProc(linkTargetPath);
+ attr = GetFileAttributes(linkTargetPath);
if (attr == INVALID_FILE_ATTRIBUTES) {
/*
* The target doesn't exist.
*/
TclWinConvertError(GetLastError());
- return -1;
-
} else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* It is a file.
*/
- if (tclWinProcs->createHardLinkProc == NULL) {
- Tcl_SetErrno(ENOTDIR);
- return -1;
- }
-
if (linkAction & TCL_CREATE_HARD_LINK) {
- if (!tclWinProcs->createHardLinkProc(linkSourcePath,
- linkTargetPath, NULL)) {
- TclWinConvertError(GetLastError());
- return -1;
+ if (CreateHardLink(linkSourcePath, linkTargetPath, NULL)) {
+ /*
+ * Success!
+ */
+
+ return 0;
}
- return 0;
+ TclWinConvertError(GetLastError());
} else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
/*
* Can't symlink files.
*/
Tcl_SetErrno(ENOTDIR);
- return -1;
} else {
Tcl_SetErrno(ENODEV);
- return -1;
}
} else {
/*
@@ -299,12 +283,11 @@ WinLink(
*/
Tcl_SetErrno(EISDIR);
- return -1;
} else {
Tcl_SetErrno(ENODEV);
- return -1;
}
}
+ return -1;
}
/*
@@ -329,8 +312,8 @@ WinReadLink(
* Get the full path referenced by the target.
*/
- if (!tclWinProcs->getFullPathNameProc(linkSourcePath, MAX_PATH,
- tempFileName, &tempFilePart)) {
+ if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName,
+ &tempFilePart)) {
/*
* Invalid file.
*/
@@ -343,7 +326,7 @@ WinReadLink(
* Make sure source file does exist.
*/
- attr = tclWinProcs->getFileAttributesProc(linkSourcePath);
+ attr = GetFileAttributes(linkSourcePath);
if (attr == INVALID_FILE_ATTRIBUTES) {
/*
* The source doesn't exist.
@@ -359,9 +342,9 @@ WinReadLink(
Tcl_SetErrno(ENOTDIR);
return NULL;
- } else {
- return WinReadLinkDirectory(linkSourcePath);
}
+
+ return WinReadLinkDirectory(linkSourcePath);
}
/*
@@ -500,9 +483,8 @@ TclWinSymLinkDelete(
memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
- hFile = tclWinProcs->createFileProc(linkOrigPath, GENERIC_WRITE, 0, NULL,
- OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT
- | FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ hFile = CreateFile(linkOrigPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (hFile != INVALID_HANDLE_VALUE) {
if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,
@@ -516,7 +498,7 @@ TclWinSymLinkDelete(
} else {
CloseHandle(hFile);
if (!linkOnly) {
- tclWinProcs->removeDirectoryProc(linkOrigPath);
+ RemoveDirectory(linkOrigPath);
}
return 0;
}
@@ -556,7 +538,7 @@ WinReadLinkDirectory(
Tcl_DString ds;
const char *copy;
- attr = tclWinProcs->getFileAttributesProc(linkDirPath);
+ attr = GetFileAttributes(linkDirPath);
if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
goto invalidError;
}
@@ -581,6 +563,7 @@ WinReadLinkDirectory(
*/
offset = 0;
+#ifdef UNICODE
if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') {
/*
* Check whether this is a mounted volume.
@@ -642,8 +625,9 @@ WinReadLinkDirectory(
offset = 4;
}
}
+#endif /* UNICODE */
- tclWinProcs->tchar2utf((const TCHAR *)
+ Tcl_WinTCharToUtf((const TCHAR *)
reparseBuffer->MountPointReparseBuffer.PathBuffer,
(int) reparseBuffer->MountPointReparseBuffer
.SubstituteNameLength, &ds);
@@ -684,9 +668,8 @@ NativeReadReparse(
HANDLE hFile;
DWORD returnedLength;
- hFile = tclWinProcs->createFileProc(linkDirPath, GENERIC_READ, 0, NULL,
- OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT
- | FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ hFile = CreateFile(linkDirPath, GENERIC_READ, 0, NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
/*
@@ -744,7 +727,7 @@ NativeWriteReparse(
* Create the directory - it must not already exist.
*/
- if (tclWinProcs->createDirectoryProc(linkDirPath, NULL) == 0) {
+ if (CreateDirectory(linkDirPath, NULL) == 0) {
/*
* Error creating directory.
*/
@@ -752,7 +735,7 @@ NativeWriteReparse(
TclWinConvertError(GetLastError());
return -1;
}
- hFile = tclWinProcs->createFileProc(linkDirPath, GENERIC_WRITE, 0, NULL,
+ hFile = CreateFile(linkDirPath, GENERIC_WRITE, 0, NULL,
OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT
| FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
@@ -777,7 +760,7 @@ NativeWriteReparse(
TclWinConvertError(GetLastError());
CloseHandle(hFile);
- tclWinProcs->removeDirectoryProc(linkDirPath);
+ RemoveDirectory(linkDirPath);
return -1;
}
CloseHandle(hFile);
@@ -790,6 +773,65 @@ NativeWriteReparse(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * tclWinDebugPanic --
+ *
+ * Display a message. If a debugger is present, present it directly to
+ * the debugger, otherwise use a MessageBox.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+tclWinDebugPanic(
+ const char *format, ...)
+{
+#define TCL_MAX_WARN_LEN 1024
+ va_list argList;
+ char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
+ WCHAR msgString[TCL_MAX_WARN_LEN];
+
+ va_start(argList, format);
+ _vsnprintf(buf, sizeof(buf), format, argList);
+
+ msgString[TCL_MAX_WARN_LEN-1] = L'\0';
+ MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN);
+
+ /*
+ * Truncate MessageBox string if it is too long to not overflow the screen
+ * and cause possible oversized window error.
+ */
+
+ if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
+ memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
+ }
+ if (IsDebuggerPresent()) {
+ OutputDebugStringW(msgString);
+ } else {
+ MessageBeep(MB_ICONEXCLAMATION);
+ MessageBoxW(NULL, msgString, L"Fatal Error",
+ MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
+ }
+#if defined(__GNUC__)
+ __builtin_trap();
+#elif defined(_WIN64)
+ __debugbreak();
+#elif defined(_MSC_VER)
+ _asm {int 3}
+#else
+ DebugBreak();
+#endif
+ abort();
+}
+
+/*
*---------------------------------------------------------------------------
*
* TclpFindExecutable --
@@ -808,28 +850,33 @@ NativeWriteReparse(
void
TclpFindExecutable(
- const char *argv0) /* The value of the application's argv[0]
- * (native). */
+ const char *argv0) /* If NULL, install PanicMessageBox, otherwise
+ * ignore. */
{
WCHAR wName[MAX_PATH];
char name[MAX_PATH * TCL_UTF_MAX];
/*
* Under Windows we ignore argv0, and return the path for the file used to
- * create this process.
+ * create this process. Only if it is NULL, install a new panic handler.
*/
- if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) {
- GetModuleFileNameA(NULL, name, sizeof(name));
+ if (argv0 == NULL) {
+ Tcl_SetPanicProc(tclWinDebugPanic);
+ }
- /*
- * Convert to WCHAR to get out of ANSI codepage
- */
+#ifdef UNICODE
+ GetModuleFileNameW(NULL, wName, MAX_PATH);
+#else
+ GetModuleFileNameA(NULL, name, sizeof(name));
- MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH);
- }
+ /*
+ * Convert to WCHAR to get out of ANSI codepage
+ */
- WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL,NULL);
+ MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH);
+#endif
+ WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
TclWinNoBackslash(name);
TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
}
@@ -875,6 +922,7 @@ TclpMatchInDirectory(
if (pattern == NULL || (*pattern == '\0')) {
Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+
if (norm != NULL) {
/*
* Match a single file directly.
@@ -882,24 +930,16 @@ TclpMatchInDirectory(
int len;
DWORD attr;
+ WIN32_FILE_ATTRIBUTE_DATA data;
const char *str = Tcl_GetStringFromObj(norm,&len);
native = Tcl_FSGetNativePath(pathPtr);
- if (tclWinProcs->getFileAttributesExProc == NULL) {
- attr = tclWinProcs->getFileAttributesProc(native);
- if (attr == INVALID_FILE_ATTRIBUTES) {
- return TCL_OK;
- }
- } else {
- WIN32_FILE_ATTRIBUTE_DATA data;
-
- if (tclWinProcs->getFileAttributesExProc(native,
- GetFileExInfoStandard, &data) != TRUE) {
- return TCL_OK;
- }
- attr = data.dwFileAttributes;
+ if (GetFileAttributesEx(native,
+ GetFileExInfoStandard, &data) != TRUE) {
+ return TCL_OK;
}
+ attr = data.dwFileAttributes;
if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
@@ -909,7 +949,7 @@ TclpMatchInDirectory(
} else {
DWORD attr;
HANDLE handle;
- WIN32_FIND_DATAT data;
+ WIN32_FIND_DATA data;
const char *dirName; /* UTF-8 dir name, later with pattern
* appended. */
int dirLength;
@@ -938,9 +978,9 @@ TclpMatchInDirectory(
if (native == NULL) {
return TCL_OK;
}
- attr = tclWinProcs->getFileAttributesProc(native);
+ attr = GetFileAttributes(native);
- if ((attr == INVALID_FILE_ATTRIBUTES)
+ if ((attr == INVALID_FILE_ATTRIBUTES)
|| ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
return TCL_OK;
}
@@ -956,7 +996,7 @@ TclpMatchInDirectory(
lastChar = dirName[dirLength -1];
if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
- Tcl_DStringAppend(&dsOrig, "/", 1);
+ TclDStringAppendLiteral(&dsOrig, "/");
dirLength++;
}
dirName = Tcl_DStringValue(&dsOrig);
@@ -976,25 +1016,25 @@ TclpMatchInDirectory(
dirName = Tcl_DStringAppend(&dsOrig, pattern, -1);
} else {
- dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3);
+ dirName = TclDStringAppendLiteral(&dsOrig, "*.*");
}
- native = tclWinProcs->utf2tchar(dirName, -1, &ds);
- if (tclWinProcs->findFirstFileExProc == NULL || (types == NULL)
- || (types->type != TCL_GLOB_TYPE_DIR)) {
- handle = tclWinProcs->findFirstFileProc(native, &data);
+ native = Tcl_WinUtfToTChar(dirName, -1, &ds);
+ if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) {
+ handle = FindFirstFile(native, &data);
} else {
/*
* We can be more efficient, for pure directory requests.
*/
- handle = tclWinProcs->findFirstFileExProc(native,
+ handle = FindFirstFileEx(native,
FindExInfoStandard, &data,
FindExSearchLimitToDirectories, NULL, 0);
}
if (handle == INVALID_HANDLE_VALUE) {
DWORD err = GetLastError();
+
Tcl_DStringFree(&ds);
if (err == ERROR_FILE_NOT_FOUND) {
/*
@@ -1008,10 +1048,9 @@ TclpMatchInDirectory(
TclWinConvertError(err);
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read directory \"",
- Tcl_DStringValue(&dsOrig), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read directory \"%s\": %s",
+ Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
}
Tcl_DStringFree(&dsOrig);
return TCL_ERROR;
@@ -1051,9 +1090,9 @@ TclpMatchInDirectory(
int checkDrive = 0, isDrive;
DWORD attr;
- native = (const TCHAR *) data.w.cFileName;
- attr = data.w.dwFileAttributes;
- utfname = tclWinProcs->tchar2utf(native, -1, &ds);
+ native = data.cFileName;
+ attr = data.dwFileAttributes;
+ utfname = Tcl_WinTCharToUtf(native, -1, &ds);
if (!matchSpecialDots) {
/*
@@ -1095,6 +1134,7 @@ TclpMatchInDirectory(
if (checkDrive) {
const char *fullname = Tcl_DStringAppend(&dsOrig, utfname,
Tcl_DStringLength(&ds));
+
isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));
Tcl_DStringSetLength(&dsOrig, dirLength);
} else {
@@ -1112,7 +1152,7 @@ TclpMatchInDirectory(
*/
Tcl_DStringFree(&ds);
- } while (tclWinProcs->findNextFileProc(handle, &data) == TRUE);
+ } while (FindNextFile(handle, &data) == TRUE);
FindClose(handle);
Tcl_DStringFree(&dsOrig);
@@ -1254,7 +1294,7 @@ WinIsReserved(
* because for NTFS root volumes, the getFileAttributesProc returns a
* 'hidden' attribute when it should not.
*
- * We never make any calss to a 'get attributes' routine here, since we
+ * We never make any calls to a 'get attributes' routine here, since we
* have arranged things so that our caller already knows such
* information.
*
@@ -1285,81 +1325,80 @@ NativeMatchType(
* If invisible, don't return the file.
*/
- if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
+ return !(attr & FILE_ATTRIBUTE_HIDDEN && !isDrive);
+ }
+
+ if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
+ /*
+ * If invisible.
+ */
+
+ if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
return 0;
}
} else {
- if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
- /*
- * If invisible.
- */
-
- if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
- return 0;
- }
- } else {
- /*
- * Visible.
- */
+ /*
+ * Visible.
+ */
- if (types->perm & TCL_GLOB_PERM_HIDDEN) {
- return 0;
- }
+ if (types->perm & TCL_GLOB_PERM_HIDDEN) {
+ return 0;
}
+ }
- if (types->perm != 0) {
- if (((types->perm & TCL_GLOB_PERM_RONLY) &&
- !(attr & FILE_ATTRIBUTE_READONLY)) ||
- ((types->perm & TCL_GLOB_PERM_R) &&
- (0 /* File exists => R_OK on Windows */)) ||
- ((types->perm & TCL_GLOB_PERM_W) &&
- (attr & FILE_ATTRIBUTE_READONLY)) ||
- ((types->perm & TCL_GLOB_PERM_X) &&
- (!(attr & FILE_ATTRIBUTE_DIRECTORY)
- && !NativeIsExec(nativeName)))) {
- return 0;
- }
+ if (types->perm != 0) {
+ if (((types->perm & TCL_GLOB_PERM_RONLY) &&
+ !(attr & FILE_ATTRIBUTE_READONLY)) ||
+ ((types->perm & TCL_GLOB_PERM_R) &&
+ (0 /* File exists => R_OK on Windows */)) ||
+ ((types->perm & TCL_GLOB_PERM_W) &&
+ (attr & FILE_ATTRIBUTE_READONLY)) ||
+ ((types->perm & TCL_GLOB_PERM_X) &&
+ (!(attr & FILE_ATTRIBUTE_DIRECTORY)
+ && !NativeIsExec(nativeName)))) {
+ return 0;
}
- if ((types->type & TCL_GLOB_TYPE_DIR)
- && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
- /*
- * Quicker test for directory, which is a common case.
- */
+ }
- return 1;
+ if ((types->type & TCL_GLOB_TYPE_DIR)
+ && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
+ /*
+ * Quicker test for directory, which is a common case.
+ */
- } else if (types->type != 0) {
- unsigned short st_mode;
- int isExec = NativeIsExec(nativeName);
+ return 1;
- st_mode = NativeStatMode(attr, 0, isExec);
+ } else if (types->type != 0) {
+ unsigned short st_mode;
+ int isExec = NativeIsExec(nativeName);
- /*
- * In order bcdpfls as in 'find -t'
- */
+ st_mode = NativeStatMode(attr, 0, isExec);
- if (((types->type&TCL_GLOB_TYPE_BLOCK) && S_ISBLK(st_mode)) ||
- ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) ||
- ((types->type&TCL_GLOB_TYPE_DIR) && S_ISDIR(st_mode)) ||
- ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) ||
+ /*
+ * In order bcdpfls as in 'find -t'
+ */
+
+ if (((types->type&TCL_GLOB_TYPE_BLOCK) && S_ISBLK(st_mode)) ||
+ ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) ||
+ ((types->type&TCL_GLOB_TYPE_DIR) && S_ISDIR(st_mode)) ||
+ ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) ||
#ifdef S_ISSOCK
- ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) ||
+ ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) ||
#endif
- ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) {
- /*
- * Do nothing - this file is ok.
- */
- } else {
+ ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) {
+ /*
+ * Do nothing - this file is ok.
+ */
+ } else {
#ifdef S_ISLNK
- if (types->type & TCL_GLOB_TYPE_LINK) {
- st_mode = NativeStatMode(attr, 1, isExec);
- if (S_ISLNK(st_mode)) {
- return 1;
- }
+ if (types->type & TCL_GLOB_TYPE_LINK) {
+ st_mode = NativeStatMode(attr, 1, isExec);
+ if (S_ISLNK(st_mode)) {
+ return 1;
}
-#endif
- return 0;
}
+#endif /* S_ISLNK */
+ return 0;
}
}
return 1;
@@ -1392,75 +1431,50 @@ TclpGetUserHome(
Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
* name of user's home directory. */
{
- const char *result;
- HINSTANCE netapiInst;
+ const char *result = NULL;
+ USER_INFO_1 *uiPtr, **uiPtrPtr = &uiPtr;
+ Tcl_DString ds;
+ int nameLen = -1;
+ int badDomain = 0;
+ char *domain;
+ WCHAR *wName, *wHomeDir, *wDomain, **wDomainPtr = &wDomain;
+ WCHAR buf[MAX_PATH];
- result = NULL;
Tcl_DStringInit(bufferPtr);
+ wDomain = NULL;
+ domain = strchr(name, '@');
+ if (domain != NULL) {
+ Tcl_DStringInit(&ds);
+ wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
+ badDomain = NetGetDCName(NULL, wName, (LPBYTE *) wDomainPtr);
+ Tcl_DStringFree(&ds);
+ nameLen = domain - name;
+ }
+ if (badDomain == 0) {
+ Tcl_DStringInit(&ds);
+ wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
+ if (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) uiPtrPtr) == 0) {
+ wHomeDir = uiPtr->usri1_home_dir;
+ if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
+ Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
+ bufferPtr);
+ } else {
+ /*
+ * User exists but has no home dir. Return
+ * "{Windows Drive}:/users/default".
+ */
- netapiInst = LoadLibraryA("netapi32.dll");
- if (netapiInst != NULL) {
- NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
- NETGETDCNAMEPROC *netGetDCNameProc;
- NETUSERGETINFOPROC *netUserGetInfoProc;
-
- netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
- GetProcAddress(netapiInst, "NetApiBufferFree");
- netGetDCNameProc = (NETGETDCNAMEPROC *)
- GetProcAddress(netapiInst, "NetGetDCName");
- netUserGetInfoProc = (NETUSERGETINFOPROC *)
- GetProcAddress(netapiInst, "NetUserGetInfo");
-
- if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
- && (netApiBufferFreeProc != NULL)) {
- USER_INFO_1 *uiPtr, **uiPtrPtr = &uiPtr;
- Tcl_DString ds;
- int nameLen, badDomain;
- char *domain;
- WCHAR *wName, *wHomeDir, *wDomain, **wDomainPtr = &wDomain;
- WCHAR buf[MAX_PATH];
-
- badDomain = 0;
- nameLen = -1;
- wDomain = NULL;
- domain = strchr(name, '@');
- if (domain != NULL) {
- Tcl_DStringInit(&ds);
- wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
- badDomain = netGetDCNameProc(NULL, wName,
- (LPBYTE *) wDomainPtr);
- Tcl_DStringFree(&ds);
- nameLen = domain - name;
- }
- if (badDomain == 0) {
- Tcl_DStringInit(&ds);
- wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
- if (netUserGetInfoProc(wDomain, wName, 1,
- (LPBYTE *) uiPtrPtr) == 0) {
- wHomeDir = uiPtr->usri1_home_dir;
- if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
- Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
- bufferPtr);
- } else {
- /*
- * User exists but has no home dir. Return
- * "{Windows Drive}:/users/default".
- */
-
- GetWindowsDirectoryW(buf, MAX_PATH);
- Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
- Tcl_DStringAppend(bufferPtr, "/users/default", -1);
- }
- result = Tcl_DStringValue(bufferPtr);
- netApiBufferFreeProc((void *) uiPtr);
- }
- Tcl_DStringFree(&ds);
- }
- if (wDomain != NULL) {
- netApiBufferFreeProc((void *) wDomain);
+ GetWindowsDirectoryW(buf, MAX_PATH);
+ Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
+ TclDStringAppendLiteral(bufferPtr, "/users/default");
}
+ result = Tcl_DStringValue(bufferPtr);
+ NetApiBufferFree((void *) uiPtr);
}
- FreeLibrary(netapiInst);
+ Tcl_DStringFree(&ds);
+ }
+ if (wDomain != NULL) {
+ NetApiBufferFree((void *) wDomain);
}
if (result == NULL) {
/*
@@ -1516,18 +1530,18 @@ NativeAccess(
{
DWORD attr;
- attr = tclWinProcs->getFileAttributesProc(nativePath);
+ attr = GetFileAttributes(nativePath);
if (attr == INVALID_FILE_ATTRIBUTES) {
/*
* File might not exist.
*/
- WIN32_FIND_DATAT ffd;
+ WIN32_FIND_DATA ffd;
HANDLE hFind;
- hFind = tclWinProcs->findFirstFileProc(nativePath, &ffd);
+ hFind = FindFirstFile(nativePath, &ffd);
if (hFind != INVALID_HANDLE_VALUE) {
- attr = ffd.w.dwFileAttributes;
+ attr = ffd.dwFileAttributes;
FindClose(hFind);
} else {
TclWinConvertError(GetLastError());
@@ -1535,14 +1549,25 @@ NativeAccess(
}
}
+ if (mode == F_OK) {
+ /*
+ * File exists, nothing else to check.
+ */
+
+ return 0;
+ }
+
if ((mode & W_OK)
- && (tclWinProcs->getFileSecurityProc == NULL)
- && (attr & FILE_ATTRIBUTE_READONLY)) {
+ && (attr & FILE_ATTRIBUTE_READONLY)
+ && !(attr & FILE_ATTRIBUTE_DIRECTORY)) {
/*
- * We don't have the advanced 'getFileSecurityProc', and our
- * attributes say the file is not writable. If we do have
- * 'getFileSecurityProc', we'll do a more robust XP-related check
- * below.
+ * The attributes say the file is not writable. If the file is a
+ * regular file (i.e., not a directory), then the file is not
+ * writable, full stop. For directories, the read-only bit is
+ * (mostly) ignored by Windows, so we can't ascertain anything about
+ * directory access from the attrib data. However, if we have the
+ * advanced 'getFileSecurityProc', then more robust ACL checks
+ * will be done below.
*/
Tcl_SetErrno(EACCES);
@@ -1566,15 +1591,15 @@ NativeAccess(
* we have a more complex permissions structure so we try to check that.
* The code below is remarkably complex for such a simple thing as finding
* what permissions the OS has set for a file.
- *
- * If we are simply checking for file existence, then we don't need all
- * these complications (which are really quite slow: with this code 'file
- * readable' is 5-6 times slower than 'file exists').
*/
- if ((mode != F_OK) && (tclWinProcs->getFileSecurityProc != NULL)) {
+#ifdef UNICODE
+ {
SECURITY_DESCRIPTOR *sdPtr = NULL;
unsigned long size;
+ PSID pSid = 0;
+ BOOL SidDefaulted;
+ SID_IDENTIFIER_AUTHORITY samba_unmapped = {{0, 0, 0, 0, 0, 22}};
GENERIC_MAPPING genMap;
HANDLE hToken = NULL;
DWORD desiredAccess = 0, grantedAccess = 0;
@@ -1588,9 +1613,10 @@ NativeAccess(
*/
size = 0;
- tclWinProcs->getFileSecurityProc(nativePath,
+ GetFileSecurity(nativePath,
OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
- | DACL_SECURITY_INFORMATION, 0, 0, &size);
+ | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION,
+ 0, 0, &size);
/*
* Should have failed with ERROR_INSUFFICIENT_BUFFER
@@ -1621,9 +1647,10 @@ NativeAccess(
* Call GetFileSecurity() for real.
*/
- if (!tclWinProcs->getFileSecurityProc(nativePath,
+ if (!GetFileSecurity(nativePath,
OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
- | DACL_SECURITY_INFORMATION, sdPtr, size, &size)) {
+ | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION,
+ sdPtr, size, &size)) {
/*
* Error getting owner SD
*/
@@ -1632,18 +1659,38 @@ NativeAccess(
}
/*
+ * As of Samba 3.0.23 (10-Jul-2006), unmapped users and groups are
+ * assigned to SID domains S-1-22-1 and S-1-22-2, where "22" is the
+ * top-level authority. If the file owner and group is unmapped then
+ * the ACL access check below will only test against world access,
+ * which is likely to be more restrictive than the actual access
+ * restrictions. Since the ACL tests are more likely wrong than
+ * right, skip them. Moreover, the unix owner access permissions are
+ * usually mapped to the Windows attributes, so if the user is the
+ * file owner then the attrib checks above are correct (as far as they
+ * go).
+ */
+
+ if(!GetSecurityDescriptorOwner(sdPtr,&pSid,&SidDefaulted) ||
+ memcmp(GetSidIdentifierAuthority(pSid),&samba_unmapped,
+ sizeof(SID_IDENTIFIER_AUTHORITY))==0) {
+ HeapFree(GetProcessHeap(), 0, sdPtr);
+ return 0; /* Attrib tests say access allowed. */
+ }
+
+ /*
* Perform security impersonation of the user and open the resulting
* thread token.
*/
- if (!tclWinProcs->impersonateSelfProc(SecurityImpersonation)) {
+ if (!ImpersonateSelf(SecurityImpersonation)) {
/*
* Unable to perform security impersonation.
*/
goto accessError;
}
- if (!tclWinProcs->openThreadTokenProc(GetCurrentThread(),
+ if (!OpenThreadToken(GetCurrentThread(),
TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) {
/*
* Unable to get current thread's token.
@@ -1652,7 +1699,7 @@ NativeAccess(
goto accessError;
}
- tclWinProcs->revertToSelfProc();
+ RevertToSelf();
/*
* Setup desiredAccess according to the access priveleges we are
@@ -1679,7 +1726,7 @@ NativeAccess(
* Perform access check using the token.
*/
- if (!tclWinProcs->accessCheckProc(sdPtr, hToken, desiredAccess,
+ if (!AccessCheck(sdPtr, hToken, desiredAccess,
&genMap, &privSet, &privSetSize, &grantedAccess,
&accessYesNo)) {
/*
@@ -1708,18 +1755,8 @@ NativeAccess(
return -1;
}
- /*
- * For directories the above checks are ok. For files, though, we must
- * still check the 'attr' value.
- */
-
- if ((mode & W_OK)
- && !(attr & FILE_ATTRIBUTE_DIRECTORY)
- && (attr & FILE_ATTRIBUTE_READONLY)) {
- Tcl_SetErrno(EACCES);
- return -1;
- }
}
+#endif /* !UNICODE */
return 0;
}
@@ -1741,19 +1778,19 @@ static int
NativeIsExec(
const TCHAR *path)
{
- int len = wcslen(path);
+ int len = _tcslen(path);
if (len < 5) {
return 0;
}
- if (path[len-4] != L'.') {
+ if (path[len-4] != '.') {
return 0;
}
- if ((_wcsicmp(path+len-3, L"exe") == 0)
- || (_wcsicmp(path+len-3, L"com") == 0)
- || (_wcsicmp(path+len-3, L"bat") == 0)) {
+ if ((_tcsicmp(path+len-3, TEXT("exe")) == 0)
+ || (_tcsicmp(path+len-3, TEXT("com")) == 0)
+ || (_tcsicmp(path+len-3, TEXT("bat")) == 0)) {
return 1;
}
return 0;
@@ -1781,27 +1818,10 @@ TclpObjChdir(
{
int result;
const TCHAR *nativePath;
-#ifdef __CYGWIN__
- extern int cygwin_conv_to_posix_path(const char *, char *);
- char posixPath[MAX_PATH+1];
- const char *path;
- Tcl_DString ds;
-#endif /* __CYGWIN__ */
nativePath = Tcl_FSGetNativePath(pathPtr);
-#ifdef __CYGWIN__
- /*
- * Cygwin chdir only groks POSIX path.
- */
-
- path = tclWinProcs->tchar2utf(nativePath, -1, &ds);
- cygwin_conv_to_posix_path(path, posixPath);
- result = (chdir(posixPath) == 0 ? 1 : 0);
- Tcl_DStringFree(&ds);
-#else /* __CYGWIN__ */
- result = tclWinProcs->setCurrentDirectoryProc(nativePath);
-#endif /* __CYGWIN__ */
+ result = SetCurrentDirectory(nativePath);
if (result == 0) {
TclWinConvertError(GetLastError());
@@ -1810,51 +1830,6 @@ TclpObjChdir(
return 0;
}
-#ifdef __CYGWIN__
-/*
- *---------------------------------------------------------------------------
- *
- * TclpReadlink --
- *
- * This function replaces the library version of readlink().
- *
- * Results:
- * The result is a pointer to a string specifying the contents of the
- * symbolic link given by 'path', or NULL if the symbolic link could not
- * be read. Storage for the result string is allocated in bufferPtr; the
- * caller must call Tcl_DStringFree() when the result is no longer
- * needed.
- *
- * Side effects:
- * See readlink() documentation.
- *
- *---------------------------------------------------------------------------
- */
-
-char *
-TclpReadlink(
- const char *path, /* Path of file to readlink (UTF-8). */
- Tcl_DString *linkPtr) /* Uninitialized or free DString filled with
- * contents of link (UTF-8). */
-{
- char link[MAXPATHLEN];
- int length;
- char *native;
- Tcl_DString ds;
-
- native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
- length = readlink(native, link, sizeof(link)); /* INTL: Native. */
- Tcl_DStringFree(&ds);
-
- if (length < 0) {
- return NULL;
- }
-
- Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
- return Tcl_DStringValue(linkPtr);
-}
-#endif /* __CYGWIN__ */
-
/*
*----------------------------------------------------------------------
*
@@ -1887,11 +1862,12 @@ TclpGetCwd(
char *p;
WCHAR *native;
- if (tclWinProcs->getCurrentDirectoryProc(MAX_PATH, buffer) == 0) {
+ if (GetCurrentDirectory(MAX_PATH, buffer) == 0) {
TclWinConvertError(GetLastError());
if (interp != NULL) {
- Tcl_AppendResult(interp, "error getting working directory name: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error getting working directory name: %s",
+ Tcl_PosixError(interp)));
}
return NULL;
}
@@ -1905,7 +1881,7 @@ TclpGetCwd(
&& (native[2] == '\\') && (native[3] == '\\')) {
native += 2;
}
- tclWinProcs->tchar2utf((TCHAR *) native, -1, bufferPtr);
+ Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
/*
* Convert to forward slashes for easier use in scripts.
@@ -1932,8 +1908,7 @@ TclpObjStat(
TclWinFlushDirtyChannels();
- return NativeStat(Tcl_FSGetNativePath(pathPtr),
- statPtr, 0);
+ return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 0);
}
/*
@@ -1979,7 +1954,7 @@ NativeStat(
* simpler routines.
*/
- fileHandle = tclWinProcs->createFileProc(nativePath, GENERIC_READ,
+ fileHandle = CreateFile(nativePath, GENERIC_READ,
FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL);
@@ -2018,30 +1993,28 @@ NativeStat(
*/
inode = data.nFileIndexHigh | data.nFileIndexLow;
- } else if (tclWinProcs->getFileAttributesExProc != NULL) {
+ } else {
/*
* Fall back on the less capable routines. This means no nlink or ino.
*/
WIN32_FILE_ATTRIBUTE_DATA data;
- if (tclWinProcs->getFileAttributesExProc(nativePath,
+ if (GetFileAttributesEx(nativePath,
GetFileExInfoStandard, &data) != TRUE) {
-
/*
* We might have just been denied access
*/
-
- WIN32_FIND_DATAT ffd;
- HANDLE hFind;
- hFind = tclWinProcs->findFirstFileProc(nativePath, &ffd);
- if (hFind != INVALID_HANDLE_VALUE) {
- memcpy(&data, &ffd, sizeof(data));
- FindClose(hFind);
- } else {
+
+ WIN32_FIND_DATA ffd;
+ HANDLE hFind = FindFirstFile(nativePath, &ffd);
+
+ if (hFind == INVALID_HANDLE_VALUE) {
Tcl_SetErrno(ENOENT);
return -1;
}
+ memcpy(&data, &ffd, sizeof(data));
+ FindClose(hFind);
}
attr = data.dwFileAttributes;
@@ -2051,46 +2024,6 @@ NativeStat(
statPtr->st_atime = ToCTime(data.ftLastAccessTime);
statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
statPtr->st_ctime = ToCTime(data.ftCreationTime);
- } else {
- /*
- * We don't have the faster attributes proc, so we're probably running
- * on Win95.
- */
-
- WIN32_FIND_DATAT data;
- HANDLE handle;
-
- handle = tclWinProcs->findFirstFileProc(nativePath, &data);
- if (handle == INVALID_HANDLE_VALUE) {
- /*
- * FindFirstFile() doesn't work on root directories, so call
- * GetFileAttributes() to see if the specified file exists.
- */
-
- attr = tclWinProcs->getFileAttributesProc(nativePath);
- if (attr == INVALID_FILE_ATTRIBUTES) {
- Tcl_SetErrno(ENOENT);
- return -1;
- }
-
- /*
- * Make up some fake information for this file. It has the correct
- * file attributes and a time of 0.
- */
-
- memset(&data, 0, sizeof(data));
- data.a.dwFileAttributes = attr;
- } else {
- FindClose(handle);
- }
-
- attr = data.a.dwFileAttributes;
-
- statPtr->st_size = ((Tcl_WideInt) data.a.nFileSizeLow) |
- (((Tcl_WideInt) data.a.nFileSizeHigh) << 32);
- statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
- statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
- statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
}
dev = NativeDev(nativePath);
@@ -2126,10 +2059,8 @@ NativeDev(
TCHAR *nativePart;
const char *fullPath;
- tclWinProcs->getFullPathNameProc(nativePath, MAX_PATH, nativeFullPath,
- &nativePart);
-
- fullPath = tclWinProcs->tchar2utf(nativeFullPath, -1, &ds);
+ GetFullPathName(nativePath, MAX_PATH, nativeFullPath, &nativePart);
+ fullPath = Tcl_WinTCharToUtf(nativeFullPath, -1, &ds);
if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
const char *p;
@@ -2145,15 +2076,14 @@ NativeDev(
* won't work.
*/
- fullPath = Tcl_DStringAppend(&ds, "\\", 1);
+ fullPath = TclDStringAppendLiteral(&ds, "\\");
p = fullPath + Tcl_DStringLength(&ds);
} else {
p++;
}
- nativeVol = tclWinProcs->utf2tchar(fullPath, p - fullPath, &volString);
+ nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
dw = (DWORD) -1;
- tclWinProcs->getVolumeInformationProc(nativeVol, NULL, 0, &dw, NULL,
- NULL, NULL, 0);
+ GetVolumeInformation(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0);
/*
* GetFullPathName() turns special devices like "NUL" into "\\.\NUL",
@@ -2215,8 +2145,8 @@ NativeStatMode(
* positions.
*/
- mode |= (mode & 0x0700) >> 3;
- mode |= (mode & 0x0700) >> 6;
+ mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 3;
+ mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 6;
return (unsigned short) mode;
}
@@ -2265,8 +2195,9 @@ FromCTime(
FILETIME *fileTime) /* UTC Time */
{
LARGE_INTEGER convertedTime;
+
convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000
- + POSIX_EPOCH_AS_FILETIME;
+ + POSIX_EPOCH_AS_FILETIME;
fileTime->dwLowDateTime = convertedTime.LowPart;
fileTime->dwHighDateTime = convertedTime.HighPart;
}
@@ -2298,13 +2229,13 @@ TclpGetNativeCwd(
{
TCHAR buffer[MAX_PATH];
- if (tclWinProcs->getCurrentDirectoryProc(MAX_PATH, buffer) == 0) {
+ if (GetCurrentDirectory(MAX_PATH, buffer) == 0) {
TclWinConvertError(GetLastError());
return NULL;
}
if (clientData != NULL) {
- if (wcscmp((const WCHAR*)clientData, (const WCHAR*)buffer) == 0) {
+ if (_tcscmp((const TCHAR*)clientData, buffer) == 0) {
return clientData;
}
}
@@ -2333,8 +2264,7 @@ TclpObjLstat(
TclWinFlushDirtyChannels();
- return NativeStat(Tcl_FSGetNativePath(pathPtr),
- statPtr, 1);
+ return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 1);
}
#ifdef S_IFLNK
@@ -2374,7 +2304,7 @@ TclpObjLink(
return WinReadLink(LinkSource);
}
}
-#endif
+#endif /* S_IFLNK */
/*
*---------------------------------------------------------------------------
@@ -2415,16 +2345,14 @@ TclpFilesystemPathType(
firstSeparator = strchr(path, '/');
if (firstSeparator == NULL) {
- found = tclWinProcs->getVolumeInformationProc(
- Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL,
- volType, VOL_BUF_SIZE);
+ found = GetVolumeInformation(Tcl_FSGetNativePath(pathPtr),
+ NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
} else {
Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
Tcl_IncrRefCount(driveName);
- found = tclWinProcs->getVolumeInformationProc(
- Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL,
- volType, VOL_BUF_SIZE);
+ found = GetVolumeInformation(Tcl_FSGetNativePath(driveName),
+ NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
Tcl_DecrRefCount(driveName);
}
@@ -2432,13 +2360,9 @@ TclpFilesystemPathType(
return NULL;
} else {
Tcl_DString ds;
- Tcl_Obj *objPtr;
- tclWinProcs->tchar2utf(volType, -1, &ds);
- objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
- return objPtr;
+ Tcl_WinTCharToUtf(volType, -1, &ds);
+ return TclDStringToObj(&ds);
}
#undef VOL_BUF_SIZE
}
@@ -2488,6 +2412,8 @@ TclpObjNormalizePath(
Tcl_DString dsNorm; /* This will hold the normalized string. */
char *path, *currentPathEndPosition;
Tcl_Obj *temp = NULL;
+ int isDrive = 1;
+ Tcl_DString ds; /* Some workspace. */
Tcl_DStringInit(&dsNorm);
path = Tcl_GetString(pathPtr);
@@ -2498,11 +2424,11 @@ TclpObjNormalizePath(
* of code. First that the native (NULL) encoding is basically ascii,
* and second that symbolic links are not possible. Both of these
* assumptions appear to be true of these operating systems.
+ *
+ * FIXME: This code branch may be derelict as those are not supported
+ * platforms any more.
*/
- int isDrive = 1;
- Tcl_DString ds;
-
currentPathEndPosition = path + nextCheckpoint;
if (*currentPathEndPosition == '/') {
currentPathEndPosition++;
@@ -2610,7 +2536,7 @@ TclpObjNormalizePath(
* string.
*/
- Tcl_DStringAppend(&dsNorm,"/", 1);
+ TclDStringAppendLiteral(&dsNorm, "/");
} else {
char *nativeName;
@@ -2620,8 +2546,8 @@ TclpObjNormalizePath(
nativeName = fData.cAlternateFileName;
}
FindClose(handle);
- Tcl_DStringAppend(&dsNorm,"/", 1);
- Tcl_DStringAppend(&dsNorm,nativeName,-1);
+ TclDStringAppendLiteral(&dsNorm, "/");
+ Tcl_DStringAppend(&dsNorm, nativeName, -1);
}
}
}
@@ -2645,9 +2571,6 @@ TclpObjNormalizePath(
* We're on WinNT (or 2000 or XP; something with an NT core).
*/
- int isDrive = 1;
- Tcl_DString ds;
-
currentPathEndPosition = path + nextCheckpoint;
if (*currentPathEndPosition == '/') {
currentPathEndPosition++;
@@ -2661,10 +2584,10 @@ TclpObjNormalizePath(
*/
WIN32_FILE_ATTRIBUTE_DATA data;
- const TCHAR *nativePath = tclWinProcs->utf2tchar(path,
+ const TCHAR *nativePath = Tcl_WinUtfToTChar(path,
currentPathEndPosition - path, &ds);
- if (tclWinProcs->getFileAttributesExProc(nativePath,
+ if (GetFileAttributesEx(nativePath,
GetFileExInfoStandard, &data) != TRUE) {
/*
* File doesn't exist.
@@ -2688,7 +2611,8 @@ TclpObjNormalizePath(
((WCHAR *) nativePath)[i] = wc;
}
}
- Tcl_DStringAppend(&dsNorm, (const char *)nativePath,
+ Tcl_DStringAppend(&dsNorm,
+ (const char *)nativePath,
(int)(sizeof(WCHAR) * len));
lastValidPathEnd = currentPathEndPosition;
}
@@ -2721,7 +2645,7 @@ TclpObjNormalizePath(
* not be normalized, otherwise we could use:
*
* Tcl_GetStringFromObj(to, &pathLen);
- * nextCheckpoint = pathLen
+ * nextCheckpoint = pathLen;
*
* So, instead we have to start from the beginning.
*/
@@ -2751,7 +2675,6 @@ TclpObjNormalizePath(
isDrive = 1;
Tcl_DStringFree(&dsNorm);
- Tcl_DStringInit(&dsNorm);
Tcl_DStringFree(&ds);
continue;
}
@@ -2766,6 +2689,7 @@ TclpObjNormalizePath(
if (isDrive) {
WCHAR drive = ((WCHAR *) nativePath)[0];
+
if (drive >= L'a') {
drive -= (L'a' - L'A');
((WCHAR *) nativePath)[0] = drive;
@@ -2795,9 +2719,10 @@ TclpObjNormalizePath(
* path segment and continue.
*/
- Tcl_DStringAppend(&dsNorm, (const char *)
- ((WCHAR *)(nativePath + Tcl_DStringLength(&ds))
- - dotLen), (int)(dotLen * sizeof(WCHAR)));
+ Tcl_DStringAppend(&dsNorm, ((const char *)nativePath)
+ + Tcl_DStringLength(&ds)
+ - (dotLen * sizeof(TCHAR)),
+ (int)(dotLen * sizeof(TCHAR)));
} else {
/*
* Normal path.
@@ -2826,12 +2751,13 @@ TclpObjNormalizePath(
FindClose(handle);
Tcl_DStringAppend(&dsNorm, (const char *) L"/",
sizeof(WCHAR));
- Tcl_DStringAppend(&dsNorm, (const char *) nativeName,
+ Tcl_DStringAppend(&dsNorm,
+ (const char *) nativeName,
(int) (wcslen(nativeName)*sizeof(WCHAR)));
}
}
}
-#endif
+#endif /* !TclNORM_LONG_PATH */
Tcl_DStringFree(&ds);
lastValidPathEnd = currentPathEndPosition;
if (cur == 0) {
@@ -2856,8 +2782,8 @@ TclpObjNormalizePath(
if (1) {
WCHAR wpath[MAX_PATH];
const TCHAR *nativePath =
- tclWinProcs->utf2tchar(path, lastValidPathEnd - path, &ds);
- DWORD wpathlen = tclWinProcs->getLongPathNameProc(nativePath,
+ Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds);
+ DWORD wpathlen = GetLongPathNameProc(nativePath,
(TCHAR *) wpath, MAX_PATH);
/*
@@ -2867,10 +2793,11 @@ TclpObjNormalizePath(
if (wpath[0] >= L'a') {
wpath[0] -= (L'a' - L'A');
}
- Tcl_DStringAppend(&dsNorm, (const char *)wpath, wpathlen*sizeof(WCHAR));
+ Tcl_DStringAppend(&dsNorm, (const char *) wpath,
+ wpathlen * sizeof(WCHAR));
Tcl_DStringFree(&ds);
}
-#endif
+#endif /* TclNORM_LONG_PATH */
}
/*
@@ -2885,11 +2812,9 @@ TclpObjNormalizePath(
* native encoding, so we have to convert it to Utf.
*/
- Tcl_DString dsTemp;
-
- tclWinProcs->tchar2utf((const TCHAR *)Tcl_DStringValue(&dsNorm),
- Tcl_DStringLength(&dsNorm), &dsTemp);
- nextCheckpoint = Tcl_DStringLength(&dsTemp);
+ Tcl_WinTCharToUtf((const TCHAR *) Tcl_DStringValue(&dsNorm),
+ Tcl_DStringLength(&dsNorm), &ds);
+ nextCheckpoint = Tcl_DStringLength(&ds);
if (*lastValidPathEnd != 0) {
/*
* Not the end of the string.
@@ -2899,7 +2824,7 @@ TclpObjNormalizePath(
char *path;
Tcl_Obj *tmpPathPtr;
- tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
+ tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
nextCheckpoint);
Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
path = Tcl_GetStringFromObj(tmpPathPtr, &len);
@@ -2910,10 +2835,9 @@ TclpObjNormalizePath(
* End of string was reached above.
*/
- Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp),
- nextCheckpoint);
+ Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint);
}
- Tcl_DStringFree(&dsTemp);
+ Tcl_DStringFree(&ds);
}
Tcl_DStringFree(&dsNorm);
@@ -3065,7 +2989,7 @@ TclpNativeToNormalized(
int len;
char *copy, *p;
- tclWinProcs->tchar2utf((const TCHAR *) clientData, -1, &ds);
+ Tcl_WinTCharToUtf((const TCHAR *) clientData, -1, &ds);
copy = Tcl_DStringValue(&ds);
len = Tcl_DStringLength(&ds);
@@ -3159,10 +3083,10 @@ TclNativeCreateNativeRep(
}
}
}
- tclWinProcs->utf2tchar(str, len, &ds);
+ Tcl_WinUtfToTChar(str, len, &ds);
len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
Tcl_DecrRefCount(validPathPtr);
- nativePathPtr = ckalloc((unsigned) len);
+ nativePathPtr = ckalloc(len);
memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
Tcl_DStringFree(&ds);
@@ -3197,9 +3121,9 @@ TclNativeDupInternalRep(
return NULL;
}
- len = sizeof(TCHAR) * (_tcslen((const WCHAR *) clientData) + 1);
+ len = sizeof(TCHAR) * (_tcslen((const TCHAR *) clientData) + 1);
- copy = (char *) ckalloc(len);
+ copy = ckalloc(len);
memcpy(copy, clientData, len);
return copy;
}
@@ -3238,7 +3162,7 @@ TclpUtime(
native = Tcl_FSGetNativePath(pathPtr);
- attr = tclWinProcs->getFileAttributesProc(native);
+ attr = GetFileAttributes(native);
if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) {
flags = FILE_FLAG_BACKUP_SEMANTICS;
@@ -3249,8 +3173,8 @@ TclpUtime(
* savings complications that utime gets wrong.
*/
- fileHandle = tclWinProcs->createFileProc(native, FILE_WRITE_ATTRIBUTES,
- 0, NULL, OPEN_EXISTING, flags, NULL);
+ fileHandle = CreateFile(native, FILE_WRITE_ATTRIBUTES, 0, NULL,
+ OPEN_EXISTING, flags, NULL);
if (fileHandle == INVALID_HANDLE_VALUE ||
!SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 564ce7d..f552e2c 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinInit.c,v 1.86 2010/09/13 14:20:39 nijtmans Exp $
*/
#include "tclWinInt.h"
@@ -103,6 +101,10 @@ static TclInitProcessGlobalValueProc InitializeDefaultLibraryDir;
static ProcessGlobalValue defaultLibraryDir =
{0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL};
+static TclInitProcessGlobalValueProc InitializeSourceLibraryDir;
+static ProcessGlobalValue sourceLibraryDir =
+ {0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL};
+
static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib);
static int ToUtf(const WCHAR *wSrc, char *dst);
@@ -177,7 +179,7 @@ TclpInitLibraryPath(
int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
-#define LIBRARY_SIZE 32
+#define LIBRARY_SIZE 64
Tcl_Obj *pathPtr;
char installLib[LIBRARY_SIZE];
const char *bytes;
@@ -208,9 +210,16 @@ TclpInitLibraryPath(
Tcl_ListObjAppendElement(NULL, pathPtr,
TclGetProcessGlobalValue(&defaultLibraryDir));
+ /*
+ * Look for the library in its source checkout location.
+ */
+
+ Tcl_ListObjAppendElement(NULL, pathPtr,
+ TclGetProcessGlobalValue(&sourceLibraryDir));
+
*encodingPtr = NULL;
bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr);
- *valuePtr = ckalloc((unsigned)(*lengthPtr)+1);
+ *valuePtr = ckalloc((*lengthPtr) + 1);
memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
Tcl_DecrRefCount(pathPtr);
}
@@ -290,8 +299,6 @@ AppendEnvironment(
*/
if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
- const char *str;
-
/*
* TCL_LIBRARY is set but refers to a different tcl installation
* than the current version. Try fiddling with the specified
@@ -301,14 +308,13 @@ AppendEnvironment(
pathv[pathc - 1] = shortlib;
Tcl_DStringInit(&ds);
- str = Tcl_JoinPath(pathc, pathv, &ds);
- objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
+ (void) Tcl_JoinPath(pathc, pathv, &ds);
+ objPtr = TclDStringToObj(&ds);
} else {
objPtr = Tcl_NewStringObj(buf, -1);
}
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- ckfree((char *) pathv);
+ ckfree(pathv);
}
}
@@ -357,7 +363,58 @@ InitializeDefaultLibraryDir(
TclWinNoBackslash(name);
sprintf(end + 1, "lib/tcl%s", TCL_VERSION);
*lengthPtr = strlen(name);
- *valuePtr = ckalloc((unsigned int) *lengthPtr + 1);
+ *valuePtr = ckalloc(*lengthPtr + 1);
+ *encodingPtr = NULL;
+ memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitializeSourceLibraryDir --
+ *
+ * Locate the Tcl script library default location relative to the
+ * location of the Tcl DLL as it exists in the build output directory
+ * associated with the source checkout.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitializeSourceLibraryDir(
+ char **valuePtr,
+ int *lengthPtr,
+ Tcl_Encoding *encodingPtr)
+{
+ HMODULE hModule = TclWinGetTclInstance();
+ WCHAR wName[MAX_PATH + LIBRARY_SIZE];
+ char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
+ char *end, *p;
+
+ if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
+ GetModuleFileNameA(hModule, name, MAX_PATH);
+ } else {
+ ToUtf(wName, name);
+ }
+
+ end = strrchr(name, '\\');
+ *end = '\0';
+ p = strrchr(name, '\\');
+ if (p != NULL) {
+ end = p;
+ }
+ *end = '\\';
+
+ TclWinNoBackslash(name);
+ sprintf(end + 1, "../library");
+ *lengthPtr = strlen(name);
+ *valuePtr = ckalloc(*lengthPtr + 1);
*encodingPtr = NULL;
memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
}
@@ -608,7 +665,7 @@ TclpFindVariable(
*/
length = strlen(name);
- nameUpper = (char *) ckalloc((unsigned) length+1);
+ nameUpper = ckalloc(length + 1);
memcpy(nameUpper, name, (size_t) length+1);
Tcl_UtfToUpper(nameUpper);
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 94aa045..22ad8e9 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -7,8 +7,6 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinInt.h,v 1.37 2010/09/09 14:30:20 nijtmans Exp $
*/
#ifndef _TCLWININT
@@ -29,91 +27,17 @@
#define VER_PLATFORM_WIN32_CE 3
#endif
-/*
- * The following structure keeps track of whether we are using the
- * multi-byte or the wide-character interfaces to the operating system.
- * System calls should be made through the following function table.
- */
-
-typedef union {
- WIN32_FIND_DATAA a;
- WIN32_FIND_DATAW w;
-} WIN32_FIND_DATAT;
-
-typedef struct TclWinProcs {
- int useWide;
- BOOL (WINAPI *buildCommDCBProc)(const TCHAR *, LPDCB);
- TCHAR * (WINAPI *charLowerProc)(TCHAR *);
- BOOL (WINAPI *copyFileProc)(const TCHAR *, const TCHAR *, BOOL);
- BOOL (WINAPI *createDirectoryProc)(const TCHAR *, LPSECURITY_ATTRIBUTES);
- HANDLE (WINAPI *createFileProc)(const TCHAR *, DWORD, DWORD,
- LPSECURITY_ATTRIBUTES, DWORD, DWORD, HANDLE);
- BOOL (WINAPI *createProcessProc)(const TCHAR *, TCHAR *,
- LPSECURITY_ATTRIBUTES, LPSECURITY_ATTRIBUTES, BOOL, DWORD,
- LPVOID, const TCHAR *, LPSTARTUPINFO, LPPROCESS_INFORMATION);
- BOOL (WINAPI *deleteFileProc)(const TCHAR *);
- HANDLE (WINAPI *findFirstFileProc)(const TCHAR *, WIN32_FIND_DATAT *);
- BOOL (WINAPI *findNextFileProc)(HANDLE, WIN32_FIND_DATAT *);
- BOOL (WINAPI *getComputerNameProc)(TCHAR *, LPDWORD);
- DWORD (WINAPI *getCurrentDirectoryProc)(DWORD, TCHAR *);
- DWORD (WINAPI *getFileAttributesProc)(const TCHAR *);
- DWORD (WINAPI *getFullPathNameProc)(const TCHAR *, DWORD, TCHAR *,
- TCHAR **);
- DWORD (WINAPI *getShortPathNameProc)(const TCHAR *, TCHAR *, DWORD);
- UINT (WINAPI *getTempFileNameProc)(const TCHAR *, const TCHAR *, UINT,
- TCHAR *);
- DWORD (WINAPI *getTempPathProc)(DWORD, TCHAR *);
- BOOL (WINAPI *getVolumeInformationProc)(const TCHAR *, TCHAR *, DWORD,
- LPDWORD, LPDWORD, LPDWORD, TCHAR *, DWORD);
- HINSTANCE (WINAPI *loadLibraryExProc)(const TCHAR *, HANDLE, DWORD);
- BOOL (WINAPI *moveFileProc)(const TCHAR *, const TCHAR *);
- BOOL (WINAPI *removeDirectoryProc)(const TCHAR *);
- DWORD (WINAPI *searchPathProc)(const TCHAR *, const TCHAR *,
- const TCHAR *, DWORD, TCHAR *, TCHAR **);
- BOOL (WINAPI *setCurrentDirectoryProc)(const TCHAR *);
- BOOL (WINAPI *setFileAttributesProc)(const TCHAR *, DWORD);
- /*
- * These two function pointers will only be set when
- * Tcl_FindExecutable is called. If you don't ever call that
- * function, the application will crash whenever WinTcl tries to call
- * functions through these null pointers. That is not a bug in Tcl
- * -- Tcl_FindExecutable is obligatory in recent Tcl releases.
- */
- BOOL (WINAPI *getFileAttributesExProc)(const TCHAR *,
- GET_FILEEX_INFO_LEVELS, LPVOID);
- BOOL (WINAPI *createHardLinkProc)(const TCHAR *, const TCHAR *,
- LPSECURITY_ATTRIBUTES);
-
- /* These two are also NULL at start; see comment above */
- HANDLE (WINAPI *findFirstFileExProc)(const TCHAR *, UINT,
- LPVOID, UINT, LPVOID, DWORD);
- BOOL (WINAPI *getVolumeNameForVMPProc)(const TCHAR *, TCHAR *, DWORD);
- DWORD (WINAPI *getLongPathNameProc)(const TCHAR *, TCHAR *, DWORD);
- /*
- * These six are for the security sdk to get correct file
- * permissions on NT, 2000, XP, etc. On 95,98,ME they are
- * always null.
- */
- BOOL (WINAPI *getFileSecurityProc)(LPCTSTR, SECURITY_INFORMATION,
- PSECURITY_DESCRIPTOR, DWORD, LPDWORD);
- BOOL (WINAPI *impersonateSelfProc) (SECURITY_IMPERSONATION_LEVEL);
- BOOL (WINAPI *openThreadTokenProc) (HANDLE, DWORD, BOOL, PHANDLE);
- BOOL (WINAPI *revertToSelfProc) (void);
- void (WINAPI *mapGenericMaskProc) (PDWORD, PGENERIC_MAPPING);
- BOOL (WINAPI *accessCheckProc)(PSECURITY_DESCRIPTOR, HANDLE, DWORD,
- PGENERIC_MAPPING, PPRIVILEGE_SET, LPDWORD, LPDWORD, LPBOOL);
- /*
- * Unicode console support. WriteConsole and ReadConsole
- */
- BOOL (WINAPI *readConsoleProc)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID);
- BOOL (WINAPI *writeConsoleProc)(HANDLE, const void *, DWORD, LPDWORD,
- LPVOID);
- BOOL (WINAPI *getUserName)(LPTSTR, LPDWORD);
- const TCHAR *(*utf2tchar)(const char *, int, Tcl_DString *);
- const char *(*tchar2utf)(const TCHAR *, int, Tcl_DString *);
-} TclWinProcs;
+#ifdef _WIN64
+# define TCL_I_MODIFIER "I"
+#else
+# define TCL_I_MODIFIER ""
+#endif
-MODULE_SCOPE const TclWinProcs *const tclWinProcs;
+#ifdef _WIN64
+# define TCL_I_MODIFIER "I"
+#else
+# define TCL_I_MODIFIER ""
+#endif
/*
* Declarations of functions that are not accessible by way of the
@@ -121,7 +45,7 @@ MODULE_SCOPE const TclWinProcs *const tclWinProcs;
*/
MODULE_SCOPE char TclWinDriveLetterForVolMountPoint(
- const WCHAR *mountPoint);
+ const TCHAR *mountPoint);
MODULE_SCOPE void TclWinEncodingsCleanup();
MODULE_SCOPE void TclWinInit(HINSTANCE hInst);
MODULE_SCOPE TclFile TclWinMakeFile(HANDLE handle);
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index cb46db9..3e11224 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -9,31 +9,27 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinLoad.c,v 1.32 2010/09/13 14:20:39 nijtmans Exp $
*/
#include "tclWinInt.h"
/*
- * Mutex protecting static data in this file;
+ * Native name of the directory in the native filesystem where DLLs used in
+ * this process are copied prior to loading, and mutex used to protect its
+ * allocation.
*/
-static Tcl_Mutex loadMutex;
+static WCHAR *dllDirectoryName = NULL;
+static Tcl_Mutex dllDirectoryNameMutex;
/*
- * Name of the directory in the native filesystem where DLLs used in this
- * process are copied prior to loading.
+ * Static functions defined within this file.
*/
-static WCHAR* dllDirectoryName = NULL;
-
-/* Static functions defined within this file */
-
-void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
- const char* symbol);
-void UnloadFile(Tcl_LoadHandle loadHandle);
-
+static void * FindSymbol(Tcl_Interp *interp,
+ Tcl_LoadHandle loadHandle, const char *symbol);
+static int InitDLLDirectoryName(void);
+static void UnloadFile(Tcl_LoadHandle loadHandle);
/*
*----------------------------------------------------------------------
@@ -61,10 +57,11 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
HINSTANCE hInstance;
const TCHAR *nativeName;
@@ -77,8 +74,7 @@ TclpDlopen(
*/
nativeName = Tcl_FSGetNativePath(pathPtr);
- hInstance = LoadLibraryEx(nativeName, NULL,
- LOAD_WITH_ALTERED_SEARCH_PATH);
+ hInstance = LoadLibraryEx(nativeName,NULL,LOAD_WITH_ALTERED_SEARCH_PATH);
if (hInstance == NULL) {
/*
* Let the OS loader examine the binary search path for whatever
@@ -87,9 +83,8 @@ TclpDlopen(
*/
Tcl_DString ds;
- const char *fileName = Tcl_GetString(pathPtr);
- nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
+ nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds);
hInstance = LoadLibraryEx(nativeName, NULL,
LOAD_WITH_ALTERED_SEARCH_PATH);
Tcl_DStringFree(&ds);
@@ -97,26 +92,8 @@ TclpDlopen(
if (hInstance == NULL) {
DWORD lastError = GetLastError();
-
-#if 0
- /*
- * It would be ideal if the FormatMessage stuff worked better, but
- * unfortunately it doesn't seem to want to...
- */
-
- LPTSTR lpMsgBuf;
- char *buf;
- int size;
-
- size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
- FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
- (LPTSTR) &lpMsgBuf, 0, NULL);
- buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
- sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
-#endif
-
- Tcl_AppendResult(interp, "couldn't load library \"",
- Tcl_GetString(pathPtr), "\": ", NULL);
+ Tcl_Obj *errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ",
+ Tcl_GetString(pathPtr));
/*
* Check for possible DLL errors. This doesn't work quite right,
@@ -127,37 +104,48 @@ TclpDlopen(
switch (lastError) {
case ERROR_MOD_NOT_FOUND:
+ Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", NULL);
+ goto notFoundMsg;
case ERROR_DLL_NOT_FOUND:
- Tcl_AppendResult(interp, "this library or a dependent library"
- " could not be found in library path", NULL);
+ Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL);
+ notFoundMsg:
+ Tcl_AppendToObj(errMsg, "this library or a dependent library"
+ " could not be found in library path", -1);
break;
case ERROR_PROC_NOT_FOUND:
- Tcl_AppendResult(interp, "A function specified in the import"
- " table could not be resolved by the system. Windows"
- " is not telling which one, I'm sorry.", NULL);
+ Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL);
+ Tcl_AppendToObj(errMsg, "A function specified in the import"
+ " table could not be resolved by the system. Windows"
+ " is not telling which one, I'm sorry.", -1);
break;
case ERROR_INVALID_DLL:
- Tcl_AppendResult(interp, "this library or a dependent library"
- " is damaged", NULL);
+ Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL);
+ Tcl_AppendToObj(errMsg, "this library or a dependent library"
+ " is damaged", -1);
break;
case ERROR_DLL_INIT_FAILED:
- Tcl_AppendResult(interp, "the library initialization"
- " routine failed", NULL);
+ Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL);
+ Tcl_AppendToObj(errMsg, "the library initialization"
+ " routine failed", -1);
break;
default:
TclWinConvertError(lastError);
- Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
+ Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1);
}
+ Tcl_SetObjResult(interp, errMsg);
return TCL_ERROR;
- } else {
- handlePtr =
- (Tcl_LoadHandle) ckalloc(sizeof(struct Tcl_LoadHandle_));
- handlePtr->clientData = (ClientData) hInstance;
- handlePtr->findSymbolProcPtr = &FindSymbol;
- handlePtr->unloadFileProcPtr = &UnloadFile;
- *loadHandle = handlePtr;
- *unloadProcPtr = &UnloadFile;
}
+
+ /*
+ * Succeded; package everything up for Tcl.
+ */
+
+ handlePtr = ckalloc(sizeof(struct Tcl_LoadHandle_));
+ handlePtr->clientData = (ClientData) hInstance;
+ handlePtr->findSymbolProcPtr = &FindSymbol;
+ handlePtr->unloadFileProcPtr = &UnloadFile;
+ *loadHandle = handlePtr;
+ *unloadProcPtr = &UnloadFile;
return TCL_OK;
}
@@ -177,32 +165,34 @@ TclpDlopen(
*----------------------------------------------------------------------
*/
-void *
+static void *
FindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
const char *symbol)
{
+ HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
Tcl_PackageInitProc *proc = NULL;
- HINSTANCE hInstance = (HINSTANCE)(loadHandle->clientData);
/*
* For each symbol, check for both Symbol and _Symbol, since Borland
* generates C symbols with a leading '_' by default.
*/
- proc = (void*) GetProcAddress(hInstance, symbol);
+ proc = (void *) GetProcAddress(hInstance, symbol);
if (proc == NULL) {
Tcl_DString ds;
- const char* sym2;
+ const char *sym2;
+
Tcl_DStringInit(&ds);
- Tcl_DStringAppend(&ds, "_", 1);
+ TclDStringAppendLiteral(&ds, "_");
sym2 = Tcl_DStringAppend(&ds, symbol, -1);
proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
Tcl_DStringFree(&ds);
}
if (proc == NULL && interp != NULL) {
- Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot find symbol \"%s\"", symbol));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
}
return proc;
@@ -226,15 +216,16 @@ FindSymbol(
*----------------------------------------------------------------------
*/
-void
+static void
UnloadFile(
Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
* TclpDlopen(). The loadHandle is a token
* that represents the loaded file. */
{
HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
+
FreeLibrary(hInstance);
- ckfree((char*) loadHandle);
+ ckfree(loadHandle);
}
/*
@@ -268,7 +259,7 @@ TclGuessPackageName(
}
/*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* TclpTempFileNameForLibrary --
*
@@ -278,87 +269,126 @@ TclGuessPackageName(
* Returns the constructed file name.
*
* On Windows, a DLL is identified by the final component of its path name.
- * Cross linking among DLL's (and hence, preloading) will not work unless
- * this name is preserved when copying a DLL from a VFS to a temp file for
- * preloading. For this reason, all DLLs in a given process are copied
- * to a temp directory, and their names are preserved.
+ * Cross linking among DLL's (and hence, preloading) will not work unless this
+ * name is preserved when copying a DLL from a VFS to a temp file for
+ * preloading. For this reason, all DLLs in a given process are copied to a
+ * temp directory, and their names are preserved.
*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
-Tcl_Obj*
-TclpTempFileNameForLibrary(Tcl_Interp* interp, /* Tcl interpreter */
- Tcl_Obj* path) /* Path name of the DLL in
- * the VFS */
+Tcl_Obj *
+TclpTempFileNameForLibrary(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *path) /* Path name of the DLL in the VFS. */
{
- size_t nameLen; /* Length of the temp folder name */
- WCHAR name[MAX_PATH]; /* Path name of the temp folder */
- BOOL status; /* Status from Win32 API calls */
- Tcl_Obj* fileName; /* Name of the temp file */
- Tcl_Obj* tail; /* Tail of the source path */
-
- /*
- * Determine the name of the directory to use, and create it.
- * (Keep trying with new names until an attempt to create the directory
- * succeeds)
- */
+ Tcl_Obj *fileName; /* Name of the temp file. */
+ Tcl_Obj *tail; /* Tail of the source path. */
- nameLen = 0;
+ Tcl_MutexLock(&dllDirectoryNameMutex);
if (dllDirectoryName == NULL) {
- Tcl_MutexLock(&loadMutex);
- if (dllDirectoryName == NULL) {
- nameLen = GetTempPathW(MAX_PATH, name);
- if (nameLen >= MAX_PATH-12) {
- Tcl_SetErrno(ENAMETOOLONG);
- nameLen = 0;
- } else {
- wcscpy(name+nameLen, L"TCLXXXXXXXX");
- nameLen += 11;
- }
- status = 1;
- if (nameLen != 0) {
- DWORD id;
- int i = 0;
- id = GetCurrentProcessId();
- for (;;) {
- DWORD lastError;
- wsprintfW(name+nameLen-8, L"%08x", id);
- status = CreateDirectoryW(name, NULL);
- if (status) {
- break;
- }
- if ((lastError = GetLastError()) != ERROR_ALREADY_EXISTS) {
- TclWinConvertError(lastError);
- break;
- } else if (++i > 256) {
- TclWinConvertError(lastError);
- break;
- }
- id *= 16777619;
- }
- }
- if (status != 0) {
- dllDirectoryName = (WCHAR*)
- ckalloc((nameLen+1) * sizeof(WCHAR));
- wcscpy(dllDirectoryName, name);
- }
+ if (InitDLLDirectoryName() == TCL_ERROR) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create temporary directory: %s",
+ Tcl_PosixError(interp)));
+ Tcl_MutexUnlock(&dllDirectoryNameMutex);
+ return NULL;
}
- Tcl_MutexUnlock(&loadMutex);
- }
- if (dllDirectoryName == NULL) {
- Tcl_AppendResult(interp, "couldn't create temporary directory: ",
- Tcl_PosixError(interp), NULL);
}
+ Tcl_MutexUnlock(&dllDirectoryNameMutex);
+
+ /*
+ * Now we know where to put temporary DLLs, construct the name.
+ */
+
fileName = TclpNativeToNormalized(dllDirectoryName);
tail = TclPathPart(interp, path, TCL_PATH_TAIL);
if (tail == NULL) {
Tcl_DecrRefCount(fileName);
return NULL;
- } else {
- Tcl_AppendToObj(fileName, "/", 1);
- Tcl_AppendObjToObj(fileName, tail);
- return fileName;
}
+ Tcl_AppendToObj(fileName, "/", 1);
+ Tcl_AppendObjToObj(fileName, tail);
+ return fileName;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitDLLDirectoryName --
+ *
+ * Helper for TclpTempFileNameForLibrary; builds a temporary directory
+ * that is specific to the current process. Should only be called once
+ * per process start. Caller must hold dllDirectoryNameMutex.
+ *
+ * Results:
+ * Tcl result code.
+ *
+ * Side-effects:
+ * Creates temp directory.
+ * Allocates memory pointed to by dllDirectoryName.
+ *
+ *----------------------------------------------------------------------
+ * [Candidate for process global?]
+ */
+
+static int
+InitDLLDirectoryName(void)
+{
+ size_t nameLen; /* Length of the temp folder name. */
+ WCHAR name[MAX_PATH]; /* Path name of the temp folder. */
+ DWORD id; /* The process id. */
+ DWORD lastError; /* Last error to happen in Win API. */
+ int i;
+
+ /*
+ * Determine the name of the directory to use, and create it. (Keep
+ * trying with new names until an attempt to create the directory
+ * succeeds)
+ */
+
+ nameLen = GetTempPathW(MAX_PATH, name);
+ if (nameLen >= MAX_PATH-12) {
+ Tcl_SetErrno(ENAMETOOLONG);
+ return TCL_ERROR;
+ }
+
+ wcscpy(name+nameLen, L"TCLXXXXXXXX");
+ nameLen += 11;
+
+ id = GetCurrentProcessId();
+ lastError = ERROR_ALREADY_EXISTS;
+
+ for (i=0 ; i<256 ; i++) {
+ wsprintfW(name+nameLen-8, L"%08x", id);
+ if (CreateDirectoryW(name, NULL)) {
+ /*
+ * Issue: we don't schedule this directory for deletion by anyone.
+ * Can we ask the OS to do this for us? There appears to be
+ * potential for using CreateFile (with the flag
+ * FILE_FLAG_BACKUP_SEMANTICS) and RemoveDirectory to do this...
+ */
+
+ goto copyToGlobalBuffer;
+ }
+ lastError = GetLastError();
+ if (lastError != ERROR_ALREADY_EXISTS) {
+ break;
+ }
+ id *= 16777619;
+ }
+
+ TclWinConvertError(lastError);
+ return TCL_ERROR;
+
+ /*
+ * Store our computed value in the global.
+ */
+
+ copyToGlobalBuffer:
+ dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR));
+ wcscpy(dllDirectoryName, name);
+ return TCL_OK;
}
/*
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 0245df3..4543b02 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinNotify.c,v 1.28 2010/05/11 14:47:12 nijtmans Exp $
*/
#include "tclInt.h"
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 3aa641a..36ae58a 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinPipe.c,v 1.84 2010/09/21 21:50:35 nijtmans Exp $
*/
#include "tclWinInt.h"
@@ -322,7 +320,6 @@ PipeSetupProc(
PipeInfo *infoPtr;
Tcl_Time blockTime = { 0, 0 };
int block = 1;
- WinFile *filePtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
@@ -336,13 +333,11 @@ PipeSetupProc(
for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask & TCL_WRITABLE) {
- filePtr = (WinFile*) infoPtr->writeFile;
if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
block = 0;
}
}
if (infoPtr->watchMask & TCL_READABLE) {
- filePtr = (WinFile*) infoPtr->readFile;
if (WaitForRead(infoPtr, 0) >= 0) {
block = 0;
}
@@ -377,7 +372,6 @@ PipeCheckProc(
{
PipeInfo *infoPtr;
PipeEvent *evPtr;
- WinFile *filePtr;
int needEvent;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -400,13 +394,11 @@ PipeCheckProc(
*/
needEvent = 0;
- filePtr = (WinFile*) infoPtr->writeFile;
if ((infoPtr->watchMask & TCL_WRITABLE) &&
(WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
needEvent = 1;
}
- filePtr = (WinFile*) infoPtr->readFile;
if ((infoPtr->watchMask & TCL_READABLE) &&
(WaitForRead(infoPtr, 0) >= 0)) {
needEvent = 1;
@@ -414,7 +406,7 @@ PipeCheckProc(
if (needEvent) {
infoPtr->flags |= PIPE_PENDING;
- evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent));
+ evPtr = ckalloc(sizeof(PipeEvent));
evPtr->header.proc = PipeEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -445,7 +437,7 @@ TclWinMakeFile(
{
WinFile *filePtr;
- filePtr = (WinFile *) ckalloc(sizeof(WinFile));
+ filePtr = ckalloc(sizeof(WinFile));
filePtr->type = WIN_FILE;
filePtr->handle = handle;
@@ -477,15 +469,15 @@ TempFileName(
TCHAR name[MAX_PATH]) /* Buffer in which name for temporary file
* gets stored. */
{
- TCHAR *prefix = TEXT("TCL");
- if (tclWinProcs->getTempPathProc(MAX_PATH, name) != 0) {
- if (tclWinProcs->getTempFileNameProc(name, prefix, 0, name) != 0) {
+ const TCHAR *prefix = TEXT("TCL");
+ if (GetTempPath(MAX_PATH, name) != 0) {
+ if (GetTempFileName(name, prefix, 0, name) != 0) {
return 1;
}
}
name[0] = '.';
name[1] = '\0';
- return tclWinProcs->getTempFileNameProc(name, prefix, 0, name);
+ return GetTempFileName(name, prefix, 0, name);
}
/*
@@ -589,7 +581,7 @@ TclpOpenFile(
break;
}
- nativePath = tclWinProcs->utf2tchar(path, -1, &ds);
+ nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
/*
* If the file is not being created, use the existing file attributes.
@@ -597,7 +589,7 @@ TclpOpenFile(
flags = 0;
if (!(mode & O_CREAT)) {
- flags = tclWinProcs->getFileAttributesProc(nativePath);
+ flags = GetFileAttributes(nativePath);
if (flags == 0xFFFFFFFF) {
flags = 0;
}
@@ -613,7 +605,7 @@ TclpOpenFile(
* Now we get to create the file.
*/
- handle = tclWinProcs->createFileProc(nativePath, accessMode, shareMode,
+ handle = CreateFile(nativePath, accessMode, shareMode,
NULL, createMode, flags, NULL);
Tcl_DStringFree(&ds);
@@ -670,7 +662,7 @@ TclpCreateTempFile(
return NULL;
}
- handle = tclWinProcs->createFileProc((TCHAR *) name,
+ handle = CreateFile(name,
GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL);
if (handle == INVALID_HANDLE_VALUE) {
@@ -684,6 +676,7 @@ TclpCreateTempFile(
if (contents != NULL) {
DWORD result, length;
const char *p;
+ int toCopy;
/*
* Convert the contents from UTF to native encoding
@@ -691,7 +684,8 @@ TclpCreateTempFile(
native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
- for (p = native; *p != '\0'; p++) {
+ toCopy = Tcl_DStringLength(&dstring);
+ for (p = native; toCopy > 0; p++, toCopy--) {
if (*p == '\n') {
length = p - native;
if (length > 0) {
@@ -730,7 +724,7 @@ TclpCreateTempFile(
TclWinConvertError(GetLastError());
CloseHandle(handle);
- tclWinProcs->deleteFileProc((TCHAR *) name);
+ DeleteFile(name);
return NULL;
}
@@ -835,7 +829,7 @@ TclpCloseFile(
if (filePtr->handle != NULL &&
CloseHandle(filePtr->handle) == FALSE) {
TclWinConvertError(GetLastError());
- ckfree((char *) filePtr);
+ ckfree(filePtr);
return -1;
}
}
@@ -845,7 +839,7 @@ TclpCloseFile(
Tcl_Panic("TclpCloseFile: unexpected file type");
}
- ckfree((char *) filePtr);
+ ckfree(filePtr);
return 0;
}
@@ -868,7 +862,7 @@ TclpCloseFile(
*--------------------------------------------------------------------------
*/
-unsigned long
+int
TclpGetPid(
Tcl_Pid pid) /* The HANDLE of the child process. */
{
@@ -1036,8 +1030,9 @@ TclpCreateProcess(
}
if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't duplicate input handle: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't duplicate input handle: %s",
+ Tcl_PosixError(interp)));
goto end;
}
@@ -1071,8 +1066,9 @@ TclpCreateProcess(
}
if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't duplicate output handle: %s",
+ Tcl_PosixError(interp)));
goto end;
}
@@ -1090,8 +1086,9 @@ TclpCreateProcess(
}
if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't duplicate error handle: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't duplicate error handle: %s",
+ Tcl_PosixError(interp)));
goto end;
}
@@ -1123,7 +1120,7 @@ TclpCreateProcess(
startInfo.wShowWindow = SW_HIDE;
startInfo.dwFlags |= STARTF_USESHOWWINDOW;
createFlags = CREATE_NEW_CONSOLE;
- Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1);
+ TclDStringAppendLiteral(&cmdLine, "cmd.exe /c");
} else {
createFlags = DETACHED_PROCESS;
}
@@ -1135,9 +1132,11 @@ TclpCreateProcess(
}
if (applType == APPL_DOS) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"DOS application process not supported on this platform",
- (char *) NULL);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP",
+ NULL);
goto end;
}
}
@@ -1162,12 +1161,12 @@ TclpCreateProcess(
BuildCommandLine(execPath, argc, argv, &cmdLine);
- if (tclWinProcs->createProcessProc(NULL,
- (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
- (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
+ if (CreateProcess(NULL, (TCHAR *) Tcl_DStringValue(&cmdLine),
+ NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo,
+ &procInfo) == 0) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't execute \"", argv[0],
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
+ argv[0], Tcl_PosixError(interp)));
goto end;
}
@@ -1296,7 +1295,7 @@ ApplicationType(
Tcl_DString nameBuf, ds;
const TCHAR *nativeName;
TCHAR nativeFullPath[MAX_PATH];
- static char extensions[][5] = {"", ".com", ".exe", ".bat"};
+ static const char extensions[][5] = {"", ".com", ".exe", ".bat"};
/*
* Look for the program as an external program. First try the name as it
@@ -1319,9 +1318,9 @@ ApplicationType(
for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) {
Tcl_DStringSetLength(&nameBuf, nameLen);
Tcl_DStringAppend(&nameBuf, extensions[i], -1);
- nativeName = tclWinProcs->utf2tchar(Tcl_DStringValue(&nameBuf),
+ nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf),
Tcl_DStringLength(&nameBuf), &ds);
- found = tclWinProcs->searchPathProc(NULL, nativeName, NULL, MAX_PATH,
+ found = SearchPath(NULL, nativeName, NULL, MAX_PATH,
nativeFullPath, &rest);
Tcl_DStringFree(&ds);
if (found == 0) {
@@ -1333,11 +1332,11 @@ ApplicationType(
* known type.
*/
- attr = tclWinProcs->getFileAttributesProc(nativeFullPath);
+ attr = GetFileAttributes(nativeFullPath);
if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) {
continue;
}
- strcpy(fullName, tclWinProcs->tchar2utf(nativeFullPath, -1, &ds));
+ strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds));
Tcl_DStringFree(&ds);
ext = strrchr(fullName, '.');
@@ -1346,7 +1345,7 @@ ApplicationType(
break;
}
- hFile = tclWinProcs->createFileProc(nativeFullPath,
+ hFile = CreateFile(nativeFullPath,
GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
@@ -1413,8 +1412,8 @@ ApplicationType(
if (applType == APPL_NONE) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't execute \"", originalName,
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
+ originalName, Tcl_PosixError(interp)));
return APPL_NONE;
}
@@ -1426,9 +1425,8 @@ ApplicationType(
* application name from the arguments.
*/
- tclWinProcs->getShortPathNameProc(nativeFullPath,
- nativeFullPath, MAX_PATH);
- strcpy(fullName, tclWinProcs->tchar2utf(nativeFullPath, -1, &ds));
+ GetShortPathName(nativeFullPath, nativeFullPath, MAX_PATH);
+ strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds));
Tcl_DStringFree(&ds);
}
return applType;
@@ -1472,9 +1470,9 @@ BuildCommandLine(
* Prime the path. Add a space separator if we were primed with something.
*/
- Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
+ TclDStringAppendDString(&ds, linePtr);
if (Tcl_DStringLength(linePtr) > 0) {
- Tcl_DStringAppend(&ds, " ", 1);
+ TclDStringAppendLiteral(&ds, " ");
}
for (i = 0; i < argc; i++) {
@@ -1482,7 +1480,7 @@ BuildCommandLine(
arg = executable;
} else {
arg = argv[i];
- Tcl_DStringAppend(&ds, " ", 1);
+ TclDStringAppendLiteral(&ds, " ");
}
quote = 0;
@@ -1501,7 +1499,7 @@ BuildCommandLine(
}
}
if (quote) {
- Tcl_DStringAppend(&ds, "\"", 1);
+ TclDStringAppendLiteral(&ds, "\"");
}
start = arg;
for (special = arg; ; ) {
@@ -1530,7 +1528,7 @@ BuildCommandLine(
}
if (*special == '"') {
Tcl_DStringAppend(&ds, start, (int) (special - start));
- Tcl_DStringAppend(&ds, "\\\"", 2);
+ TclDStringAppendLiteral(&ds, "\\\"");
start = special + 1;
}
if (*special == '\0') {
@@ -1540,11 +1538,11 @@ BuildCommandLine(
}
Tcl_DStringAppend(&ds, start, (int) (special - start));
if (quote) {
- Tcl_DStringAppend(&ds, "\"", 1);
+ TclDStringAppendLiteral(&ds, "\"");
}
}
Tcl_DStringFree(linePtr);
- tclWinProcs->utf2tchar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
Tcl_DStringFree(&ds);
}
@@ -1575,9 +1573,8 @@ TclpCreateCommandChannel(
Tcl_Pid *pidPtr) /* An array of process identifiers. */
{
char channelName[16 + TCL_INTEGER_SPACE];
- int channelId;
DWORD id;
- PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo));
+ PipeInfo *infoPtr = ckalloc(sizeof(PipeInfo));
PipeInit();
@@ -1594,20 +1591,6 @@ TclpCreateCommandChannel(
infoPtr->writeError = 0;
infoPtr->channel = NULL;
- /*
- * Use one of the fds associated with the channel as the channel id.
- */
-
- if (readFile) {
- channelId = (int) ((WinFile *) readFile)->handle;
- } else if (writeFile) {
- channelId = (int) ((WinFile *) writeFile)->handle;
- } else if (errorFile) {
- channelId = (int) ((WinFile *) errorFile)->handle;
- } else {
- channelId = 0;
- }
-
infoPtr->validMask = 0;
infoPtr->threadId = Tcl_GetCurrentThread();
@@ -1648,7 +1631,7 @@ TclpCreateCommandChannel(
* unique, in case channels share handles (stdin/stdout).
*/
- wsprintfA(channelName, "file%lx", infoPtr);
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
infoPtr, infoPtr->validMask);
@@ -1693,8 +1676,8 @@ Tcl_CreatePipe(
if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "pipe creation failed: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "pipe creation failed: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -1731,8 +1714,8 @@ TclGetAndDetachPids(
{
PipeInfo *pipePtr;
const Tcl_ChannelType *chanTypePtr;
+ Tcl_Obj *pidsObj;
int i;
- char buf[TCL_INTEGER_SPACE];
/*
* Punt if the channel is not a command channel.
@@ -1743,14 +1726,17 @@ TclGetAndDetachPids(
return;
}
- pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
+ pipePtr = Tcl_GetChannelInstanceData(chan);
+ TclNewObj(pidsObj);
for (i = 0; i < pipePtr->numPids; i++) {
- wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
- Tcl_AppendElement(interp, buf);
- Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
+ Tcl_ListObjAppendElement(NULL, pidsObj,
+ Tcl_NewWideIntObj((unsigned)
+ TclpGetPid(pipePtr->pidPtr[i])));
+ Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
}
+ Tcl_SetObjResult(interp, pidsObj);
if (pipePtr->numPids > 0) {
- ckfree((char *) pipePtr->pidPtr);
+ ckfree(pipePtr->pidPtr);
pipePtr->numPids = 0;
}
}
@@ -1895,12 +1881,26 @@ PipeClose2Proc(
&& (pipePtr->writeFile != NULL)) {
if (pipePtr->writeThread) {
/*
- * Wait for the writer thread to finish the current buffer, then
- * terminate the thread and close the handles. If the channel is
- * nonblocking, there should be no pending write operations.
+ * Wait for the writer thread to finish the current buffer, then
+ * terminate the thread and close the handles. If the channel is
+ * nonblocking but blocked during exit, bail out since the worker
+ * thread is not interruptible and we want TIP#398-fast-exit.
*/
+ if (TclInExit()
+ && (pipePtr->flags & PIPE_ASYNC)) {
- WaitForSingleObject(pipePtr->writable, INFINITE);
+ /* give it a chance to leave honorably */
+ SetEvent(pipePtr->stopWriter);
+
+ if (WaitForSingleObject(pipePtr->writable, 0) == WAIT_TIMEOUT) {
+ return EAGAIN;
+ }
+
+ } else {
+
+ WaitForSingleObject(pipePtr->writable, INFINITE);
+
+ }
/*
* The thread may already have closed on it's own. Check its exit
@@ -2014,7 +2014,7 @@ PipeClose2Proc(
errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
TCL_READABLE);
- ckfree((char *) filePtr);
+ ckfree(filePtr);
} else {
errChan = NULL;
}
@@ -2024,14 +2024,14 @@ PipeClose2Proc(
}
if (pipePtr->numPids > 0) {
- ckfree((char *) pipePtr->pidPtr);
+ ckfree(pipePtr->pidPtr);
}
if (pipePtr->writeBuf != NULL) {
ckfree(pipePtr->writeBuf);
}
- ckfree((char*) pipePtr);
+ ckfree(pipePtr);
if (errorCode == 0) {
return result;
@@ -2199,7 +2199,7 @@ PipeOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
+ infoPtr->writeBuf = ckalloc(toWrite);
}
memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
infoPtr->toWrite = toWrite;
@@ -2255,7 +2255,6 @@ PipeEventProc(
{
PipeEvent *pipeEvPtr = (PipeEvent *)evPtr;
PipeInfo *infoPtr;
- WinFile *filePtr;
int mask;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -2292,14 +2291,12 @@ PipeEventProc(
* detected EOF.
*/
- filePtr = (WinFile*) ((PipeInfo*)infoPtr)->writeFile;
mask = 0;
if ((infoPtr->watchMask & TCL_WRITABLE) &&
(WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
mask = TCL_WRITABLE;
}
- filePtr = (WinFile*) ((PipeInfo*)infoPtr)->readFile;
if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr,0) >= 0)) {
if (infoPtr->readFlags & PIPE_EOF) {
mask = TCL_READABLE;
@@ -2581,7 +2578,7 @@ Tcl_WaitPid(
*/
CloseHandle(infoPtr->hProcess);
- ckfree((char*)infoPtr);
+ ckfree(infoPtr);
return result;
}
@@ -2609,7 +2606,7 @@ TclWinAddProcess(
void *hProcess, /* Handle to process */
unsigned long id) /* Global process identifier */
{
- ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
+ ProcInfo *procPtr = ckalloc(sizeof(ProcInfo));
PipeInit();
@@ -2651,15 +2648,13 @@ Tcl_PidObjCmd(
PipeInfo *pipePtr;
int i;
Tcl_Obj *resultPtr;
- char buf[TCL_INTEGER_SPACE];
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
return TCL_ERROR;
}
if (objc == 1) {
- wsprintfA(buf, "%lu", (unsigned long) getpid());
- Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid()));
} else {
chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
NULL);
@@ -2674,9 +2669,9 @@ Tcl_PidObjCmd(
pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
resultPtr = Tcl_NewObj();
for (i = 0; i < pipePtr->numPids; i++) {
- wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
- Tcl_NewStringObj(buf, -1));
+ Tcl_NewWideIntObj((unsigned)
+ TclpGetPid(pipePtr->pidPtr[i])));
}
Tcl_SetObjResult(interp, resultPtr);
}
@@ -2968,6 +2963,10 @@ PipeWriterThread(
* an error, so exit.
*/
+ if (waitResult == WAIT_OBJECT_0) {
+ SetEvent(infoPtr->writable);
+ }
+
break;
}
@@ -3104,7 +3103,7 @@ TclpOpenTemporaryFile(
}
namePtr = (char *) name;
- length = tclWinProcs->getTempPathProc(MAX_PATH, name);
+ length = GetTempPath(MAX_PATH, name);
if (length == 0) {
goto gotError;
}
@@ -3112,12 +3111,12 @@ TclpOpenTemporaryFile(
if (basenameObj) {
const char *string = Tcl_GetStringFromObj(basenameObj, &length);
- tclWinProcs->utf2tchar(string, length, &buf);
+ Tcl_WinUtfToTChar(string, length, &buf);
memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf));
namePtr += Tcl_DStringLength(&buf);
Tcl_DStringFree(&buf);
} else {
- TCHAR *baseStr = TEXT("TCL");
+ const TCHAR *baseStr = TEXT("TCL");
int length = 3 * sizeof(TCHAR);
memcpy(namePtr, baseStr, length);
@@ -3132,12 +3131,12 @@ TclpOpenTemporaryFile(
sprintf(number, "%d.TMP", counter);
counter = (unsigned short) (counter + 1);
- tclWinProcs->utf2tchar(number, strlen(number), &buf);
+ Tcl_WinUtfToTChar(number, strlen(number), &buf);
Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf) + 1);
memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1);
Tcl_DStringFree(&buf);
- handle = tclWinProcs->createFileProc((TCHAR *) name,
+ handle = CreateFile(name,
GENERIC_READ|GENERIC_WRITE, 0, NULL, CREATE_NEW, flags, NULL);
} while (handle == INVALID_HANDLE_VALUE
&& --counter2 > 0
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index 669fceb..48f7894 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -9,13 +9,16 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinPort.h,v 1.61 2010/09/14 08:53:49 nijtmans Exp $
*/
#ifndef _TCLWINPORT
#define _TCLWINPORT
+#if !defined(_WIN64) && defined(BUILD_tcl)
+/* See [Bug 3354324]: file mtime sets wrong time */
+# define _USE_32BIT_TIME_T
+#endif
+
/*
* We must specify the lower version we intend to support.
*
@@ -23,21 +26,31 @@
*/
#ifndef WINVER
-# define WINVER 0x0500
+# define WINVER 0x0501
#endif
#ifndef _WIN32_WINNT
-# define _WIN32_WINNT 0x0500
+# define _WIN32_WINNT 0x0501
#endif
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
+/* Compatibility to older visual studio / windows platform SDK */
+#if !defined(MAXULONG_PTR)
+typedef DWORD DWORD_PTR;
+typedef DWORD_PTR * PDWORD_PTR;
+#endif
+
/*
* Ask for the winsock function typedefs, also.
*/
#define INCL_WINSOCK_API_TYPEDEFS 1
#include <winsock2.h>
+#include <ws2tcpip.h>
+#ifdef HAVE_WSPIAPI_H
+# include <wspiapi.h>
+#endif
#ifdef CHECK_UNICODE_CALLS
# define _UNICODE
@@ -57,6 +70,10 @@
typedef _TCHAR TCHAR;
# define _TCHAR_DEFINED
#endif
+#if defined(_MSC_VER) && defined(__STDC__)
+ /* VS2005 SP1 misses this. See [Bug #3110161] */
+ typedef _TCHAR TCHAR;
+#endif
/*
*---------------------------------------------------------------------------
@@ -75,18 +92,11 @@
#include <signal.h>
#include <limits.h>
-#ifdef __CYGWIN__
-# include <unistd.h>
-# ifndef _wcsicmp
-# define _wcsicmp wcscasecmp
-# endif
-#else
-# ifndef strncasecmp
-# define strncasecmp strnicmp
-# endif
-# ifndef strcasecmp
-# define strcasecmp stricmp
-# endif
+#ifndef strncasecmp
+# define strncasecmp strnicmp
+#endif
+#ifndef strcasecmp
+# define strcasecmp stricmp
#endif
/*
@@ -220,7 +230,7 @@
# define EOVERFLOW 132 /* File too big */
#endif
#ifndef EOWNERDEAD
-# define EOWNERDEAD 133 /* File too big */
+# define EOWNERDEAD 133 /* Owner dead */
#endif
#ifndef EPROTO
# define EPROTO 134 /* Protocol error */
@@ -245,20 +255,28 @@
#endif
-#undef ESOCKTNOSUPPORT
-#define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT /* Socket type not supported */
-#undef ESHUTDOWN
-#define ESHUTDOWN WSAESHUTDOWN /* Can't send after socket shutdown */
-#undef ETOOMANYREFS
-#define ETOOMANYREFS WSAETOOMANYREFS /* Too many references: can't splice */
-#undef EHOSTDOWN
-#define EHOSTDOWN WSAEHOSTDOWN /* Host is down */
-#undef EUSERS
-#define EUSERS WSAEUSERS /* Too many users (for UFS) */
-#undef EDQUOT
-#define EDQUOT WSAEDQUOT /* Disc quota exceeded */
-#undef ESTALE
-#define ESTALE WSAESTALE /* Stale NFS file handle */
+/* Visual Studio doesn't have these, so just choose some high numbers */
+#ifndef ESOCKTNOSUPPORT
+# define ESOCKTNOSUPPORT 240 /* Socket type not supported */
+#endif
+#ifndef ESHUTDOWN
+# define ESHUTDOWN 241 /* Can't send after socket shutdown */
+#endif
+#ifndef ETOOMANYREFS
+# define ETOOMANYREFS 242 /* Too many references: can't splice */
+#endif
+#ifndef EHOSTDOWN
+# define EHOSTDOWN 243 /* Host is down */
+#endif
+#ifndef EUSERS
+# define EUSERS 244 /* Too many users (for UFS) */
+#endif
+#ifndef EDQUOT
+# define EDQUOT 245 /* Disc quota exceeded */
+#endif
+#ifndef ESTALE
+# define ESTALE 246 /* Stale NFS file handle */
+#endif
/*
* Signals not known to the standard ANSI signal.h. These are used
@@ -420,7 +438,9 @@
#if defined(_MSC_VER) || defined(__MINGW32__)
# define environ _environ
-# define hypot _hypot
+# if defined(_MSC_VER) && (_MSC_VER < 1600)
+# define hypot _hypot
+# endif
# define exception _exception
# undef EDEADLOCK
# if defined(__MINGW32__) && !defined(__MSVCRT__)
@@ -438,11 +458,6 @@
#endif /* __BORLANDC__ */
#ifdef __WATCOMC__
- /*
- * OpenWatcom uses a wine derived winsock2.h that is missing the
- * LPFN_* typedefs.
- */
-# define HAVE_NO_LPFN_DECLS
# if !defined(__CHAR_SIGNED__)
# error "You must use the -j switch to ensure char is signed."
# endif
@@ -499,7 +514,7 @@
/*
* Older version of Mingw are known to lack a MWMO_ALERTABLE define.
*/
-#if defined(HAVE_NO_MWMO_ALERTABLE)
+#if !defined(MWMO_ALERTABLE)
# define MWMO_ALERTABLE 2
#endif
@@ -508,18 +523,12 @@
* use by tclAlloc.c.
*/
-#ifdef __CYGWIN__
-# define TclpSysAlloc(size, isBin) malloc((size))
-# define TclpSysFree(ptr) free((ptr))
-# define TclpSysRealloc(ptr, size) realloc((ptr), (size))
-#else
-# define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \
+#define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \
(DWORD)0, (DWORD)size))
-# define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \
+#define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \
(DWORD)0, (HGLOBAL)ptr))
-# define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \
+#define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \
(DWORD)0, (LPVOID)ptr, (DWORD)size))
-#endif
/*
* The following defines map from standard socket names to our internal
@@ -529,7 +538,6 @@
#define getservbyname TclWinGetServByName
#define getsockopt TclWinGetSockOpt
-#define ntohs TclWinNToHS
#define setsockopt TclWinSetSockOpt
/* This type is not defined in the Windows headers */
#define socklen_t int
@@ -553,4 +561,8 @@
#define INVALID_SET_FILE_POINTER 0xFFFFFFFF
#endif /* INVALID_SET_FILE_POINTER */
+#ifndef LABEL_SECURITY_INFORMATION
+# define LABEL_SECURITY_INFORMATION (0x00000010L)
+#endif
+
#endif /* _TCLWINPORT */
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 987099c..6ac5caf 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -10,35 +10,42 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinReg.c,v 1.54 2010/08/30 09:19:38 nijtmans Exp $
- */
-
-/* TODO: This file does not compile in UNICODE mode.
- * See [Freq 2965056]: Windows build with -DUNICODE
*/
-#undef UNICODE
-#undef _UNICODE
#undef STATIC_BUILD
-#ifndef USE_TCL_STUBS
-# define USE_TCL_STUBS
-#endif
+#undef USE_TCL_STUBS
+#define USE_TCL_STUBS
+
#include "tclInt.h"
#ifdef _MSC_VER
# pragma comment (lib, "advapi32.lib")
#endif
#include <stdlib.h>
+#ifndef UNICODE
+# undef Tcl_WinTCharToUtf
+# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
+# undef Tcl_WinUtfToTChar
+# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
+#endif /* !UNICODE */
+
/*
* Ensure that we can say which registry is being accessed.
*/
#ifndef KEY_WOW64_64KEY
-#define KEY_WOW64_64KEY (0x0100)
+# define KEY_WOW64_64KEY (0x0100)
#endif
#ifndef KEY_WOW64_32KEY
-#define KEY_WOW64_32KEY (0x0200)
+# define KEY_WOW64_32KEY (0x0200)
+#endif
+
+/*
+ * The maximum length of a sub-key name.
+ */
+
+#ifndef MAX_KEY_LENGTH
+# define MAX_KEY_LENGTH 256
#endif
/*
@@ -75,7 +82,7 @@ static const char *const rootKeyNames[] = {
"HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL
};
-static HKEY rootKeys[] = {
+static const HKEY rootKeys[] = {
HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA
};
@@ -96,90 +103,6 @@ static const char *const typeNames[] = {
static DWORD lastType = REG_RESOURCE_LIST;
/*
- * The following structures allow us to select between the Unicode and ASCII
- * interfaces at run time based on whether Unicode APIs are available. The
- * Unicode APIs are preferable because they will handle characters outside of
- * the current code page.
- */
-
-typedef struct RegWinProcs {
- int useWide;
-
- LONG (WINAPI *regConnectRegistryProc)(const TCHAR *, HKEY, PHKEY);
- LONG (WINAPI *regCreateKeyExProc)(HKEY, const TCHAR *, DWORD, TCHAR *,
- DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *);
- LONG (WINAPI *regDeleteKeyProc)(HKEY, const TCHAR *);
- LONG (WINAPI *regDeleteValueProc)(HKEY, const TCHAR *);
- LONG (WINAPI *regEnumKeyProc)(HKEY, DWORD, TCHAR *, DWORD);
- LONG (WINAPI *regEnumKeyExProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
- TCHAR *, DWORD *, FILETIME *);
- LONG (WINAPI *regEnumValueProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
- DWORD *, BYTE *, DWORD *);
- LONG (WINAPI *regOpenKeyExProc)(HKEY, const TCHAR *, DWORD, REGSAM,
- HKEY *);
- LONG (WINAPI *regQueryInfoKeyProc)(HKEY, TCHAR *, DWORD *, DWORD *,
- DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
- FILETIME *);
- LONG (WINAPI *regQueryValueExProc)(HKEY, const TCHAR *, DWORD *, DWORD *,
- BYTE *, DWORD *);
- LONG (WINAPI *regSetValueExProc)(HKEY, const TCHAR *, DWORD, DWORD,
- const BYTE*, DWORD);
-} RegWinProcs;
-
-static RegWinProcs *regWinProcs;
-
-static RegWinProcs asciiProcs = {
- 0,
-
- (LONG (WINAPI *)(const TCHAR *, HKEY, PHKEY)) RegConnectRegistryA,
- (LONG (WINAPI *)(HKEY, const TCHAR *, DWORD, TCHAR *,
- DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
- DWORD *)) RegCreateKeyExA,
- (LONG (WINAPI *)(HKEY, const TCHAR *)) RegDeleteKeyA,
- (LONG (WINAPI *)(HKEY, const TCHAR *)) RegDeleteValueA,
- (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA,
- (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
- TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExA,
- (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
- DWORD *, BYTE *, DWORD *)) RegEnumValueA,
- (LONG (WINAPI *)(HKEY, const TCHAR *, DWORD, REGSAM,
- HKEY *)) RegOpenKeyExA,
- (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *,
- DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
- FILETIME *)) RegQueryInfoKeyA,
- (LONG (WINAPI *)(HKEY, const TCHAR *, DWORD *, DWORD *,
- BYTE *, DWORD *)) RegQueryValueExA,
- (LONG (WINAPI *)(HKEY, const TCHAR *, DWORD, DWORD,
- const BYTE*, DWORD)) RegSetValueExA,
-};
-
-static RegWinProcs unicodeProcs = {
- 1,
-
- (LONG (WINAPI *)(const TCHAR *, HKEY, PHKEY)) RegConnectRegistryW,
- (LONG (WINAPI *)(HKEY, const TCHAR *, DWORD, TCHAR *,
- DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
- DWORD *)) RegCreateKeyExW,
- (LONG (WINAPI *)(HKEY, const TCHAR *)) RegDeleteKeyW,
- (LONG (WINAPI *)(HKEY, const TCHAR *)) RegDeleteValueW,
- (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW,
- (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
- TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExW,
- (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
- DWORD *, BYTE *, DWORD *)) RegEnumValueW,
- (LONG (WINAPI *)(HKEY, const TCHAR *, DWORD, REGSAM,
- HKEY *)) RegOpenKeyExW,
- (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *,
- DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
- FILETIME *)) RegQueryInfoKeyW,
- (LONG (WINAPI *)(HKEY, const TCHAR *, DWORD *, DWORD *,
- BYTE *, DWORD *)) RegQueryValueExW,
- (LONG (WINAPI *)(HKEY, const TCHAR *, DWORD, DWORD,
- const BYTE*, DWORD)) RegSetValueExW,
-};
-
-
-/*
* Declarations for functions defined in this file.
*/
@@ -240,25 +163,16 @@ int
Registry_Init(
Tcl_Interp *interp)
{
- int useWide;
Tcl_Command cmd;
- if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
return TCL_ERROR;
}
- /*
- * Determine if the unicode interfaces are available and select the
- * appropriate registry function table.
- */
-
- useWide = (TclWinGetPlatformId() != VER_PLATFORM_WIN32_WINDOWS);
- regWinProcs = useWide ? &unicodeProcs : &asciiProcs;
-
cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
interp, DeleteCmd);
Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
- return Tcl_PkgProvide(interp, "registry", "1.3");
+ return Tcl_PkgProvide(interp, "registry", "1.3.0");
}
/*
@@ -498,7 +412,7 @@ DeleteKey(
REGSAM mode) /* Mode flags to pass. */
{
char *tail, *buffer, *hostName, *keyName;
- const char *nativeTail;
+ const TCHAR *nativeTail;
HKEY rootKey, subkey;
DWORD result;
int length;
@@ -510,7 +424,7 @@ DeleteKey(
*/
keyName = Tcl_GetStringFromObj(keyNameObj, &length);
- buffer = ckalloc((unsigned) length + 1);
+ buffer = ckalloc(length + 1);
strcpy(buffer, keyName);
if (ParseKeyName(interp, buffer, &hostName, &rootKey,
@@ -522,6 +436,7 @@ DeleteKey(
if (*keyName == '\0') {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("bad key: cannot delete root keys", -1));
+ Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
ckfree(buffer);
return TCL_ERROR;
}
@@ -609,12 +524,12 @@ DeleteValue(
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
Tcl_WinUtfToTChar(valueName, length, &ds);
- result = regWinProcs->regDeleteValueProc(key, Tcl_DStringValue(&ds));
+ result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
if (result != ERROR_SUCCESS) {
- Tcl_AppendResult(interp, "unable to delete value \"",
- Tcl_GetString(valueNameObj), "\" from key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to delete value \"%s\" from key \"%s\": ",
+ Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
AppendSystemError(interp, result);
result = TCL_ERROR;
} else {
@@ -652,9 +567,8 @@ GetKeyNames(
{
const char *pattern; /* Pattern being matched against subkeys */
HKEY key; /* Handle to the key being examined */
- DWORD subKeyCount; /* Number of subkeys to list */
- DWORD maxSubKeyLen; /* Maximum string length of any subkey */
- char *buffer; /* Buffer to hold the subkey name */
+ TCHAR buffer[MAX_KEY_LENGTH];
+ /* Buffer to hold the subkey name */
DWORD bufSize; /* Size of the buffer */
DWORD index; /* Position of the current subkey */
char *name; /* Subkey name */
@@ -678,48 +592,27 @@ GetKeyNames(
}
/*
- * Determine how big a buffer is needed for enumerating subkeys, and how
- * many subkeys there are.
- */
-
- result = regWinProcs->regQueryInfoKeyProc(key, NULL, NULL, NULL,
- &subKeyCount, &maxSubKeyLen, NULL, NULL, NULL, NULL, NULL, NULL);
- if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp, Tcl_NewObj());
- Tcl_AppendResult(interp, "unable to query key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
- AppendSystemError(interp, result);
- RegCloseKey(key);
- return TCL_ERROR;
- }
- if (regWinProcs->useWide) {
- buffer = ckalloc((maxSubKeyLen+1) * sizeof(WCHAR));
- } else {
- buffer = ckalloc(maxSubKeyLen+1);
- }
-
- /*
* Enumerate the subkeys.
*/
resultPtr = Tcl_NewObj();
- for (index = 0; index < subKeyCount; ++index) {
- bufSize = maxSubKeyLen+1;
- result = regWinProcs->regEnumKeyExProc(key, index, buffer, &bufSize,
+ for (index = 0;; ++index) {
+ bufSize = MAX_KEY_LENGTH;
+ result = RegEnumKeyEx(key, index, buffer, &bufSize,
NULL, NULL, NULL, NULL);
if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp, Tcl_NewObj());
- Tcl_AppendResult(interp, "unable to enumerate subkeys of \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
- AppendSystemError(interp, result);
- result = TCL_ERROR;
+ if (result == ERROR_NO_MORE_ITEMS) {
+ result = TCL_OK;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to enumerate subkeys of \"%s\": ",
+ Tcl_GetString(keyNameObj)));
+ AppendSystemError(interp, result);
+ result = TCL_ERROR;
+ }
break;
}
- if (regWinProcs->useWide) {
- Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize * sizeof(WCHAR), &ds);
- } else {
- Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize, &ds);
- }
+ Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
name = Tcl_DStringValue(&ds);
if (pattern && !Tcl_StringMatch(name, pattern)) {
Tcl_DStringFree(&ds);
@@ -734,9 +627,10 @@ GetKeyNames(
}
if (result == TCL_OK) {
Tcl_SetObjResult(interp, resultPtr);
+ } else {
+ Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */
}
- ckfree(buffer);
RegCloseKey(key);
return result;
}
@@ -768,7 +662,8 @@ GetType(
HKEY key;
DWORD result, type;
Tcl_DString ds;
- const char *valueName, *nativeValue;
+ const char *valueName;
+ const TCHAR *nativeValue;
int length;
/*
@@ -786,15 +681,15 @@ GetType(
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
- result = regWinProcs->regQueryValueExProc(key, nativeValue, NULL, &type,
+ result = RegQueryValueEx(key, nativeValue, NULL, &type,
NULL, NULL);
Tcl_DStringFree(&ds);
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
- Tcl_AppendResult(interp, "unable to get type of value \"",
- Tcl_GetString(valueNameObj), "\" from key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to get type of value \"%s\" from key \"%s\": ",
+ Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
AppendSystemError(interp, result);
return TCL_ERROR;
}
@@ -837,7 +732,8 @@ GetValue(
REGSAM mode) /* Mode flags to pass. */
{
HKEY key;
- const char *valueName, *nativeValue;
+ const char *valueName;
+ const TCHAR *nativeValue;
DWORD result, length, type;
Tcl_DString data, buf;
int nameLen;
@@ -862,13 +758,13 @@ GetValue(
*/
Tcl_DStringInit(&data);
- length = TCL_DSTRING_STATIC_SIZE - 1;
- Tcl_DStringSetLength(&data, (int) length);
+ Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
+ length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1;
valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
- result = regWinProcs->regQueryValueExProc(key, nativeValue, NULL, &type,
+ result = RegQueryValueEx(key, nativeValue, NULL, &type,
(BYTE *) Tcl_DStringValue(&data), &length);
while (result == ERROR_MORE_DATA) {
/*
@@ -877,17 +773,17 @@ GetValue(
* HKEY_PERFORMANCE_DATA
*/
- length *= 2;
- Tcl_DStringSetLength(&data, (int) length);
- result = regWinProcs->regQueryValueExProc(key, (char *) nativeValue,
+ length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR));
+ Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR));
+ result = RegQueryValueEx(key, nativeValue,
NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
}
Tcl_DStringFree(&buf);
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
- Tcl_AppendResult(interp, "unable to get value \"",
- Tcl_GetString(valueNameObj), "\" from key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to get value \"%s\" from key \"%s\": ",
+ Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
AppendSystemError(interp, result);
Tcl_DStringFree(&data);
return TCL_ERROR;
@@ -914,20 +810,17 @@ GetValue(
* we get bogus data.
*/
- while ((p < end)
- && (regWinProcs->useWide ? *((Tcl_UniChar *) p) : *p) != 0) {
+ while ((p < end) && *((Tcl_UniChar *) p) != 0) {
+ Tcl_UniChar *up;
+
Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
Tcl_ListObjAppendElement(interp, resultPtr,
Tcl_NewStringObj(Tcl_DStringValue(&buf),
Tcl_DStringLength(&buf)));
- if (regWinProcs->useWide) {
- Tcl_UniChar *up = (Tcl_UniChar *) p;
+ up = (Tcl_UniChar *) p;
- while (*up++ != 0) {}
- p = (char *) up;
- } else {
- while (*p++ != '\0') {}
- }
+ while (*up++ != 0) {/* empty body */}
+ p = (char *) up;
Tcl_DStringFree(&buf);
}
Tcl_SetObjResult(interp, resultPtr);
@@ -974,7 +867,7 @@ GetValueNames(
{
HKEY key;
Tcl_Obj *resultPtr;
- DWORD index, size, maxSize, result;
+ DWORD index, size, result;
Tcl_DString buffer, ds;
const char *pattern, *name;
@@ -987,27 +880,9 @@ GetValueNames(
return TCL_ERROR;
}
- /*
- * Query the key to determine the appropriate buffer size to hold the
- * largest value name plus the terminating null.
- */
-
- result = regWinProcs->regQueryInfoKeyProc(key, NULL, NULL, NULL, NULL,
- NULL, NULL, &index, &maxSize, NULL, NULL, NULL);
- if (result != ERROR_SUCCESS) {
- Tcl_AppendResult(interp, "unable to query key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
- AppendSystemError(interp, result);
- RegCloseKey(key);
- result = TCL_ERROR;
- goto done;
- }
- maxSize++;
-
resultPtr = Tcl_NewObj();
Tcl_DStringInit(&buffer);
- Tcl_DStringSetLength(&buffer,
- (int) (regWinProcs->useWide ? maxSize*2 : maxSize));
+ Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
index = 0;
result = TCL_OK;
@@ -1023,12 +898,10 @@ GetValueNames(
* each iteration because RegEnumValue smashes the old value.
*/
- size = maxSize;
- while (regWinProcs->regEnumValueProc(key,index, Tcl_DStringValue(&buffer),
+ size = MAX_KEY_LENGTH;
+ while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer),
&size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) {
- if (regWinProcs->useWide) {
- size *= 2;
- }
+ size *= sizeof(TCHAR);
Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size,
&ds);
@@ -1044,12 +917,10 @@ GetValueNames(
Tcl_DStringFree(&ds);
index++;
- size = maxSize;
+ size = MAX_KEY_LENGTH;
}
Tcl_SetObjResult(interp, resultPtr);
Tcl_DStringFree(&buffer);
-
- done:
RegCloseKey(key);
return result;
}
@@ -1085,7 +956,7 @@ OpenKey(
DWORD result;
keyName = Tcl_GetStringFromObj(keyNameObj, &length);
- buffer = ckalloc((unsigned) length + 1);
+ buffer = ckalloc(length + 1);
strcpy(buffer, keyName);
result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
@@ -1141,7 +1012,7 @@ OpenSubKey(
if (hostName) {
hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf);
- result = regWinProcs->regConnectRegistryProc(hostName, rootKey,
+ result = RegConnectRegistry((TCHAR *)hostName, rootKey,
&rootKey);
Tcl_DStringFree(&buf);
if (result != ERROR_SUCCESS) {
@@ -1158,7 +1029,7 @@ OpenSubKey(
if (flags & REG_CREATE) {
DWORD create;
- result = regWinProcs->regCreateKeyExProc(rootKey, keyName, 0, NULL,
+ result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL,
REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
} else if (rootKey == HKEY_PERFORMANCE_DATA) {
/*
@@ -1169,7 +1040,7 @@ OpenSubKey(
*keyPtr = HKEY_PERFORMANCE_DATA;
result = ERROR_SUCCESS;
} else {
- result = regWinProcs->regOpenKeyExProc(rootKey, keyName, 0, mode,
+ result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode,
keyPtr);
}
Tcl_DStringFree(&buf);
@@ -1233,8 +1104,9 @@ ParseKeyName(
rootName = name;
}
if (!rootName) {
- Tcl_AppendResult(interp, "bad key \"", name,
- "\": must start with a valid root", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad key \"%s\": must start with a valid root", name));
+ Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL);
return TCL_ERROR;
}
@@ -1286,11 +1158,11 @@ ParseKeyName(
static DWORD
RecursiveDeleteKey(
HKEY startKey, /* Parent of key to be deleted. */
- const char *keyName, /* Name of key to be deleted in external
+ const TCHAR *keyName, /* Name of key to be deleted in external
* encoding, not UTF. */
REGSAM mode) /* Mode flags to pass. */
{
- DWORD result, size, maxSize;
+ DWORD result, size;
Tcl_DString subkey;
HKEY hKey;
REGSAM saveMode = mode;
@@ -1306,20 +1178,13 @@ RecursiveDeleteKey(
}
mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE;
- result = regWinProcs->regOpenKeyExProc(startKey, keyName, 0, mode, &hKey);
- if (result != ERROR_SUCCESS) {
- return result;
- }
- result = regWinProcs->regQueryInfoKeyProc(hKey, NULL, NULL, NULL, NULL,
- &maxSize, NULL, NULL, NULL, NULL, NULL, NULL);
- maxSize++;
+ result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey);
if (result != ERROR_SUCCESS) {
return result;
}
Tcl_DStringInit(&subkey);
- Tcl_DStringSetLength(&subkey,
- (int) ((regWinProcs->useWide) ? maxSize * 2 : maxSize));
+ Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
mode = saveMode;
while (result == ERROR_SUCCESS) {
@@ -1327,9 +1192,9 @@ RecursiveDeleteKey(
* Always get index 0 because key deletion changes ordering.
*/
- size = maxSize;
- result = regWinProcs->regEnumKeyExProc(hKey, 0,
- Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL);
+ size = MAX_KEY_LENGTH;
+ result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey),
+ &size, NULL, NULL, NULL, NULL);
if (result == ERROR_NO_MORE_ITEMS) {
/*
* RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we
@@ -1341,26 +1206,21 @@ RecursiveDeleteKey(
HINSTANCE dllH;
checkExProc = 1;
- dllH = LoadLibrary("advapi32.dll");
+ dllH = LoadLibrary(TEXT("advapi32.dll"));
if (dllH) {
- if (regWinProcs->useWide) {
- regDeleteKeyExProc = (FARPROC)
- GetProcAddress(dllH, "RegDeleteKeyExW");
- } else {
- regDeleteKeyExProc = (FARPROC)
- GetProcAddress(dllH, "RegDeleteKeyExA");
- }
+ regDeleteKeyExProc = (FARPROC)
+ GetProcAddress(dllH, "RegDeleteKeyExW");
}
}
if (mode && regDeleteKeyExProc) {
result = regDeleteKeyExProc(startKey, keyName, mode, 0);
} else {
- result = regWinProcs->regDeleteKeyProc(startKey, keyName);
+ result = RegDeleteKey(startKey, keyName);
}
break;
} else if (result == ERROR_SUCCESS) {
- result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey),
- mode);
+ result = RecursiveDeleteKey(hKey,
+ (const TCHAR *) Tcl_DStringValue(&subkey), mode);
}
}
Tcl_DStringFree(&subkey);
@@ -1416,7 +1276,7 @@ SetValue(
}
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
- valueName = Tcl_WinUtfToTChar(valueName, length, &nameBuf);
+ valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
int value;
@@ -1427,8 +1287,8 @@ SetValue(
return TCL_ERROR;
}
- value = ConvertDWORD((DWORD)type, (DWORD)value);
- result = regWinProcs->regSetValueExProc(key, valueName, 0,
+ value = ConvertDWORD((DWORD) type, (DWORD) value);
+ result = RegSetValueEx(key, (TCHAR *) valueName, 0,
(DWORD) type, (BYTE *) &value, sizeof(DWORD));
} else if (type == REG_MULTI_SZ) {
Tcl_DString data, buf;
@@ -1449,21 +1309,20 @@ SetValue(
Tcl_DStringInit(&data);
for (i = 0; i < objc; i++) {
- Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1);
+ const char *bytes = Tcl_GetStringFromObj(objv[i], &length);
+
+ Tcl_DStringAppend(&data, bytes, length);
/*
- * Add a null character to separate this value from the next. We
- * accomplish this by growing the string by one byte. Since the
- * DString always tacks on an extra null byte, the new byte will
- * already be set to null.
+ * Add a null character to separate this value from the next.
*/
- Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1);
+ Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */
}
Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
&buf);
- result = regWinProcs->regSetValueExProc(key, valueName, 0,
+ result = RegSetValueEx(key, (TCHAR *) valueName, 0,
(DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
(DWORD) Tcl_DStringLength(&buf));
Tcl_DStringFree(&data);
@@ -1472,18 +1331,16 @@ SetValue(
Tcl_DString buf;
const char *data = Tcl_GetStringFromObj(dataObj, &length);
- data = Tcl_WinUtfToTChar(data, length, &buf);
+ data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
/*
* Include the null in the length, padding if needed for Unicode.
*/
- if (regWinProcs->useWide) {
- Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
- }
+ Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
length = Tcl_DStringLength(&buf) + 1;
- result = regWinProcs->regSetValueExProc(key, valueName, 0,
+ result = RegSetValueEx(key, (TCHAR *) valueName, 0,
(DWORD) type, (BYTE *) data, (DWORD) length);
Tcl_DStringFree(&buf);
} else {
@@ -1494,7 +1351,7 @@ SetValue(
*/
data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length);
- result = regWinProcs->regSetValueExProc(key, valueName, 0,
+ result = RegSetValueEx(key, (TCHAR *) valueName, 0,
(DWORD) type, data, (DWORD) length);
}
@@ -1534,7 +1391,7 @@ BroadcastValue(
Tcl_Obj *const objv[]) /* Argument values. */
{
LRESULT result;
- DWORD sendResult;
+ DWORD_PTR sendResult;
UINT timeout = 3000;
int len;
const char *str;
@@ -1560,7 +1417,7 @@ BroadcastValue(
* Use the ignore the result.
*/
- result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
+ result = SendMessageTimeoutA(HWND_BROADCAST, WM_SETTINGCHANGE,
(WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult);
objPtr = Tcl_NewObj();
@@ -1594,7 +1451,7 @@ AppendSystemError(
DWORD error) /* Result code from error. */
{
int length;
- WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr;
+ TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr;
const char *msg;
char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
Tcl_DString ds;
@@ -1603,40 +1460,18 @@ AppendSystemError(
if (Tcl_IsShared(resultPtr)) {
resultPtr = Tcl_DuplicateObj(resultPtr);
}
- length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
+ length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
| FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr,
0, NULL);
if (length == 0) {
- char *msgPtr;
-
- length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM
- | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr,
- 0, NULL);
- if (length > 0) {
- wMsgPtr = (WCHAR *)
- LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR));
- MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr,
- length + 1);
- LocalFree(msgPtr);
- }
- }
- if (length == 0) {
- if (error == ERROR_CALL_NOT_IMPLEMENTED) {
- strcpy(msgBuf, "function not supported under Win32s");
- } else {
- sprintf(msgBuf, "unknown error: %ld", error);
- }
+ sprintf(msgBuf, "unknown error: %ld", error);
msg = msgBuf;
} else {
- Tcl_Encoding encoding;
char *msgPtr;
- encoding = Tcl_GetEncoding(NULL, "unicode");
- Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds);
- Tcl_FreeEncoding(encoding);
- LocalFree(wMsgPtr);
+ Tcl_WinTCharToUtf(tMsgPtr, -1, &ds);
+ LocalFree(tMsgPtr);
msgPtr = Tcl_DStringValue(&ds);
length = Tcl_DStringLength(&ds);
@@ -1687,14 +1522,15 @@ ConvertDWORD(
DWORD type, /* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */
DWORD value) /* The value to be converted. */
{
- DWORD order = 1;
+ const DWORD order = 1;
DWORD localType;
/*
* Check to see if the low bit is in the first byte.
*/
- localType = (*((char *) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
+ localType = (*((const char *) &order) == 1)
+ ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
return (type != localType) ? (DWORD) SWAPLONG(value) : value;
}
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index 2f8cbd9..458b05b 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -10,8 +10,6 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* Serial functionality implemented by Rolf.Schroedter@dlr.de
- *
- * RCS: @(#) $Id: tclWinSerial.c,v 1.44 2010/09/13 14:20:38 nijtmans Exp $
*/
#include "tclWinInt.h"
@@ -378,7 +376,7 @@ SerialGetMilliseconds(void)
{
Tcl_Time time;
- TclpGetTime(&time);
+ Tcl_GetTime(&time);
return (time.sec * 1000 + time.usec / 1000);
}
@@ -531,7 +529,7 @@ SerialCheckProc(
if (needEvent) {
infoPtr->flags |= SERIAL_PENDING;
- evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent));
+ evPtr = ckalloc(sizeof(SerialEvent));
evPtr->header.proc = SerialEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -710,7 +708,7 @@ SerialCloseProc(
ckfree(serialPtr->writeBuf);
serialPtr->writeBuf = NULL;
}
- ckfree((char*) serialPtr);
+ ckfree(serialPtr);
if (errorCode == 0) {
return result;
@@ -1038,7 +1036,7 @@ SerialOutputProc(
* the channel is in non-blocking mode.
*/
- errno = EWOULDBLOCK;
+ errno = EAGAIN;
goto error1;
}
@@ -1075,7 +1073,7 @@ SerialOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
+ infoPtr->writeBuf = ckalloc(toWrite);
}
memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
infoPtr->toWrite = toWrite;
@@ -1435,9 +1433,7 @@ TclWinSerialReopen(
const TCHAR *name,
DWORD access)
{
- ThreadSpecificData *tsdPtr;
-
- tsdPtr = SerialInit();
+ SerialInit();
/*
* Multithreaded I/O needs the overlapped flag set otherwise
@@ -1482,7 +1478,7 @@ TclWinOpenSerialChannel(
SerialInit();
- infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
+ infoPtr = ckalloc(sizeof(SerialInfo));
memset(infoPtr, 0, sizeof(SerialInfo));
infoPtr->validMask = permissions;
@@ -1503,7 +1499,7 @@ TclWinOpenSerialChannel(
* are shared between multiple channels (stdin/stdout).
*/
- wsprintfA(channelName, "file%lx", (int) infoPtr);
+ sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
infoPtr, permissions);
@@ -1677,10 +1673,7 @@ SerialSetOptionProc(
if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
if (!GetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
- }
- return TCL_ERROR;
+ goto getStateFailed;
}
native = Tcl_WinUtfToTChar(value, -1, &ds);
result = BuildCommDCB(native, &dcb);
@@ -1688,8 +1681,10 @@ SerialSetOptionProc(
if (result == FALSE) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad value \"", value,
- "\" for -mode: should be baud,parity,data,stop", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad value \"%s\" for -mode: should be baud,parity,data,stop",
+ value));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
}
return TCL_ERROR;
}
@@ -1704,10 +1699,7 @@ SerialSetOptionProc(
dcb.fAbortOnError = FALSE;
if (!SetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set comm state", NULL);
- }
- return TCL_ERROR;
+ goto setStateFailed;
}
return TCL_OK;
}
@@ -1718,10 +1710,7 @@ SerialSetOptionProc(
if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
if (!GetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
- }
- return TCL_ERROR;
+ goto getStateFailed;
}
/*
@@ -1756,18 +1745,16 @@ SerialSetOptionProc(
dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
} else {
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad value \"", value,
- "\" for -handshake: must be one of xonxoff, rtscts, "
- "dtrdsr or none", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad value \"%s\" for -handshake: must be one of"
+ " xonxoff, rtscts, dtrdsr or none", value));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL);
}
return TCL_ERROR;
}
if (!SetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set comm state", NULL);
- }
- return TCL_ERROR;
+ goto setStateFailed;
}
return TCL_OK;
}
@@ -1778,10 +1765,7 @@ SerialSetOptionProc(
if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
if (!GetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
- }
- return TCL_ERROR;
+ goto getStateFailed;
}
if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
@@ -1790,11 +1774,12 @@ SerialSetOptionProc(
if (argc != 2) {
badXchar:
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad value for -xchar: should be "
- "a list of two elements with each a single character",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -xchar: should be a list of"
+ " two elements with each a single character", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
@@ -1825,13 +1810,10 @@ SerialSetOptionProc(
}
dcb.XoffChar = (char) character;
}
- ckfree((char *) argv);
+ ckfree(argv);
if (!SetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set comm state", NULL);
- }
- return TCL_ERROR;
+ goto setStateFailed;
}
return TCL_OK;
}
@@ -1848,11 +1830,12 @@ SerialSetOptionProc(
}
if ((argc % 2) == 1) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad value \"", value,
- "\" for -ttycontrol: should be a list of "
- "signal,value pairs", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad value \"%s\" for -ttycontrol: should be "
+ "a list of signal,value pairs", value));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
@@ -1865,7 +1848,10 @@ SerialSetOptionProc(
if (!EscapeCommFunction(infoPtr->handle,
(DWORD) (flag ? SETDTR : CLRDTR))) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set DTR signal", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't set DTR signal", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+ "FCONFIGURE", "TTY_SIGNAL", NULL);
}
result = TCL_ERROR;
break;
@@ -1874,7 +1860,10 @@ SerialSetOptionProc(
if (!EscapeCommFunction(infoPtr->handle,
(DWORD) (flag ? SETRTS : CLRRTS))) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set RTS signal", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't set RTS signal", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+ "FCONFIGURE", "TTY_SIGNAL", NULL);
}
result = TCL_ERROR;
break;
@@ -1883,15 +1872,20 @@ SerialSetOptionProc(
if (!EscapeCommFunction(infoPtr->handle,
(DWORD) (flag ? SETBREAK : CLRBREAK))) {
if (interp != NULL) {
- Tcl_AppendResult(interp,"can't set BREAK signal",NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't set BREAK signal", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+ "FCONFIGURE", "TTY_SIGNAL", NULL);
}
result = TCL_ERROR;
break;
}
} else {
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad signal name \"", argv[i],
- "\" for -ttycontrol: must be DTR, RTS or BREAK",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad signal name \"%s\" for -ttycontrol: must be"
+ " DTR, RTS or BREAK", argv[i]));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL",
NULL);
}
result = TCL_ERROR;
@@ -1899,7 +1893,7 @@ SerialSetOptionProc(
}
}
- ckfree((char *) argv);
+ ckfree(argv);
return result;
}
@@ -1925,20 +1919,24 @@ SerialSetOptionProc(
inSize = atoi(argv[0]);
outSize = atoi(argv[1]);
}
- ckfree((char *) argv);
+ ckfree(argv);
if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad value \"", value,
- "\" for -sysbuffer: should be a list of one or two "
- "integers > 0", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad value \"%s\" for -sysbuffer: should be "
+ "a list of one or two integers > 0", value));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
}
return TCL_ERROR;
}
if (!SetupComm(infoPtr->handle, inSize, outSize)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't setup comm buffers", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't setup comm buffers: %s",
+ Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1951,18 +1949,12 @@ SerialSetOptionProc(
*/
if (!GetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
- }
- return TCL_ERROR;
+ goto getStateFailed;
}
dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
if (!SetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set comm state", NULL);
- }
- return TCL_ERROR;
+ goto setStateFailed;
}
return TCL_OK;
}
@@ -1992,7 +1984,10 @@ SerialSetOptionProc(
tout.ReadTotalTimeoutConstant = msec;
if (!SetCommTimeouts(infoPtr->handle, &tout)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set comm timeouts", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't set comm timeouts: %s",
+ Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2002,6 +1997,22 @@ SerialSetOptionProc(
return Tcl_BadChannelOption(interp, optionName,
"mode handshake pollinterval sysbuffer timeout ttycontrol xchar");
+
+ getStateFailed:
+ if (interp != NULL) {
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get comm state: %s", Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
+
+ setStateFailed:
+ if (interp != NULL) {
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't set comm state: %s", Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
}
/*
@@ -2059,7 +2070,9 @@ SerialGetOptionProc(
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get comm state: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2127,7 +2140,9 @@ SerialGetOptionProc(
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get comm state: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2203,7 +2218,9 @@ SerialGetOptionProc(
if (!GetCommModemStatus(infoPtr->handle, &status)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't get tty status", NULL);
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get tty status: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2213,10 +2230,9 @@ SerialGetOptionProc(
if (valid) {
return TCL_OK;
- } else {
- return Tcl_BadChannelOption(interp, optionName,
- "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
}
+ return Tcl_BadChannelOption(interp, optionName,
+ "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
}
/*
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index f3127d5..1a74354 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -8,8 +8,6 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinSock.c,v 1.75 2010/09/24 17:53:39 andreas_kupries Exp $
- *
* -----------------------------------------------------------------------
*
* General information on how this module works.
@@ -49,6 +47,13 @@
#include "tclWinInt.h"
+/*
+ * Which version of the winsock API do we want?
+ */
+
+#define WSA_VERSION_MAJOR 1
+#define WSA_VERSION_MINOR 1
+
#ifdef _MSC_VER
# pragma comment (lib, "ws2_32")
#endif
@@ -67,7 +72,6 @@
#undef getservbyname
#undef getsockopt
-#undef ntohs
#undef setsockopt
/*
@@ -93,20 +97,44 @@ static ProcessGlobalValue hostName = {
* The following defines declare the messages used on socket windows.
*/
-#define SOCKET_MESSAGE WM_USER+1
-#define SOCKET_SELECT WM_USER+2
-#define SOCKET_TERMINATE WM_USER+3
-#define SELECT TRUE
-#define UNSELECT FALSE
+#define SOCKET_MESSAGE WM_USER+1
+#define SOCKET_SELECT WM_USER+2
+#define SOCKET_TERMINATE WM_USER+3
+#define SELECT TRUE
+#define UNSELECT FALSE
+
+/*
+ * This is needed to comply with the strict aliasing rules of GCC, but it also
+ * simplifies casting between the different sockaddr types.
+ */
+
+typedef union {
+ struct sockaddr sa;
+ struct sockaddr_in sa4;
+ struct sockaddr_in6 sa6;
+ struct sockaddr_storage sas;
+} address;
+
+#ifndef IN6_ARE_ADDR_EQUAL
+#define IN6_ARE_ADDR_EQUAL IN6_ADDR_EQUAL
+#endif
+
+typedef struct SocketInfo SocketInfo;
+
+typedef struct TcpFdList {
+ SocketInfo *infoPtr;
+ SOCKET fd;
+ struct TcpFdList *next;
+} TcpFdList;
/*
* The following structure is used to store the data associated with each
* socket.
*/
-typedef struct SocketInfo {
+struct SocketInfo {
Tcl_Channel channel; /* Channel associated with this socket. */
- SOCKET socket; /* Windows SOCKET handle. */
+ struct TcpFdList *sockets; /* Windows SOCKET handle. */
int flags; /* Bit field comprised of the flags described
* below. */
int watchEvents; /* OR'ed combination of FD_READ, FD_WRITE,
@@ -127,14 +155,14 @@ typedef struct SocketInfo {
int lastError; /* Error code from last message. */
struct SocketInfo *nextPtr; /* The next socket on the per-thread socket
* list. */
-} SocketInfo;
+};
/*
* The following structure is what is added to the Tcl event queue when a
* socket event occurs.
*/
-typedef struct SocketEvent {
+typedef struct {
Tcl_Event header; /* Information that is standard for all
* events. */
SOCKET socket; /* Socket descriptor that is ready. Used to
@@ -162,7 +190,7 @@ typedef struct SocketEvent {
#define SOCKET_PENDING (1<<3) /* A message has been sent for this
* socket */
-typedef struct ThreadSpecificData {
+typedef struct {
HWND hwnd; /* Handle to window for socket messages. */
HANDLE socketThread; /* Thread handling the window */
Tcl_ThreadId threadId; /* Parent thread. */
@@ -185,15 +213,13 @@ static WNDCLASS windowClass;
static SocketInfo * CreateSocket(Tcl_Interp *interp, int port,
const char *host, int server, const char *myaddr,
int myport, int async);
-static int CreateSocketAddress(LPSOCKADDR_IN sockaddrPtr,
- const char *host, int port);
static void InitSockets(void);
static SocketInfo * NewSocketInfo(SOCKET socket);
static void SocketExitHandler(ClientData clientData);
static LRESULT CALLBACK SocketProc(HWND hwnd, UINT message, WPARAM wParam,
LPARAM lParam);
static int SocketsEnabled(void);
-static void TcpAccept(SocketInfo *infoPtr);
+static void TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
static int WaitForSocketEvent(SocketInfo *infoPtr, int events,
int *errorCodePtr);
static DWORD WINAPI SocketThread(LPVOID arg);
@@ -261,11 +287,9 @@ static const Tcl_ChannelType tcpChannelType = {
static void
InitSockets(void)
{
- DWORD id;
+ DWORD id, err;
WSADATA wsaData;
- DWORD err;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
if (!initialized) {
initialized = 1;
@@ -300,72 +324,73 @@ InitSockets(void)
* that it not be less than 1.1.
*/
-#define WSA_VERSION_MAJOR 1
-#define WSA_VERSION_MINOR 1
-#define WSA_VERSION_REQD MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR)
-
- err = WSAStartup((WORD)WSA_VERSION_REQD, &wsaData);
+ err = WSAStartup((WORD) MAKEWORD(WSA_VERSION_MAJOR,WSA_VERSION_MINOR),
+ &wsaData);
if (err != 0) {
- TclWinConvertWSAError(err);
+ TclWinConvertError(err);
goto initFailure;
}
/*
- * Note the byte positions are swapped for the comparison, so that
- * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1).
- * We want the comparison to be 0x0200 < 0x0101.
+ * Note the byte positions ae swapped for the comparison, so that
+ * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1). We
+ * want the comparison to be 0x0200 < 0x0101.
*/
if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
- TclWinConvertWSAError(WSAVERNOTSUPPORTED);
+ TclWinConvertError(WSAVERNOTSUPPORTED);
WSACleanup();
goto initFailure;
}
-
-#undef WSA_VERSION_REQD
-#undef WSA_VERSION_MAJOR
-#undef WSA_VERSION_MINOR
}
/*
* Check for per-thread initialization.
*/
- if (tsdPtr == NULL) {
- tsdPtr = TCL_TSD_INIT(&dataKey);
- tsdPtr->socketList = NULL;
- tsdPtr->hwnd = NULL;
- tsdPtr->threadId = Tcl_GetCurrentThread();
- tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
- if (tsdPtr->readyEvent == NULL) {
- goto initFailure;
- }
- tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
- if (tsdPtr->socketListLock == NULL) {
- goto initFailure;
- }
- tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr,
- 0, &id);
- if (tsdPtr->socketThread == NULL) {
- goto initFailure;
- }
+ if (tsdPtr != NULL) {
+ return;
+ }
- SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
+ /*
+ * OK, this thread has never done anything with sockets before. Construct
+ * a worker thread to handle asynchronous events related to sockets
+ * assigned to _this_ thread.
+ */
- /*
- * Wait for the thread to signal when the window has been created and
- * if it is ready to go.
- */
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->socketList = NULL;
+ tsdPtr->hwnd = NULL;
+ tsdPtr->threadId = Tcl_GetCurrentThread();
+ tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
+ if (tsdPtr->readyEvent == NULL) {
+ goto initFailure;
+ }
+ tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
+ if (tsdPtr->socketListLock == NULL) {
+ goto initFailure;
+ }
+ tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0,
+ &id);
+ if (tsdPtr->socketThread == NULL) {
+ goto initFailure;
+ }
- WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
+ SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
- if (tsdPtr->hwnd == NULL) {
- goto initFailure; /* Trouble creating the window */
- }
+ /*
+ * Wait for the thread to signal when the window has been created and if
+ * it is ready to go.
+ */
+
+ WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
- Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
+ if (tsdPtr->hwnd == NULL) {
+ goto initFailure; /* Trouble creating the window. */
}
+
+ Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
return;
initFailure:
@@ -395,6 +420,7 @@ static int
SocketsEnabled(void)
{
int enabled;
+
Tcl_MutexLock(&socketMutex);
enabled = (initialized == 1);
Tcl_MutexUnlock(&socketMutex);
@@ -425,6 +451,7 @@ SocketExitHandler(
ClientData clientData) /* Not used. */
{
Tcl_MutexLock(&socketMutex);
+
/*
* Make sure the socket event handling window is cleaned-up for, at
* most, this thread.
@@ -459,35 +486,40 @@ SocketExitHandler(
void
TclpFinalizeSockets(void)
{
- ThreadSpecificData *tsdPtr;
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
- tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
- if (tsdPtr != NULL) {
- if (tsdPtr->socketThread != NULL) {
- if (tsdPtr->hwnd != NULL) {
- PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);
+ /*
+ * Careful! This is a finalizer!
+ */
- /*
- * Wait for the thread to exit. This ensures that we are
- * completely cleaned up before we leave this function.
- */
+ if (tsdPtr == NULL) {
+ return;
+ }
- WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
- tsdPtr->hwnd = NULL;
- }
- CloseHandle(tsdPtr->socketThread);
- tsdPtr->socketThread = NULL;
- }
- if (tsdPtr->readyEvent != NULL) {
- CloseHandle(tsdPtr->readyEvent);
- tsdPtr->readyEvent = NULL;
- }
- if (tsdPtr->socketListLock != NULL) {
- CloseHandle(tsdPtr->socketListLock);
- tsdPtr->socketListLock = NULL;
+ if (tsdPtr->socketThread != NULL) {
+ if (tsdPtr->hwnd != NULL) {
+ PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);
+
+ /*
+ * Wait for the thread to exit. This ensures that we are
+ * completely cleaned up before we leave this function.
+ */
+
+ WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
+ tsdPtr->hwnd = NULL;
}
- Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
+ CloseHandle(tsdPtr->socketThread);
+ tsdPtr->socketThread = NULL;
+ }
+ if (tsdPtr->readyEvent != NULL) {
+ CloseHandle(tsdPtr->readyEvent);
+ tsdPtr->readyEvent = NULL;
+ }
+ if (tsdPtr->socketListLock != NULL) {
+ CloseHandle(tsdPtr->socketListLock);
+ tsdPtr->socketListLock = NULL;
}
+ Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
}
/*
@@ -525,8 +557,8 @@ TclpHasSockets(
return TCL_OK;
}
if (interp != NULL) {
- Tcl_AppendResult(interp, "sockets are not available on this system",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "sockets are not available on this system", -1));
}
return TCL_ERROR;
}
@@ -618,9 +650,9 @@ SocketCheckProc(
if ((infoPtr->readyEvents & infoPtr->watchEvents)
&& !(infoPtr->flags & SOCKET_PENDING)) {
infoPtr->flags |= SOCKET_PENDING;
- evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent));
+ evPtr = ckalloc(sizeof(SocketEvent));
evPtr->header.proc = SocketEventProc;
- evPtr->socket = infoPtr->socket;
+ evPtr->socket = infoPtr->sockets->fd;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
}
}
@@ -656,9 +688,12 @@ SocketEventProc(
{
SocketInfo *infoPtr;
SocketEvent *eventPtr = (SocketEvent *) evPtr;
- int mask = 0;
- int events;
+ int mask = 0, events;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ TcpFdList *fds;
+ SOCKET newSocket;
+ address addr;
+ int len;
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
@@ -671,17 +706,17 @@ SocketEventProc(
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
- if (infoPtr->socket == eventPtr->socket) {
+ if (infoPtr->sockets->fd == eventPtr->socket) {
break;
}
}
- SetEvent(tsdPtr->socketListLock);
/*
* Discard events that have gone stale.
*/
if (!infoPtr) {
+ SetEvent(tsdPtr->socketListLock);
return 1;
}
@@ -692,10 +727,66 @@ SocketEventProc(
*/
if (infoPtr->readyEvents & FD_ACCEPT) {
- TcpAccept(infoPtr);
+ for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+
+ /*
+ * Accept the incoming connection request.
+ */
+ len = sizeof(address);
+
+ newSocket = accept(fds->fd, &(addr.sa), &len);
+
+ /* On Tcl server sockets with multiple OS fds we loop over the fds trying
+ * an accept() on each, so we expect INVALID_SOCKET. There are also other
+ * network stack conditions that can result in FD_ACCEPT but a subsequent
+ * failure on accept() by the time we get around to it.
+ * Access to sockets (acceptEventCount, readyEvents) in socketList
+ * is still protected by the lock (prevents reintroduction of
+ * SF Tcl Bug 3056775.
+ */
+
+ if (newSocket == INVALID_SOCKET) {
+ /* int err = WSAGetLastError(); */
+ continue;
+ }
+
+ /*
+ * It is possible that more than one FD_ACCEPT has been sent, so an extra
+ * count must be kept. Decrement the count, and reset the readyEvent bit
+ * if the count is no longer > 0.
+ */
+ infoPtr->acceptEventCount--;
+
+ if (infoPtr->acceptEventCount <= 0) {
+ infoPtr->readyEvents &= ~(FD_ACCEPT);
+ }
+
+ SetEvent(tsdPtr->socketListLock);
+
+ /* Caution: TcpAccept() has the side-effect of evaluating the server
+ * accept script (via AcceptCallbackProc() in tclIOCmd.c), which can
+ * close the server socket and invalidate infoPtr and fds.
+ * If TcpAccept() accepts a socket we must return immediately and let
+ * SocketCheckProc queue additional FD_ACCEPT events.
+ */
+ TcpAccept(fds, newSocket, addr);
+ return 1;
+ }
+
+ /* Loop terminated with no sockets accepted; clear the ready mask so
+ * we can detect the next connection request. Note that connection
+ * requests are level triggered, so if there is a request already
+ * pending, a new event will be generated.
+ */
+ infoPtr->acceptEventCount = 0;
+ infoPtr->readyEvents &= ~(FD_ACCEPT);
+
+ SetEvent(tsdPtr->socketListLock);
return 1;
}
+ SetEvent(tsdPtr->socketListLock);
+
/*
* Mask off unwanted events and compute the read/write mask so we can
* notify the channel.
@@ -715,6 +806,7 @@ SocketEventProc(
*/
Tcl_Time blockTime = { 0, 0 };
+
Tcl_SetMaxBlockTime(&blockTime);
mask |= TCL_READABLE|TCL_WRITABLE;
} else if (events & FD_READ) {
@@ -733,7 +825,7 @@ SocketEventProc(
(WPARAM) UNSELECT, (LPARAM) infoPtr);
FD_ZERO(&readFds);
- FD_SET(infoPtr->socket, &readFds);
+ FD_SET(infoPtr->sockets->fd, &readFds);
timeout.tv_usec = 0;
timeout.tv_sec = 0;
@@ -784,7 +876,7 @@ TcpBlockProc(
int mode) /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ SocketInfo *infoPtr = instanceData;
if (mode == TCL_MODE_NONBLOCKING) {
infoPtr->flags |= SOCKET_ASYNC;
@@ -818,7 +910,7 @@ TcpCloseProc(
ClientData instanceData, /* The socket to close. */
Tcl_Interp *interp) /* Unused. */
{
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ SocketInfo *infoPtr = instanceData;
/* TIP #218 */
int errorCode = 0;
/* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
@@ -836,9 +928,15 @@ TcpCloseProc(
* background.
*/
- if (closesocket(infoPtr->socket) == SOCKET_ERROR) {
- TclWinConvertWSAError((DWORD) WSAGetLastError());
- errorCode = Tcl_GetErrno();
+ while ( infoPtr->sockets != NULL ) {
+ TcpFdList *thisfd = infoPtr->sockets;
+ infoPtr->sockets = thisfd->next;
+
+ if (closesocket(thisfd->fd) == SOCKET_ERROR) {
+ TclWinConvertError((DWORD) WSAGetLastError());
+ errorCode = Tcl_GetErrno();
+ }
+ ckfree(thisfd);
}
}
@@ -849,7 +947,7 @@ TcpCloseProc(
* fear of damaging the list.
*/
- ckfree((char *) infoPtr);
+ ckfree(infoPtr);
return errorCode;
}
@@ -876,29 +974,32 @@ TcpClose2Proc(
Tcl_Interp *interp, /* For error reporting. */
int flags) /* Flags that indicate which side to close. */
{
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
- int errorCode = 0;
- int sd;
+ SocketInfo *infoPtr = instanceData;
+ int errorCode = 0, sd;
/*
* Shutdown the OS socket handle.
*/
- switch(flags)
- {
- case TCL_CLOSE_READ:
- sd=SD_RECEIVE;
- break;
- case TCL_CLOSE_WRITE:
- sd=SD_SEND;
- break;
- default:
- if (interp) {
- Tcl_AppendResult(interp, "Socket close2proc called bidirectionally", NULL);
- }
- return TCL_ERROR;
+
+ switch (flags) {
+ case TCL_CLOSE_READ:
+ sd = SD_RECEIVE;
+ break;
+ case TCL_CLOSE_WRITE:
+ sd = SD_SEND;
+ break;
+ default:
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Socket close2proc called bidirectionally", -1));
}
- if (shutdown(infoPtr->socket,sd) == SOCKET_ERROR) {
- TclWinConvertWSAError((DWORD) WSAGetLastError());
+ return TCL_ERROR;
+ }
+
+ /* single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or
+ * TCL_WRITABLE so this should never be called for a server socket. */
+ if (shutdown(infoPtr->sockets->fd, sd) == SOCKET_ERROR) {
+ TclWinConvertError((DWORD) WSAGetLastError());
errorCode = Tcl_GetErrno();
}
@@ -908,6 +1009,51 @@ TcpClose2Proc(
/*
*----------------------------------------------------------------------
*
+ * AddSocketInfoFd --
+ *
+ * This function adds a SOCKET file descriptor to the 'sockets' linked
+ * list of a SocketInfo structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None, except for allocation of memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AddSocketInfoFd(
+ SocketInfo *infoPtr,
+ SOCKET socket)
+{
+ TcpFdList *fds = infoPtr->sockets;
+
+ if ( fds == NULL ) {
+ /* Add the first FD */
+ infoPtr->sockets = ckalloc(sizeof(TcpFdList));
+ fds = infoPtr->sockets;
+ } else {
+ /* Find end of list and append FD */
+ while ( fds->next != NULL ) {
+ fds = fds->next;
+ }
+
+ fds->next = ckalloc(sizeof(TcpFdList));
+ fds = fds->next;
+ }
+
+ /* Populate new FD */
+ fds->fd = socket;
+ fds->infoPtr = infoPtr;
+ fds->next = NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
* NewSocketInfo --
*
* This function allocates and initializes a new SocketInfo structure.
@@ -925,12 +1071,11 @@ static SocketInfo *
NewSocketInfo(
SOCKET socket)
{
- SocketInfo *infoPtr;
- /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
+ SocketInfo *infoPtr = ckalloc(sizeof(SocketInfo));
- infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
+ /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
infoPtr->channel = 0;
- infoPtr->socket = socket;
+ infoPtr->sockets = NULL;
infoPtr->flags = 0;
infoPtr->watchEvents = 0;
infoPtr->readyEvents = 0;
@@ -948,6 +1093,8 @@ NewSocketInfo(
infoPtr->nextPtr = NULL;
+ AddSocketInfoFd(infoPtr, socket);
+
return infoPtr;
}
@@ -983,12 +1130,15 @@ CreateSocket(
u_long flag = 1; /* Indicates nonblocking mode. */
int asyncConnect = 0; /* Will be 1 if async connect is in
* progress. */
- SOCKADDR_IN sockaddr; /* Socket address */
- SOCKADDR_IN mysockaddr; /* Socket address for client */
+ unsigned short chosenport = 0;
+ struct addrinfo *addrlist = NULL, *addrPtr;
+ /* Socket address to connect to. */
+ struct addrinfo *myaddrlist = NULL, *myaddrPtr;
+ /* Socket address for our side. */
+ const char *errorMsg = NULL;
SOCKET sock = INVALID_SOCKET;
- SocketInfo *infoPtr; /* The returned value. */
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ SocketInfo *infoPtr = NULL; /* The returned value. */
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
/*
* Check that WinSock is initialized; do not call it if not, to prevent
@@ -1000,112 +1150,195 @@ CreateSocket(
return NULL;
}
- if (!CreateSocketAddress(&sockaddr, host, port)) {
- goto error;
- }
- if ((myaddr != NULL || myport != 0) &&
- !CreateSocketAddress(&mysockaddr, myaddr, myport)) {
+ /*
+ * Construct the addresses for each end of the socket.
+ */
+
+ if (!TclCreateSocketAddress(interp, &addrlist, host, port, server,
+ &errorMsg)) {
goto error;
}
-
- sock = socket(AF_INET, SOCK_STREAM, 0);
- if (sock == INVALID_SOCKET) {
+ if (!TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
+ &errorMsg)) {
goto error;
}
- /*
- * Win-NT has a misfeature that sockets are inherited in child processes
- * by default. Turn off the inherit bit.
- */
+ if (server) {
- SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
+ for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
+ sock = socket(addrPtr->ai_family, SOCK_STREAM, 0);
+ if (sock == INVALID_SOCKET) {
+ TclWinConvertError((DWORD) WSAGetLastError());
+ continue;
+ }
- /*
- * Set kernel space buffering
- */
+ /*
+ * Win-NT has a misfeature that sockets are inherited in child
+ * processes by default. Turn off the inherit bit.
+ */
- TclSockMinimumBuffers((int) sock, TCP_BUFFER_SIZE);
+ SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
- if (server) {
- /*
- * Bind to the specified port. Note that we must not call setsockopt
- * with SO_REUSEADDR because Microsoft allows addresses to be reused
- * even if they are still in use.
- *
- * Bind should not be affected by the socket having already been set
- * into nonblocking mode. If there is trouble, this is one place to
- * look for bugs.
- */
+ /*
+ * Set kernel space buffering
+ */
- if (bind(sock, (SOCKADDR *) &sockaddr, sizeof(SOCKADDR_IN))
- == SOCKET_ERROR) {
- goto error;
- }
+ TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
- /*
- * Set the maximum number of pending connect requests to the max value
- * allowed on each platform (Win32 and Win32s may be different, and
- * there may be differences between TCP/IP stacks).
- */
+ /*
+ * Make sure we use the same port when opening two server sockets
+ * for IPv4 and IPv6.
+ *
+ * As sockaddr_in6 uses the same offset and size for the port
+ * member as sockaddr_in, we can handle both through the IPv4 API.
+ */
- if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
- goto error;
- }
+ if (port == 0 && chosenport != 0) {
+ ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
+ htons(chosenport);
+ }
- /*
- * Add this socket to the global list of sockets.
- */
+ /*
+ * Bind to the specified port. Note that we must not call
+ * setsockopt with SO_REUSEADDR because Microsoft allows addresses
+ * to be reused even if they are still in use.
+ *
+ * Bind should not be affected by the socket having already been
+ * set into nonblocking mode. If there is trouble, this is one
+ * place to look for bugs.
+ */
- infoPtr = NewSocketInfo(sock);
+ if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
+ == SOCKET_ERROR) {
+ TclWinConvertError((DWORD) WSAGetLastError());
+ closesocket(sock);
+ continue;
+ }
+ if (port == 0 && chosenport == 0) {
+ address sockname;
+ socklen_t namelen = sizeof(sockname);
- /*
- * Set up the select mask for connection request events.
- */
+ /*
+ * Synchronize port numbers when binding to port 0 of multiple
+ * addresses.
+ */
- infoPtr->selectEvents = FD_ACCEPT;
- infoPtr->watchEvents |= FD_ACCEPT;
+ if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
+ chosenport = ntohs(sockname.sa4.sin_port);
+ }
+ }
- } else {
- /*
- * Try to bind to a local port, if specified.
- */
+ /*
+ * Set the maximum number of pending connect requests to the max
+ * value allowed on each platform (Win32 and Win32s may be
+ * different, and there may be differences between TCP/IP stacks).
+ */
- if (myaddr != NULL || myport != 0) {
- if (bind(sock, (SOCKADDR *) &mysockaddr, sizeof(SOCKADDR_IN))
- == SOCKET_ERROR) {
- goto error;
+ if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
+ TclWinConvertError((DWORD) WSAGetLastError());
+ closesocket(sock);
+ continue;
}
- }
- /*
- * Set the socket into nonblocking mode if the connect should be done
- * in the background.
- */
+ if (infoPtr == NULL) {
+ /*
+ * Add this socket to the global list of sockets.
+ */
+
+ infoPtr = NewSocketInfo(sock);
+
+ /*
+ * Set up the select mask for connection request events.
+ */
- if (async) {
- if (ioctlsocket(sock, (long) FIONBIO, &flag) == SOCKET_ERROR) {
- goto error;
+ infoPtr->selectEvents = FD_ACCEPT;
+ infoPtr->watchEvents |= FD_ACCEPT;
+
+ } else {
+ AddSocketInfoFd( infoPtr, sock );
}
}
+ } else {
+ for (addrPtr = addrlist; addrPtr != NULL;
+ addrPtr = addrPtr->ai_next) {
+ for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
+ myaddrPtr = myaddrPtr->ai_next) {
+ /*
+ * No need to try combinations of local and remote addresses
+ * of different families.
+ */
- /*
- * Attempt to connect to the remote socket.
- */
+ if (myaddrPtr->ai_family != addrPtr->ai_family) {
+ continue;
+ }
- if (connect(sock, (SOCKADDR *) &sockaddr,
- sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
- TclWinConvertWSAError((DWORD) WSAGetLastError());
- if (Tcl_GetErrno() != EWOULDBLOCK) {
- goto error;
- }
+ sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0);
+ if (sock == INVALID_SOCKET) {
+ TclWinConvertError((DWORD) WSAGetLastError());
+ continue;
+ }
- /*
- * The connection is progressing in the background.
- */
+ /*
+ * Win-NT has a misfeature that sockets are inherited in child
+ * processes by default. Turn off the inherit bit.
+ */
+
+ SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
+
+ /*
+ * Set kernel space buffering
+ */
+
+ TclSockMinimumBuffers((void *) sock, TCP_BUFFER_SIZE);
+
+ /*
+ * Try to bind to a local port.
+ */
+
+ if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen)
+ == SOCKET_ERROR) {
+ TclWinConvertError((DWORD) WSAGetLastError());
+ goto looperror;
+ }
+ /*
+ * Set the socket into nonblocking mode if the connect should
+ * be done in the background.
+ */
+ if (async && ioctlsocket(sock, (long) FIONBIO, &flag)
+ == SOCKET_ERROR) {
+ TclWinConvertError((DWORD) WSAGetLastError());
+ goto looperror;
+ }
+
+ /*
+ * Attempt to connect to the remote socket.
+ */
+
+ if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
+ == SOCKET_ERROR) {
+ TclWinConvertError((DWORD) WSAGetLastError());
+ if (Tcl_GetErrno() != EAGAIN) {
+ goto looperror;
+ }
+
+ /*
+ * The connection is progressing in the background.
+ */
+
+ asyncConnect = 1;
+ }
+ goto connected;
- asyncConnect = 1;
+ looperror:
+ if (sock != INVALID_SOCKET) {
+ closesocket(sock);
+ sock = INVALID_SOCKET;
+ }
+ }
}
+ goto error;
+ connected:
/*
* Add this socket to the global list of sockets.
*/
@@ -1124,22 +1357,33 @@ CreateSocket(
}
}
+ error:
+ if (addrlist == NULL) {
+ freeaddrinfo(addrlist);
+ }
+ if (myaddrlist == NULL) {
+ freeaddrinfo(myaddrlist);
+ }
+
/*
* Register for interest in events in the select mask. Note that this
* automatically places the socket into non-blocking mode.
*/
- ioctlsocket(sock, (long) FIONBIO, &flag);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr);
+ if (infoPtr != NULL) {
+ ioctlsocket(sock, (long) FIONBIO, &flag);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+ (LPARAM) infoPtr);
- return infoPtr;
+ return infoPtr;
+ }
- error:
- TclWinConvertWSAError((DWORD) WSAGetLastError());
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open socket: %s",
+ (errorMsg ? errorMsg : Tcl_PosixError(interp))));
}
+
if (sock != INVALID_SOCKET) {
closesocket(sock);
}
@@ -1149,78 +1393,6 @@ CreateSocket(
/*
*----------------------------------------------------------------------
*
- * CreateSocketAddress --
- *
- * This function initializes a sockaddr structure for a host and port.
- *
- * Results:
- * 1 if the host was valid, 0 if the host could not be converted to an IP
- * address.
- *
- * Side effects:
- * Fills in the *sockaddrPtr structure.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CreateSocketAddress(
- LPSOCKADDR_IN sockaddrPtr, /* Socket address */
- const char *host, /* Host. NULL implies INADDR_ANY */
- int port) /* Port number */
-{
- struct hostent *hostent; /* Host database entry */
- struct in_addr addr; /* For 64/32 bit madness */
-
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
-
- if (!SocketsEnabled()) {
- Tcl_SetErrno(EFAULT);
- return 0;
- }
-
- ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN));
- sockaddrPtr->sin_family = AF_INET;
- sockaddrPtr->sin_port = htons((u_short) (port & 0xFFFF));
- if (host == NULL) {
- addr.s_addr = INADDR_ANY;
- } else {
- addr.s_addr = inet_addr(host);
- if (addr.s_addr == INADDR_NONE) {
- hostent = gethostbyname(host);
- if (hostent != NULL) {
- memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length);
- } else {
-#ifdef EHOSTUNREACH
- Tcl_SetErrno(EHOSTUNREACH);
-#else
-#ifdef ENXIO
- Tcl_SetErrno(ENXIO);
-#endif
-#endif
- return 0; /* Error. */
- }
- }
- }
-
- /*
- * NOTE: On 64 bit machines the assignment below is rumored to not do the
- * right thing. Please report errors related to this if you observe
- * incorrect behavior on 64 bit machines such as DEC Alphas. Should we
- * modify this code to do an explicit memcpy?
- */
-
- sockaddrPtr->sin_addr.s_addr = addr.s_addr;
- return 1; /* Success. */
-}
-
-/*
- *----------------------------------------------------------------------
- *
* WaitForSocketEvent --
*
* Waits until one of the specified events occurs on a socket.
@@ -1243,8 +1415,7 @@ WaitForSocketEvent(
{
int result = 1;
int oldMode;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
/*
* Be sure to disable event servicing so we are truly modal.
@@ -1258,7 +1429,6 @@ WaitForSocketEvent(
SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
(LPARAM) infoPtr);
-
SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
(LPARAM) infoPtr);
@@ -1270,7 +1440,7 @@ WaitForSocketEvent(
} else if (infoPtr->readyEvents & events) {
break;
} else if (infoPtr->flags & SOCKET_ASYNC) {
- *errorCodePtr = EWOULDBLOCK;
+ *errorCodePtr = EAGAIN;
result = 0;
break;
}
@@ -1329,19 +1499,18 @@ Tcl_OpenTcpClient(
return NULL;
}
- wsprintfA(channelName, "sock%d", infoPtr->socket);
+ sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
infoPtr, (TCL_READABLE | TCL_WRITABLE));
- if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation",
- "auto crlf") == TCL_ERROR) {
- Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
- return (Tcl_Channel) NULL;
- }
- if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "")
- == TCL_ERROR) {
- Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
- return (Tcl_Channel) NULL;
+ if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel,
+ "-translation", "auto crlf")) {
+ Tcl_Close(NULL, infoPtr->channel);
+ return NULL;
+ } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel,
+ "-eofchar", "")) {
+ Tcl_Close(NULL, infoPtr->channel);
+ return NULL;
}
return infoPtr->channel;
}
@@ -1376,13 +1545,13 @@ Tcl_MakeTcpClientChannel(
return NULL;
}
- tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ tsdPtr = TclThreadDataKeyGet(&dataKey);
/*
* Set kernel space buffering and non-blocking.
*/
- TclSockMinimumBuffers((int) sock, TCP_BUFFER_SIZE);
+ TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);
infoPtr = NewSocketInfo((SOCKET) sock);
@@ -1391,10 +1560,9 @@ Tcl_MakeTcpClientChannel(
*/
infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) SELECT, (LPARAM) infoPtr);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);
- wsprintfA(channelName, "sock%d", infoPtr->socket);
+ sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
infoPtr, (TCL_READABLE | TCL_WRITABLE));
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
@@ -1447,14 +1615,14 @@ Tcl_OpenTcpServer(
infoPtr->acceptProc = acceptProc;
infoPtr->acceptProcData = acceptProcData;
- wsprintfA(channelName, "sock%d", infoPtr->socket);
+ sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
infoPtr, 0);
if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
- return (Tcl_Channel) NULL;
+ Tcl_Close(NULL, infoPtr->channel);
+ return NULL;
}
return infoPtr->channel;
@@ -1465,8 +1633,9 @@ Tcl_OpenTcpServer(
*
* TcpAccept --
*
- * Accept a TCP socket connection. This is called by SocketEventProc and
- * it in turns calls the registered accept function.
+ * Creates a channel for a newly accepted socket connection. This is
+ * called by SocketEventProc and it in turns calls the registered
+ * accept function.
*
* Results:
* None.
@@ -1479,58 +1648,16 @@ Tcl_OpenTcpServer(
static void
TcpAccept(
- SocketInfo *infoPtr) /* Socket to accept. */
+ TcpFdList *fds, /* Server socket that accepted newSocket. */
+ SOCKET newSocket, /* Newly accepted socket. */
+ address addr) /* Address of new socket. */
{
- SOCKET newSocket;
SocketInfo *newInfoPtr;
- SOCKADDR_IN addr;
- int len;
+ SocketInfo *infoPtr = fds->infoPtr;
+ int len = sizeof(addr);
char channelName[16 + TCL_INTEGER_SPACE];
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
-
- /*
- * Accept the incoming connection request.
- */
-
- len = sizeof(SOCKADDR_IN);
-
- newSocket = accept(infoPtr->socket, (SOCKADDR *)&addr,
- &len);
-
- /*
- * Protect access to sockets (acceptEventCount, readyEvents) in socketList
- * by the lock. Fix for SF Tcl Bug 3056775.
- */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-
- /*
- * Clear the ready mask so we can detect the next connection request. Note
- * that connection requests are level triggered, so if there is a request
- * already pending, a new event will be generated.
- */
-
- if (newSocket == INVALID_SOCKET) {
- infoPtr->acceptEventCount = 0;
- infoPtr->readyEvents &= ~(FD_ACCEPT);
-
- SetEvent(tsdPtr->socketListLock);
- return;
- }
-
- /*
- * It is possible that more than one FD_ACCEPT has been sent, so an extra
- * count must be kept. Decrement the count, and reset the readyEvent bit
- * if the count is no longer > 0.
- */
-
- infoPtr->acceptEventCount--;
-
- if (infoPtr->acceptEventCount <= 0) {
- infoPtr->readyEvents &= ~(FD_ACCEPT);
- }
-
- SetEvent(tsdPtr->socketListLock);
+ char host[NI_MAXHOST], port[NI_MAXSERV];
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
/*
* Win-NT has a misfeature that sockets are inherited in child processes
@@ -1550,20 +1677,20 @@ TcpAccept(
*/
newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) SELECT, (LPARAM) newInfoPtr);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+ (LPARAM) newInfoPtr);
- wsprintfA(channelName, "sock%d", newInfoPtr->socket);
+ sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) newInfoPtr->sockets->fd);
newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
- Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
+ Tcl_Close(NULL, newInfoPtr->channel);
return;
}
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
+ Tcl_Close(NULL, newInfoPtr->channel);
return;
}
@@ -1572,8 +1699,10 @@ TcpAccept(
*/
if (infoPtr->acceptProc != NULL) {
+ getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port),
+ NI_NUMERICHOST|NI_NUMERICSERV);
infoPtr->acceptProc(infoPtr->acceptProcData, newInfoPtr->channel,
- inet_ntoa(addr.sin_addr), ntohs(addr.sin_port));
+ host, atoi(port));
}
}
@@ -1601,11 +1730,10 @@ TcpInputProc(
int toRead, /* Maximum number of bytes to read. */
int *errorCodePtr) /* Where to store error codes. */
{
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ SocketInfo *infoPtr = instanceData;
int bytesRead;
DWORD error;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
*errorCodePtr = 0;
@@ -1649,7 +1777,8 @@ TcpInputProc(
while (1) {
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) UNSELECT, (LPARAM) infoPtr);
- bytesRead = recv(infoPtr->socket, buf, toRead, 0);
+ /* single fd operation: this proc is only called for a connected socket. */
+ bytesRead = recv(infoPtr->sockets->fd, buf, toRead, 0);
infoPtr->readyEvents &= ~(FD_READ);
/*
@@ -1692,7 +1821,7 @@ TcpInputProc(
*/
if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
- TclWinConvertWSAError(error);
+ TclWinConvertError(error);
*errorCodePtr = Tcl_GetErrno();
bytesRead = -1;
break;
@@ -1709,8 +1838,7 @@ TcpInputProc(
}
}
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) SELECT, (LPARAM) infoPtr);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);
return bytesRead;
}
@@ -1739,11 +1867,10 @@ TcpOutputProc(
int toWrite, /* Maximum number of bytes to write. */
int *errorCodePtr) /* Where to store error codes. */
{
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ SocketInfo *infoPtr = instanceData;
int bytesWritten;
DWORD error;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
*errorCodePtr = 0;
@@ -1771,7 +1898,8 @@ TcpOutputProc(
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) UNSELECT, (LPARAM) infoPtr);
- bytesWritten = send(infoPtr->socket, buf, toWrite, 0);
+ /* single fd operation: this proc is only called for a connected socket. */
+ bytesWritten = send(infoPtr->sockets->fd, buf, toWrite, 0);
if (bytesWritten != SOCKET_ERROR) {
/*
* Since Windows won't generate a new write event until we hit an
@@ -1797,12 +1925,12 @@ TcpOutputProc(
if (error == WSAEWOULDBLOCK) {
infoPtr->readyEvents &= ~(FD_WRITE);
if (infoPtr->flags & SOCKET_ASYNC) {
- *errorCodePtr = EWOULDBLOCK;
+ *errorCodePtr = EAGAIN;
bytesWritten = -1;
break;
}
} else {
- TclWinConvertWSAError(error);
+ TclWinConvertError(error);
*errorCodePtr = Tcl_GetErrno();
bytesWritten = -1;
break;
@@ -1819,8 +1947,7 @@ TcpOutputProc(
}
}
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) SELECT, (LPARAM) infoPtr);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);
return bytesWritten;
}
@@ -1848,8 +1975,10 @@ TcpSetOptionProc(
const char *optionName, /* Name of the option to set. */
const char *value) /* New value for option. */
{
- SocketInfo *infoPtr;
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+ SocketInfo *infoPtr = instanceData;
SOCKET sock;
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
/*
* Check that WinSock is initialized; do not call it if not, to prevent
@@ -1859,15 +1988,16 @@ TcpSetOptionProc(
if (!SocketsEnabled()) {
if (interp) {
- Tcl_AppendResult(interp, "winsock is not initialized", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "winsock is not initialized", -1));
}
return TCL_ERROR;
}
- infoPtr = (SocketInfo *) instanceData;
- sock = infoPtr->socket;
-
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+ #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat infoPtr->sockets as single fd or list"
+ sock = infoPtr->sockets->fd;
+
if (!strcasecmp(optionName, "-keepalive")) {
BOOL val = FALSE;
int boolVar, rtn;
@@ -1881,10 +2011,11 @@ TcpSetOptionProc(
rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
(const char *) &val, sizeof(BOOL));
if (rtn != 0) {
- TclWinConvertWSAError(WSAGetLastError());
+ TclWinConvertError(WSAGetLastError());
if (interp) {
- Tcl_AppendResult(interp, "couldn't set socket option: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't set socket option: %s",
+ Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1902,10 +2033,11 @@ TcpSetOptionProc(
rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
(const char *) &val, sizeof(BOOL));
if (rtn != 0) {
- TclWinConvertWSAError(WSAGetLastError());
+ TclWinConvertError(WSAGetLastError());
if (interp) {
- Tcl_AppendResult(interp, "couldn't set socket option: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't set socket option: %s",
+ Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1948,14 +2080,12 @@ TcpGetOptionProc(
Tcl_DString *dsPtr) /* Where to store the computed value;
* initialized by caller. */
{
- SocketInfo *infoPtr;
- SOCKADDR_IN sockname;
- SOCKADDR_IN peername;
- struct hostent *hostEntPtr;
+ SocketInfo *infoPtr = instanceData;
+ char host[NI_MAXHOST], port[NI_MAXSERV];
SOCKET sock;
- int size = sizeof(SOCKADDR_IN);
size_t len = 0;
- char buf[TCL_INTEGER_SPACE];
+ int reverseDNS = 0;
+#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
/*
* Check that WinSock is initialized; do not call it if not, to prevent
@@ -1965,13 +2095,13 @@ TcpGetOptionProc(
if (!SocketsEnabled()) {
if (interp) {
- Tcl_AppendResult(interp, "winsock is not initialized", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "winsock is not initialized", -1));
}
return TCL_ERROR;
}
- infoPtr = (SocketInfo *) instanceData;
- sock = (int) infoPtr->socket;
+ sock = infoPtr->sockets->fd;
if (optionName != NULL) {
len = strlen(optionName);
}
@@ -1983,40 +2113,40 @@ TcpGetOptionProc(
int ret;
optlen = sizeof(int);
- ret = TclWinGetSockOpt((int)sock, SOL_SOCKET, SO_ERROR,
+ ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
(char *)&err, &optlen);
if (ret == SOCKET_ERROR) {
err = WSAGetLastError();
}
if (err) {
- TclWinConvertWSAError(err);
+ TclWinConvertError(err);
Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
}
return TCL_OK;
}
+ if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
+ reverseDNS = NI_NUMERICHOST;
+ }
+
if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
(strncmp(optionName, "-peername", len) == 0))) {
- if (getpeername(sock, (LPSOCKADDR) &peername, &size) == 0) {
+ address peername;
+ socklen_t size = sizeof(peername);
+
+ if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-peername");
Tcl_DStringStartSublist(dsPtr);
}
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
- if (peername.sin_addr.s_addr == 0) {
- hostEntPtr = NULL;
- } else {
- hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr),
- sizeof(peername.sin_addr), AF_INET);
- }
- if (hostEntPtr != NULL) {
- Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
- } else {
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
- }
- TclFormatInt(buf, ntohs(peername.sin_port));
- Tcl_DStringAppendElement(dsPtr, buf);
+ getnameinfo(&(peername.sa), size, host, sizeof(host),
+ NULL, 0, NI_NUMERICHOST);
+ Tcl_DStringAppendElement(dsPtr, host);
+ getnameinfo(&(peername.sa), size, host, sizeof(host),
+ port, sizeof(port), reverseDNS | NI_NUMERICSERV);
+ Tcl_DStringAppendElement(dsPtr, host);
+ Tcl_DStringAppendElement(dsPtr, port);
if (len == 0) {
Tcl_DStringEndSublist(dsPtr);
} else {
@@ -2031,10 +2161,11 @@ TcpGetOptionProc(
*/
if (len) {
- TclWinConvertWSAError((DWORD) WSAGetLastError());
+ TclWinConvertError((DWORD) WSAGetLastError());
if (interp) {
- Tcl_AppendResult(interp, "can't get peername: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get peername: %s",
+ Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2043,25 +2174,53 @@ TcpGetOptionProc(
if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
(strncmp(optionName, "-sockname", len) == 0))) {
- if (getsockname(sock, (LPSOCKADDR) &sockname, &size) == 0) {
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-sockname");
- Tcl_DStringStartSublist(dsPtr);
- }
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
- if (sockname.sin_addr.s_addr == 0) {
- hostEntPtr = NULL;
- } else {
- hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr),
- sizeof(peername.sin_addr), AF_INET);
- }
- if (hostEntPtr != NULL) {
- Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
- } else {
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
+ TcpFdList *fds;
+ address sockname;
+ socklen_t size;
+ int found = 0;
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-sockname");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+ sock = fds->fd;
+ size = sizeof(sockname);
+ if (getsockname(sock, &(sockname.sa), &size) >= 0) {
+ int flags = reverseDNS;
+
+ found = 1;
+ getnameinfo(&sockname.sa, size, host, sizeof(host),
+ NULL, 0, NI_NUMERICHOST);
+ Tcl_DStringAppendElement(dsPtr, host);
+
+ /*
+ * We don't want to resolve INADDR_ANY and sin6addr_any; they
+ * can sometimes cause problems (and never have a name).
+ */
+ flags |= NI_NUMERICSERV;
+ if (sockname.sa.sa_family == AF_INET) {
+ if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) {
+ flags |= NI_NUMERICHOST;
+ }
+ } else if (sockname.sa.sa_family == AF_INET6) {
+ if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr,
+ &in6addr_any)) ||
+ (IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr)
+ && sockname.sa6.sin6_addr.s6_addr[12] == 0
+ && sockname.sa6.sin6_addr.s6_addr[13] == 0
+ && sockname.sa6.sin6_addr.s6_addr[14] == 0
+ && sockname.sa6.sin6_addr.s6_addr[15] == 0)) {
+ flags |= NI_NUMERICHOST;
+ }
+ }
+ getnameinfo(&sockname.sa, size, host, sizeof(host),
+ port, sizeof(port), flags);
+ Tcl_DStringAppendElement(dsPtr, host);
+ Tcl_DStringAppendElement(dsPtr, port);
}
- TclFormatInt(buf, ntohs(sockname.sin_port));
- Tcl_DStringAppendElement(dsPtr, buf);
+ }
+ if (found) {
if (len == 0) {
Tcl_DStringEndSublist(dsPtr);
} else {
@@ -2069,9 +2228,9 @@ TcpGetOptionProc(
}
} else {
if (interp) {
- TclWinConvertWSAError((DWORD) WSAGetLastError());
- Tcl_AppendResult(interp, "can't get sockname: ",
- Tcl_PosixError(interp), NULL);
+ TclWinConvertError((DWORD) WSAGetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get sockname: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2105,8 +2264,7 @@ TcpGetOptionProc(
Tcl_DStringAppendElement(dsPtr, "-nagle");
}
optlen = sizeof(BOOL);
- getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt,
- &optlen);
+ getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen);
if (opt) {
Tcl_DStringAppendElement(dsPtr, "0");
} else {
@@ -2155,11 +2313,11 @@ TcpWatchProc(
* TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION. */
{
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ SocketInfo *infoPtr = instanceData;
/*
* Update the watch events mask. Only if the socket is not a server
- * socket. Fix for SF Tcl Bug #557878.
+ * socket. [Bug 557878]
*/
if (!infoPtr->acceptProc) {
@@ -2178,6 +2336,7 @@ TcpWatchProc(
if (infoPtr->readyEvents & infoPtr->watchEvents) {
Tcl_Time blockTime = { 0, 0 };
+
Tcl_SetMaxBlockTime(&blockTime);
}
}
@@ -2206,9 +2365,9 @@ TcpGetHandleProc(
int direction, /* Not used. */
ClientData *handlePtr) /* Where to store the handle. */
{
- SocketInfo *statePtr = (SocketInfo *) instanceData;
+ SocketInfo *statePtr = instanceData;
- *handlePtr = INT2PTR(statePtr->socket);
+ *handlePtr = INT2PTR(statePtr->sockets->fd);
return TCL_OK;
}
@@ -2233,14 +2392,14 @@ SocketThread(
LPVOID arg)
{
MSG msg;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *) arg;
+ ThreadSpecificData *tsdPtr = arg;
/*
* Create a dummy window receiving socket events.
*/
- tsdPtr->hwnd = CreateWindow(classname, classname,
- WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg);
+ tsdPtr->hwnd = CreateWindow(classname, classname, WS_TILED, 0, 0, 0, 0,
+ NULL, NULL, windowClass.hInstance, arg);
/*
* Signalize thread creator that we are done creating the window.
@@ -2304,6 +2463,7 @@ SocketProc(
int event, error;
SOCKET socket;
SocketInfo *infoPtr;
+ TcpFdList *fds = NULL;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
#ifdef _WIN64
GetWindowLongPtr(hwnd, GWLP_USERDATA);
@@ -2348,58 +2508,60 @@ SocketProc(
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
- if (infoPtr->socket == socket) {
- /*
- * Update the socket state.
- *
- * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
- * happens, then clear the FD_ACCEPT count. Otherwise,
- * increment the count if the current event is an FD_ACCEPT.
- */
-
- if (event & FD_CLOSE) {
- infoPtr->acceptEventCount = 0;
- infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
- } else if (event & FD_ACCEPT) {
- infoPtr->acceptEventCount++;
- }
-
- if (event & FD_CONNECT) {
+ for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+ if (fds->fd == socket) {
/*
- * The socket is now connected, clear the async connect
- * flag.
+ * Update the socket state.
+ *
+ * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
+ * happens, then clear the FD_ACCEPT count. Otherwise,
+ * increment the count if the current event is an FD_ACCEPT.
*/
- infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+ if (event & FD_CLOSE) {
+ infoPtr->acceptEventCount = 0;
+ infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
+ } else if (event & FD_ACCEPT) {
+ infoPtr->acceptEventCount++;
+ }
+
+ if (event & FD_CONNECT) {
+ /*
+ * The socket is now connected, clear the async connect
+ * flag.
+ */
- /*
- * Remember any error that occurred so we can report
- * connection failures.
- */
+ infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
- if (error != ERROR_SUCCESS) {
- TclWinConvertWSAError((DWORD) error);
- infoPtr->lastError = Tcl_GetErrno();
+ /*
+ * Remember any error that occurred so we can report
+ * connection failures.
+ */
+
+ if (error != ERROR_SUCCESS) {
+ TclWinConvertError((DWORD) error);
+ infoPtr->lastError = Tcl_GetErrno();
+ }
}
- }
- if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
- infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
- if (error != ERROR_SUCCESS) {
- TclWinConvertWSAError((DWORD) error);
- infoPtr->lastError = Tcl_GetErrno();
+ if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
+ infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+ if (error != ERROR_SUCCESS) {
+ TclWinConvertError((DWORD) error);
+ infoPtr->lastError = Tcl_GetErrno();
+ }
+ infoPtr->readyEvents |= FD_WRITE;
}
- infoPtr->readyEvents |= FD_WRITE;
- }
- infoPtr->readyEvents |= event;
+ infoPtr->readyEvents |= event;
- /*
- * Wake up the Main Thread.
- */
+ /*
+ * Wake up the Main Thread.
+ */
- SetEvent(tsdPtr->readyEvent);
- Tcl_ThreadAlert(tsdPtr->threadId);
- break;
+ SetEvent(tsdPtr->readyEvent);
+ Tcl_ThreadAlert(tsdPtr->threadId);
+ break;
+ }
}
}
SetEvent(tsdPtr->socketListLock);
@@ -2407,15 +2569,18 @@ SocketProc(
case SOCKET_SELECT:
infoPtr = (SocketInfo *) lParam;
- if (wParam == SELECT) {
- WSAAsyncSelect(infoPtr->socket, hwnd,
- SOCKET_MESSAGE, infoPtr->selectEvents);
- } else {
- /*
- * Clear the selection mask
- */
+ for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+ infoPtr = (SocketInfo *) lParam;
+ if (wParam == SELECT) {
+ WSAAsyncSelect(fds->fd, hwnd,
+ SOCKET_MESSAGE, infoPtr->selectEvents);
+ } else {
+ /*
+ * Clear the selection mask
+ */
- WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0);
+ WSAAsyncSelect(fds->fd, hwnd, 0, 0);
+ }
}
break;
@@ -2485,22 +2650,18 @@ InitializeHostName(
Tcl_DStringInit(&ds);
if (TclpHasSockets(NULL) == TCL_OK) {
/*
- * Buffer length of 255 copied slavishly from previous version of
- * this routine. Presumably there's a more "correct" macro value
- * for a properly sized buffer for a gethostname() call.
- * Maintainers are welcome to supply it.
+ * The buffer size of 256 is recommended by the MSDN page that
+ * documents gethostname() as being always adequate.
*/
Tcl_DString inDs;
Tcl_DStringInit(&inDs);
- Tcl_DStringSetLength(&inDs, 255);
+ Tcl_DStringSetLength(&inDs, 256);
if (gethostname(Tcl_DStringValue(&inDs),
- Tcl_DStringLength(&inDs)) == 0) {
- Tcl_DStringSetLength(&ds, 0);
- } else {
- Tcl_ExternalToUtfDString(NULL,
- Tcl_DStringValue(&inDs), -1, &ds);
+ Tcl_DStringLength(&inDs)) == 0) {
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
+ &ds);
}
Tcl_DStringFree(&inDs);
}
@@ -2508,7 +2669,7 @@ InitializeHostName(
*encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
*lengthPtr = Tcl_DStringLength(&ds);
- *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
+ *valuePtr = ckalloc((*lengthPtr) + 1);
memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
Tcl_DStringFree(&ds);
}
@@ -2534,11 +2695,11 @@ InitializeHostName(
int
TclWinGetSockOpt(
- int s,
+ SOCKET s,
int level,
int optname,
- char * optval,
- int FAR *optlen)
+ char *optval,
+ int *optlen)
{
/*
* Check that WinSock is initialized; do not call it if not, to prevent
@@ -2550,15 +2711,15 @@ TclWinGetSockOpt(
return SOCKET_ERROR;
}
- return getsockopt((SOCKET)s, level, optname, optval, optlen);
+ return getsockopt(s, level, optname, optval, optlen);
}
int
TclWinSetSockOpt(
- int s,
+ SOCKET s,
int level,
int optname,
- const char * optval,
+ const char *optval,
int optlen)
{
/*
@@ -2571,12 +2732,12 @@ TclWinSetSockOpt(
return SOCKET_ERROR;
}
- return setsockopt((SOCKET)s, level, optname, optval, optlen);
+ return setsockopt(s, level, optname, optval, optlen);
}
-u_short
-TclWinNToHS(
- u_short netshort)
+char *
+TclpInetNtoa(
+ struct in_addr addr)
{
/*
* Check that WinSock is initialized; do not call it if not, to prevent
@@ -2585,10 +2746,10 @@ TclWinNToHS(
*/
if (!SocketsEnabled()) {
- return (u_short) -1;
+ return NULL;
}
- return ntohs(netshort);
+ return inet_ntoa(addr);
}
struct servent *
@@ -2631,7 +2792,7 @@ TcpThreadActionProc(
int action)
{
ThreadSpecificData *tsdPtr;
- SocketInfo *infoPtr = (SocketInfo *) instanceData;
+ SocketInfo *infoPtr = instanceData;
int notifyCmd;
if (action == TCL_CHANNEL_THREAD_INSERT) {
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 1a1c9d2..136c4db 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -7,15 +7,7 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinTest.c,v 1.27 2010/08/30 09:19:38 nijtmans Exp $
- */
-
-/* TODO: This file does not compile in UNICODE mode.
- * See [Freq 2965056]: Windows build with -DUNICODE
*/
-#undef UNICODE
-#undef _UNICODE
#ifndef USE_TCL_STUBS
# define USE_TCL_STUBS
@@ -50,8 +42,6 @@ static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp,
static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp,
int objc, Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc TestExceptionCmd;
-static int TestwincpuidCmd(ClientData dummy, Tcl_Interp* interp,
- int objc, Tcl_Obj *const objv[]);
static int TestplatformChmod(const char *nativePath, int pmode);
static int TestchmodCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
@@ -86,7 +76,6 @@ TclplatformtestInit(
Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL);
- Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL);
return TCL_OK;
@@ -302,83 +291,6 @@ TestwinclockCmd(
return TCL_OK;
}
-/*
- *----------------------------------------------------------------------
- *
- * TestwincpuidCmd --
- *
- * Retrieves CPU ID information.
- *
- * Usage:
- * testwincpuid <eax>
- *
- * Parameters:
- * eax - The value to pass in the EAX register to a CPUID instruction.
- *
- * Results:
- * Returns a four-element list containing the values from the EAX, EBX,
- * ECX and EDX registers returned from the CPUID instruction.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestwincpuidCmd(
- ClientData dummy,
- Tcl_Interp* interp, /* Tcl interpreter */
- int objc, /* Parameter count */
- Tcl_Obj *const * objv) /* Parameter vector */
-{
- int status, index, i;
- unsigned int regs[4];
- Tcl_Obj *regsObjs[4];
-
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "eax");
- return TCL_ERROR;
- }
- if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
- return TCL_ERROR;
- }
- status = TclWinCPUID((unsigned) index, regs);
- if (status != TCL_OK) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("operation not available", -1));
- return status;
- }
- for (i=0 ; i<4 ; ++i) {
- regsObjs[i] = Tcl_NewIntObj((int) regs[i]);
- }
- Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestwinsleepCmd --
- *
- * Causes this process to wait for the given number of milliseconds by
- * means of a direct call to Sleep.
- *
- * Usage:
- * testwinsleep <n>
- *
- * Parameters:
- * n - the number of milliseconds to sleep
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sleeps for the requisite number of milliseconds.
- *
- *----------------------------------------------------------------------
- */
-
static int
TestwinsleepCmd(
ClientData clientData, /* Unused */
@@ -438,7 +350,7 @@ TestExceptionCmd(
"invalid_disp", "guard_page", "invalid_handle", "ctrl+c",
NULL
};
- static DWORD exceptions[] = {
+ static const DWORD exceptions[] = {
EXCEPTION_ACCESS_VIOLATION, EXCEPTION_DATATYPE_MISALIGNMENT,
EXCEPTION_ARRAY_BOUNDS_EXCEEDED, EXCEPTION_FLT_DENORMAL_OPERAND,
EXCEPTION_FLT_DIVIDE_BY_ZERO, EXCEPTION_FLT_INEXACT_RESULT,
@@ -486,28 +398,6 @@ TestplatformChmod(
const char *nativePath,
int pmode)
{
- typedef DWORD (WINAPI *getSidLengthRequiredDef)(UCHAR);
- typedef BOOL (WINAPI *initializeSidDef)(PSID, PSID_IDENTIFIER_AUTHORITY,
- BYTE);
- typedef PDWORD (WINAPI *getSidSubAuthorityDef)(PSID, DWORD);
- typedef DWORD (WINAPI *setNamedSecurityInfoADef)(IN LPSTR,
- IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID,
- IN PACL, IN PACL);
- typedef BOOL (WINAPI *getAceDef)(PACL, DWORD, LPVOID *);
- typedef BOOL (WINAPI *addAceDef)(PACL, DWORD, DWORD, LPVOID, DWORD);
- typedef BOOL (WINAPI *equalSidDef)(PSID, PSID);
- typedef BOOL (WINAPI *addAccessDeniedAceDef)(PACL, DWORD, DWORD, PSID);
- typedef BOOL (WINAPI *initializeAclDef)(PACL, DWORD, DWORD);
- typedef DWORD (WINAPI *getLengthSidDef)(PSID);
- typedef BOOL (WINAPI *getAclInformationDef)(PACL, LPVOID, DWORD,
- ACL_INFORMATION_CLASS);
- typedef BOOL (WINAPI *getSecurityDescriptorDaclDef)(PSECURITY_DESCRIPTOR,
- LPBOOL, PACL *, LPBOOL);
- typedef BOOL (WINAPI *lookupAccountNameADef)(LPCSTR, LPCSTR, PSID,
- PDWORD, LPSTR, LPDWORD, PSID_NAME_USE);
- typedef BOOL (WINAPI *getFileSecurityADef)(LPCSTR, SECURITY_INFORMATION,
- PSECURITY_DESCRIPTOR, DWORD, LPDWORD);
-
static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION
| GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE
@@ -518,22 +408,6 @@ TestplatformChmod(
* References to security functions (only available on NT and later).
*/
- static getSidLengthRequiredDef getSidLengthRequiredProc;
- static initializeSidDef initializeSidProc;
- static getSidSubAuthorityDef getSidSubAuthorityProc;
- static setNamedSecurityInfoADef setNamedSecurityInfoProc;
- static getAceDef getAceProc;
- static addAceDef addAceProc;
- static equalSidDef equalSidProc;
- static addAccessDeniedAceDef addAccessDeniedAceProc;
- static initializeAclDef initializeAclProc;
- static getLengthSidDef getLengthSidProc;
- static getAclInformationDef getAclInformationProc;
- static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc;
- static lookupAccountNameADef lookupAccountNameProc;
- static getFileSecurityADef getFileSecurityProc;
- static int initialized = 0;
-
const BOOL set_readOnly = !(pmode & 0222);
BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted;
SID_IDENTIFIER_AUTHORITY userSidAuthority = {
@@ -545,72 +419,14 @@ TestplatformChmod(
PACL curAcl, newAcl = 0;
WORD j;
SID *userSid = 0;
- TCHAR *userDomain = 0;
+ char *userDomain = 0;
int res = 0;
/*
- * One time initialization, dynamically load Windows NT features
- */
-
- if (!initialized) {
- TCL_DECLARE_MUTEX(initializeMutex)
- Tcl_MutexLock(&initializeMutex);
- if (!initialized) {
- HINSTANCE hInstance = LoadLibrary("Advapi32");
-
- if (hInstance != NULL) {
- setNamedSecurityInfoProc = (setNamedSecurityInfoADef)
- GetProcAddress(hInstance, "SetNamedSecurityInfoA");
- getFileSecurityProc = (getFileSecurityADef)
- GetProcAddress(hInstance, "GetFileSecurityA");
- getAceProc = (getAceDef)
- GetProcAddress(hInstance, "GetAce");
- addAceProc = (addAceDef)
- GetProcAddress(hInstance, "AddAce");
- equalSidProc = (equalSidDef)
- GetProcAddress(hInstance, "EqualSid");
- addAccessDeniedAceProc = (addAccessDeniedAceDef)
- GetProcAddress(hInstance, "AddAccessDeniedAce");
- initializeAclProc = (initializeAclDef)
- GetProcAddress(hInstance, "InitializeAcl");
- getLengthSidProc = (getLengthSidDef)
- GetProcAddress(hInstance, "GetLengthSid");
- getAclInformationProc = (getAclInformationDef)
- GetProcAddress(hInstance, "GetAclInformation");
- getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef)
- GetProcAddress(hInstance, "GetSecurityDescriptorDacl");
- lookupAccountNameProc = (lookupAccountNameADef)
- GetProcAddress(hInstance, "LookupAccountNameA");
- getSidLengthRequiredProc = (getSidLengthRequiredDef)
- GetProcAddress(hInstance, "GetSidLengthRequired");
- initializeSidProc = (initializeSidDef)
- GetProcAddress(hInstance, "InitializeSid");
- getSidSubAuthorityProc = (getSidSubAuthorityDef)
- GetProcAddress(hInstance, "GetSidSubAuthority");
-
- if (setNamedSecurityInfoProc && getAceProc && addAceProc
- && equalSidProc && addAccessDeniedAceProc
- && initializeAclProc && getLengthSidProc
- && getAclInformationProc
- && getSecurityDescriptorDaclProc
- && lookupAccountNameProc && getFileSecurityProc
- && getSidLengthRequiredProc && initializeSidProc
- && getSidSubAuthorityProc) {
- initialized = 1;
- }
- }
- if (!initialized) {
- initialized = -1;
- }
- }
- Tcl_MutexUnlock(&initializeMutex);
- }
-
- /*
* Process the chmod request.
*/
- attr = GetFileAttributes(nativePath);
+ attr = GetFileAttributesA(nativePath);
/*
* nativePath not found
@@ -622,11 +438,10 @@ TestplatformChmod(
}
/*
- * If no ACL API is present or nativePath is not a directory, there is no
- * special handling.
+ * If nativePath is not a directory, there is no special handling.
*/
- if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) {
+ if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
goto done;
}
@@ -642,15 +457,15 @@ TestplatformChmod(
* obtains the size of the security descriptor.
*/
- if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) {
+ if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {
DWORD secDescLen2 = 0;
if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
goto done;
}
- secDesc = (BYTE *) ckalloc(secDescLen);
- if (!getFileSecurityProc(nativePath, infoBits,
+ secDesc = ckalloc(secDescLen);
+ if (!GetFileSecurityA(nativePath, infoBits,
(PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
|| (secDescLen < secDescLen2)) {
goto done;
@@ -661,22 +476,22 @@ TestplatformChmod(
* Get the World SID.
*/
- userSid = (SID *) ckalloc(getSidLengthRequiredProc((UCHAR) 1));
- initializeSidProc(userSid, &userSidAuthority, (BYTE) 1);
- *(getSidSubAuthorityProc(userSid, 0)) = SECURITY_WORLD_RID;
+ userSid = ckalloc(GetSidLengthRequired((UCHAR) 1));
+ InitializeSid(userSid, &userSidAuthority, (BYTE) 1);
+ *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID;
/*
* If curAclPresent == false then curAcl and curAclDefaulted not valid.
*/
- if (!getSecurityDescriptorDaclProc((PSECURITY_DESCRIPTOR) secDesc,
+ if (!GetSecurityDescriptorDacl((PSECURITY_DESCRIPTOR) secDesc,
&curAclPresent, &curAcl, &curAclDefaulted)) {
goto done;
}
if (!curAclPresent || !curAcl) {
ACLSize.AclBytesInUse = 0;
ACLSize.AceCount = 0;
- } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize),
+ } else if (!GetAclInformation(curAcl, &ACLSize, sizeof(ACLSize),
AclSizeInformation)) {
goto done;
}
@@ -686,14 +501,14 @@ TestplatformChmod(
*/
newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
- + getLengthSidProc(userSid) - sizeof(DWORD);
- newAcl = (ACL *) ckalloc(newAclSize);
+ + GetLengthSid(userSid) - sizeof(DWORD);
+ newAcl = ckalloc(newAclSize);
/*
* Initialize the new ACL.
*/
- if (!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) {
+ if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
goto done;
}
@@ -701,7 +516,7 @@ TestplatformChmod(
* Add denied to make readonly, this will be known as a "read-only tag".
*/
- if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION,
+ if (set_readOnly && !AddAccessDeniedAce(newAcl, ACL_REVISION,
readOnlyMask, userSid)) {
goto done;
}
@@ -711,7 +526,7 @@ TestplatformChmod(
LPVOID pACE2;
ACE_HEADER *phACE2;
- if (!getAceProc(curAcl, j, &pACE2)) {
+ if (!GetAce(curAcl, j, &pACE2)) {
goto done;
}
@@ -734,7 +549,7 @@ TestplatformChmod(
ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2;
if (pACEd->Mask == readOnlyMask
- && equalSidProc(userSid, (PSID) &pACEd->SidStart)) {
+ && EqualSid(userSid, (PSID) &pACEd->SidStart)) {
acl_readOnly_found = TRUE;
continue;
}
@@ -744,7 +559,7 @@ TestplatformChmod(
* Copy the current ACE from the old to the new ACL.
*/
- if (!addAceProc(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2,
+ if (!AddAce(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2,
((PACE_HEADER) pACE2)->AceSize)) {
goto done;
}
@@ -754,7 +569,7 @@ TestplatformChmod(
* Apply the new ACL.
*/
- if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc(
+ if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
(LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION,
NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
res = 0;
@@ -762,13 +577,13 @@ TestplatformChmod(
done:
if (secDesc) {
- ckfree((char *) secDesc);
+ ckfree(secDesc);
}
if (newAcl) {
- ckfree((char *) newAcl);
+ ckfree(newAcl);
}
if (userSid) {
- ckfree((char *) userSid);
+ ckfree(userSid);
}
if (userDomain) {
ckfree(userDomain);
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index 7154496..7b0f6f8 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -9,14 +9,21 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinThrd.c,v 1.53 2010/06/16 14:49:51 nijtmans Exp $
*/
#include "tclWinInt.h"
+#include <float.h>
#include <sys/stat.h>
+/* Workaround for mingw versions which don't provide this in float.h */
+#ifndef _MCW_EM
+# define _MCW_EM 0x0008001F /* Error masks */
+# define _MCW_RC 0x00000300 /* Rounding */
+# define _MCW_PC 0x00030000 /* Precision */
+_CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask);
+#endif
+
/*
* This is the master lock used to serialize access to other serialization
* data structures.
@@ -126,6 +133,66 @@ typedef struct allocMutex {
#endif /* USE_THREAD_ALLOC */
/*
+ * The per thread data passed from TclpThreadCreate
+ * to TclWinThreadStart.
+ */
+
+typedef struct WinThread {
+ LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */
+ LPVOID lpParameter; /* Original startup data */
+ unsigned int fpControl; /* Floating point control word from the
+ * main thread */
+} WinThread;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinThreadStart --
+ *
+ * This procedure is the entry point for all new threads created
+ * by Tcl on Windows.
+ *
+ * Results:
+ * Various, depending on the result of the wrapped thread start
+ * routine.
+ *
+ * Side effects:
+ * Arbitrary, since user code is executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD WINAPI
+TclWinThreadStart(
+ LPVOID lpParameter) /* The WinThread structure pointer passed
+ * from TclpThreadCreate */
+{
+ WinThread *winThreadPtr = (WinThread *) lpParameter;
+ unsigned int fpmask;
+ LPTHREAD_START_ROUTINE lpOrigStartAddress;
+ LPVOID lpOrigParameter;
+
+ if (!winThreadPtr) {
+ return TCL_ERROR;
+ }
+
+ fpmask = _MCW_EM | _MCW_RC | _MCW_PC;
+
+#if defined(_MSC_VER) && _MSC_VER >= 1200
+ fpmask |= _MCW_DN;
+#endif
+
+ _controlfp(winThreadPtr->fpControl, fpmask);
+
+ lpOrigStartAddress = winThreadPtr->lpStartAddress;
+ lpOrigParameter = winThreadPtr->lpParameter;
+
+ ckfree((char *)winThreadPtr);
+ return lpOrigStartAddress(lpOrigParameter);
+}
+
+/*
*----------------------------------------------------------------------
*
* TclpThreadCreate --
@@ -151,8 +218,14 @@ TclpThreadCreate(
int flags) /* Flags controlling behaviour of the new
* thread. */
{
+ WinThread *winThreadPtr; /* Per-thread startup info */
HANDLE tHandle;
+ winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread));
+ winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
+ winThreadPtr->lpParameter = clientData;
+ winThreadPtr->fpControl = _controlfp(0, 0);
+
EnterCriticalSection(&joinLock);
*idPtr = 0; /* must initialize as Tcl_Thread is a pointer and
@@ -160,12 +233,12 @@ TclpThreadCreate(
*/
#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
- tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, proc,
- clientData, 0, (unsigned *)idPtr);
+ tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize,
+ (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr,
+ 0, (unsigned *)idPtr);
#else
tHandle = CreateThread(NULL, (DWORD) stackSize,
- (LPTHREAD_START_ROUTINE) proc, (LPVOID) clientData,
- (DWORD) 0, (LPDWORD)idPtr);
+ TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr);
#endif
if (tHandle == NULL) {
@@ -263,7 +336,7 @@ TclpThreadExit(
Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
- return (Tcl_ThreadId) GetCurrentThreadId();
+ return (Tcl_ThreadId)(size_t)GetCurrentThreadId();
}
/*
@@ -505,7 +578,7 @@ Tcl_MutexLock(
*/
if (*mutexPtr == NULL) {
- csPtr = (CRITICAL_SECTION *) ckalloc(sizeof(CRITICAL_SECTION));
+ csPtr = ckalloc(sizeof(CRITICAL_SECTION));
InitializeCriticalSection(csPtr);
*mutexPtr = (Tcl_Mutex)csPtr;
TclRememberMutex(mutexPtr);
@@ -566,7 +639,7 @@ TclpFinalizeMutex(
if (csPtr != NULL) {
DeleteCriticalSection(csPtr);
- ckfree((char *) csPtr);
+ ckfree(csPtr);
*mutexPtr = NULL;
}
}
@@ -648,7 +721,7 @@ Tcl_ConditionWait(
*/
if (*condPtr == NULL) {
- winCondPtr = (WinCondition *) ckalloc(sizeof(WinCondition));
+ winCondPtr = ckalloc(sizeof(WinCondition));
InitializeCriticalSection(&winCondPtr->condLock);
winCondPtr->firstPtr = NULL;
winCondPtr->lastPtr = NULL;
@@ -859,7 +932,7 @@ TclpFinalizeCondition(
if (winCondPtr != NULL) {
DeleteCriticalSection(&winCondPtr->condLock);
- ckfree((char *) winCondPtr);
+ ckfree(winCondPtr);
*condPtr = NULL;
}
}
diff --git a/win/tclWinThrd.h b/win/tclWinThrd.h
deleted file mode 100644
index 2572d1b..0000000
--- a/win/tclWinThrd.h
+++ /dev/null
@@ -1,21 +0,0 @@
-/*
- * tclWinThrd.h --
- *
- * This header file defines things for thread support.
- *
- * Copyright (c) 1998 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * SCCS: @(#) tclWinThrd.h 1.2 98/01/27 11:48:05
- */
-
-#ifndef _TCLWINTHRD
-#define _TCLWINTHRD
-
-#ifdef TCL_THREADS
-
-#endif /* TCL_THREADS */
-
-#endif /* _TCLWINTHRD */
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index cf340c7..daa229d 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -8,8 +8,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinTime.c,v 1.37 2010/05/11 14:47:12 nijtmans Exp $
*/
#include "tclInt.h"
@@ -202,35 +200,6 @@ TclpGetClicks(void)
/*
*----------------------------------------------------------------------
*
- * TclpGetTimeZone --
- *
- * Determines the current timezone. The method varies wildly between
- * different Platform implementations, so its hidden in this function.
- *
- * Results:
- * Minutes west of GMT.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpGetTimeZone(
- unsigned long currentTime)
-{
- int timeZone;
-
- tzset();
- timeZone = timezone / 60;
-
- return timeZone;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_GetTime --
*
* Gets the current system time in seconds and microseconds since the
@@ -520,93 +489,6 @@ StopCalibration(
/*
*----------------------------------------------------------------------
*
- * TclpGetTZName --
- *
- * Gets the current timezone string.
- *
- * Results:
- * Returns a pointer to a static string, or NULL on failure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-char *
-TclpGetTZName(
- int dst)
-{
- int len;
- char *zone, *p;
- TIME_ZONE_INFORMATION tz;
- Tcl_Encoding encoding;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- char *name = tsdPtr->tzName;
-
- /*
- * tzset() under Borland doesn't seem to set up tzname[] at all.
- * tzset() under MSVC has the following weird observed behavior:
- * First time we call "clock format [clock seconds] -format %Z -gmt 1"
- * we get "GMT", but on all subsequent calls we get the current time
- * ezone string, even though env(TZ) is GMT and the variable _timezone
- * is 0.
- */
-
- name[0] = '\0';
-
- zone = getenv("TZ");
- if (zone != NULL) {
- /*
- * TZ is of form "NST-4:30NDT", where "NST" would be the name of the
- * standard time zone for this area, "-4:30" is the offset from GMT in
- * hours, and "NDT is the name of the daylight savings time zone in
- * this area. The offset and DST strings are optional.
- */
-
- len = strlen(zone);
- if (len > 3) {
- len = 3;
- }
- if (dst != 0) {
- /*
- * Skip the offset string and get the DST string.
- */
-
- p = zone + len;
- p += strspn(p, "+-:0123456789");
- if (*p != '\0') {
- zone = p;
- len = strlen(zone);
- if (len > 3) {
- len = 3;
- }
- }
- }
- Tcl_ExternalToUtf(NULL, NULL, zone, len, 0, NULL, name,
- sizeof(tsdPtr->tzName), NULL, NULL, NULL);
- }
- if (name[0] == '\0') {
- if (GetTimeZoneInformation(&tz) == TIME_ZONE_ID_UNKNOWN) {
- /*
- * MSDN: On NT this is returned if DST is not used in the current
- * TZ
- */
-
- dst = 0;
- }
- encoding = Tcl_GetEncoding(NULL, "unicode");
- Tcl_ExternalToUtf(NULL, encoding,
- (char *) ((dst) ? tz.DaylightName : tz.StandardName), -1,
- 0, NULL, name, sizeof(tsdPtr->tzName), NULL, NULL, NULL);
- Tcl_FreeEncoding(encoding);
- }
- return name;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclpGetDate --
*
* This function converts between seconds and struct tm. If useGMT is
diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh
index 86959ac..721825b 100644
--- a/win/tclooConfig.sh
+++ b/win/tclooConfig.sh
@@ -8,8 +8,6 @@
# this all out for themselves.
#
# The information in this file is specific to a single platform.
-#
-# RCS: @(#) $Id: tclooConfig.sh,v 1.2 2009/11/27 07:27:53 dkf Exp $
# These are mostly empty because no special steps are ever needed from Tcl 8.6
# onwards; all libraries and include files are just part of Tcl.
@@ -17,5 +15,5 @@ TCLOO_LIB_SPEC=""
TCLOO_STUB_LIB_SPEC=""
TCLOO_INCLUDE_SPEC=""
TCLOO_PRIVATE_INCLUDE_SPEC=""
-TCLOO_CFLAGS=-DUSE_TCLOO_STUBS
-TCLOO_VERSION=0.6.2
+TCLOO_CFLAGS=""
+TCLOO_VERSION=1.0
diff --git a/win/tclsh.rc b/win/tclsh.rc
index dd781da..16eaf83 100644
--- a/win/tclsh.rc
+++ b/win/tclsh.rc
@@ -1,5 +1,3 @@
-// RCS: @(#) $Id: tclsh.rc,v 1.11 2004/02/07 21:47:19 davygrvy Exp $
-//
// Version Resource Script
//